From 0c00fded800e0ece5f235a20240271a388975ad2 Mon Sep 17 00:00:00 2001 From: Eelis van der Weegen Date: Wed, 23 Sep 2009 16:49:48 +0200 Subject: [PATCH] Use consistent layout (in particular indentation) in all proof scripts. --- Liouville/Liouville.v | 383 ++- Liouville/QX_ZX.v | 316 +-- Liouville/QX_extract_roots.v | 240 +- Liouville/QX_root_loc.v | 464 ++-- Liouville/Q_can.v | 146 +- Liouville/RX_deg.v | 214 +- Liouville/RX_div.v | 40 +- Liouville/Zlcm.v | 246 +- Liouville/nat_Q_lists.v | 180 +- algebra/Basics.v | 1097 ++++---- algebra/Bernstein.v | 625 +++-- algebra/CAbGroups.v | 449 ++-- algebra/CAbMonoids.v | 21 +- algebra/CFields.v | 774 +++--- algebra/CGroups.v | 455 ++-- algebra/CHomomorphism_Theorems.v | 262 +- algebra/CIdeals.v | 56 +- algebra/CModule_Homomorphisms.v | 55 +- algebra/CModules.v | 175 +- algebra/CMonoids.v | 1092 ++++---- algebra/COrdAbs.v | 784 +++--- algebra/COrdCauchy.v | 822 +++--- algebra/COrdFields.v | 1577 ++++++------ algebra/COrdFields2.v | 1444 ++++++----- algebra/CPoly_ApZero.v | 745 +++--- algebra/CPoly_Degree.v | 631 ++--- algebra/CPoly_Euclid.v | 118 +- algebra/CPoly_NthCoeff.v | 473 ++-- algebra/CPolynomials.v | 3462 +++++++++++++------------- algebra/CQuotient_Modules.v | 294 +-- algebra/CQuotient_Rings.v | 294 +-- algebra/CRingClass.v | 20 +- algebra/CRing_Homomorphisms.v | 109 +- algebra/CRing_as_Ring.v | 5 +- algebra/CRings.v | 918 +++---- algebra/CSemiGroups.v | 208 +- algebra/CSetoidFun.v | 1014 ++++---- algebra/CSetoidInc.v | 84 +- algebra/CSetoids.v | 583 ++--- algebra/CSums.v | 898 +++---- algebra/CVectorSpace.v | 112 +- algebra/Cauchy_COF.v | 1388 +++++------ algebra/Expon.v | 1057 ++++---- algebra/OperationClasses.v | 16 +- algebra/RSetoid.v | 137 +- algebra/RingClass.v | 28 +- complex/AbsCC.v | 648 +++-- complex/CComplex.v | 515 ++-- complex/Complex_Exponential.v | 330 ++- complex/NRootCC.v | 1521 +++++------ coq_reals/Rreals.v | 570 +++-- coq_reals/Rreals_iso.v | 1372 +++++----- coq_reals/Rsign.v | 4 +- fta/CC_Props.v | 289 ++- fta/CPoly_Contin1.v | 166 +- fta/CPoly_Rev.v | 540 ++-- fta/CPoly_Shift.v | 242 +- fta/FTA.v | 316 ++- fta/FTAreg.v | 800 +++--- fta/KeyLemma.v | 629 ++--- fta/KneserLemma.v | 819 +++--- fta/MainLemma.v | 668 +++-- ftc/COrdLemmas.v | 577 +++-- ftc/CalculusTheorems.v | 1094 ++++---- ftc/Composition.v | 1137 +++++---- ftc/Continuity.v | 1367 +++++----- ftc/Derivative.v | 505 ++-- ftc/DerivativeOps.v | 947 ++++--- ftc/Differentiability.v | 338 +-- ftc/FTC.v | 775 +++--- ftc/FunctSequence.v | 1377 +++++----- ftc/FunctSeries.v | 1030 ++++---- ftc/FunctSums.v | 567 +++-- ftc/Integral.v | 2212 ++++++++-------- ftc/IntegrationRules.v | 470 ++-- ftc/IntervalFunct.v | 83 +- ftc/MoreFunSeries.v | 1084 ++++---- ftc/MoreFunctions.v | 1586 ++++++------ ftc/MoreIntegrals.v | 874 +++---- ftc/MoreIntervals.v | 1234 ++++----- ftc/NthDerivative.v | 920 +++---- ftc/PartFunEquality.v | 407 +-- ftc/PartInterval.v | 183 +- ftc/Partitions.v | 877 +++---- ftc/RefLemma.v | 1128 ++++----- ftc/RefSepRef.v | 1024 ++++---- ftc/RefSeparated.v | 1246 +++++---- ftc/RefSeparating.v | 1971 +++++++-------- ftc/Rolle.v | 934 ++++--- ftc/StrongIVT.v | 792 +++--- ftc/Taylor.v | 599 ++--- ftc/TaylorLemma.v | 1180 +++++---- ftc/WeakIVT.v | 768 +++--- logic/CLogic.v | 1720 +++++++------ logic/Classic.v | 121 +- logic/PropDecid.v | 5 +- metric2/Classification.v | 52 +- metric2/Compact.v | 2321 +++++++++-------- metric2/Complete.v | 1100 ++++---- metric2/CompleteProduct.v | 68 +- metric2/FinEnum.v | 1053 ++++---- metric2/Graph.v | 798 +++--- metric2/Hausdorff.v | 210 +- metric2/Limit.v | 179 +- metric2/Metric.v | 61 +- metric2/Prelength.v | 739 +++--- metric2/ProductMetric.v | 193 +- metric2/StepFunction.v | 912 ++++--- metric2/StepFunctionMonad.v | 396 +-- metric2/StepFunctionSetoid.v | 950 +++---- metric2/UniformContinuity.v | 216 +- metrics/CMetricSpaces.v | 1085 ++++---- metrics/CPMSTheory.v | 1046 ++++---- metrics/CPseudoMSpaces.v | 302 +-- metrics/ContFunctions.v | 883 ++++--- metrics/Equiv.v | 1050 ++++---- metrics/IR_CPMSpace.v | 786 +++--- metrics/LipExt.v | 606 +++-- metrics/Prod_Sub.v | 494 ++-- model/Zmod/Cmod.v | 177 +- model/Zmod/IrrCrit.v | 334 +-- model/Zmod/ZBasics.v | 801 +++--- model/Zmod/ZDivides.v | 1050 ++++---- model/Zmod/ZGcd.v | 1761 ++++++------- model/Zmod/ZMod.v | 737 +++--- model/Zmod/Zm.v | 651 ++--- model/abgroups/CRabgroup.v | 14 +- model/abgroups/QSposabgroup.v | 14 +- model/abgroups/Qabgroup.v | 14 +- model/abgroups/Qposabgroup.v | 13 +- model/abgroups/Zabgroup.v | 16 +- model/fields/CRfield.v | 59 +- model/fields/Qfield.v | 16 +- model/groups/CRgroup.v | 55 +- model/groups/QSposgroup.v | 16 +- model/groups/Qgroup.v | 20 +- model/groups/Qposgroup.v | 12 +- model/groups/Zgroup.v | 22 +- model/metric2/CRmetric.v | 3 +- model/metric2/L1metric.v | 627 +++-- model/metric2/LinfDistMonad.v | 344 ++- model/metric2/LinfMetric.v | 237 +- model/metric2/LinfMetricMonad.v | 413 ++- model/metric2/Qmetric.v | 267 +- model/monoids/CRmonoid.v | 28 +- model/monoids/Nm_to_cycm.v | 145 +- model/monoids/Nm_to_freem.v | 220 +- model/monoids/Nmonoid.v | 40 +- model/monoids/Nposmonoid.v | 38 +- model/monoids/QSposmonoid.v | 30 +- model/monoids/Qmonoid.v | 38 +- model/monoids/Qposmonoid.v | 20 +- model/monoids/Zmonoid.v | 55 +- model/monoids/freem_to_Nm.v | 98 +- model/monoids/twoelemmonoid.v | 317 ++- model/non_examples/N_no_group.v | 48 +- model/non_examples/Npos_no_group.v | 53 +- model/non_examples/Npos_no_monoid.v | 36 +- model/ordfields/CRordfield.v | 118 +- model/ordfields/Qordfield.v | 63 +- model/reals/CRreal.v | 325 ++- model/reals/Cauchy_IR.v | 8 +- model/rings/CRring.v | 130 +- model/rings/Qring.v | 80 +- model/rings/Zring.v | 18 +- model/semigroups/CRsemigroup.v | 42 +- model/semigroups/Npossemigroup.v | 33 +- model/semigroups/Nsemigroup.v | 19 +- model/semigroups/QSpossemigroup.v | 8 +- model/semigroups/Qpossemigroup.v | 8 +- model/semigroups/Qsemigroup.v | 8 +- model/semigroups/Zsemigroup.v | 18 +- model/semigroups/twoelemsemigroup.v | 223 +- model/setoids/CRsetoid.v | 61 +- model/setoids/Nfinsetoid.v | 125 +- model/setoids/Npossetoid.v | 63 +- model/setoids/Nsetoid.v | 281 +-- model/setoids/Qpossetoid.v | 111 +- model/setoids/Qsetoid.v | 109 +- model/setoids/Zfinsetoid.v | 125 +- model/setoids/Zsetoid.v | 115 +- model/setoids/twoelemsetoid.v | 439 ++-- model/structures/Npossec.v | 104 +- model/structures/Nsec.v | 272 +- model/structures/OpenUnit.v | 156 +- model/structures/QposInf.v | 23 +- model/structures/Qpossec.v | 232 +- model/structures/Qsec.v | 1329 +++++----- model/structures/StepQsec.v | 474 ++-- model/structures/Zsec.v | 403 ++- model/totalorder/QMinMax.v | 103 +- model/totalorder/QposMinMax.v | 105 +- model/totalorder/ZMinMax.v | 92 +- order/Lattice.v | 62 +- order/PartialOrder.v | 69 +- order/SemiLattice.v | 112 +- order/TotalOrder.v | 201 +- raster/Raster.v | 227 +- reals/Bridges_LUB.v | 1544 ++++++------ reals/Bridges_iso.v | 1903 +++++++------- reals/CMetricFields.v | 181 +- reals/CPoly_Contin.v | 152 +- reals/CReals.v | 16 +- reals/CReals1.v | 658 ++--- reals/CSumsReals.v | 211 +- reals/CauchySeq.v | 1255 +++++----- reals/Cauchy_CReals.v | 1077 ++++---- reals/Cesaro.v | 251 +- reals/IVT.v | 619 ++--- reals/Intervals.v | 1349 +++++----- reals/Max_AbsIR.v | 1809 +++++++------- reals/NRootIR.v | 1047 ++++---- reals/OddPolyRootIR.v | 290 +-- reals/PosSeq.v | 195 +- reals/Q_dense.v | 925 ++++--- reals/Q_in_CReals.v | 1082 ++++---- reals/R_morphism.v | 351 +-- reals/RealCount.v | 457 ++-- reals/RealFuncts.v | 10 +- reals/RealLists.v | 577 ++--- reals/Series.v | 1967 +++++++-------- reals/fast/CRAlternatingSum.v | 787 +++--- reals/fast/CRArith.v | 245 +- reals/fast/CRFieldOps.v | 1031 ++++---- reals/fast/CRGeometricSum.v | 1295 +++++----- reals/fast/CRGroupOps.v | 731 +++--- reals/fast/CRIR.v | 433 ++-- reals/fast/CRabs.v | 150 +- reals/fast/CRarctan.v | 506 ++-- reals/fast/CRarctan_small.v | 248 +- reals/fast/CRartanh_slow.v | 208 +- reals/fast/CRcorrect.v | 1359 +++++----- reals/fast/CRcos.v | 281 ++- reals/fast/CRexp.v | 1039 ++++---- reals/fast/CRln.v | 551 ++-- reals/fast/CRpi.v | 7 +- reals/fast/CRpi_slow.v | 400 ++- reals/fast/CRpower.v | 338 +-- reals/fast/CRroot.v | 1248 +++++----- reals/fast/CRseries.v | 770 +++--- reals/fast/CRsign.v | 25 +- reals/fast/CRsin.v | 703 +++--- reals/fast/CRsum.v | 261 +- reals/fast/Compress.v | 190 +- reals/fast/ContinuousCorrect.v | 204 +- reals/fast/Integration.v | 1219 +++++---- reals/fast/Interval.v | 728 +++--- reals/fast/LazyNat.v | 24 +- reals/fast/ModulusDerivative.v | 364 ++- reals/fast/MultivariatePolynomials.v | 1956 +++++++-------- reals/fast/Plot.v | 120 +- reals/fast/PowerBound.v | 150 +- reals/fast/RasterQ.v | 293 ++- reals/fast/RasterizeQ.v | 629 +++-- reals/iso_CReals.v | 2567 ++++++++----------- tactics/AlgReflection.v | 110 +- tactics/CornTac.v | 22 +- tactics/DiffTactics1.v | 8 +- tactics/DiffTactics2.v | 203 +- tactics/DiffTactics3.v | 8 +- tactics/FieldReflection.v | 1250 +++++----- tactics/GroupReflection.v | 1029 ++++---- tactics/Rational.v | 16 +- tactics/RingReflection.v | 1031 ++++---- tactics/Step.v | 8 +- tactics/csetoid_rewrite.v | 299 ++- transc/ArTanH.v | 785 +++--- transc/Exponential.v | 1885 +++++++------- transc/InvTrigonom.v | 1928 +++++++------- transc/MoreArcTan.v | 1026 ++++---- transc/Pi.v | 1527 ++++++------ transc/PowerSeries.v | 679 +++-- transc/RealPowers.v | 792 +++--- transc/SinCos.v | 443 ++-- transc/TaylorSeries.v | 881 +++---- transc/TrigMon.v | 1192 +++++---- transc/Trigonometric.v | 1082 ++++---- 277 files changed, 74036 insertions(+), 77059 deletions(-) diff --git a/Liouville/Liouville.v b/Liouville/Liouville.v index e22b5b328..c2c3e5f47 100644 --- a/Liouville/Liouville.v +++ b/Liouville/Liouville.v @@ -43,18 +43,18 @@ Proof. reflexivity. Qed. Lemma Abs_poly_nth_coeff : forall P i, nth_coeff i (AbsPoly P) [=] AbsIR (nth_coeff i P). Proof. -intro P. -pattern P; apply Ccpoly_induc; clear P. + intro P. + pattern P; apply Ccpoly_induc; clear P. intro; rewrite AbsPoly_zero nth_coeff_zero. symmetry; apply AbsIRz_isz. -intros P c Hrec n. -rewrite AbsPoly_linear. -destruct n. + intros P c Hrec n. + rewrite AbsPoly_linear. + destruct n. rewrite coeff_O_lin; reflexivity. -rewrite coeff_Sm_lin. -rewrite Hrec. -apply AbsIR_wd. -symmetry; apply coeff_Sm_lin. + rewrite coeff_Sm_lin. + rewrite Hrec. + apply AbsIR_wd. + symmetry; apply coeff_Sm_lin. Qed. Definition CPoly_bound (P : cpoly_cring IR) : IR := @@ -62,55 +62,55 @@ Definition CPoly_bound (P : cpoly_cring IR) : IR := Lemma AbsIR_leEq : forall a b, a [<=] b -> [--]a [<=] b -> AbsIR a [<=] b. Proof. -intros a b Hp Hm. -unfold AbsIR, ABSIR; simpl. -apply Max_leEq; assumption. + intros a b Hp Hm. + unfold AbsIR, ABSIR; simpl. + apply Max_leEq; assumption. Qed. Lemma abs_max : forall a b x, a [<=] x -> x [<=] b -> AbsIR x [<=] Max (AbsIR a) (AbsIR b). Proof. -intros a b x Ha Hb. -apply AbsIR_leEq. + intros a b x Ha Hb. + apply AbsIR_leEq. apply (leEq_transitive _ _ (AbsIR b)); [|apply rht_leEq_Max]. apply (leEq_transitive _ _ b); [assumption|apply leEq_AbsIR]. -apply (leEq_transitive _ _ (AbsIR a)); [|apply lft_leEq_Max]. -apply (leEq_transitive _ _ ([--]a)). + apply (leEq_transitive _ _ (AbsIR a)); [|apply lft_leEq_Max]. + apply (leEq_transitive _ _ ([--]a)). apply inv_resp_leEq; assumption. -rewrite AbsIR_inv; apply leEq_AbsIR. + rewrite AbsIR_inv; apply leEq_AbsIR. Qed. Lemma Abs_min_max : forall x, I x -> AbsIR x [<=] Max (AbsIR (left_end I I_fin)) (AbsIR (right_end I I_fin)). Proof. -intros x HI; unfold left_end, right_end. -destruct I; try inversion I_fin; destruct HI; apply abs_max; - (apply less_leEq; assumption)|| assumption. + intros x HI; unfold left_end, right_end. + destruct I; try inversion I_fin; destruct HI; apply abs_max; + (apply less_leEq; assumption)|| assumption. Qed. Lemma CPoly_bound_spec : forall x P, I x -> AbsIR (P ! x) [<=] CPoly_bound P. Proof. -intros x P HI. -destruct (Cpoly_ex_degree _ P) as [n Hdeg]. -destruct (Cpoly_ex_degree _ (AbsPoly P)) as [m HdegA]. -unfold CPoly_bound. -set (degree_le_mon _ _ _ _ (le_max_l n m) Hdeg). -set (degree_le_mon _ _ _ _ (le_max_r n m) HdegA). -revert HI d d0; generalize (max n m); clear. -intros n HI HdegP HdegA. -rewrite (poly_as_sum _ _ _ HdegP). -rewrite (poly_as_sum _ _ _ HdegA). -apply (leEq_transitive _ _ (Sum 0 n (fun i => AbsIR (nth_coeff i P[*]x[^]i)))). + intros x P HI. + destruct (Cpoly_ex_degree _ P) as [n Hdeg]. + destruct (Cpoly_ex_degree _ (AbsPoly P)) as [m HdegA]. + unfold CPoly_bound. + set (degree_le_mon _ _ _ _ (le_max_l n m) Hdeg). + set (degree_le_mon _ _ _ _ (le_max_r n m) HdegA). + revert HI d d0; generalize (max n m); clear. + intros n HI HdegP HdegA. + rewrite (poly_as_sum _ _ _ HdegP). + rewrite (poly_as_sum _ _ _ HdegA). + apply (leEq_transitive _ _ (Sum 0 n (fun i => AbsIR (nth_coeff i P[*]x[^]i)))). apply triangle_SumIR. apply le_O_n. -apply Sum_resp_leEq. + apply Sum_resp_leEq. apply le_O_n. -intros i H1 H2. -rewrite AbsIR_resp_mult. -rewrite Abs_poly_nth_coeff. -apply mult_resp_leEq_lft; [|apply AbsIR_nonneg]. -rewrite AbsIR_nexp_op. -apply nexp_resp_leEq; [apply AbsIR_nonneg|]. -apply Abs_min_max; assumption. + intros i H1 H2. + rewrite AbsIR_resp_mult. + rewrite Abs_poly_nth_coeff. + apply mult_resp_leEq_lft; [|apply AbsIR_nonneg]. + rewrite AbsIR_nexp_op. + apply nexp_resp_leEq; [apply AbsIR_nonneg|]. + apply Abs_min_max; assumption. Qed. End CPoly_bounded. @@ -128,20 +128,19 @@ Let Hderiv := Derivative_poly I I_proper P. Lemma poly_law_of_mean : forall a b, I a -> I b -> AbsIR (P ! b [-] P ! a) [<=] C [*] (AbsIR (b [-] a)). Proof. -intros a b Ha Hb. -set (Law_of_the_Mean_Abs_ineq I I_proper (FPoly IR P) (FPoly IR (_D_ P)) Hderiv a b Ha Hb - (CPoly_bound I I_fin (_D_ P))). -simpl in c. -apply c; [|auto|auto]. -clear c; intros x Hcomp Htrue; clear Htrue. -apply CPoly_bound_spec. -destruct Hcomp. -destruct I; simpl in *; try auto; try split; -try (destruct Ha; destruct Hb); -(apply (less_leEq_trans _ _ (MIN a b)); [apply less_Min|]; assumption)|| -(apply (leEq_less_trans _ _ (MAX a b)); [|apply Max_less]; assumption)|| -(apply (leEq_transitive _ _ (MIN a b)); [apply leEq_Min|]; assumption)|| -(apply (leEq_transitive _ _ (MAX a b)); [|apply Max_leEq]; assumption). + intros a b Ha Hb. + set (Law_of_the_Mean_Abs_ineq I I_proper (FPoly IR P) (FPoly IR (_D_ P)) Hderiv a b Ha Hb + (CPoly_bound I I_fin (_D_ P))). + simpl in c. + apply c; [|auto|auto]. + clear c; intros x Hcomp Htrue; clear Htrue. + apply CPoly_bound_spec. + destruct Hcomp. + destruct I; simpl in *; try auto; try split; try (destruct Ha; destruct Hb); + (apply (less_leEq_trans _ _ (MIN a b)); [apply less_Min|]; assumption)|| + (apply (leEq_less_trans _ _ (MAX a b)); [|apply Max_less]; assumption)|| + (apply (leEq_transitive _ _ (MIN a b)); [apply leEq_Min|]; assumption)|| + (apply (leEq_transitive _ _ (MAX a b)); [|apply Max_leEq]; assumption). Qed. End poly_law_of_mean. @@ -154,36 +153,36 @@ Lemma Ia_fin : finite Ia. Proof. simpl; auto. Qed. Lemma Ia_proper : proper Ia. Proof. -simpl. -apply shift_minus_less. -apply (less_wdl _ (a[+]((Zero[+]Zero[+]Zero)[+](Zero[+]Zero[+]Zero)))); [|rational]. -apply (less_wdr _ _ (a[+](Two[+]Two))); [|rational]. -apply plus_resp_less_lft. -apply plus_resp_less_both. + simpl. + apply shift_minus_less. + apply (less_wdl _ (a[+]((Zero[+]Zero[+]Zero)[+](Zero[+]Zero[+]Zero)))); [|rational]. + apply (less_wdr _ _ (a[+](Two[+]Two))); [|rational]. + apply plus_resp_less_lft. + apply plus_resp_less_both. apply plus_resp_less_both; [|apply pos_one]. apply plus_resp_less_lft; apply pos_one. -apply plus_resp_less_both; [|apply pos_one]. -apply plus_resp_less_lft; apply pos_one. + apply plus_resp_less_both; [|apply pos_one]. + apply plus_resp_less_lft; apply pos_one. Qed. Lemma a_in_Ia : Ia a. Proof. -split. + split. apply less_leEq. apply (less_wdr _ _ (a[-](Zero[+]Zero[+]Zero))); [|rational]. apply minus_resp_less_rht. apply plus_resp_less_both; [|apply pos_one]. apply plus_resp_less_lft; apply pos_one. -apply less_leEq. -apply (less_wdl _ (a[+](Zero[+]Zero[+]Zero))); [|rational]. -apply plus_resp_less_lft. -apply plus_resp_less_both; [|apply pos_one]. -apply plus_resp_less_lft; apply pos_one. + apply less_leEq. + apply (less_wdl _ (a[+](Zero[+]Zero[+]Zero))); [|rational]. + apply plus_resp_less_lft. + apply plus_resp_less_both; [|apply pos_one]. + apply plus_resp_less_lft; apply pos_one. Qed. Lemma Liouville_lemma1 : forall x : IR, AbsIR (x[-]a) [<=] Two -> Ia x. Proof. -intros x Hle. -split. + intros x Hle. + split. apply (leEq_wdr _ _ (x[+]Two[-]Two)); [|rational]. apply minus_resp_leEq. apply (leEq_wdl _ (x[+](a[-]x))); [|rational]. @@ -191,12 +190,12 @@ split. rewrite -> AbsIR_minus in Hle. apply (leEq_transitive _ _ (AbsIR (a[-]x))); [|assumption]. apply leEq_AbsIR. -apply (leEq_wdl _ (x[-]Two[+]Two)); [|rational]. -apply plus_resp_leEq. -apply (leEq_wdr _ _ (x[-](x[-]a))); [|rational]. -apply minus_resp_leEq_rht. -apply (leEq_transitive _ _ (AbsIR (x[-]a))); [|assumption]. -apply leEq_AbsIR. + apply (leEq_wdl _ (x[-]Two[+]Two)); [|rational]. + apply plus_resp_leEq. + apply (leEq_wdr _ _ (x[-](x[-]a))); [|rational]. + apply minus_resp_leEq_rht. + apply (leEq_transitive _ _ (AbsIR (x[-]a))); [|assumption]. + apply leEq_AbsIR. Qed. Variable P : cpoly_cring IR. @@ -205,18 +204,18 @@ Let C := CPoly_bound Ia Ia_fin (_D_ P). Lemma Liouville_lemma2 : forall x : IR, AbsIR (x[-]a) [<=] Two -> AbsIR (P ! x [-] P ! a) [<=] C [*] AbsIR (x [-] a). Proof. -intros x Hle. -apply (poly_law_of_mean Ia Ia_fin Ia_proper P a x a_in_Ia (Liouville_lemma1 x Hle)). + intros x Hle. + apply (poly_law_of_mean Ia Ia_fin Ia_proper P a x a_in_Ia (Liouville_lemma1 x Hle)). Qed. Lemma Liouville_lemma3 : forall x : IR, One [<] x or x [<] Two. Proof. -intro x. -apply less_cotransitive_unfolded. -apply (less_wdl _ (Zero[+]Zero[+]One)); [|rational]. -apply plus_resp_less_rht. -apply plus_resp_less_lft. -apply pos_one. + intro x. + apply less_cotransitive_unfolded. + apply (less_wdl _ (Zero[+]Zero[+]One)); [|rational]. + apply plus_resp_less_rht. + apply plus_resp_less_lft. + apply pos_one. Qed. End liouville_lemmas. @@ -229,62 +228,62 @@ Variable P : cpoly_cring Z_as_CRing. Lemma Liouville_lemma4 : forall p : Z_as_CRing, p [#] Zero -> One [<=] AbsIR (inj_Q_rh p). Proof. -intros p Hap. -change (One[<=]AbsIR(inj_Q IR p)). -rewrite AbsIR_Qabs. -unfold Qabs.Qabs. -unfold inject_Z. -rewrite <- inj_Q_One. -apply inj_Q_leEq. -unfold Zabs. -destruct p. - destruct Hap; reflexivity. + intros p Hap. + change (One[<=]AbsIR(inj_Q IR p)). + rewrite AbsIR_Qabs. + unfold Qabs.Qabs. + unfold inject_Z. + rewrite <- inj_Q_One. + apply inj_Q_leEq. + unfold Zabs. + destruct p. + destruct Hap; reflexivity. simpl; unfold Qle; simpl; intuition. -simpl; unfold Qle; simpl; intuition. + simpl; unfold Qle; simpl; intuition. Qed. Lemma Liouville_lemma5 : forall (p : Z_as_CRing) (q : positive), (zx2qx P) ! (p#q)%Q [#] Zero -> One [<=] (inj_Q_rh q)[^](ZX_deg P) [*] AbsIR (inj_Q_rh ((zx2qx P) ! (p#q)%Q)). Proof. -intros p q Hap. -set (n := ZX_deg P). -assert (Zpos q=Zabs q); [reflexivity|]. -rewrite H; clear H. -rewrite <- nexp_ring_hom. -assert (((Zabs q):Q_as_CRing)[^]n [=] Zabs ((q:Z_as_CRing)[^]n)). + intros p q Hap. + set (n := ZX_deg P). + assert (Zpos q=Zabs q); [reflexivity|]. + rewrite H; clear H. + rewrite <- nexp_ring_hom. + assert (((Zabs q):Q_as_CRing)[^]n [=] Zabs ((q:Z_as_CRing)[^]n)). generalize n; clear; induction n; [reflexivity|]. rewrite <- nexp_Sn. rewrite <- nexp_Sn. rewrite Zabs_Zmult. rewrite IHn. reflexivity. -rewrite H; clear H. -rewrite <- (AbsIR_Qabs ((q:Z_as_CRing)[^]n)). -rewrite <- AbsIR_resp_mult. -change (inj_Q IR ((q:Z_as_CRing)[^]n)) with (inj_Q_rh ((q:Z_as_CRing)[^]n)). -rewrite <- rh_pres_mult. -assert (inject_Z ((q:Z_as_CRing)[^]n) [=] (inject_Z (q:Z_as_CRing))[^]n). + rewrite H; clear H. + rewrite <- (AbsIR_Qabs ((q:Z_as_CRing)[^]n)). + rewrite <- AbsIR_resp_mult. + change (inj_Q IR ((q:Z_as_CRing)[^]n)) with (inj_Q_rh ((q:Z_as_CRing)[^]n)). + rewrite <- rh_pres_mult. + assert (inject_Z ((q:Z_as_CRing)[^]n) [=] (inject_Z (q:Z_as_CRing))[^]n). generalize n; clear; induction n; [reflexivity|]. rewrite <- nexp_Sn. rewrite <- nexp_Sn. rewrite <- IHn. reflexivity. -rewrite H; clear H. -set (H:=Q_Z_poly_apply P p q). -cbv zeta in H. -fold ZX_deg in H. -fold n in H. -rewrite H. -apply Liouville_lemma4. -intro. -destruct (ap_imp_neq _ _ _ Hap); clear Hap. -assert ((inject_Z (Zpos q))[^]n [#] Zero). + rewrite H; clear H. + set (H:=Q_Z_poly_apply P p q). + cbv zeta in H. + fold ZX_deg in H. + fold n in H. + rewrite H. + apply Liouville_lemma4. + intro. + destruct (ap_imp_neq _ _ _ Hap); clear Hap. + assert ((inject_Z (Zpos q))[^]n [#] Zero). generalize n; clear; induction n; [discriminate|]. intro; destruct IHn. rewrite <- nexp_Sn in H. destruct (Qmult_integral _ _ H); [discriminate|assumption]. -rewrite -> H0 in H. -apply (mult_eq_zero _ _ _ X); assumption. + rewrite -> H0 in H. + apply (mult_eq_zero _ _ _ X); assumption. Qed. End liouville_lemmas2. @@ -298,36 +297,36 @@ Variable P : cpoly_cring Q_as_CRing. Lemma Liouville_lemma6 : forall (p : Z_as_CRing) (q : positive), P ! (p#q)%Q [#] Zero -> One [<=] (inj_Q_rh q)[^](QX_deg P) [*] AbsIR (inj_Q_rh ((Zlcm_den_poly P:Q_as_CRing)[*]P ! (p#q)%Q)). Proof. -intros p q Hap. -assert ((zx2qx (qx2zx P)) ! (p#q)%Q[#]Zero). + intros p q Hap. + assert ((zx2qx (qx2zx P)) ! (p#q)%Q[#]Zero). case (Q_dec ((zx2qx (qx2zx P)) ! (p#q)%Q) Zero); [|tauto]. intro Heq; destruct (ap_imp_neq _ _ _ Hap); revert Heq. rewrite qx2zx_spec. rewrite mult_apply c_apply. intro Heq. apply (mult_eq_zero _ (Zlcm_den_poly P:Q_as_CField)). - intro Heq2; injection Heq2. - rewrite Zmult_1_r. - apply Zlcm_den_poly_nz. + intro Heq2; injection Heq2. + rewrite Zmult_1_r. + apply Zlcm_den_poly_nz. assumption. -rewrite -> qx2zx_deg; fold ZX_deg. -apply (leEq_wdr _ _ _ _ (Liouville_lemma5 _ _ _ X)); fold ZX_deg. -apply mult_wdr. -apply AbsIR_wd. -apply csf_wd. -rewrite qx2zx_spec. -rewrite mult_apply c_apply; reflexivity. + rewrite -> qx2zx_deg; fold ZX_deg. + apply (leEq_wdr _ _ _ _ (Liouville_lemma5 _ _ _ X)); fold ZX_deg. + apply mult_wdr. + apply AbsIR_wd. + apply csf_wd. + rewrite qx2zx_spec. + rewrite mult_apply c_apply; reflexivity. Qed. Lemma Liouville_lemma7 : forall (p : Z_as_CRing) (q : positive), P ! (p#q)%Q [#] Zero -> One [<=] (inj_Q_rh q)[^](QX_deg P) [*] AbsIR (inj_Q_rh (Zlcm_den_poly P:Q_as_CRing)) [*] AbsIR (inj_Q_rh (P ! (p#q)%Q)). Proof. -intros p q Hap. -apply (leEq_wdr _ _ _ _ (Liouville_lemma6 _ _ Hap)). -rewrite <- mult_assoc. -apply mult_wdr. -rewrite rh_pres_mult. -apply AbsIR_resp_mult. + intros p q Hap. + apply (leEq_wdr _ _ _ _ (Liouville_lemma6 _ _ Hap)). + rewrite <- mult_assoc. + apply mult_wdr. + rewrite rh_pres_mult. + apply AbsIR_resp_mult. Qed. Variable a : IR. @@ -336,26 +335,26 @@ Hypothesis Ha : (inj_QX_rh P) ! a [=] Zero. Lemma Liouville_lemma8 : forall (n : nat) (q : positive), One [<=] (inj_Q_rh q)[^]n. Proof. -intros n q; induction n. + intros n q; induction n. apply leEq_reflexive. -rewrite <- nexp_Sn. -apply (leEq_wdl _ (One[*]One)); [|rational]. -apply mult_resp_leEq_both; [apply less_leEq; apply pos_one|apply less_leEq; apply pos_one| |apply IHn]. -rewrite <- (rh_pres_unit _ _ inj_Q_rh). -apply inj_Q_leEq. -simpl; unfold Qle; simpl; rewrite Pmult_1_r. -unfold Zle; simpl. -case q; intros; discriminate. + rewrite <- nexp_Sn. + apply (leEq_wdl _ (One[*]One)); [|rational]. + apply mult_resp_leEq_both; [apply less_leEq; apply pos_one|apply less_leEq; apply pos_one| |apply IHn]. + rewrite <- (rh_pres_unit _ _ inj_Q_rh). + apply inj_Q_leEq. + simpl; unfold Qle; simpl; rewrite Pmult_1_r. + unfold Zle; simpl. + case q; intros; discriminate. Qed. Lemma Liouville_lemma9 : forall (p : Z_as_CRing) (q : positive), P ! (p#q)%Q [#] Zero -> AbsIR ((inj_Q_rh (p#q)%Q) [-] a) [<=] Two -> One [<=] (inj_Q_rh q)[^](QX_deg P) [*] C [*] AbsIR ((inj_Q_rh (p#q)%Q) [-] a). Proof. -intros p q Hap Hle. -apply (leEq_transitive _ _ _ _ (Liouville_lemma7 _ _ Hap)). -rewrite <- mult_assoc, <- mult_assoc. -apply mult_resp_leEq_lft. + intros p q Hap Hle. + apply (leEq_transitive _ _ _ _ (Liouville_lemma7 _ _ Hap)). + rewrite <- mult_assoc, <- mult_assoc. + apply mult_resp_leEq_lft. unfold C. rewrite <- mult_assoc. apply mult_resp_leEq_lft; [|apply AbsIR_nonneg]. @@ -365,9 +364,9 @@ apply mult_resp_leEq_lft. rewrite cg_inv_zero. unfold inj_QX_rh. rewrite cpoly_map_apply; reflexivity. -set (Liouville_lemma8 (QX_deg P) q). -apply (leEq_transitive _ _ One); [apply less_leEq; apply pos_one|]. -apply Liouville_lemma8. + set (Liouville_lemma8 (QX_deg P) q). + apply (leEq_transitive _ _ One); [apply less_leEq; apply pos_one|]. + apply Liouville_lemma8. Qed. Let C' := Max One C. @@ -376,20 +375,20 @@ Lemma Liouville_lemma10 : forall (p : Z_as_CRing) (q : positive), P ! (p#q)%Q [#] Zero -> One [<=] (inj_Q_rh q)[^](QX_deg P) [*] C' [*] AbsIR ((inj_Q_rh (p#q)%Q) [-] a). Proof. -intros p q Hap. -destruct (Liouville_lemma3 (AbsIR (inj_Q_rh (p # q)%Q[-]a))). + intros p q Hap. + destruct (Liouville_lemma3 (AbsIR (inj_Q_rh (p # q)%Q[-]a))). apply (leEq_transitive _ _ _ _ (less_leEq _ _ _ c)). apply (leEq_wdl _ (One [*] AbsIR (inj_Q_rh (p#q)%Q [-] a))); [|rational]. apply mult_resp_leEq_rht; [|apply AbsIR_nonneg]. apply (leEq_wdl _ (One [*] One)); [|rational]. apply mult_resp_leEq_both; [apply less_leEq; apply pos_one|apply less_leEq; apply pos_one| |apply lft_leEq_Max]. apply Liouville_lemma8. -apply (leEq_transitive _ _ _ _ (Liouville_lemma9 _ _ Hap (less_leEq _ _ _ c))). -apply mult_resp_leEq_rht; [|apply AbsIR_nonneg]. -apply mult_resp_leEq_lft; [|]. + apply (leEq_transitive _ _ _ _ (Liouville_lemma9 _ _ Hap (less_leEq _ _ _ c))). + apply mult_resp_leEq_rht; [|apply AbsIR_nonneg]. + apply mult_resp_leEq_lft; [|]. unfold C'; apply rht_leEq_Max. -apply (leEq_transitive _ _ One); [apply less_leEq; apply pos_one|]. -apply Liouville_lemma8. + apply (leEq_transitive _ _ One); [apply less_leEq; apply pos_one|]. + apply Liouville_lemma8. Qed. End liouville_lemmas3. @@ -405,10 +404,10 @@ Hypothesis a_alg : (inj_QX_rh P) ! a [=] Zero. Let C : IR := Max One (AbsIR (inj_Q_rh (Zlcm_den_poly (QX_extract_roots P):Q_as_CRing)) [*] CPoly_bound (Ia a) (Ia_fin a) (_D_ (inj_QX_rh (QX_extract_roots P)))). Lemma constant_pos : Zero [<] C. Proof. -unfold C. -apply (less_leEq_trans _ _ One). + unfold C. + apply (less_leEq_trans _ _ One). apply pos_one. -apply lft_leEq_Max. + apply lft_leEq_Max. Qed. Lemma constant_nz : C [#] Zero. @@ -422,54 +421,54 @@ Theorem Liouville_theorem : forall (x : Q), (Liouville_constant[*]inj_Q IR (1#Qden x)%Q[^]Liouville_degree) [<=] AbsIR (inj_Q _ x [-] a). Proof. -intro x. -destruct x as [p q]; unfold Qden. -apply (mult_cancel_leEq _ _ _ (inj_Q_rh q[^]Liouville_degree)). + intro x. + destruct x as [p q]; unfold Qden. + apply (mult_cancel_leEq _ _ _ (inj_Q_rh q[^]Liouville_degree)). apply (less_leEq_trans _ _ One); [apply pos_one|]. apply Liouville_lemma8. -assert (H : inj_Q IR (1#q)%Q = inj_Q_rh (1#q)%Q). + assert (H : inj_Q IR (1#q)%Q = inj_Q_rh (1#q)%Q). reflexivity. -rewrite H; clear H. -rewrite <- nexp_ring_hom. -rewrite <- mult_assoc. -rewrite <- nexp_ring_hom. -rewrite <- rh_pres_mult. -assert (H : (1 # q)%Q[^]Liouville_degree[*](inject_Z q)[^]Liouville_degree [=] One). + rewrite H; clear H. + rewrite <- nexp_ring_hom. + rewrite <- mult_assoc. + rewrite <- nexp_ring_hom. + rewrite <- rh_pres_mult. + assert (H : (1 # q)%Q[^]Liouville_degree[*](inject_Z q)[^]Liouville_degree [=] One). rewrite <- mult_nexp. rewrite <- (one_nexp _ Liouville_degree). apply nexp_wd; reflexivity. -rewrite H; clear H. -rewrite rh_pres_unit. -rewrite mult_one. -unfold Liouville_constant. -apply shift_div_leEq'. + rewrite H; clear H. + rewrite rh_pres_unit. + rewrite mult_one. + unfold Liouville_constant. + apply shift_div_leEq'. apply constant_pos. -assert (H : (inj_QX_rh (QX_extract_roots P)) ! a[=]Zero). + assert (H : (inj_QX_rh (QX_extract_roots P)) ! a[=]Zero). apply QX_extract_roots_spec_nrat; assumption. -assert (H1 : (QX_extract_roots P) ! ((p # q)%Q)[#]Zero). + assert (H1 : (QX_extract_roots P) ! ((p # q)%Q)[#]Zero). apply QX_extract_roots_spec_rat; assumption. -apply (leEq_wdr _ _ _ _ (Liouville_lemma10 _ _ H _ _ H1)). -fold C. -rewrite (mult_commutes _ _ C). -rewrite <- mult_assoc. -apply mult_wdr. -rewrite mult_commutes. -apply mult_wdr. -unfold Liouville_degree. -symmetry; apply nexp_ring_hom. + apply (leEq_wdr _ _ _ _ (Liouville_lemma10 _ _ H _ _ H1)). + fold C. + rewrite (mult_commutes _ _ C). + rewrite <- mult_assoc. + apply mult_wdr. + rewrite mult_commutes. + apply mult_wdr. + unfold Liouville_degree. + symmetry; apply nexp_ring_hom. Qed. Theorem Liouville_theorem2 : {n : nat | {C : IR | Zero [<] C | forall (x : Q), (C[*]inj_Q IR (1#Qden x)%Q[^]n) [<=] AbsIR (inj_Q _ x [-] a)}}. Proof. -exists Liouville_degree. -exists Liouville_constant. + exists Liouville_degree. + exists Liouville_constant. unfold Liouville_constant. apply recip_resp_pos. apply constant_pos. -intro x. -apply Liouville_theorem. + intro x. + apply Liouville_theorem. Qed. End liouville_theorem. diff --git a/Liouville/QX_ZX.v b/Liouville/QX_ZX.v index 1757aea08..58c1311b8 100644 --- a/Liouville/QX_ZX.v +++ b/Liouville/QX_ZX.v @@ -52,34 +52,34 @@ Definition QX_normalize (p : QX) : Q_as_CRing := Lemma QX_normalize_spec : forall p : QX, p [#] Zero -> monic (QX_deg p) ((_C_ (QX_normalize p)) [*] p). Proof. -intros p H. -destruct (RX_deg_spec _ Q_dec _ H) as [Hcoeff Hdeg]. -split. + intros p H. + destruct (RX_deg_spec _ Q_dec _ H) as [Hcoeff Hdeg]. + split. rewrite nth_coeff_c_mult_p. unfold QX_normalize. case (dec_Qeq (nth_coeff (QX_deg p) p) Zero). - intro; destruct Hcoeff; assumption. + intro; destruct Hcoeff; assumption. intro Hap. apply (div_1 Q_as_CField). -intros m Hlt; rewrite nth_coeff_c_mult_p. -rewrite (Hdeg m Hlt). -ring. + intros m Hlt; rewrite nth_coeff_c_mult_p. + rewrite (Hdeg m Hlt). + ring. Qed. Definition QX_to_monic (p : QX) : QX := (_C_ (QX_normalize p)) [*] p. Lemma QX_to_monic_spec : forall p : QX, p [#] Zero -> monic (QX_deg p) (QX_to_monic p). Proof. -intros p H. -apply QX_normalize_spec. -assumption. + intros p H. + apply QX_normalize_spec. + assumption. Qed. Lemma QX_to_monic_apply : forall (p : QX) (a : Q), p ! a [=] Zero -> (QX_to_monic p) ! a [=] Zero. Proof. -intros p a Heq. -unfold QX_to_monic; rewrite mult_apply; rewrite Heq; ring. + intros p a Heq. + unfold QX_to_monic; rewrite mult_apply; rewrite Heq; ring. Qed. Fixpoint den_list (P : QX) : list Z_as_CRing := @@ -97,23 +97,23 @@ Proof. reflexivity. Qed. Lemma den_list_spec : forall P n, n <= QX_deg P -> In (Q_can_den (nth_coeff n P)) (den_list P). Proof. -intro P; pattern P; apply Ccpoly_induc; clear P. + intro P; pattern P; apply Ccpoly_induc; clear P. simpl; left. rewrite Q_can_den_pos_val_spec. unfold Q_can_den_pos_val; reflexivity. -intros P c Hrec n. -unfold QX_deg; rewrite RX_deg_linear; fold QX_deg; fold QX_dec. -case (QX_dec P Zero). + intros P c Hrec n. + unfold QX_deg; rewrite RX_deg_linear; fold QX_deg; fold QX_dec. + case (QX_dec P Zero). simpl. case n. - left; reflexivity. + left; reflexivity. intros A B C; inversion C. -intros Hap Hle. -simpl. -destruct n. + intros Hap Hle. + simpl. + destruct n. left; reflexivity. -right; apply Hrec. -apply le_S_n; assumption. + right; apply Hrec. + apply le_S_n; assumption. Qed. Definition Zlcm_den_poly (P : QX) := @@ -121,33 +121,33 @@ Definition Zlcm_den_poly (P : QX) := Lemma Zlcm_den_poly_nz : forall P, Zlcm_den_poly P [#] Zero. Proof. -intro P; apply Zlcm_gen_nz. -intro a; pattern P; apply Ccpoly_induc; clear P. + intro P; apply Zlcm_gen_nz. + intro a; pattern P; apply Ccpoly_induc; clear P. simpl; intro H; destruct H; [|contradiction]. rewrite <- H; discriminate. -intros P c. -rewrite den_list_linear. -rewrite Q_can_den_pos_val_spec. -induction (den_list P). + intros P c. + rewrite den_list_linear. + rewrite Q_can_den_pos_val_spec. + induction (den_list P). simpl; intros. destruct H0; [rewrite <- H0; discriminate|contradiction]. -simpl; intros. - destruct H0; [rewrite <- H0; discriminate|]. -apply H; assumption. + simpl; intros. + destruct H0; [rewrite <- H0; discriminate|]. + apply H; assumption. Qed. Lemma den_1_div_iff : forall q : Q_as_CRing, Q_can_den q = 1 <-> Zdivides (Qden q) (Qnum q). Proof. -intro q. -split; intro H. + intro q. + split; intro H. unfold Q_can_den in H. destruct q; simpl in *. cut (Zpos Qden = Zgcd Qnum Qden). - intro H0; rewrite H0. - apply Zgcd_is_divisor_lft. + intro H0; rewrite H0. + apply Zgcd_is_divisor_lft. rewrite {1} (Zgcd_div_mult_rht Qnum Qden). - rewrite H. - apply Zmult_1_l. + rewrite H. + apply Zmult_1_l. intro. destruct (Zgcd_zero _ _ H0). rewrite H1 in H. @@ -155,21 +155,21 @@ split; intro H. rewrite Zgcd_zero_rht in H. rewrite Zdiv_0_r in H. discriminate. -unfold Q_can_den. -destruct q; simpl in *. -case (Z_dec Qnum 0). + unfold Q_can_den. + destruct q; simpl in *. + case (Z_dec Qnum 0). intro H0; rewrite H0. rewrite Zgcd_zero_lft. apply Z_div_same_full. discriminate. -intro Hap. -cut (Zpos Qden = Zgcd Qnum Qden). + intro Hap. + cut (Zpos Qden = Zgcd Qnum Qden). intro H0; rewrite {1} H0. apply Z_div_same_full. intro H1; destruct (Zgcd_zero _ _ H1). discriminate. -symmetry. -apply Zgcd_divisor; assumption. + symmetry. + apply Zgcd_divisor; assumption. Qed. Fixpoint Q_can_num_poly (P : QX) : ZX := @@ -186,56 +186,56 @@ Proof. reflexivity. Qed. Lemma Q_can_num_poly_spec : forall P Q, P [=] Q -> Q_can_num_poly P [=] Q_can_num_poly Q. Proof. -intros P Q; pattern P, Q; apply Ccpoly_double_sym_ind; clear P Q. - intros P Q Hsym Heq. - symmetry; apply Hsym; symmetry; assumption. + intros P Q; pattern P, Q; apply Ccpoly_double_sym_ind; clear P Q. + intros P Q Hsym Heq. + symmetry; apply Hsym; symmetry; assumption. intro P. pattern P; apply Ccpoly_induc; clear P. - reflexivity. + reflexivity. intros P c Hrec Heq. destruct (zero_eq_linear_ _ _ _ Heq). split. - rewrite (Q_can_num_spec _ Zero). - reflexivity. - assumption. + rewrite (Q_can_num_spec _ Zero). + reflexivity. + assumption. change (Zero [=] Q_can_num_poly P). symmetry; apply Hrec; symmetry; assumption. -intros P Q c d Hrec Heq. -destruct (linear_eq_linear_ _ _ _ _ _ Heq). -rewrite Q_can_num_poly_linear Q_can_num_poly_linear. -apply _linear_eq_linear. -split. + intros P Q c d Hrec Heq. + destruct (linear_eq_linear_ _ _ _ _ _ Heq). + rewrite Q_can_num_poly_linear Q_can_num_poly_linear. + apply _linear_eq_linear. + split. apply Q_can_num_spec; assumption. -apply Hrec; assumption. + apply Hrec; assumption. Qed. Lemma Q_can_num_poly_deg_eq : forall P, QX_deg P = ZX_deg (Q_can_num_poly P). Proof. -intro P. -pattern P; apply Ccpoly_induc; clear P. + intro P. + pattern P; apply Ccpoly_induc; clear P. reflexivity. -intros P c Heq. -rewrite Q_can_num_poly_linear. -unfold QX_deg, ZX_deg. -rewrite RX_deg_linear; fold QX_dec. -rewrite RX_deg_linear; fold ZX_dec. -fold QX_deg; fold ZX_deg. -rewrite <- Heq. -case (QX_dec P Zero). + intros P c Heq. + rewrite Q_can_num_poly_linear. + unfold QX_deg, ZX_deg. + rewrite RX_deg_linear; fold QX_dec. + rewrite RX_deg_linear; fold ZX_dec. + fold QX_deg; fold ZX_deg. + rewrite <- Heq. + case (QX_dec P Zero). case (ZX_dec (Q_can_num_poly P) Zero). - reflexivity. + reflexivity. intros Hap Heq2; destruct (ap_imp_neq _ _ _ Hap); revert Heq2; clear. pattern P; apply Ccpoly_induc; clear P. - reflexivity. + reflexivity. intros P c Hrec Heq; destruct (linear_eq_zero_ _ _ _ Heq). rewrite Q_can_num_poly_linear. apply _linear_eq_zero; split. - rewrite (Q_can_num_spec _ _ H); reflexivity. + rewrite (Q_can_num_spec _ _ H); reflexivity. apply Hrec; assumption. -intro Hap; case (ZX_dec (Q_can_num_poly P) Zero). + intro Hap; case (ZX_dec (Q_can_num_poly P) Zero). intro Heq2; destruct (ap_imp_neq _ _ _ Hap); revert Heq2; clear. pattern P; apply Ccpoly_induc; clear P. - reflexivity. + reflexivity. intros P c Hrec Heq. rewrite Q_can_num_poly_linear in Heq. destruct (linear_eq_zero_ _ _ _ Heq). @@ -244,76 +244,76 @@ intro Hap; case (ZX_dec (Q_can_num_poly P) Zero). unfold Q_can_num; simpl; unfold Qeq; simpl. rewrite Zmult_1_r. intro H; rewrite (Zgcd_div_mult_lft qn qd). - rewrite H. - apply Zmult_0_l. + rewrite H. + apply Zmult_0_l. intro H0; destruct (Zgcd_zero _ _ H0); discriminate. -reflexivity. + reflexivity. Qed. Lemma nth_coeff_Q_can_num_poly_spec : forall P n, nth_coeff n (Q_can_num_poly P) = Q_can_num (nth_coeff n P). Proof. -intro P; pattern P; apply Ccpoly_induc; clear P. + intro P; pattern P; apply Ccpoly_induc; clear P. simpl; unfold Q_can_num. rewrite Zdiv_0_l; reflexivity. -destruct n. + destruct n. reflexivity. -rewrite Q_can_num_poly_linear. -rewrite coeff_Sm_lin. -rewrite H. -apply Q_can_num_spec. -symmetry; apply coeff_Sm_lin. + rewrite Q_can_num_poly_linear. + rewrite coeff_Sm_lin. + rewrite H. + apply Q_can_num_spec. + symmetry; apply coeff_Sm_lin. Qed. Lemma injZ_strext : fun_strext (inject_Z : Z_as_CRing -> Q_as_CRing). Proof. -intros x y. -unfold inject_Z; simpl; unfold Qap, Qeq, ap_Z; simpl. -rewrite Zmult_1_r Zmult_1_r; tauto. + intros x y. + unfold inject_Z; simpl; unfold Qap, Qeq, ap_Z; simpl. + rewrite Zmult_1_r Zmult_1_r; tauto. Qed. Lemma injZ_spec : forall q : Q_as_CRing, in_Z q -> q [=] (Q_can_num q). Proof. -unfold in_Z. -intros q Hin. -destruct q as [qn qd]. -unfold inject_Z. -simpl; unfold Qeq; simpl. -rewrite Zmult_1_r. -unfold Q_can_num; simpl. -unfold Q_can_den in Hin. -simpl in Hin. -cut (Zpos qd = Zgcd qn qd). + unfold in_Z. + intros q Hin. + destruct q as [qn qd]. + unfold inject_Z. + simpl; unfold Qeq; simpl. + rewrite Zmult_1_r. + unfold Q_can_num; simpl. + unfold Q_can_den in Hin. + simpl in Hin. + cut (Zpos qd = Zgcd qn qd). intro H; rewrite {2} H. rewrite Zmult_comm. symmetry; apply Zdivides_spec. apply Zgcd_is_divisor_lft. -rewrite {1} (Zgcd_div_mult_rht qn qd). + rewrite {1} (Zgcd_div_mult_rht qn qd). rewrite Hin; rewrite Zmult_1_l; reflexivity. -intro H; destruct (Zgcd_zero _ _ H); discriminate. + intro H; destruct (Zgcd_zero _ _ H); discriminate. Qed. Lemma injZ_spec2 : forall p : Z_as_CRing, p = Q_can_num p. Proof. -intro p. -unfold Q_can_num, inject_Z; simpl. -rewrite Zgcd_one_rht Zdiv_1_r; reflexivity. + intro p. + unfold Q_can_num, inject_Z; simpl. + rewrite Zgcd_one_rht Zdiv_1_r; reflexivity. Qed. Definition injZ_fun := Build_CSetoid_fun _ _ _ injZ_strext. Lemma injZ_pres_plus : fun_pres_plus _ _ injZ_fun. Proof. -intros x y. -simpl; unfold inject_Z, Qeq; simpl. -ring. + intros x y. + simpl; unfold inject_Z, Qeq; simpl. + ring. Qed. Lemma injZ_pres_unit : fun_pres_unit _ _ injZ_fun. Proof. -unfold fun_pres_unit; simpl; unfold inject_Z, Qeq. -simpl; reflexivity. + unfold fun_pres_unit; simpl; unfold inject_Z, Qeq. + simpl; reflexivity. Qed. Lemma injZ_pres_mult : fun_pres_mult _ _ injZ_fun. Proof. -intros x y. -simpl; unfold inject_Z, Qeq; simpl. -ring. + intros x y. + simpl; unfold inject_Z, Qeq; simpl. + ring. Qed. Definition injZ_rh := Build_RingHom _ _ _ injZ_pres_plus injZ_pres_mult injZ_pres_unit. Definition zx2qx := cpoly_map injZ_rh. @@ -325,89 +325,89 @@ Proof. reflexivity. Qed. Lemma nth_coeff_zx2qx : forall P n, nth_coeff n (zx2qx P) [=] nth_coeff n P. Proof. -intro P; pattern P; apply Ccpoly_induc; clear P. + intro P; pattern P; apply Ccpoly_induc; clear P. reflexivity. -intros P c Hrec n. -rewrite zx2qx_linear. -induction n. + intros P c Hrec n. + rewrite zx2qx_linear. + induction n. reflexivity. -rewrite coeff_Sm_lin coeff_Sm_lin. -apply Hrec. + rewrite coeff_Sm_lin coeff_Sm_lin. + apply Hrec. Qed. Lemma zx2qx_spec : forall P : QX, in_ZX P -> P [=] zx2qx (Q_can_num_poly P). Proof. -intros P Hin. -apply all_nth_coeff_eq_imp. -intro n. -set (Hin n). -rewrite nth_coeff_zx2qx. -rewrite (injZ_spec _ i). -unfold inject_Z; simpl; unfold Qeq; simpl. -rewrite Zmult_1_r Zmult_1_r. -symmetry; apply nth_coeff_Q_can_num_poly_spec. + intros P Hin. + apply all_nth_coeff_eq_imp. + intro n. + set (Hin n). + rewrite nth_coeff_zx2qx. + rewrite (injZ_spec _ i). + unfold inject_Z; simpl; unfold Qeq; simpl. + rewrite Zmult_1_r Zmult_1_r. + symmetry; apply nth_coeff_Q_can_num_poly_spec. Qed. Lemma Zlcm_den_poly_spec0 : forall P n, nth_coeff n (_C_ (Zlcm_den_poly P:Q_as_CRing) [*] P) [=] Qmake (Zlcm_den_poly P * Qnum (nth_coeff n P)) (Qden (nth_coeff n P)). Proof. -intros P n. -rewrite nth_coeff_c_mult_p. -simpl. -generalize (Zlcm_den_poly P), (nth_coeff n P); clear; intros z q. -destruct q as [qn qd]; simpl. -unfold Qmult; simpl. -reflexivity. + intros P n. + rewrite nth_coeff_c_mult_p. + simpl. + generalize (Zlcm_den_poly P), (nth_coeff n P); clear; intros z q. + destruct q as [qn qd]; simpl. + unfold Qmult; simpl. + reflexivity. Qed. Lemma Zlcm_den_poly_spec : forall P, in_ZX (_C_ (Zlcm_den_poly P:Q_as_CRing) [*] P). Proof. -intros P n. -unfold in_Z. -case (le_lt_dec n (QX_deg P)). + intros P n. + unfold in_Z. + case (le_lt_dec n (QX_deg P)). transitivity (Q_can_den ((Qmake (Zlcm_den_poly P) xH) [*] nth_coeff n P)). - apply Q_can_den_spec. - apply nth_coeff_c_mult_p. + apply Q_can_den_spec. + apply nth_coeff_c_mult_p. simpl; unfold Qmult; simpl. rewrite den_1_div_iff. unfold Qmult; simpl. unfold Zlcm_den_poly. rewrite (Zgcd_div_mult_rht (Qnum (nth_coeff n P)) (Qden (nth_coeff n P))); - try (intro H0; destruct (Zgcd_zero _ _ H0); discriminate). + try (intro H0; destruct (Zgcd_zero _ _ H0); discriminate). fold (Q_can_den (nth_coeff n P)). apply Zdivides_mult_elim; try apply Zgcd_is_divisor_lft. apply Zlcm_gen_spec. apply den_list_spec; assumption. -intros Hgt. -cut (nth_coeff n (_C_ (Zlcm_den_poly P:Q_as_CRing)[*]P) [=] Zero). -intro Heq. -transitivity (Q_can_den Zero). -apply Q_can_den_spec; assumption. -rewrite Q_can_den_pos_val_spec; reflexivity. -case (RX_dec _ Q_dec P Zero). -intro H. -transitivity (nth_coeff n (Zero:QX)). -apply nth_coeff_wd. -rewrite {2} H. -apply I. -reflexivity. -intro Hap. -rewrite nth_coeff_c_mult_p. -cut (nth_coeff n P [=] Zero). + intros Hgt. + cut (nth_coeff n (_C_ (Zlcm_den_poly P:Q_as_CRing)[*]P) [=] Zero). + intro Heq. + transitivity (Q_can_den Zero). + apply Q_can_den_spec; assumption. + rewrite Q_can_den_pos_val_spec; reflexivity. + case (RX_dec _ Q_dec P Zero). + intro H. + transitivity (nth_coeff n (Zero:QX)). + apply nth_coeff_wd. + rewrite {2} H. + apply I. + reflexivity. + intro Hap. + rewrite nth_coeff_c_mult_p. + cut (nth_coeff n P [=] Zero). intro H; rewrite H; ring. -cut (degree_le (QX_deg P) P). + cut (degree_le (QX_deg P) P). intro H; apply H; assumption. -destruct (RX_deg_spec _ Q_dec P); assumption. + destruct (RX_deg_spec _ Q_dec P); assumption. Qed. Definition qx2zx (P : QX) : ZX := Q_can_num_poly (_C_ (Zlcm_den_poly P:Q_as_CRing) [*] P). Lemma qx2zx_spec : forall P, zx2qx (qx2zx P) [=] _C_ (Zlcm_den_poly P:Q_as_CRing) [*] P. Proof. -intro P. -unfold qx2zx. -symmetry; apply zx2qx_spec. -apply Zlcm_den_poly_spec. + intro P. + unfold qx2zx. + symmetry; apply zx2qx_spec. + apply Zlcm_den_poly_spec. Qed. End Z_Q. diff --git a/Liouville/QX_extract_roots.v b/Liouville/QX_extract_roots.v index c94adf802..ad128f098 100644 --- a/Liouville/QX_extract_roots.v +++ b/Liouville/QX_extract_roots.v @@ -45,37 +45,37 @@ Fixpoint QX_test_list (P : QX) (l : list Q_as_CRing) : option Q_as_CRing := Lemma QX_test_list_spec_none : forall P l, QX_test_list P l = None -> forall q : Q_as_CRing, In q l -> P ! q [#] Zero. Proof. -induction l. + induction l. intros; contradiction. -unfold QX_test_list. -case (Q_dec P ! a Zero). + unfold QX_test_list. + case (Q_dec P ! a Zero). intros; discriminate. -fold (QX_test_list P l). -intros Hap Hnone q. -simpl (In q (a::l)). -case (Q_dec a q). + fold (QX_test_list P l). + intros Hap Hnone q. + simpl (In q (a::l)). + case (Q_dec a q). intros Haq Hin Hval. destruct Hap. rewrite Haq; assumption. -intros. -apply IHl. + intros. + apply IHl. assumption. -destruct H. + destruct H. destruct c; rewrite H; reflexivity. -assumption. + assumption. Qed. Lemma QX_test_list_spec_some : forall P l x, QX_test_list P l = Some x -> P ! x [=] Zero. Proof. -induction l. + induction l. intros; discriminate. -unfold QX_test_list. -fold (QX_test_list P l). -case (Q_dec P ! a Zero); [|intro; assumption]. -intros. -injection H; intro. -rewrite <- H0; assumption. + unfold QX_test_list. + fold (QX_test_list P l). + case (Q_dec P ! a Zero); [|intro; assumption]. + intros. + injection H; intro. + rewrite <- H0; assumption. Qed. Let P0 (P : QX) := nth_coeff 0 (QX_ZX.qx2zx P). @@ -86,109 +86,109 @@ Definition QX_find_root (P : QX) : option Q_as_CRing := Lemma QX_find_root_spec_none : forall P, QX_find_root P = None -> forall q : Q_as_CRing, P ! q [#] Zero. Proof. -intro P; unfold QX_find_root. -case (Q_dec P ! Zero Zero). + intro P; unfold QX_find_root. + case (Q_dec P ! Zero Zero). intros; discriminate. -intros Hap Hnone q. -assert (forall x y : Q_as_CRing, {x = y} + {x <> y}). + intros Hap Hnone q. + assert (forall x y : Q_as_CRing, {x = y} + {x <> y}). clear; intros x y. destruct x; destruct y; simpl. case (Z_eq_dec Qnum Qnum0); case (Z_eq_dec Qden Qden0); intros H1 H2. - left; f_equal; [assumption|injection H1; tauto]. - right; intro H3; injection H3; intros; destruct H1; f_equal; assumption. - right; intro H3; injection H3; intros; destruct H2; assumption. + left; f_equal; [assumption|injection H1; tauto]. + right; intro H3; injection H3; intros; destruct H1; f_equal; assumption. + right; intro H3; injection H3; intros; destruct H2; assumption. right; intro H3; injection H3; intros; destruct H2; assumption. -destruct (In_dec X (Q_can q) (list_Q (P0 P) (Pn P))). + destruct (In_dec X (Q_can q) (list_Q (P0 P) (Pn P))). intro H; rewrite -> (Q_can_spec q) in H; revert H. apply (QX_test_list_spec_none _ _ Hnone _ i). -intro Hval; apply n. -apply QX_root_loc; assumption. + intro Hval; apply n. + apply QX_root_loc; assumption. Qed. Lemma QX_find_root_spec_some : forall P x, QX_find_root P = Some x -> P ! x [=] Zero. Proof. -intros P x; unfold QX_find_root. -case (Q_dec P ! Zero Zero). + intros P x; unfold QX_find_root. + case (Q_dec P ! Zero Zero). intros H1 H2; injection H2; intro H3; rewrite <- H3; assumption. -intro Hap; apply QX_test_list_spec_some. + intro Hap; apply QX_test_list_spec_some. Qed. Lemma QX_integral : forall p q : QX, p [#] Zero -> q [#] Zero -> p[*]q [#] Zero. Proof. -intros p q Hp Hq. -apply (nth_coeff_strext _ (QX_deg p + QX_deg q)). -simpl (nth_coeff (QX_deg p + QX_deg q) (Zero:QX)). -cut (degree (QX_deg p + QX_deg q) (p[*]q)). + intros p q Hp Hq. + apply (nth_coeff_strext _ (QX_deg p + QX_deg q)). + simpl (nth_coeff (QX_deg p + QX_deg q) (Zero:QX)). + cut (degree (QX_deg p + QX_deg q) (p[*]q)). intro H; apply H. -apply (degree_mult Q_as_CField). + apply (degree_mult Q_as_CField). apply RX_deg_spec; assumption. -apply RX_deg_spec; assumption. + apply RX_deg_spec; assumption. Qed. Lemma QX_deg_mult : forall p q, p [#] Zero -> q [#] Zero -> QX_deg (p[*]q) = QX_deg p + QX_deg q. Proof. -intros p q Hp Hq. -set (RX_deg_spec _ Q_dec _ Hp). -set (RX_deg_spec _ Q_dec _ Hq). -set (degree_mult Q_as_CField _ _ _ _ d d0). -fold QX_deg in d1. -apply (degree_inj _ (p[*]q)); [|assumption]. -apply RX_deg_spec. -apply QX_integral; assumption. + intros p q Hp Hq. + set (RX_deg_spec _ Q_dec _ Hp). + set (RX_deg_spec _ Q_dec _ Hq). + set (degree_mult Q_as_CField _ _ _ _ d d0). + fold QX_deg in d1. + apply (degree_inj _ (p[*]q)); [|assumption]. + apply RX_deg_spec. + apply QX_integral; assumption. Qed. Lemma QX_div_deg0 : forall (p : QX) (a : Q_as_CRing), QX_deg p <> 0 -> RX_div _ p a [#] Zero. Proof. -intros p a Hdeg. -case (QX_dec (RX_div _ p a) Zero); [|tauto]. -intro Heq; destruct Hdeg; revert Heq. -unfold RX_div. -destruct (cpoly_div p (_X_monic _ a)). -destruct x as [q r]. -unfold fst, snd in *. -clear s. -destruct c. -destruct d. -intro Hq. -rewrite -> Hq in s. -assert (H : p [=] r); [rewrite s; unfold cg_minus; unfold QX; ring|]. -unfold QX_deg; rewrite (RX_deg_wd _ Q_dec _ _ H); fold QX_deg. -destruct (_X_monic _ a). -destruct (degree_le_zero _ _ (d _ H1)). -unfold QX_deg; rewrite (RX_deg_wd _ Q_dec _ _ s1). -rewrite RX_deg_c_; reflexivity. + intros p a Hdeg. + case (QX_dec (RX_div _ p a) Zero); [|tauto]. + intro Heq; destruct Hdeg; revert Heq. + unfold RX_div. + destruct (cpoly_div p (_X_monic _ a)). + destruct x as [q r]. + unfold fst, snd in *. + clear s. + destruct c. + destruct d. + intro Hq. + rewrite -> Hq in s. + assert (H : p [=] r); [rewrite s; unfold cg_minus; unfold QX; ring|]. + unfold QX_deg; rewrite (RX_deg_wd _ Q_dec _ _ H); fold QX_deg. + destruct (_X_monic _ a). + destruct (degree_le_zero _ _ (d _ H1)). + unfold QX_deg; rewrite (RX_deg_wd _ Q_dec _ _ s1). + rewrite RX_deg_c_; reflexivity. Qed. Lemma QX_div_deg : forall (p : QX) (a : Q_as_CRing), QX_deg p <> 0 -> QX_deg p = S (QX_deg (RX_div _ p a)). Proof. -intros p a Hdeg. -case_eq (QX_deg p). + intros p a Hdeg. + case_eq (QX_deg p). intro; destruct Hdeg; assumption. -intros n Heq. -f_equal. -revert Heq. -unfold QX_deg; rewrite (RX_deg_wd _ Q_dec _ _ (RX_div_spec _ p a)). -rewrite RX_deg_sum. + intros n Heq. + f_equal. + revert Heq. + unfold QX_deg; rewrite (RX_deg_wd _ Q_dec _ _ (RX_div_spec _ p a)). + rewrite RX_deg_sum. rewrite RX_deg_c_. rewrite max_comm; unfold max. rewrite -> QX_deg_mult. - unfold QX_deg; rewrite RX_deg_minus. - rewrite RX_deg_c_ RX_deg_x_; fold QX_deg. - simpl; rewrite plus_comm; simpl. - intro H; injection H; symmetry; assumption. - rewrite RX_deg_x_ RX_deg_c_; discriminate. - apply QX_div_deg0; assumption. - right; left; discriminate. -rewrite -> QX_deg_mult. unfold QX_deg; rewrite RX_deg_minus. - rewrite RX_deg_x_ RX_deg_c_ RX_deg_c_. - rewrite plus_comm; discriminate. + rewrite RX_deg_c_ RX_deg_x_; fold QX_deg. + simpl; rewrite plus_comm; simpl. + intro H; injection H; symmetry; assumption. rewrite RX_deg_x_ RX_deg_c_; discriminate. + apply QX_div_deg0; assumption. + right; left; discriminate. + rewrite -> QX_deg_mult. + unfold QX_deg; rewrite RX_deg_minus. + rewrite RX_deg_x_ RX_deg_c_ RX_deg_c_. + rewrite plus_comm; discriminate. + rewrite RX_deg_x_ RX_deg_c_; discriminate. apply QX_div_deg0; assumption. -right; left; discriminate. + right; left; discriminate. Qed. Fixpoint QX_extract_roots_rec (n : nat) (P : QX) := @@ -206,9 +206,9 @@ Definition QX_extract_roots (P : QX) := QX_extract_roots_rec (QX_deg P) P. Lemma QX_extract_roots_spec_rat : forall P a, P [#] Zero -> (QX_extract_roots P) ! a [#] Zero. Proof. -unfold QX_extract_roots. -intros P a; remember (QX_deg P) as n; revert P Heqn. -induction n. + unfold QX_extract_roots. + intros P a; remember (QX_deg P) as n; revert P Heqn. + induction n. intros P Hdeg Hap; unfold QX_extract_roots_rec. destruct (RX_deg_spec _ Q_dec _ Hap). fold QX_deg in d; rewrite <- Hdeg in d. @@ -216,18 +216,18 @@ induction n. case (Q_dec P ! a Zero); [|tauto]. intro Heq; destruct (ap_imp_neq _ _ _ Hap); clear Hap; revert Heq. rewrite s c_apply; intro H; rewrite H; split; [reflexivity|apply I]. -unfold QX_extract_roots_rec. -intros P Hdeg Hap. -case_eq (QX_find_root P). + unfold QX_extract_roots_rec. + intros P Hdeg Hap. + case_eq (QX_find_root P). intros x Hsome; fold (QX_extract_roots_rec n (RX_div _ P x)). apply IHn. - apply eq_add_S. - rewrite <- QX_div_deg; [assumption|]. - rewrite <- Hdeg; discriminate. + apply eq_add_S. + rewrite <- QX_div_deg; [assumption|]. + rewrite <- Hdeg; discriminate. case (QX_dec (RX_div _ P x) Zero); [|tauto]. intro Heq; apply QX_div_deg0. rewrite <- Hdeg; discriminate. -intro; apply QX_find_root_spec_none; assumption. + intro; apply QX_find_root_spec_none; assumption. Qed. Definition inj_Q_fun := Build_CSetoid_fun _ _ _ (inj_Q_strext IR). @@ -244,39 +244,39 @@ Lemma QX_extract_roots_spec_nrat : forall (P : QX) (x : IR), (forall y : Q_as_CRing, x [~=] (inj_Q_rh y)) -> (inj_QX_rh P) ! x [=] Zero -> (inj_QX_rh (QX_extract_roots P)) ! x [=] Zero. Proof. -intros P x Hx; unfold QX_extract_roots. -remember (QX_deg P) as n; revert P Heqn; induction n. + intros P x Hx; unfold QX_extract_roots. + remember (QX_deg P) as n; revert P Heqn; induction n. intros; unfold QX_extract_roots_rec; assumption. -intros P Hdeg Hval; unfold QX_extract_roots_rec; fold (QX_extract_roots_rec). -case_eq (QX_find_root P); [|intro; assumption]. -intros y Hsome. -apply IHn. + intros P Hdeg Hval; unfold QX_extract_roots_rec; fold (QX_extract_roots_rec). + case_eq (QX_find_root P); [|intro; assumption]. + intros y Hsome. + apply IHn. apply eq_add_S. rewrite Hdeg; apply QX_div_deg. rewrite <- Hdeg; discriminate. -clear IHn; revert Hval. -rewrite {1} (RX_div_spec _ P y). -rewrite rh_pres_plus. -rewrite rh_pres_mult. -rewrite rh_pres_minus. -rewrite (cpoly_map_X _ _ inj_Q_rh). -rewrite (cpoly_map_C _ _ inj_Q_rh). -rewrite (cpoly_map_C _ _ inj_Q_rh). -rewrite plus_apply. -rewrite mult_apply. -rewrite minus_apply. -rewrite x_apply. -rewrite c_apply. -rewrite c_apply. -rewrite (QX_find_root_spec_some _ _ Hsome). -rewrite rh_pres_zero. -rewrite cm_rht_unit. -rewrite mult_commutes. -set (H := Hx y); revert H; generalize (RX_div Q_as_CRing P y). -clear; intros P Hap Heq. -apply (mult_eq_zero IR (x[-]inj_Q_rh y)); [|assumption]. -intro; apply Hap. -apply cg_inv_unique_2; assumption. + clear IHn; revert Hval. + rewrite {1} (RX_div_spec _ P y). + rewrite rh_pres_plus. + rewrite rh_pres_mult. + rewrite rh_pres_minus. + rewrite (cpoly_map_X _ _ inj_Q_rh). + rewrite (cpoly_map_C _ _ inj_Q_rh). + rewrite (cpoly_map_C _ _ inj_Q_rh). + rewrite plus_apply. + rewrite mult_apply. + rewrite minus_apply. + rewrite x_apply. + rewrite c_apply. + rewrite c_apply. + rewrite (QX_find_root_spec_some _ _ Hsome). + rewrite rh_pres_zero. + rewrite cm_rht_unit. + rewrite mult_commutes. + set (H := Hx y); revert H; generalize (RX_div Q_as_CRing P y). + clear; intros P Hap Heq. + apply (mult_eq_zero IR (x[-]inj_Q_rh y)); [|assumption]. + intro; apply Hap. + apply cg_inv_unique_2; assumption. Qed. End Z_Q. diff --git a/Liouville/QX_root_loc.v b/Liouville/QX_root_loc.v index 0c8ff3917..896b9f334 100644 --- a/Liouville/QX_root_loc.v +++ b/Liouville/QX_root_loc.v @@ -45,159 +45,159 @@ Let QX_deg := RX_deg Q_as_CRing Q_dec. Lemma Sum0_ring_hom : forall R S (phi : RingHom R S) f n, phi (Sum0 n f) [=] Sum0 n (fun i => phi (f i)). Proof. -intros. -induction n; [apply rh_pres_zero|]. -simpl; rewrite rh_pres_plus IHn; reflexivity. + intros. + induction n; [apply rh_pres_zero|]. + simpl; rewrite rh_pres_plus IHn; reflexivity. Qed. Lemma Sum_ring_hom : forall R S (phi : RingHom R S) f i j, phi (Sum i j f) [=] Sum i j (fun i => phi (f i)). Proof. -intros; unfold Sum, Sum1; simpl. -rewrite rh_pres_minus rh_pres_plus. -rewrite Sum0_ring_hom Sum0_ring_hom; reflexivity. + intros; unfold Sum, Sum1; simpl. + rewrite rh_pres_minus rh_pres_plus. + rewrite Sum0_ring_hom Sum0_ring_hom; reflexivity. Qed. Lemma nexp_ring_hom : forall R S (phi : RingHom R S) a n, phi (a[^]n) [=] phi a[^]n. Proof. -intros; induction n; [apply rh_pres_unit|]. -rewrite <- nexp_Sn, <- nexp_Sn; rewrite rh_pres_mult IHn; reflexivity. + intros; induction n; [apply rh_pres_unit|]. + rewrite <- nexp_Sn, <- nexp_Sn; rewrite rh_pres_mult IHn; reflexivity. Qed. Lemma Q_Z_nexp : forall (p : Z_as_CRing) (q : positive) i, ((p#q)[^]i[*](q:Q_as_CRing)[^]i [=] p[^]i)%Q. Proof. -intros p q. -induction i. + intros p q. + induction i. reflexivity. -rewrite <- nexp_Sn, <- nexp_Sn, <- nexp_Sn. -rewrite (mult_commutes _ (p#q)%Q). -rewrite <- CRings.mult_assoc. -rewrite (mult_commutes _ (p#q)%Q). -rewrite (mult_commutes _ (q:Q_as_CRing)). -rewrite CRings.mult_assoc. -rewrite CRings.mult_assoc. -rewrite IHi. -rewrite (mult_commutes _ p). -rewrite <- CRings.mult_assoc. -apply (mult_wdr _ (inject_Z ((p:Z_as_CRing)[^]i)) ((q:Q_as_CRing)[*](p # q)%Q) p). -simpl; unfold Qeq; simpl. -case p. - rewrite Zmult_0_l Zmult_0_l; reflexivity. + rewrite <- nexp_Sn, <- nexp_Sn, <- nexp_Sn. + rewrite (mult_commutes _ (p#q)%Q). + rewrite <- CRings.mult_assoc. + rewrite (mult_commutes _ (p#q)%Q). + rewrite (mult_commutes _ (q:Q_as_CRing)). + rewrite CRings.mult_assoc. + rewrite CRings.mult_assoc. + rewrite IHi. + rewrite (mult_commutes _ p). + rewrite <- CRings.mult_assoc. + apply (mult_wdr _ (inject_Z ((p:Z_as_CRing)[^]i)) ((q:Q_as_CRing)[*](p # q)%Q) p). + simpl; unfold Qeq; simpl. + case p. + rewrite Zmult_0_l Zmult_0_l; reflexivity. intro r; rewrite Zmult_1_r; rewrite Zmult_comm; reflexivity. -intro r; rewrite Zmult_1_r; rewrite Zmult_comm; reflexivity. + intro r; rewrite Zmult_1_r; rewrite Zmult_comm; reflexivity. Qed. Lemma Q_Z_poly_apply : forall (P : ZX) (p : Z_as_CRing) (q : positive), let n := ZX_deg P in (q:Q_as_CRing)[^]n [*] (zx2qx P) ! (p # q)%Q [=] Sum 0 n (fun i => (nth_coeff i P) [*] p [^] i [*] (q : Z_as_CRing)[^](n - i)). Proof. -intros P p q n. -assert (degree_le n (zx2qx P)). + intros P p q n. + assert (degree_le n (zx2qx P)). case (ZX_dec P Zero). - intro H; apply (degree_le_wd _ (_C_ Zero)). - rewrite H; split; [reflexivity|apply I]. - apply (degree_le_mon _ _ 0). - apply le_O_n. - apply degree_le_c_. + intro H; apply (degree_le_wd _ (_C_ Zero)). + rewrite H; split; [reflexivity|apply I]. + apply (degree_le_mon _ _ 0). + apply le_O_n. + apply degree_le_c_. intro Hap. destruct (RX_deg_spec _ Z_dec _ Hap). clear c; fold (ZX_deg P) in d; fold n in d. intros m Hlt. rewrite nth_coeff_zx2qx. rewrite d; [reflexivity|assumption]. -rewrite (poly_as_sum _ _ _ H). -rewrite <- mult_distr_sum_lft. -rewrite -> (Sum_ring_hom _ _ injZ_rh). -apply Sum_wd'. -apply le_O_n. -intros i H0 Hn. -rewrite nth_coeff_zx2qx. -rewrite rh_pres_mult. -rewrite rh_pres_mult. -rewrite mult_commutes. -rewrite nexp_ring_hom nexp_ring_hom. -rewrite <- CRings.mult_assoc, <- CRings.mult_assoc. -apply mult_wdr. -rewrite {1} (le_plus_minus _ _ Hn). -clear H0 Hn. -rewrite <- nexp_plus. -rewrite CRings.mult_assoc. -apply mult_wdl. -simpl (injZ_rh p). -rewrite (Q_Z_nexp p q i). -apply (nexp_ring_hom _ _ injZ_rh). + rewrite (poly_as_sum _ _ _ H). + rewrite <- mult_distr_sum_lft. + rewrite -> (Sum_ring_hom _ _ injZ_rh). + apply Sum_wd'. + apply le_O_n. + intros i H0 Hn. + rewrite nth_coeff_zx2qx. + rewrite rh_pres_mult. + rewrite rh_pres_mult. + rewrite mult_commutes. + rewrite nexp_ring_hom nexp_ring_hom. + rewrite <- CRings.mult_assoc, <- CRings.mult_assoc. + apply mult_wdr. + rewrite {1} (le_plus_minus _ _ Hn). + clear H0 Hn. + rewrite <- nexp_plus. + rewrite CRings.mult_assoc. + apply mult_wdl. + simpl (injZ_rh p). + rewrite (Q_Z_nexp p q i). + apply (nexp_ring_hom _ _ injZ_rh). Qed. Lemma RX_deg_cmult_p : forall P a, a [#] Zero -> QX_deg (_C_ a [*] P) = QX_deg P. Proof. -intros P a Hap. -case (QX_dec P Zero). + intros P a Hap. + case (QX_dec P Zero). intro; apply RX_deg_wd. rewrite s; ring. -intro HapP. -apply (degree_inj _ (_C_ a [*] P)). + intro HapP. + apply (degree_inj _ (_C_ a [*] P)). case (QX_dec (_C_ a[*]P) Zero). - intro Heq; destruct (ap_imp_neq _ _ _ HapP); clear HapP. - apply all_nth_coeff_eq_imp. - intro i; set (nth_coeff_wd _ i _ _ Heq). - revert s; rewrite nth_coeff_c_mult_p. - fold QX; simpl (nth_coeff i (Zero:QX)). - intro Heq2; apply (mult_eq_zero _ a); [apply Hap|assumption]. + intro Heq; destruct (ap_imp_neq _ _ _ HapP); clear HapP. + apply all_nth_coeff_eq_imp. + intro i; set (nth_coeff_wd _ i _ _ Heq). + revert s; rewrite nth_coeff_c_mult_p. + fold QX; simpl (nth_coeff i (Zero:QX)). + intro Heq2; apply (mult_eq_zero _ a); [apply Hap|assumption]. apply RX_deg_spec. -destruct (RX_deg_spec _ Q_dec _ HapP). -split. + destruct (RX_deg_spec _ Q_dec _ HapP). + split. intro. destruct c. rewrite -> nth_coeff_c_mult_p in H. apply (mult_eq_zero _ _ _ Hap H). -intros m Hlt. -rewrite nth_coeff_c_mult_p. -rewrite (d m Hlt); ring. + intros m Hlt. + rewrite nth_coeff_c_mult_p. + rewrite (d m Hlt); ring. Qed. Lemma den_div_Pn0 : forall (Q : ZX) (n : nat) (p q : Z_as_CRing), Sum 0 n (fun i : nat => nth_coeff i Q[*]p[^]i[*]q[^](n - i))[=]Zero -> Zdivides q (nth_coeff n Q[*]p[^]n). Proof. -clear QX QX_dec QX_deg. -intros P n p q. -destruct n. + clear QX QX_dec QX_deg. + intros P n p q. + destruct n. rewrite Sum_one. simpl. rewrite Zmult_1_r; intro H; rewrite H. apply Zdivides_zero_rht. -rewrite Sum_last. -rewrite minus_diag. -simpl (q[^]0). -rewrite mult_one. -generalize (nth_coeff (S n) P[*]p[^]S n); intro r. -exists ([--](Sum 0 n (fun i : nat => nth_coeff i P[*]p[^]i[*]q[^](n - i)))). -rewrite Zopp_mult_distr_l_reverse. -symmetry; apply (cg_inv_unique Z_as_CRing). -rewrite <- H. -apply cs_bin_op_wd; [|reflexivity]. -rewrite <- (mult_distr_sum_rht Z_as_CRing). -apply Sum_wd'. -apply le_O_n. -intros i H0 Hn. -rewrite <- CRings.mult_assoc. -apply mult_wd. + rewrite Sum_last. + rewrite minus_diag. + simpl (q[^]0). + rewrite mult_one. + generalize (nth_coeff (S n) P[*]p[^]S n); intro r. + exists ([--](Sum 0 n (fun i : nat => nth_coeff i P[*]p[^]i[*]q[^](n - i)))). + rewrite Zopp_mult_distr_l_reverse. + symmetry; apply (cg_inv_unique Z_as_CRing). + rewrite <- H. + apply cs_bin_op_wd; [|reflexivity]. + rewrite <- (mult_distr_sum_rht Z_as_CRing). + apply Sum_wd'. + apply le_O_n. + intros i H0 Hn. + rewrite <- CRings.mult_assoc. + apply mult_wd. reflexivity. -rewrite <- minus_Sn_m; [|assumption]. -rewrite -> CRings.mult_commutes; reflexivity. + rewrite <- minus_Sn_m; [|assumption]. + rewrite -> CRings.mult_commutes; reflexivity. Qed. Lemma qx2zx_deg : forall P, QX_deg P = ZX_deg (qx2zx P). Proof. -intro P; unfold qx2zx. -rewrite <- Q_can_num_poly_deg_eq. -symmetry; apply RX_deg_cmult_p. -intro; apply (Zlcm_den_poly_nz P). -rewrite (injZ_spec2 (Zlcm_den_poly P)). -revert H; generalize (inject_Z (Zlcm_den_poly P)); clear. -intro q; destruct q as [qn qd]. -unfold Qeq, Q_can_num; simpl. -rewrite Zmult_1_r; intro H; rewrite H. -compute; reflexivity. + intro P; unfold qx2zx. + rewrite <- Q_can_num_poly_deg_eq. + symmetry; apply RX_deg_cmult_p. + intro; apply (Zlcm_den_poly_nz P). + rewrite (injZ_spec2 (Zlcm_den_poly P)). + revert H; generalize (inject_Z (Zlcm_den_poly P)); clear. + intro q; destruct q as [qn qd]. + unfold Qeq, Q_can_num; simpl. + rewrite Zmult_1_r; intro H; rewrite H. + compute; reflexivity. Qed. Let Pn (P : QX) := nth_coeff (QX_deg P) (qx2zx P). @@ -205,102 +205,102 @@ Let Pn (P : QX) := nth_coeff (QX_deg P) (qx2zx P). Lemma den_div_Pn1 : forall (P : QX) (a : Q_as_CRing), P ! a [=] Zero -> Zdivides (Qden a) (Pn P[*](Qnum a:Z_as_CRing)[^]QX_deg P). Proof. -intros P a Hval. -set (P0 := _C_ (Zlcm_den_poly P:Q_as_CRing)[*]P). -assert (H : P0 ! a [=] Zero). + intros P a Hval. + set (P0 := _C_ (Zlcm_den_poly P:Q_as_CRing)[*]P). + assert (H : P0 ! a [=] Zero). unfold P0; rewrite mult_apply c_apply Hval; ring. -clear Hval; revert H. -rewrite (zx2qx_spec P0); [|apply Zlcm_den_poly_spec]. -unfold P0; clear P0. -destruct a as [p q]; unfold Qnum, Qden. -set (Q := qx2zx P). -intro Hval. -assert ((q:Q_as_CRing)[^](ZX_deg Q) [*] (zx2qx Q) ! (p # q)%Q [=] Zero). + clear Hval; revert H. + rewrite (zx2qx_spec P0); [|apply Zlcm_den_poly_spec]. + unfold P0; clear P0. + destruct a as [p q]; unfold Qnum, Qden. + set (Q := qx2zx P). + intro Hval. + assert ((q:Q_as_CRing)[^](ZX_deg Q) [*] (zx2qx Q) ! (p # q)%Q [=] Zero). unfold Q. rewrite Hval; ring. -assert (Q_can_num ((q:Q_as_CRing)[^](ZX_deg Q) [*] (zx2qx Q) ! (p # q)%Q) [=] Zero). + assert (Q_can_num ((q:Q_as_CRing)[^](ZX_deg Q) [*] (zx2qx Q) ! (p # q)%Q) [=] Zero). rewrite (Q_can_num_spec _ _ H). unfold Q_can_num; simpl. rewrite Zgcd_one_rht Zdiv_0_l; reflexivity. -clear Hval H; revert H0. -rewrite (Q_can_num_spec _ _ (Q_Z_poly_apply _ _ _)). -rewrite <- injZ_spec2. -assert (ZX_deg Q = QX_deg P). + clear Hval H; revert H0. + rewrite (Q_can_num_spec _ _ (Q_Z_poly_apply _ _ _)). + rewrite <- injZ_spec2. + assert (ZX_deg Q = QX_deg P). symmetry; apply qx2zx_deg. -assert (nth_coeff (QX_deg P) (qx2zx P) = nth_coeff (QX_deg P) Q). + assert (nth_coeff (QX_deg P) (qx2zx P) = nth_coeff (QX_deg P) Q). reflexivity. -unfold Q. -unfold Pn; rewrite H0. -rewrite <- H; clear H H0. -apply den_div_Pn0. + unfold Q. + unfold Pn; rewrite H0. + rewrite <- H; clear H H0. + apply den_div_Pn0. Qed. Lemma Zrelprime_nexp : forall (p q : Z_as_CRing) n, Zrelprime p q -> Zrelprime p (q[^]n). Proof. -intros p q n; intro H. -induction n. -apply Zgcd_one_rht. -rewrite <- nexp_Sn. -apply Zrelprime_symm. -apply Zrelprime_mult_elim_lft. -apply Zrelprime_symm; assumption. -apply Zrelprime_symm; assumption. + intros p q n; intro H. + induction n. + apply Zgcd_one_rht. + rewrite <- nexp_Sn. + apply Zrelprime_symm. + apply Zrelprime_mult_elim_lft. + apply Zrelprime_symm; assumption. + apply Zrelprime_symm; assumption. Qed. Lemma den_div_Pn : forall (P : QX) (a : Q_as_CRing), P ! a [=] Zero -> Zdivides (Q_can_den a) (Pn P). Proof. -intros P a Hval. -rewrite Q_can_den_pos_val_spec. -apply (Zrelprime_div_mult_intro _ ((Q_can_num a:Z_as_CRing)[^]QX_deg P)). + intros P a Hval. + rewrite Q_can_den_pos_val_spec. + apply (Zrelprime_div_mult_intro _ ((Q_can_num a:Z_as_CRing)[^]QX_deg P)). apply Zrelprime_nexp. apply Zrelprime_symm. apply (Q_can_spec2 a). -rewrite Zmult_comm. -apply (den_div_Pn1 _ (Q_can a)). -rewrite <- Hval. -apply cpoly_apply_wd; [reflexivity|]. -symmetry; apply Q_can_spec. + rewrite Zmult_comm. + apply (den_div_Pn1 _ (Q_can a)). + rewrite <- Hval. + apply cpoly_apply_wd; [reflexivity|]. + symmetry; apply Q_can_spec. Qed. Lemma Sum_shift_simpl : forall (G : CAbGroup) (f : nat -> G) m n, Sum (S m) (S n) f [=] Sum m n (fun i => f (S i)). Proof. -intros G f m n. -symmetry; apply Sum_shift. -intro; reflexivity. + intros G f m n. + symmetry; apply Sum_shift. + intro; reflexivity. Qed. Lemma den_div_P00 : forall (Q : ZX) (n : nat) (p q : Z_as_CRing), Sum 0 n (fun i : nat => nth_coeff i Q[*]p[^]i[*]q[^](n - i))[=]Zero -> Zdivides p (nth_coeff 0 Q[*]q[^]n). Proof. -clear Pn QX QX_dec QX_deg. -intros P n p q. -destruct n. + clear Pn QX QX_dec QX_deg. + intros P n p q. + destruct n. rewrite Sum_one. simpl. rewrite Zmult_1_r; intro H; rewrite H. apply Zdivides_zero_rht. -rewrite Sum_first. -rewrite Sum_shift_simpl. -simpl (p[^]0). -rewrite mult_one. -simpl (S n - 0). -generalize (nth_coeff 0 P[*]q[^]S n); intro r. -exists ([--](Sum 0 n (fun i : nat => nth_coeff (S i) P[*]p[^]i[*]q[^](n - i)))). -rewrite Zopp_mult_distr_l_reverse. -symmetry; apply (cg_inv_unique Z_as_CRing). -rewrite <- H. -rewrite cag_commutes. -apply cs_bin_op_wd; [reflexivity|]. -rewrite <- (mult_distr_sum_rht Z_as_CRing). -apply Sum_wd'. -apply le_O_n. -intros i H0 Hn. -rewrite <- nexp_Sn. -simpl (S n - S i). -ring. + rewrite Sum_first. + rewrite Sum_shift_simpl. + simpl (p[^]0). + rewrite mult_one. + simpl (S n - 0). + generalize (nth_coeff 0 P[*]q[^]S n); intro r. + exists ([--](Sum 0 n (fun i : nat => nth_coeff (S i) P[*]p[^]i[*]q[^](n - i)))). + rewrite Zopp_mult_distr_l_reverse. + symmetry; apply (cg_inv_unique Z_as_CRing). + rewrite <- H. + rewrite cag_commutes. + apply cs_bin_op_wd; [reflexivity|]. + rewrite <- (mult_distr_sum_rht Z_as_CRing). + apply Sum_wd'. + apply le_O_n. + intros i H0 Hn. + rewrite <- nexp_Sn. + simpl (S n - S i). + ring. Qed. Let P0 (P : QX) := nth_coeff 0 (qx2zx P). @@ -308,100 +308,100 @@ Let P0 (P : QX) := nth_coeff 0 (qx2zx P). Lemma den_div_P01 : forall (P : QX) (a : Q_as_CRing), P ! a [=] Zero -> Zdivides (Qnum a) (P0 P[*](Qden a:Z_as_CRing)[^]QX_deg P). Proof. -intros P a Hval. -set (Q := _C_ (Zlcm_den_poly P:Q_as_CRing)[*]P). -assert (H : Q ! a [=] Zero). + intros P a Hval. + set (Q := _C_ (Zlcm_den_poly P:Q_as_CRing)[*]P). + assert (H : Q ! a [=] Zero). unfold Q; rewrite mult_apply c_apply Hval; ring. -clear Hval; revert H. -rewrite (zx2qx_spec Q); [|apply Zlcm_den_poly_spec]. -unfold Q; clear Q. -destruct a as [p q]; unfold Qnum, Qden. -set (Q := qx2zx P). -intro Hval. -assert ((q:Q_as_CRing)[^](ZX_deg Q) [*] (zx2qx Q) ! (p # q)%Q [=] Zero). + clear Hval; revert H. + rewrite (zx2qx_spec Q); [|apply Zlcm_den_poly_spec]. + unfold Q; clear Q. + destruct a as [p q]; unfold Qnum, Qden. + set (Q := qx2zx P). + intro Hval. + assert ((q:Q_as_CRing)[^](ZX_deg Q) [*] (zx2qx Q) ! (p # q)%Q [=] Zero). unfold Q. rewrite Hval; ring. -assert (Q_can_num ((q:Q_as_CRing)[^](ZX_deg Q) [*] (zx2qx Q) ! (p # q)%Q) [=] Zero). + assert (Q_can_num ((q:Q_as_CRing)[^](ZX_deg Q) [*] (zx2qx Q) ! (p # q)%Q) [=] Zero). rewrite (Q_can_num_spec _ _ H). unfold Q_can_num; simpl. rewrite Zgcd_one_rht Zdiv_0_l; reflexivity. -clear Hval H; revert H0. -rewrite (Q_can_num_spec _ _ (Q_Z_poly_apply _ _ _)). -rewrite <- injZ_spec2. -assert (ZX_deg Q = QX_deg P). + clear Hval H; revert H0. + rewrite (Q_can_num_spec _ _ (Q_Z_poly_apply _ _ _)). + rewrite <- injZ_spec2. + assert (ZX_deg Q = QX_deg P). symmetry; apply qx2zx_deg. -assert (nth_coeff 0 (qx2zx P) = nth_coeff 0 Q). + assert (nth_coeff 0 (qx2zx P) = nth_coeff 0 Q). reflexivity. -unfold Q. -unfold P0; rewrite H0. -rewrite <- H; clear H H0. -apply den_div_P00. + unfold Q. + unfold P0; rewrite H0. + rewrite <- H; clear H H0. + apply den_div_P00. Qed. Lemma den_div_P0 : forall (P : QX) (a : Q_as_CRing), P ! a [=] Zero -> Zdivides (Q_can_num a) (P0 P). Proof. -intros P a Hval. -apply (Zrelprime_div_mult_intro _ ((Q_can_den a:Z_as_CRing)[^]QX_deg P)). + intros P a Hval. + apply (Zrelprime_div_mult_intro _ ((Q_can_den a:Z_as_CRing)[^]QX_deg P)). apply Zrelprime_nexp. rewrite Q_can_den_pos_val_spec. apply (Q_can_spec2 a). -rewrite Zmult_comm. -rewrite Q_can_den_pos_val_spec. -apply (den_div_P01 _ (Q_can a)). -rewrite <- Hval. -apply cpoly_apply_wd; [reflexivity|]. -symmetry; apply Q_can_spec. + rewrite Zmult_comm. + rewrite Q_can_den_pos_val_spec. + apply (den_div_P01 _ (Q_can a)). + rewrite <- Hval. + apply cpoly_apply_wd; [reflexivity|]. + symmetry; apply Q_can_spec. Qed. Lemma QX_root_loc : forall (P : QX) (a : Q_as_CRing), P ! Zero [#] Zero -> P ! a [=] Zero -> In (Q_can a) (list_Q (P0 P) (Pn P)). Proof. -intros P a Hap Hval. -apply list_Q_spec. - intro; apply Hap; clear Hap. - unfold P0 in H. - cut ((_C_ (Zlcm_den_poly P:Q_as_CRing) [*] P) ! Zero [=] Zero). - rewrite mult_apply c_apply. - intro H0; apply (Qmult_eq (Zlcm_den_poly P)); [|assumption]. - intro H1; destruct (Zlcm_den_poly_nz P). - unfold Qeq in H1; simpl in H1. - rewrite Zmult_1_r in H1; assumption. - cut ((zx2qx (qx2zx P)) ! Zero [=] Zero). - rewrite qx2zx_spec; tauto. - unfold zx2qx. - rewrite <- (rh_pres_zero _ _ injZ_rh) at 1. - rewrite <- cpoly_map_apply. - cut ((qx2zx P) ! Zero [=] Zero). - intro H0; rewrite H0; reflexivity. - rewrite poly_at_zero; assumption. - case (QX_dec P Zero). - intro H; destruct Hap; rewrite H; reflexivity. - intros Hap2 Heq; apply (ap_imp_neq _ _ _ Hap2); clear Hap Hval; revert Heq. - unfold Pn. - destruct (RX_deg_spec _ Z_dec (qx2zx P)); [|]. - case (ZX_dec (qx2zx P) Zero); [|tauto]. - intro Heq; destruct (ap_imp_neq _ _ _ Hap2); clear Hap2. - cut (_C_(Zlcm_den_poly P:Q_as_CRing) [*] P [=] Zero). - intro Heq2; apply all_nth_coeff_eq_imp; intro i. - apply (Qmult_eq (Zlcm_den_poly P)). - intro H1; destruct (Zlcm_den_poly_nz P). - unfold Qeq in H1; simpl in H1. - rewrite Zmult_1_r in H1; assumption. - set (nth_coeff_wd _ i _ _ Heq2). - revert s. - rewrite nth_coeff_c_mult_p. - simpl; tauto. - rewrite <- qx2zx_spec. - rewrite Heq. - apply (rh_pres_zero _ _ zx2qx). - intro H; destruct c; fold (ZX_deg (qx2zx P)). - rewrite <- qx2zx_deg; assumption. + intros P a Hap Hval. + apply list_Q_spec. + intro; apply Hap; clear Hap. + unfold P0 in H. + cut ((_C_ (Zlcm_den_poly P:Q_as_CRing) [*] P) ! Zero [=] Zero). + rewrite mult_apply c_apply. + intro H0; apply (Qmult_eq (Zlcm_den_poly P)); [|assumption]. + intro H1; destruct (Zlcm_den_poly_nz P). + unfold Qeq in H1; simpl in H1. + rewrite Zmult_1_r in H1; assumption. + cut ((zx2qx (qx2zx P)) ! Zero [=] Zero). + rewrite qx2zx_spec; tauto. + unfold zx2qx. + rewrite <- (rh_pres_zero _ _ injZ_rh) at 1. + rewrite <- cpoly_map_apply. + cut ((qx2zx P) ! Zero [=] Zero). + intro H0; rewrite H0; reflexivity. + rewrite poly_at_zero; assumption. + case (QX_dec P Zero). + intro H; destruct Hap; rewrite H; reflexivity. + intros Hap2 Heq; apply (ap_imp_neq _ _ _ Hap2); clear Hap Hval; revert Heq. + unfold Pn. + destruct (RX_deg_spec _ Z_dec (qx2zx P)); [|]. + case (ZX_dec (qx2zx P) Zero); [|tauto]. + intro Heq; destruct (ap_imp_neq _ _ _ Hap2); clear Hap2. + cut (_C_(Zlcm_den_poly P:Q_as_CRing) [*] P [=] Zero). + intro Heq2; apply all_nth_coeff_eq_imp; intro i. + apply (Qmult_eq (Zlcm_den_poly P)). + intro H1; destruct (Zlcm_den_poly_nz P). + unfold Qeq in H1; simpl in H1. + rewrite Zmult_1_r in H1; assumption. + set (nth_coeff_wd _ i _ _ Heq2). + revert s. + rewrite nth_coeff_c_mult_p. + simpl; tauto. + rewrite <- qx2zx_spec. + rewrite Heq. + apply (rh_pres_zero _ _ zx2qx). + intro H; destruct c; fold (ZX_deg (qx2zx P)). + rewrite <- qx2zx_deg; assumption. apply den_div_P0; assumption. -rewrite inj_Zabs_nat. -rewrite <- Q_can_den_pos_val_spec. -apply Zdivides_abs_elim_lft. -apply den_div_Pn; assumption. + rewrite inj_Zabs_nat. + rewrite <- Q_can_den_pos_val_spec. + apply Zdivides_abs_elim_lft. + apply den_div_Pn; assumption. Qed. End QX_root. diff --git a/Liouville/Q_can.v b/Liouville/Q_can.v index 16b5d397e..0e7ca5034 100644 --- a/Liouville/Q_can.v +++ b/Liouville/Q_can.v @@ -30,80 +30,80 @@ Definition Q_can_num (q : Q_as_CRing) : Z_as_CRing := Zdiv (Qnum q) (Zgcd (Qnum Lemma Q_can_num_spec : forall q q', q [=] q' -> Q_can_num q = Q_can_num q'. Proof. -intros q q'. -unfold Q_can_num. -destruct q as [qn qd]; destruct q' as [q'n q'd]. -simpl; unfold Qeq; simpl. -intro Heq. -apply (Zmult_reg_l _ _ (Zgcd qn qd * Zgcd q'n q'd)). + intros q q'. + unfold Q_can_num. + destruct q as [qn qd]; destruct q' as [q'n q'd]. + simpl; unfold Qeq; simpl. + intro Heq. + apply (Zmult_reg_l _ _ (Zgcd qn qd * Zgcd q'n q'd)). intro; destruct (Zmult_integral _ _ H); destruct (Zgcd_zero _ _ H0); discriminate. -rewrite -> (Zmult_comm (Zgcd qn qd)) at 1. -rewrite <- Zmult_assoc, <- Zmult_assoc. -rewrite -> (Zmult_comm (Zgcd qn qd)) at 1. -rewrite -> (Zmult_comm (Zgcd q'n q'd) (q'n / Zgcd q'n q'd)). -rewrite <- Zgcd_div_mult_lft, <- Zgcd_div_mult_lft; - try (intro H; destruct (Zgcd_zero _ _ H); discriminate). -rewrite Zmult_comm (Zmult_comm _ q'n). -rewrite <- (Zabs_Zsgn qn) at 1; rewrite <- (Zabs_Zsgn q'n) at 2. -rewrite (Zmult_comm (Zabs qn)) (Zmult_comm (Zabs q'n)). -rewrite <- Zmult_assoc, <- Zmult_assoc. -rewrite Zgcd_lin Zgcd_lin. -rewrite Heq. -rewrite (Zmult_comm qn q'n). -cut (Zsgn qn = Zsgn q'n). + rewrite -> (Zmult_comm (Zgcd qn qd)) at 1. + rewrite <- Zmult_assoc, <- Zmult_assoc. + rewrite -> (Zmult_comm (Zgcd qn qd)) at 1. + rewrite -> (Zmult_comm (Zgcd q'n q'd) (q'n / Zgcd q'n q'd)). + rewrite <- Zgcd_div_mult_lft, <- Zgcd_div_mult_lft; + try (intro H; destruct (Zgcd_zero _ _ H); discriminate). + rewrite Zmult_comm (Zmult_comm _ q'n). + rewrite <- (Zabs_Zsgn qn) at 1; rewrite <- (Zabs_Zsgn q'n) at 2. + rewrite (Zmult_comm (Zabs qn)) (Zmult_comm (Zabs q'n)). + rewrite <- Zmult_assoc, <- Zmult_assoc. + rewrite Zgcd_lin Zgcd_lin. + rewrite Heq. + rewrite (Zmult_comm qn q'n). + cut (Zsgn qn = Zsgn q'n). intro H; rewrite H; reflexivity. -destruct qn; destruct q'n; reflexivity||discriminate. + destruct qn; destruct q'n; reflexivity||discriminate. Qed. Definition Q_can_den (q : Q_as_CRing) : Z_as_CRing := Zdiv (Qden q) (Zgcd (Qnum q) (Qden q)). Lemma Q_can_den_spec : forall q q', q [=] q' -> Q_can_den q = Q_can_den q'. Proof. -intros q q'. -unfold Q_can_den. -destruct q as [qn qd]; destruct q' as [q'n q'd]. -simpl; unfold Qeq; simpl. -intro Heq. -apply (Zmult_reg_l _ _ (Zgcd qn qd * Zgcd q'n q'd)). + intros q q'. + unfold Q_can_den. + destruct q as [qn qd]; destruct q' as [q'n q'd]. + simpl; unfold Qeq; simpl. + intro Heq. + apply (Zmult_reg_l _ _ (Zgcd qn qd * Zgcd q'n q'd)). intro; destruct (Zmult_integral _ _ H); destruct (Zgcd_zero _ _ H0); discriminate. -rewrite -> (Zmult_comm (Zgcd qn qd)) at 1. -rewrite <- Zmult_assoc, <- Zmult_assoc. -rewrite -> (Zmult_comm (Zgcd qn qd)) at 1. -rewrite (Zmult_comm (Zgcd q'n q'd) (q'd / Zgcd q'n q'd)). -rewrite <- Zgcd_div_mult_rht, <- Zgcd_div_mult_rht; - try (intro H; destruct (Zgcd_zero _ _ H); discriminate). -rewrite Zmult_comm (Zmult_comm _ q'd). -rewrite <- (Zabs_Zsgn qd) at 1; rewrite <- (Zabs_Zsgn q'd) at 2. -rewrite (Zmult_comm (Zabs qd)) (Zmult_comm (Zabs q'd)). -rewrite <- Zmult_assoc, <- Zmult_assoc. -rewrite Zgcd_lin Zgcd_lin. -rewrite (Zmult_comm qd q'n) (Zmult_comm q'd qn). -rewrite Heq. -rewrite (Zmult_comm qd q'd). -reflexivity. + rewrite -> (Zmult_comm (Zgcd qn qd)) at 1. + rewrite <- Zmult_assoc, <- Zmult_assoc. + rewrite -> (Zmult_comm (Zgcd qn qd)) at 1. + rewrite (Zmult_comm (Zgcd q'n q'd) (q'd / Zgcd q'n q'd)). + rewrite <- Zgcd_div_mult_rht, <- Zgcd_div_mult_rht; + try (intro H; destruct (Zgcd_zero _ _ H); discriminate). + rewrite Zmult_comm (Zmult_comm _ q'd). + rewrite <- (Zabs_Zsgn qd) at 1; rewrite <- (Zabs_Zsgn q'd) at 2. + rewrite (Zmult_comm (Zabs qd)) (Zmult_comm (Zabs q'd)). + rewrite <- Zmult_assoc, <- Zmult_assoc. + rewrite Zgcd_lin Zgcd_lin. + rewrite (Zmult_comm qd q'n) (Zmult_comm q'd qn). + rewrite Heq. + rewrite (Zmult_comm qd q'd). + reflexivity. Qed. Lemma Q_can_den_pos : forall q : Q_as_CRing, (0 < Q_can_den q)%Z. Proof. -intro q; destruct q as [qn qd]; unfold Q_can_den. -simpl. -set (Zdiv_le_lower_bound qd (Zgcd qn qd) 1). -assert (0 <= qd)%Z. + intro q; destruct q as [qn qd]; unfold Q_can_den. + simpl. + set (Zdiv_le_lower_bound qd (Zgcd qn qd) 1). + assert (0 <= qd)%Z. discriminate. -assert (0 < Zgcd qn qd)%Z. + assert (0 < Zgcd qn qd)%Z. apply Zgcd_pos. right. discriminate. -assert (1 * Zgcd qn qd <= qd)%Z. + assert (1 * Zgcd qn qd <= qd)%Z. rewrite Zmult_1_l. apply Zgcd_le_rht. reflexivity. -set (z H H0 H1). -revert z0; generalize (qd / Zgcd qn qd)%Z; clear; intros x H. -destruct x. - destruct H; reflexivity. + set (z H H0 H1). + revert z0; generalize (qd / Zgcd qn qd)%Z; clear; intros x H. + destruct x. + destruct H; reflexivity. reflexivity. -destruct H; reflexivity. + destruct H; reflexivity. Qed. Definition Q_can_den_pos_val (q : Q_as_CRing) : positive := @@ -114,43 +114,43 @@ Definition Q_can_den_pos_val (q : Q_as_CRing) : positive := Lemma Q_can_den_pos_val_spec : forall q : Q_as_CRing, Q_can_den q = Q_can_den_pos_val q. Proof. -intro q; set (Q_can_den_pos q). -unfold Q_can_den_pos_val. -revert z. -case (Q_can_den q). - intro; discriminate. + intro q; set (Q_can_den_pos q). + unfold Q_can_den_pos_val. + revert z. + case (Q_can_den q). + intro; discriminate. reflexivity. -intros; discriminate. + intros; discriminate. Qed. Definition Q_can (q : Q_as_CRing) := Qmake (Q_can_num q) (Q_can_den_pos_val q). Lemma Q_can_spec : forall q : Q_as_CRing, q [=] Q_can q. Proof. -intro q; destruct q as [qn qd]; unfold Q_can; simpl; unfold Qeq; simpl. -rewrite <- Q_can_den_pos_val_spec. -unfold Q_can_den, Q_can_num; simpl. -assert (Zgcd qn qd <> 0). + intro q; destruct q as [qn qd]; unfold Q_can; simpl; unfold Qeq; simpl. + rewrite <- Q_can_den_pos_val_spec. + unfold Q_can_den, Q_can_num; simpl. + assert (Zgcd qn qd <> 0). intro. destruct (Zgcd_zero _ _ H). discriminate. -rewrite -> (Zgcd_div_mult_lft qn qd) at 1. + rewrite -> (Zgcd_div_mult_lft qn qd) at 1. rewrite -> (Zgcd_div_mult_rht qn qd) at 6. ring. assumption. -assumption. + assumption. Qed. Lemma Q_can_spec2 : forall q : Q_as_CRing, Zrelprime (Qnum (Q_can q)) (Qden (Q_can q)). Proof. -intro q; destruct q as [qn qd]. -unfold Q_can; simpl. -rewrite <- Q_can_den_pos_val_spec. -unfold Q_can_den, Q_can_num; simpl. -apply Zgcd_div_gcd_1. -intro. -destruct (Zgcd_zero _ _ H). -discriminate. + intro q; destruct q as [qn qd]. + unfold Q_can; simpl. + rewrite <- Q_can_den_pos_val_spec. + unfold Q_can_den, Q_can_num; simpl. + apply Zgcd_div_gcd_1. + intro. + destruct (Zgcd_zero _ _ H). + discriminate. Qed. Definition in_Z (q : Q_as_CRing) := Q_can_den q = 1. diff --git a/Liouville/RX_deg.v b/Liouville/RX_deg.v index 9200789a6..f45a1336c 100644 --- a/Liouville/RX_deg.v +++ b/Liouville/RX_deg.v @@ -30,23 +30,23 @@ Hypothesis R_dec : forall x y : R, COr (x [=] y) (x [#] y). Lemma RX_dec : forall p q : RX, COr (p [=] q) (p [#] q). Proof. -unfold RX; intros p q; pattern p, q; apply Ccpoly_double_sym_ind; clear p q. - intros p q H. - case H. - left; symmetry; assumption. - right; apply ap_symmetric; assumption. + unfold RX; intros p q; pattern p, q; apply Ccpoly_double_sym_ind; clear p q. + intros p q H. + case H. + left; symmetry; assumption. + right; apply ap_symmetric; assumption. intro p; pattern p; apply Ccpoly_induc; clear p. - left; reflexivity. + left; reflexivity. intros p c; case (R_dec c Zero). - intros H1 H2; destruct H2. - left; apply _linear_eq_zero; split; assumption. - right; rewrite linear_ap_zero; right; assumption. + intros H1 H2; destruct H2. + left; apply _linear_eq_zero; split; assumption. + right; rewrite linear_ap_zero; right; assumption. right; rewrite linear_ap_zero; left; assumption. -intros p q c d H; case (R_dec c d). + intros p q c d H; case (R_dec c d). case H. - left; apply _linear_eq_linear; split; assumption. + left; apply _linear_eq_linear; split; assumption. right; rewrite linear_ap_linear; right; assumption. -right; rewrite linear_ap_linear; left; assumption. + right; rewrite linear_ap_linear; left; assumption. Qed. Fixpoint RX_deg (p : RX) : nat := @@ -61,156 +61,156 @@ Proof. reflexivity. Qed. Lemma RX_deg_spec : forall p : RX, p [#] Zero -> degree (RX_deg p) p. Proof. -intro p; pattern p; apply Ccpoly_induc; clear p. + intro p; pattern p; apply Ccpoly_induc; clear p. intro H; destruct (ap_irreflexive _ _ H). -unfold RX; intros p c Hrec. -rewrite linear_ap_zero; intro H. -rewrite RX_deg_linear. -case (RX_dec p Zero). + unfold RX; intros p c Hrec. + rewrite linear_ap_zero; intro H. + rewrite RX_deg_linear. + case (RX_dec p Zero). case H. - split. - assumption. - intro m; case m. - intro H1; inversion H1. - intros; rewrite coeff_Sm_lin. - rewrite <- (nth_coeff_zero _ n). - apply nth_coeff_wd; assumption. + split. + assumption. + intro m; case m. + intro H1; inversion H1. + intros; rewrite coeff_Sm_lin. + rewrite <- (nth_coeff_zero _ n). + apply nth_coeff_wd; assumption. intros Hap Heq; destruct (eq_imp_not_ap _ _ _ Heq Hap). -intro H0; destruct (Hrec H0) as [Hcoeff Hdeg]. -split. + intro H0; destruct (Hrec H0) as [Hcoeff Hdeg]. + split. case (R_dec (nth_coeff (S (RX_deg p)) (c[+X*]p)) Zero). - intro H1; destruct (ap_imp_neq _ _ _ Hcoeff). - rewrite -> coeff_Sm_lin in H1; assumption. + intro H1; destruct (ap_imp_neq _ _ _ Hcoeff). + rewrite -> coeff_Sm_lin in H1; assumption. tauto. -intro m; case m. -intro H1; inversion H1. -clear m; intros m Hlt; rewrite coeff_Sm_lin. -apply Hdeg; apply le_S_n; assumption. + intro m; case m. + intro H1; inversion H1. + clear m; intros m Hlt; rewrite coeff_Sm_lin. + apply Hdeg; apply le_S_n; assumption. Qed. Lemma RX_deg_wd : forall P Q, P [=] Q -> RX_deg P = RX_deg Q. Proof. -intros P Q; pattern P, Q; apply Ccpoly_double_sym_ind; clear P Q. -intros P Q Hsym Heq. -symmetry; apply Hsym; symmetry; assumption. -intro p; pattern p; apply Ccpoly_induc; clear p. -reflexivity. -intros. -rewrite RX_deg_linear. -case (RX_dec p Zero). -reflexivity. -intro Hap; destruct (ap_imp_neq _ _ _ Hap). -apply (linear_eq_zero_ _ _ _ H0). -intros P Q c d Hrec Heq. -destruct (linear_eq_linear_ _ _ _ _ _ Heq). -rewrite RX_deg_linear. -rewrite RX_deg_linear. -case (RX_dec P Zero). -case (RX_dec Q Zero). -reflexivity. -intros H1 H2; destruct (ap_imp_neq _ _ _ H1). -rewrite <- H0; assumption. -case (RX_dec Q Zero). -intros H1 H2; destruct (ap_imp_neq _ _ _ H2). -rewrite H0; assumption. -intros HQ HP. -f_equal; apply Hrec; assumption. + intros P Q; pattern P, Q; apply Ccpoly_double_sym_ind; clear P Q. + intros P Q Hsym Heq. + symmetry; apply Hsym; symmetry; assumption. + intro p; pattern p; apply Ccpoly_induc; clear p. + reflexivity. + intros. + rewrite RX_deg_linear. + case (RX_dec p Zero). + reflexivity. + intro Hap; destruct (ap_imp_neq _ _ _ Hap). + apply (linear_eq_zero_ _ _ _ H0). + intros P Q c d Hrec Heq. + destruct (linear_eq_linear_ _ _ _ _ _ Heq). + rewrite RX_deg_linear. + rewrite RX_deg_linear. + case (RX_dec P Zero). + case (RX_dec Q Zero). + reflexivity. + intros H1 H2; destruct (ap_imp_neq _ _ _ H1). + rewrite <- H0; assumption. + case (RX_dec Q Zero). + intros H1 H2; destruct (ap_imp_neq _ _ _ H2). + rewrite H0; assumption. + intros HQ HP. + f_equal; apply Hrec; assumption. Qed. Lemma degree_inj : forall (P : RX) m n, degree m P -> degree n P -> m = n. Proof. -intros P m n Hm Hn. -destruct Hm as [Hm1 Hm2]. -destruct Hn as [Hn1 Hn2]. -case (lt_eq_lt_dec m n). + intros P m n Hm Hn. + destruct Hm as [Hm1 Hm2]. + destruct Hn as [Hn1 Hn2]. + case (lt_eq_lt_dec m n). intro H; destruct H. - destruct (ap_imp_neq _ _ _ Hn1). - apply Hm2; assumption. + destruct (ap_imp_neq _ _ _ Hn1). + apply Hm2; assumption. assumption. -intro Hlt; destruct (ap_imp_neq _ _ _ Hm1). -apply Hn2; assumption. + intro Hlt; destruct (ap_imp_neq _ _ _ Hm1). + apply Hn2; assumption. Qed. Lemma RX_deg_c_ : forall a : R, RX_deg (_C_ a) = 0. Proof. -simpl; case (RX_dec (cpoly_zero R) (cpoly_zero R)); [reflexivity|]. -intro H; destruct (ap_irreflexive _ _ H). + simpl; case (RX_dec (cpoly_zero R) (cpoly_zero R)); [reflexivity|]. + intro H; destruct (ap_irreflexive _ _ H). Qed. Lemma RX_deg_x_ : RX_deg _X_ = 1. Proof. -simpl. -case (RX_dec (cpoly_one R) (cpoly_zero R)). -intro H; destruct (eq_imp_not_ap _ _ _ H (ring_non_triv _)). -intro; case (RX_dec (cpoly_zero R) (cpoly_zero R)); [reflexivity|]. -intro H; destruct (ap_irreflexive _ _ H). + simpl. + case (RX_dec (cpoly_one R) (cpoly_zero R)). + intro H; destruct (eq_imp_not_ap _ _ _ H (ring_non_triv _)). + intro; case (RX_dec (cpoly_zero R) (cpoly_zero R)); [reflexivity|]. + intro H; destruct (ap_irreflexive _ _ H). Qed. Lemma RX_deg_inv : forall p, RX_deg p = RX_deg ([--]p). Proof. -intro p. -case (RX_dec p Zero). + intro p. + case (RX_dec p Zero). intro H; rewrite (RX_deg_wd _ _ H) RX_deg_zero. rewrite <- RX_deg_zero; apply RX_deg_wd; rewrite H; unfold RX; ring. -intro Hp. -apply (degree_inj p). -apply RX_deg_spec; assumption. -apply (degree_wd _ ([--][--]p)); [apply cg_inv_inv|]. -apply degree_inv. -apply RX_deg_spec. -apply inv_resp_ap_zero; assumption. + intro Hp. + apply (degree_inj p). + apply RX_deg_spec; assumption. + apply (degree_wd _ ([--][--]p)); [apply cg_inv_inv|]. + apply degree_inv. + apply RX_deg_spec. + apply inv_resp_ap_zero; assumption. Qed. Lemma RX_deg_sum : forall p q, RX_deg p <> RX_deg q -> RX_deg (p[+]q)=max (RX_deg p) (RX_deg q). Proof. -intros p q Hneq. -case (RX_dec p Zero). + intros p q Hneq. + case (RX_dec p Zero). intro H; rewrite (RX_deg_wd _ _ H). transitivity (RX_deg q); [apply RX_deg_wd; rewrite H; unfold RX; ring|]. rewrite RX_deg_zero; reflexivity. -case (RX_dec q Zero). + case (RX_dec q Zero). intro H; rewrite (RX_deg_wd _ _ H). transitivity (RX_deg p); [apply RX_deg_wd; rewrite H; unfold RX; ring|]. rewrite RX_deg_zero; rewrite max_comm; reflexivity. -intros Hq Hp. -set (RX_deg_spec _ Hp). -set (RX_deg_spec _ Hq). -case (le_lt_dec (RX_deg p) (RX_deg q)); intro. + intros Hq Hp. + set (RX_deg_spec _ Hp). + set (RX_deg_spec _ Hq). + case (le_lt_dec (RX_deg p) (RX_deg q)); intro. rewrite max_r; [|assumption]. inversion l. - destruct (Hneq H0). + destruct (Hneq H0). apply (degree_inj (p[+]q)). - apply RX_deg_spec. - case (RX_dec (p[+]q) Zero); [|tauto]. - intro; destruct Hneq. - rewrite (RX_deg_wd p ([--]q)). - symmetry; apply RX_deg_inv. - apply cg_inv_unique'; assumption. + apply RX_deg_spec. + case (RX_dec (p[+]q) Zero); [|tauto]. + intro; destruct Hneq. + rewrite (RX_deg_wd p ([--]q)). + symmetry; apply RX_deg_inv. + apply cg_inv_unique'; assumption. apply (degree_plus_rht _ _ _ m); [| |apply le_n]. - apply (degree_le_mon _ _ (RX_deg p)); [assumption|apply d]. + apply (degree_le_mon _ _ (RX_deg p)); [assumption|apply d]. rewrite H; apply RX_deg_spec; assumption. -rewrite max_l; [|apply lt_le_weak; assumption]. -apply (degree_inj (p[+]q)). + rewrite max_l; [|apply lt_le_weak; assumption]. + apply (degree_inj (p[+]q)). apply RX_deg_spec. case (RX_dec (p[+]q) Zero); [|tauto]. intro; destruct Hneq. rewrite (RX_deg_wd p ([--]q)). - symmetry; apply RX_deg_inv. + symmetry; apply RX_deg_inv. apply cg_inv_unique'; assumption. -apply (degree_wd _ _ _ _ (cag_commutes _ _ _)). - apply (degree_plus_rht _ _ _ (RX_deg q)); [| |assumption]. + apply (degree_wd _ _ _ _ (cag_commutes _ _ _)). + apply (degree_plus_rht _ _ _ (RX_deg q)); [| |assumption]. apply degree_imp_degree_le. apply RX_deg_spec; assumption. -apply RX_deg_spec; assumption. + apply RX_deg_spec; assumption. Qed. Lemma RX_deg_minus : forall p q, RX_deg p <> RX_deg q -> RX_deg (p[-]q)=max (RX_deg p) (RX_deg q). Proof. -unfold cg_minus; intros p q Hneq. -rewrite (RX_deg_inv q) in Hneq. -rewrite (RX_deg_sum _ _ Hneq). -f_equal. -symmetry; apply RX_deg_inv. + unfold cg_minus; intros p q Hneq. + rewrite (RX_deg_inv q) in Hneq. + rewrite (RX_deg_sum _ _ Hneq). + f_equal. + symmetry; apply RX_deg_inv. Qed. End RX_deg. diff --git a/Liouville/RX_div.v b/Liouville/RX_div.v index 24adababf..33a9b4651 100644 --- a/Liouville/RX_div.v +++ b/Liouville/RX_div.v @@ -30,37 +30,37 @@ Add Ring rx_r : (r_rt (Ring:=CRing_is_Ring (cpoly_cring R))). Lemma _X_monic : forall a : R, monic 1 (_X_ [-] _C_ a). Proof. -split. + split. reflexivity. -intro m; destruct m. + intro m; destruct m. intro H; inversion H. -destruct m. + destruct m. intro H; destruct (lt_irrefl _ H). -reflexivity. + reflexivity. Qed. Definition RX_div (p : RX) (a : R) : RX. Proof. -intros p a; destruct (cpoly_div p (_X_monic a)) as [qr Hunq Heq]; exact (fst qr). + intros p a; destruct (cpoly_div p (_X_monic a)) as [qr Hunq Heq]; exact (fst qr). Defined. Lemma RX_div_spec : forall (p : RX) (a : R), p [=] (RX_div p a) [*] (_X_ [-] _C_ a) [+] _C_ (p ! a). Proof. -intros p a. -unfold RX_div. -destruct (cpoly_div p (_X_monic a)). -destruct x as [q r]. -unfold fst, snd in *. -destruct c. -rewrite s0. -apply cs_bin_op_wd; [reflexivity|]. -destruct d. -destruct (_X_monic a). -destruct (degree_le_zero _ _ (d _ H0)). -rewrite s2. -apply csf_wd. -rewrite plus_apply mult_apply minus_apply. -rewrite x_apply c_apply c_apply; unfold cg_minus; ring. + intros p a. + unfold RX_div. + destruct (cpoly_div p (_X_monic a)). + destruct x as [q r]. + unfold fst, snd in *. + destruct c. + rewrite s0. + apply cs_bin_op_wd; [reflexivity|]. + destruct d. + destruct (_X_monic a). + destruct (degree_le_zero _ _ (d _ H0)). + rewrite s2. + apply csf_wd. + rewrite plus_apply mult_apply minus_apply. + rewrite x_apply c_apply c_apply; unfold cg_minus; ring. Qed. End RX_div. diff --git a/Liouville/Zlcm.v b/Liouville/Zlcm.v index 7873e6f25..8d3044cb1 100644 --- a/Liouville/Zlcm.v +++ b/Liouville/Zlcm.v @@ -24,68 +24,68 @@ Section Zgcd_lin. Lemma Z_dec : forall x y : Z_as_CRing, x [=] y or x [#] y. Proof. -intros x y; case (Z_eq_dec x y). -left; assumption. -right; assumption. + intros x y; case (Z_eq_dec x y). + left; assumption. + right; assumption. Qed. Lemma Zgcd_lin : forall a b c, (Zabs c * Zgcd a b = Zgcd (c * a) (c * b))%Z. Proof. -intros a b c. -case (Z_eq_dec a 0). + intros a b c. + case (Z_eq_dec a 0). intro H; rewrite H; rewrite Zmult_0_r Zgcd_zero_lft Zgcd_zero_lft; apply Zabs_mult_compat. -intro Ha; case (Z_eq_dec b 0). + intro Ha; case (Z_eq_dec b 0). intro H; rewrite H; rewrite Zmult_0_r Zgcd_zero_rht Zgcd_zero_rht; apply Zabs_mult_compat. -intro Hb; case (Z_eq_dec c 0). + intro Hb; case (Z_eq_dec c 0). intro H; rewrite H; rewrite Zmult_0_l Zmult_0_l Zmult_0_l Zgcd_zero_lft; reflexivity. -intro Hc; apply Zdivides_antisymm. - rewrite <- (Zmult_0_r (Zabs c)). - apply Zmult_pos_mon_lt_lft. - apply Zlt_gt. - apply Zgcd_pos. - left; assumption. - destruct c; [destruct Hc| |]; reflexivity. - apply Zlt_gt. - apply Zgcd_pos. - left. - intro H0; destruct (Zmult_zero_div _ _ H0). - destruct Hc; assumption. - destruct Ha; assumption. + intro Hc; apply Zdivides_antisymm. + rewrite <- (Zmult_0_r (Zabs c)). + apply Zmult_pos_mon_lt_lft. + apply Zlt_gt. + apply Zgcd_pos. + left; assumption. + destruct c; [destruct Hc| |]; reflexivity. + apply Zlt_gt. + apply Zgcd_pos. + left. + intro H0; destruct (Zmult_zero_div _ _ H0). + destruct Hc; assumption. + destruct Ha; assumption. apply Zdiv_gcd_elim. - apply Zdivides_mult_elim. - apply Zdivides_abs_elim_lft. - apply Zdivides_ref. - apply Zgcd_is_divisor_lft. - apply Zdivides_mult_elim. + apply Zdivides_mult_elim. apply Zdivides_abs_elim_lft. apply Zdivides_ref. + apply Zgcd_is_divisor_lft. + apply Zdivides_mult_elim. + apply Zdivides_abs_elim_lft. + apply Zdivides_ref. apply Zgcd_is_divisor_rht. -cut (forall c : positive, Zdivides (Zgcd (c * a) (c * b)) (Zabs c * Zgcd a b)). + cut (forall c : positive, Zdivides (Zgcd (c * a) (c * b)) (Zabs c * Zgcd a b)). intro H; case c. - simpl; rewrite Zgcd_zero_lft; apply Zdivides_ref. - apply H. + simpl; rewrite Zgcd_zero_lft; apply Zdivides_ref. + apply H. intro p; rewrite Zgcd_abs. rewrite <- Zabs_mult_compat, <- Zabs_mult_compat. simpl (Zabs (Zneg p)). assert ((p:Z) = Zabs p). - reflexivity. + reflexivity. rewrite H0; clear H0. rewrite Zabs_mult_compat Zabs_mult_compat. rewrite <- Zgcd_abs. apply H. -clear c Hc; intro c. -rewrite (Zgcd_lin_comb a b). -rewrite Zmult_plus_distr_r. -simpl (Zabs c). -rewrite Zmult_assoc Zmult_assoc. -rewrite (Zmult_comm c (Zgcd_coeff_a a b)). -rewrite (Zmult_comm c (Zgcd_coeff_b a b)). -rewrite <- Zmult_assoc, <- Zmult_assoc. -apply Zdivides_plus_elim. + clear c Hc; intro c. + rewrite (Zgcd_lin_comb a b). + rewrite Zmult_plus_distr_r. + simpl (Zabs c). + rewrite Zmult_assoc Zmult_assoc. + rewrite (Zmult_comm c (Zgcd_coeff_a a b)). + rewrite (Zmult_comm c (Zgcd_coeff_b a b)). + rewrite <- Zmult_assoc, <- Zmult_assoc. + apply Zdivides_plus_elim. apply Zdivides_mult_elim_lft. apply Zgcd_is_divisor_lft. -apply Zdivides_mult_elim_lft. -apply Zgcd_is_divisor_rht. + apply Zdivides_mult_elim_lft. + apply Zgcd_is_divisor_rht. Qed. End Zgcd_lin. @@ -94,104 +94,104 @@ Definition Zlcm (a b : Z_as_CRing) : Z_as_CRing := Zdiv (a [*] b) (Zgcd a b). Lemma Zlcm_specl : forall a b : Z_as_CRing, Zdivides a (Zlcm a b). Proof. -intros a b. -unfold Zlcm. -case (Z_eq_dec (Zgcd a b) (Zero:Z_as_CRing)). + intros a b. + unfold Zlcm. + case (Z_eq_dec (Zgcd a b) (Zero:Z_as_CRing)). intro H; rewrite H; simpl. rewrite Zdiv_0_r. apply Zdivides_zero_rht. -intro H; rewrite -> (Zgcd_div_mult_rht a b) at 1; [|assumption]. -simpl. -rewrite Zmult_assoc. -rewrite Z_div_mult_full; [|assumption]. -apply Zdivides_mult_rht. + intro H; rewrite -> (Zgcd_div_mult_rht a b) at 1; [|assumption]. + simpl. + rewrite Zmult_assoc. + rewrite Z_div_mult_full; [|assumption]. + apply Zdivides_mult_rht. Qed. Lemma Zlcm_specr : forall a b : Z_as_CRing, Zdivides b (Zlcm a b). Proof. -intros a b. -unfold Zlcm. -case (Z_eq_dec (Zgcd a b) (Zero:Z_as_CRing)). + intros a b. + unfold Zlcm. + case (Z_eq_dec (Zgcd a b) (Zero:Z_as_CRing)). intro H; rewrite H; simpl. rewrite Zdiv_0_r. apply Zdivides_zero_rht. -intro H; rewrite -> (Zgcd_div_mult_lft a b) at 1; [|assumption]. -simpl. -rewrite Zmult_comm. -rewrite Zmult_assoc. -rewrite Z_div_mult_full; [|assumption]. -apply Zdivides_mult_rht. + intro H; rewrite -> (Zgcd_div_mult_lft a b) at 1; [|assumption]. + simpl. + rewrite Zmult_comm. + rewrite Zmult_assoc. + rewrite Z_div_mult_full; [|assumption]. + apply Zdivides_mult_rht. Qed. Lemma Zlcm_spec : forall a b c : Z_as_CRing, Zdivides a c -> Zdivides b c -> Zdivides (Zlcm a b) c. Proof. -intros a b c Hac Hbc; unfold Zlcm; simpl. -case (Z_eq_dec (Zgcd a b) (Zero:Z_as_CRing)). + intros a b c Hac Hbc; unfold Zlcm; simpl. + case (Z_eq_dec (Zgcd a b) (Zero:Z_as_CRing)). intro H; rewrite H; simpl. destruct (Zgcd_zero _ _ H). rewrite H0 in Hac; clear H H0 H1. rewrite Zdiv_0_r; assumption. -case (Z_eq_dec c (Zero:Z_as_CRing)). + case (Z_eq_dec c (Zero:Z_as_CRing)). intro Hc; rewrite Hc. intro Hap; apply Zdivides_zero_rht. -intros Hc Hap. -apply Zdivides_abs_intro_rht. -rewrite <- (Zmult_1_r (Zabs c)). -rewrite <- (Zgcd_div_gcd_1 a b); [|assumption]. -rewrite Zgcd_lin. -apply Zdiv_gcd_elim. + intros Hc Hap. + apply Zdivides_abs_intro_rht. + rewrite <- (Zmult_1_r (Zabs c)). + rewrite <- (Zgcd_div_gcd_1 a b); [|assumption]. + rewrite Zgcd_lin. + apply Zdiv_gcd_elim. cut (a * b / Zgcd a b = b * (a / Zgcd a b))%Z. - intro H; rewrite H; clear H. - apply Zdivides_mult_cancel_rht. - assumption. + intro H; rewrite H; clear H. + apply Zdivides_mult_cancel_rht. + assumption. rewrite Zmult_comm. apply (Zmult_reg_r _ _ (Zgcd a b) Hap). rewrite <- Zmult_assoc. rewrite <- (Zgcd_div_mult_lft _ _ Hap). rewrite Zmult_comm. rewrite <- (Z_div_exact_full_2 _ _ Hap). - reflexivity. + reflexivity. apply Zmod0_Zdivides. - apply Hap. + apply Hap. apply Zdivides_mult_elim_lft. apply Zgcd_is_divisor_lft. -cut (a * b / Zgcd a b = a * (b / Zgcd a b))%Z. + cut (a * b / Zgcd a b = a * (b / Zgcd a b))%Z. intro H; rewrite H; clear H. apply Zdivides_mult_cancel_rht. assumption. -apply (Zmult_reg_r _ _ (Zgcd a b) Hap). -rewrite <- Zmult_assoc. -rewrite <- (Zgcd_div_mult_rht _ _ Hap). -rewrite Zmult_comm. -rewrite <- (Z_div_exact_full_2 _ _ Hap). + apply (Zmult_reg_r _ _ (Zgcd a b) Hap). + rewrite <- Zmult_assoc. + rewrite <- (Zgcd_div_mult_rht _ _ Hap). + rewrite Zmult_comm. + rewrite <- (Z_div_exact_full_2 _ _ Hap). reflexivity. -apply Zmod0_Zdivides. + apply Zmod0_Zdivides. apply Hap. -apply Zdivides_mult_elim_lft. -apply Zgcd_is_divisor_rht. + apply Zdivides_mult_elim_lft. + apply Zgcd_is_divisor_rht. Qed. Lemma Zlcm_zero : forall p q, Zlcm p q [=] Zero -> p [=] Zero or q [=] Zero. Proof. -intros p q; unfold Zlcm; intro Heq. -case (Z_eq_dec p (Zero:Z_as_CRing)). + intros p q; unfold Zlcm; intro Heq. + case (Z_eq_dec p (Zero:Z_as_CRing)). left; assumption. -intro Happ; right. -simpl in *. -unfold ap_Z in Happ. -apply (Zmult_integral_l _ _ Happ). -rewrite Zmult_comm. -revert Heq. -assert (Zgcd p q <> 0%Z). + intro Happ; right. + simpl in *. + unfold ap_Z in Happ. + apply (Zmult_integral_l _ _ Happ). + rewrite Zmult_comm. + revert Heq. + assert (Zgcd p q <> 0%Z). intro H; destruct Happ; apply (Zgcd_zero _ _ H). -rewrite -> (Zgcd_div_mult_lft p q) at 1; [|assumption]. -rewrite (Zmult_comm (p / Zgcd p q)). -rewrite <- Zmult_assoc. -rewrite Zdiv_mult_cancel_lft; [|assumption]. -intro Heq. -rewrite (Zgcd_div_mult_lft p q); [|assumption]. -rewrite <- Zmult_assoc, (Zmult_comm _ q), Zmult_assoc. -rewrite Heq Zmult_0_l; reflexivity. + rewrite -> (Zgcd_div_mult_lft p q) at 1; [|assumption]. + rewrite (Zmult_comm (p / Zgcd p q)). + rewrite <- Zmult_assoc. + rewrite Zdiv_mult_cancel_lft; [|assumption]. + intro Heq. + rewrite (Zgcd_div_mult_lft p q); [|assumption]. + rewrite <- Zmult_assoc, (Zmult_comm _ q), Zmult_assoc. + rewrite Heq Zmult_0_l; reflexivity. Qed. Fixpoint Zlcm_gen (l : list Z_as_CRing) : Z_as_CRing := @@ -202,54 +202,54 @@ Fixpoint Zlcm_gen (l : list Z_as_CRing) : Z_as_CRing := Lemma Zlcm_gen_spec : forall l x, In x l -> Zdivides x (Zlcm_gen l). Proof. -induction l. + induction l. intros x Hin; destruct Hin. -intros x Hin; destruct Hin. + intros x Hin; destruct Hin. rewrite <- H; clear H. apply Zlcm_specl. -fold (In x l) in H. -simpl. -apply (Zdivides_trans _ _ _ (IHl _ H)). -apply Zlcm_specr. + fold (In x l) in H. + simpl. + apply (Zdivides_trans _ _ _ (IHl _ H)). + apply Zlcm_specr. Qed. Lemma Zlcm_gen_spec2 : forall l x, (forall y, In y l -> Zdivides y x) -> Zdivides (Zlcm_gen l) x. Proof. -induction l. + induction l. intros; apply Zdivides_one. -intros x H; apply Zlcm_spec. + intros x H; apply Zlcm_spec. apply H; left; reflexivity. -fold (Zlcm_gen l). -apply IHl. -intros y Hin; apply H. -right; assumption. + fold (Zlcm_gen l). + apply IHl. + intros y Hin; apply H. + right; assumption. Qed. Lemma Zdivides_spec : forall (a b : Z), Zdivides a b -> (a * (b / a) = b)%Z. Proof. -intros a b Hdiv. -case (Z_eq_dec a 0). + intros a b Hdiv. + case (Z_eq_dec a 0). intro H; rewrite H; simpl. symmetry; apply Zdivides_zero_lft; rewrite <- H; assumption. -intro Hap. -rewrite <- Z_div_exact_full_2. - reflexivity. + intro Hap. + rewrite <- Z_div_exact_full_2. + reflexivity. assumption. -case (Z_eq_dec a 0). + case (Z_eq_dec a 0). intro H; rewrite H; simpl; apply Zmod_0_r. -intro H; clear H. -apply Zmod0_Zdivides; assumption. + intro H; clear H. + apply Zmod0_Zdivides; assumption. Qed. Lemma Zlcm_gen_nz : forall l, (forall x, In x l -> x [#] Zero) -> Zlcm_gen l [#] Zero. Proof. -induction l. + induction l. intro; intro; discriminate. -simpl. -intros H1 H2; simpl. -destruct (Zlcm_zero a (Zlcm_gen l) H2). + simpl. + intros H1 H2; simpl. + destruct (Zlcm_zero a (Zlcm_gen l) H2). apply (H1 a); [left; reflexivity|assumption]. -destruct IHl; [|assumption]. -intros; apply H1; right; assumption. + destruct IHl; [|assumption]. + intros; apply H1; right; assumption. Qed. diff --git a/Liouville/nat_Q_lists.v b/Liouville/nat_Q_lists.v index 4696baf82..353c7e427 100644 --- a/Liouville/nat_Q_lists.v +++ b/Liouville/nat_Q_lists.v @@ -30,15 +30,15 @@ Fixpoint list_nat (p : nat) : list nat := Lemma list_nat_spec : forall p a, a <= p -> In a (list_nat p). Proof. -intro p; induction p. + intro p; induction p. intros a Hle; inversion Hle; left; reflexivity. -intros a Hle; simpl. -case (eq_nat_dec (S p) a). + intros a Hle; simpl. + case (eq_nat_dec (S p) a). left; assumption. -right; apply IHp. -inversion Hle. + right; apply IHp. + inversion Hle. destruct n; symmetry; assumption. -assumption. + assumption. Qed. Definition list_nat_prod (p q : nat) : list (nat * nat) := @@ -47,7 +47,7 @@ Definition list_nat_prod (p q : nat) : list (nat * nat) := Lemma list_nat_prod_spec : forall p q a b, a <= p -> b <= q -> In (a, b) (list_nat_prod p q). Proof. -intros; apply in_prod; apply list_nat_spec; assumption. + intros; apply in_prod; apply list_nat_spec; assumption. Qed. Definition nat_prod_to_Q (pq : nat * nat) : list Q_as_CRing := @@ -68,8 +68,8 @@ Definition list_Q (a b : Z_as_CRing) : list Q_as_CRing := Lemma list_Q_spec_pos : forall a b c d, Zabs_nat c <= Zabs_nat a -> Zabs_nat (Zpos d) <= Zabs_nat b -> In (Qmake c d) (list_Q a b). Proof. -intros a b c d Hca Hdb. -case (dec_Qeq (c#d)%Q Zero). + intros a b c d Hca Hdb. + case (dec_Qeq (c#d)%Q Zero). unfold Qeq; simpl; rewrite Zmult_1_r. intro Heq; rewrite Heq. clear c Hca Heq. @@ -77,9 +77,9 @@ case (dec_Qeq (c#d)%Q Zero). rewrite in_flat_map. exists (0, pred (nat_of_P d)). split. - apply list_nat_prod_spec. - apply le_O_n. - apply (le_trans _ _ _ (le_pred_n _) Hdb). + apply list_nat_prod_spec. + apply le_O_n. + apply (le_trans _ _ _ (le_pred_n _) Hdb). left. f_equal. destruct (ZL4 d). @@ -87,92 +87,92 @@ case (dec_Qeq (c#d)%Q Zero). simpl. rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H. apply nat_of_P_inj; symmetry; assumption. -unfold list_Q. -rewrite in_flat_map. -exists (Zabs_nat c, Zabs_nat d). -split. + unfold list_Q. + rewrite in_flat_map. + exists (Zabs_nat c, Zabs_nat d). + split. apply list_nat_prod_spec; assumption. -simpl. -case (ZL4 d). -intros d' Hd'. -unfold Zabs_nat at 1 in Hdb. -rewrite Hd'. -rewrite Hd' in Hdb. -case_eq (Zabs_nat c). + simpl. + case (ZL4 d). + intros d' Hd'. + unfold Zabs_nat at 1 in Hdb. + rewrite Hd'. + rewrite Hd' in Hdb. + case_eq (Zabs_nat c). intro Heq. destruct H. destruct c. - reflexivity. - simpl in Heq; destruct (ZL4 p); rewrite Heq in H; discriminate. + reflexivity. + simpl in Heq; destruct (ZL4 p); rewrite Heq in H; discriminate. simpl in Heq; destruct (ZL4 p); rewrite Heq in H; discriminate. -intros. -destruct c as [|c|c]. - discriminate. + intros. + destruct c as [|c|c]. + discriminate. constructor 1. unfold Qeq; simpl. assert (c = P_of_succ_nat n). - rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H0. - simpl in H. - apply nat_of_P_inj; assumption. + rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H0. + simpl in H. + apply nat_of_P_inj; assumption. rewrite H1. cut (P_of_succ_nat d' = d). - intro H2; rewrite H2; reflexivity. + intro H2; rewrite H2; reflexivity. apply nat_of_P_inj. rewrite nat_of_P_o_P_of_succ_nat_eq_succ. symmetry; assumption. -constructor 2. -constructor 1. -unfold Qeq; simpl. -assert (c = P_of_succ_nat n). + constructor 2. + constructor 1. + unfold Qeq; simpl. + assert (c = P_of_succ_nat n). rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H0. simpl in H. apply nat_of_P_inj; assumption. -rewrite H1. -cut (P_of_succ_nat d' = d). + rewrite H1. + cut (P_of_succ_nat d' = d). intro H2; rewrite H2; reflexivity. -apply nat_of_P_inj. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -symmetry; assumption. + apply nat_of_P_inj. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + symmetry; assumption. Qed. Lemma list_Q_spec_neg : forall a b c d, Zabs_nat c <= Zabs_nat a -> Zabs_nat (Zneg d) <= Zabs_nat b -> In (Qmake c d) (list_Q a b). Proof. -intros a b c d. -apply list_Q_spec_pos. + intros a b c d. + apply list_Q_spec_pos. Qed. Lemma list_Q_spec_zero : forall a b d, nat_of_P d <= Zabs_nat b -> In (Qmake Z0 d) (list_Q a b). Proof. -intros a b d Hle. -unfold list_Q. -rewrite in_flat_map. -exists (0, pred (nat_of_P d)). -split. + intros a b d Hle. + unfold list_Q. + rewrite in_flat_map. + exists (0, pred (nat_of_P d)). + split. apply list_nat_prod_spec. - apply le_O_n. + apply le_O_n. apply (le_trans _ _ _ (le_pred_n _) Hle). -left. -f_equal. -destruct (ZL4 d). -rewrite H. -simpl. -rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H. -apply nat_of_P_inj; symmetry; assumption. + left. + f_equal. + destruct (ZL4 d). + rewrite H. + simpl. + rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H. + apply nat_of_P_inj; symmetry; assumption. Qed. Lemma div_imp_leq : forall a b : Z_as_CRing, b [#] Zero -> Zdivides a b -> Zabs_nat a <= Zabs_nat b. Proof. -intros a b Hap Hdiv. -destruct Hdiv. -rewrite <- H. -rewrite Zabs_nat_mult. -rewrite <- H in Hap. -destruct x. - destruct Hap. - reflexivity. + intros a b Hap Hdiv. + destruct Hdiv. + rewrite <- H. + rewrite Zabs_nat_mult. + rewrite <- H in Hap. + destruct x. + destruct Hap. + reflexivity. simpl. destruct (ZL4 p). rewrite H0. @@ -180,45 +180,45 @@ destruct x. rewrite <- (plus_0_r (Zabs_nat a)) at 1. apply plus_le_compat_l. apply le_O_n. -simpl. -destruct (ZL4 p). -rewrite H0. -simpl. -rewrite <- (plus_0_r (Zabs_nat a)) at 1. -apply plus_le_compat_l. -apply le_O_n. + simpl. + destruct (ZL4 p). + rewrite H0. + simpl. + rewrite <- (plus_0_r (Zabs_nat a)) at 1. + apply plus_le_compat_l. + apply le_O_n. Qed. Lemma list_Q_spec : forall (a b : Z_as_CRing) q, a [#] Zero -> b [#] Zero -> Zdivides (Q_can_num q) a -> Zdivides (Zabs_nat (Q_can_den_pos_val q)) b -> In (Q_can q) (list_Q a b). Proof. -intros a b q Hapa Hapb Ha Hb. -destruct q as [qn qd]. -destruct qn. - apply list_Q_spec_zero. - revert Hb; generalize (Q_can_den_pos_val (0#qd)%Q). - intros p Hdiv. - assert (nat_of_P p = Zabs_nat p). - reflexivity. - rewrite H; apply div_imp_leq. - assumption. - rewrite inj_Zabs_nat in Hdiv. - apply Zdivides_abs_intro_lft; assumption. + intros a b q Hapa Hapb Ha Hb. + destruct q as [qn qd]. + destruct qn. + apply list_Q_spec_zero. + revert Hb; generalize (Q_can_den_pos_val (0#qd)%Q). + intros p Hdiv. + assert (nat_of_P p = Zabs_nat p). + reflexivity. + rewrite H; apply div_imp_leq. + assumption. + rewrite inj_Zabs_nat in Hdiv. + apply Zdivides_abs_intro_lft; assumption. apply list_Q_spec_pos. - apply div_imp_leq; assumption. + apply div_imp_leq; assumption. apply div_imp_leq. - assumption. + assumption. apply Zdivides_abs_intro_lft. rewrite <- inj_Zabs_nat. assumption. -apply list_Q_spec_neg. + apply list_Q_spec_neg. apply div_imp_leq; assumption. -apply div_imp_leq. + apply div_imp_leq. assumption. -apply Zdivides_abs_intro_lft. -rewrite <- inj_Zabs_nat. -assumption. + apply Zdivides_abs_intro_lft. + rewrite <- inj_Zabs_nat. + assumption. Qed. End nat_Q_lists. diff --git a/algebra/Basics.v b/algebra/Basics.v index d6a3bdfd5..4473b756f 100644 --- a/algebra/Basics.v +++ b/algebra/Basics.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing alpha %\ensuremath{\alpha}% #α# *) (** printing beta %\ensuremath{\beta}% #β# *) @@ -58,115 +58,120 @@ This is random stuff that should be in the Coq basic library. *) Lemma lt_le_dec : forall n m : nat, {n < m} + {m <= n}. -intros. -case (le_lt_dec m n); auto. +Proof. + intros. + case (le_lt_dec m n); auto. Qed. Lemma lt_z_two : 0 < 2. -auto. +Proof. + auto. Qed. Lemma le_pred : forall n m : nat, n <= m -> pred n <= pred m. Proof. -simple induction n. simpl in |- *. auto with arith. -intros n0 Hn0. simple induction m. simpl in |- *. intro H. inversion H. -intros n1 H H0. simpl in |- *. auto with arith. + simple induction n. simpl in |- *. auto with arith. + intros n0 Hn0. simple induction m. simpl in |- *. intro H. inversion H. + intros n1 H H0. simpl in |- *. auto with arith. Qed. Lemma lt_mult_right : forall x y z : nat, x < y -> 0 < z -> x * z < y * z. -intros x y z H H0. -induction z as [| z Hrecz]. -elim (lt_irrefl _ H0). -rewrite mult_comm. -replace (y * S z) with (S z * y); auto with arith. +Proof. + intros x y z H H0. + induction z as [| z Hrecz]. + elim (lt_irrefl _ H0). + rewrite mult_comm. + replace (y * S z) with (S z * y); auto with arith. Qed. Lemma le_mult_right : forall x y z : nat, x <= y -> x * z <= y * z. -intros x y z H. -rewrite mult_comm. rewrite (mult_comm y). -auto with arith. +Proof. + intros x y z H. + rewrite mult_comm. rewrite (mult_comm y). + auto with arith. Qed. Lemma le_irrelevent : forall n m (H1 H2:le n m), H1=H2. Proof. -assert (forall n (H1: le n n), H1 = le_n n). - intros n H1. - change H1 with (eq_rec n (fun a => a <= n) H1 _ (refl_equal n)). - generalize (refl_equal n). - revert H1. - generalize n at 1 3 7. - dependent inversion H1. - apply K_dec_set. - decide equality. - reflexivity. - intros; elimtype False; omega. -induction m. + assert (forall n (H1: le n n), H1 = le_n n). + intros n H1. + change H1 with (eq_rec n (fun a => a <= n) H1 _ (refl_equal n)). + generalize (refl_equal n). + revert H1. + generalize n at 1 3 7. + dependent inversion H1. + apply K_dec_set. + decide equality. + reflexivity. + intros; elimtype False; omega. + induction m. + dependent inversion H1. + symmetry. + apply H. dependent inversion H1. - symmetry. - apply H. -dependent inversion H1. - symmetry. - apply H. -intros H3. -change H3 with (eq_rec (S m) (le n) (eq_rec n (fun n => n <= S m) H3 _ (refl_equal n)) _ (refl_equal (S m))). -generalize (refl_equal n) (refl_equal (S m)). -revert H3. -generalize n at 1 2 7. -generalize (S m) at 1 2 5 6. -dependent inversion H3. - intros; elimtype False; omega. -intros e e0. -assert (e':=e). -assert (e0':=e0). -revert e e0 l0. -rewrite e', (eq_add_S _ _ e0'). -intros e. -elim e using K_dec_set. - decide equality. -intros e0. -elim e0 using K_dec_set. - decide equality. -simpl. -intros l0. -rewrite (IHm l l0). -reflexivity. + symmetry. + apply H. + intros H3. + change H3 with (eq_rec (S m) (le n) (eq_rec n (fun n => n <= S m) H3 _ (refl_equal n)) _ (refl_equal (S m))). + generalize (refl_equal n) (refl_equal (S m)). + revert H3. + generalize n at 1 2 7. + generalize (S m) at 1 2 5 6. + dependent inversion H3. + intros; elimtype False; omega. + intros e e0. + assert (e':=e). + assert (e0':=e0). + revert e e0 l0. + rewrite e', (eq_add_S _ _ e0'). + intros e. + elim e using K_dec_set. + decide equality. + intros e0. + elim e0 using K_dec_set. + decide equality. + simpl. + intros l0. + rewrite (IHm l l0). + reflexivity. Qed. Lemma minus3:forall (a b c:nat),(c<=b<=a)-> a+(b-c)=b+(a-c). -intros a b d H. -cut ((Z_of_nat a) + ((Z_of_nat b) - (Z_of_nat d)) = -(Z_of_nat b) + ((Z_of_nat a) - (Z_of_nat d)))%Z. -2:intuition. -intro H1. -elim H. -intros H2 H3. -set (H4:=(inj_minus1 b d H2)). -rewrite<- H4 in H1. -cut (d <=a). -intro H5. -2:intuition. -set (H6:=(inj_minus1 a d H5)). -rewrite<- H6 in H1. -intuition. +Proof. + intros a b d H. + cut ((Z_of_nat a) + ((Z_of_nat b) - (Z_of_nat d)) = (Z_of_nat b) + ((Z_of_nat a) - (Z_of_nat d)))%Z. + 2:intuition. + intro H1. + elim H. + intros H2 H3. + set (H4:=(inj_minus1 b d H2)). + rewrite<- H4 in H1. + cut (d <=a). + intro H5. + 2:intuition. + set (H6:=(inj_minus1 a d H5)). + rewrite<- H6 in H1. + intuition. Qed. Lemma minus4:forall (a b c d:nat), (d<=c<=b)-> (a+b)+(c-d)=(a+c)+(b-d). -intros a b c0 d H. -cut (((Z_of_nat a)+(Z_of_nat b))+((Z_of_nat c0)-(Z_of_nat d))= - ((Z_of_nat a)+(Z_of_nat c0))+((Z_of_nat b)-(Z_of_nat d)))%Z. -intro H0. -2:intuition. -elim H. -intros H1 H2. -set (H3:=(inj_minus1 c0 d H1)). -rewrite<- H3 in H0. -cut (d<=b). -2:intuition. -intro H4. -set (H5:=(inj_minus1 b d H4)). -rewrite<- H5 in H0. -intuition. +Proof. + intros a b c0 d H. + cut (((Z_of_nat a)+(Z_of_nat b))+((Z_of_nat c0)-(Z_of_nat d))= + ((Z_of_nat a)+(Z_of_nat c0))+((Z_of_nat b)-(Z_of_nat d)))%Z. + intro H0. + 2:intuition. + elim H. + intros H1 H2. + set (H3:=(inj_minus1 c0 d H1)). + rewrite<- H3 in H0. + cut (d<=b). + 2:intuition. + intro H4. + set (H5:=(inj_minus1 b d H4)). + rewrite<- H5 in H0. + intuition. Qed. (** The power function does not exist in the standard library *) @@ -188,7 +193,7 @@ Fixpoint fac (n : nat) : nat := Lemma nat_fac_gtzero : forall n : nat, 0 < fac n. Proof. -simple induction n; simpl in |- *; auto with arith. + simple induction n; simpl in |- *; auto with arith. Qed. (* needed for computational behavior of "Inversion" tactic *) @@ -235,16 +240,18 @@ Qed. Lemma not_r_sumbool_rec : forall (A B : Prop) (S : Set) (l r : S), ~ B -> forall H : {A} + {B}, sumbool_rec (fun _ : {A} + {B} => S) (fun x : A => l) (fun x : B => r) H = l. -intros. elim H0. -intros. reflexivity. -intro. elim H. assumption. +Proof. + intros. elim H0. + intros. reflexivity. + intro. elim H. assumption. Qed. Lemma not_l_sumbool_rec : forall (A B : Prop) (S : Set) (l r : S), ~ A -> forall H : {A} + {B}, sumbool_rec (fun _ : {A} + {B} => S) (fun x : A => l) (fun x : B => r) H = r. -intros. elim H0. -intro. elim H. assumption. -intros. reflexivity. +Proof. + intros. elim H0. + intro. elim H. assumption. + intros. reflexivity. Qed. (* begin hide *) @@ -263,269 +270,260 @@ Coercion Z_of_nat : nat >-> Z. (* end hide *) Lemma POS_anti_convert : forall n : nat, S n = Zpos (P_of_succ_nat n) :>Z. -simple induction n. -simpl in |- *. -reflexivity. -intros n0 H. -simpl in |- *. -reflexivity. +Proof. + simple induction n. + simpl in |- *. + reflexivity. + intros n0 H. + simpl in |- *. + reflexivity. Qed. Lemma NEG_anti_convert : forall n : nat, (- S n)%Z = Zneg (P_of_succ_nat n). -simple induction n. -simpl in |- *. -reflexivity. -intros n0 H. -simpl in |- *. -reflexivity. +Proof. + simple induction n. + simpl in |- *. + reflexivity. + intros n0 H. + simpl in |- *. + reflexivity. Qed. Lemma lt_O_positive_to_nat : forall (p : positive) (m : nat), 0 < m -> 0 < Pmult_nat p m. -intro p. -elim p. -intros p0 H m H0. -simpl in |- *. -auto with arith. -intros p0 H m H0. -simpl in |- *. -apply H. -auto with arith. -intros m H. -simpl in |- *. -assumption. +Proof. + intro p. + elim p. + intros p0 H m H0. + simpl in |- *. + auto with arith. + intros p0 H m H0. + simpl in |- *. + apply H. + auto with arith. + intros m H. + simpl in |- *. + assumption. Qed. Lemma anti_convert_pred_convert : forall p : positive, p = P_of_succ_nat (pred (nat_of_P p)). -intro p. -pattern p at 1 in |- *. -rewrite <- pred_o_P_of_succ_nat_o_nat_of_P_eq_id. -cut (exists n : nat, nat_of_P p = S n). - -intro H. -elim H; intros x H0. -rewrite H0. -elim x. - -simpl in |- *. -reflexivity. - -intros n H1. -simpl in |- *. -rewrite Ppred_succ. -reflexivity. - -exists (pred (nat_of_P p)). -apply S_pred with 0. -unfold nat_of_P in |- *. -apply lt_O_positive_to_nat. -auto with arith. +Proof. + intro p. + pattern p at 1 in |- *. + rewrite <- pred_o_P_of_succ_nat_o_nat_of_P_eq_id. + cut (exists n : nat, nat_of_P p = S n). + intro H. + elim H; intros x H0. + rewrite H0. + elim x. + simpl in |- *. + reflexivity. + intros n H1. + simpl in |- *. + rewrite Ppred_succ. + reflexivity. + exists (pred (nat_of_P p)). + apply S_pred with 0. + unfold nat_of_P in |- *. + apply lt_O_positive_to_nat. + auto with arith. Qed. Lemma p_is_some_anti_convert : forall p : positive, exists n : nat, p = P_of_succ_nat n. -intro p. -exists (pred (nat_of_P p)). -apply anti_convert_pred_convert. +Proof. + intro p. + exists (pred (nat_of_P p)). + apply anti_convert_pred_convert. Qed. Lemma convert_is_POS : forall p : positive, nat_of_P p = Zpos p :>Z. -intro p. -elim (p_is_some_anti_convert p). -intros x H. -rewrite H. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -apply POS_anti_convert. +Proof. + intro p. + elim (p_is_some_anti_convert p). + intros x H. + rewrite H. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + apply POS_anti_convert. Qed. Lemma min_convert_is_NEG : forall p : positive, (- nat_of_P p)%Z = Zneg p. -intro p. -elim (p_is_some_anti_convert p). -intros x H. -rewrite H. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -apply NEG_anti_convert. +Proof. + intro p. + elim (p_is_some_anti_convert p). + intros x H. + rewrite H. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + apply NEG_anti_convert. Qed. -Lemma surj_eq:forall (n m:nat), +Lemma surj_eq:forall (n m:nat), ((Z_of_nat n)=(Z_of_nat m))%Z -> n=m. -intros n m. -intuition. +Proof. + intros n m. + intuition. Qed. -Lemma surj_le:forall (n m:nat), +Lemma surj_le:forall (n m:nat), ((Z_of_nat n)<=(Z_of_nat m))%Z -> n<=m. -intros n m. -intuition. +Proof. + intros n m. + intuition. Qed. -Lemma surj_lt:forall (n m:nat), +Lemma surj_lt:forall (n m:nat), ((Z_of_nat n)<(Z_of_nat m))%Z -> n(Z_of_nat m))%Z -> n<>m. -intros n m. -intuition. +Proof. + intros n m. + intuition. Qed. Lemma lt_lt_minus:forall(q p l:nat), q p p+(l-q)nat. -intros z. -case z. -intro H. -exact 0. -intros p H. -exact (nat_of_P p). - -intros p H. -cut False. -intuition. -intuition. +Proof. + intros z. + case z. + intro H. + exact 0. + intros p H. + exact (nat_of_P p). + intros p H. + cut False. + intuition. + intuition. Defined. Lemma Z_to_nat_correct:forall (z:Z)(H:(0<=z)%Z), z=(Z_of_nat (Z_to_nat H)). -intro z. -case z. -intro H. -unfold Z_to_nat. -reflexivity. - -intros p H. -unfold Z_to_nat. -cut ( Z_of_nat (nat_of_P p)= Zpos p). -intuition. -apply inject_nat_convert. -intros p H. -cut False. -intuition. -intuition. +Proof. + intro z. + case z. + intro H. + unfold Z_to_nat. + reflexivity. + intros p H. + unfold Z_to_nat. + cut ( Z_of_nat (nat_of_P p)= Zpos p). + intuition. + apply inject_nat_convert. + intros p H. + cut False. + intuition. + intuition. Qed. Lemma Z_exh : forall z : Z, (exists n : nat, z = n) \/ (exists n : nat, z = (- n)%Z). -intro z. -elim z. - -left. -exists 0. -auto. - -intro p. -left. -exists (nat_of_P p). -rewrite convert_is_POS. -reflexivity. - -intro p. -right. -exists (nat_of_P p). -rewrite min_convert_is_NEG. -reflexivity. +Proof. + intro z. + elim z. + left. + exists 0. + auto. + intro p. + left. + exists (nat_of_P p). + rewrite convert_is_POS. + reflexivity. + intro p. + right. + exists (nat_of_P p). + rewrite min_convert_is_NEG. + reflexivity. Qed. Lemma nats_Z_ind : forall P : Z -> Prop, (forall n : nat, P n) -> (forall n : nat, P (- n)%Z) -> forall z : Z, P z. -intros P H H0 z. -elim (Z_exh z); intro H1. - -elim H1; intros x H2. -rewrite H2. -apply H. - -elim H1; intros x H2. -rewrite H2. -apply H0. +Proof. + intros P H H0 z. + elim (Z_exh z); intro H1. + elim H1; intros x H2. + rewrite H2. + apply H. + elim H1; intros x H2. + rewrite H2. + apply H0. Qed. Lemma pred_succ_Z_ind : forall P : Z -> Prop, P 0%Z -> (forall n : Z, P n -> P (n + 1)%Z) -> (forall n : Z, P n -> P (n - 1)%Z) -> forall z : Z, P z. -intros P H H0 H1 z. -apply nats_Z_ind. - -intro n. -elim n. - -exact H. - -intros n0 H2. -replace (S n0:Z) with (n0 + 1)%Z. - -apply H0. -assumption. - -rewrite Znat.inj_S. -reflexivity. - -intro n. -elim n. - -exact H. - -intros n0 H2. -replace (- S n0)%Z with (- n0 - 1)%Z. - -apply H1. -assumption. - -rewrite Znat.inj_S. -unfold Zsucc in |- *. -rewrite Zopp_plus_distr. -reflexivity. +Proof. + intros P H H0 H1 z. + apply nats_Z_ind. + intro n. + elim n. + exact H. + intros n0 H2. + replace (S n0:Z) with (n0 + 1)%Z. + apply H0. + assumption. + rewrite Znat.inj_S. + reflexivity. + intro n. + elim n. + exact H. + intros n0 H2. + replace (- S n0)%Z with (- n0 - 1)%Z. + apply H1. + assumption. + rewrite Znat.inj_S. + unfold Zsucc in |- *. + rewrite Zopp_plus_distr. + reflexivity. Qed. Lemma Zmult_minus_distr_r : forall n m p : Z, (p * (n - m))%Z = (p * n - p * m)%Z. -intros n m p. -rewrite Zmult_comm. -rewrite Zmult_minus_distr_r. -rewrite Zmult_comm. -pattern (m * p)%Z in |- *. -rewrite Zmult_comm. -reflexivity. +Proof. + intros n m p. + rewrite Zmult_comm. + rewrite Zmult_minus_distr_r. + rewrite Zmult_comm. + pattern (m * p)%Z in |- *. + rewrite Zmult_comm. + reflexivity. Qed. Lemma Zodd_Zeven_min1 : forall x : Z, Zeven.Zodd x -> Zeven.Zeven (x - 1). -intro x. -elim x. - -simpl in |- *. -auto. -simple induction p. - -simpl in |- *. -auto. - -intros p0 H H0. -simpl in H0. -tauto. - -simpl in |- *; auto. - -simple induction p. - -simpl in |- *; auto. - -simpl in |- *; auto. - -auto. +Proof. + intro x. + elim x. + simpl in |- *. + auto. + simple induction p. + simpl in |- *. + auto. + intros p0 H H0. + simpl in H0. + tauto. + simpl in |- *; auto. + simple induction p. + simpl in |- *; auto. + simpl in |- *; auto. + auto. Qed. (* begin hide *) @@ -546,93 +544,77 @@ Unset Implicit Arguments. (* end hide *) Lemma caseZ_diff_O : forall (A : Type) (f : nat -> nat -> A), caseZ_diff 0 f = f 0 0. -auto. +Proof. + auto. Qed. Lemma caseZ_diff_Pos : forall (A : Type) (f : nat -> nat -> A) (n : nat), caseZ_diff n f = f n 0. -intros A f n. -elim n. - -reflexivity. - -intros n0 H. -simpl in |- *. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -reflexivity. +Proof. + intros A f n. + elim n. + reflexivity. + intros n0 H. + simpl in |- *. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + reflexivity. Qed. Lemma caseZ_diff_Neg : forall (A : Type) (f : nat -> nat -> A) (n : nat), caseZ_diff (- n) f = f 0 n. -intros A f n. -elim n. - -reflexivity. - -intros n0 H. -simpl in |- *. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -reflexivity. +Proof. + intros A f n. + elim n. + reflexivity. + intros n0 H. + simpl in |- *. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + reflexivity. Qed. Lemma proper_caseZ_diff : forall (A : Type) (f : nat -> nat -> A), (forall m n p q : nat, m + q = n + p -> f m n = f p q) -> forall m n : nat, caseZ_diff (m - n) f = f m n. -intros A F H m n. -pattern m, n in |- *. -apply nat_double_ind. - -intro n0. -replace (0%nat - n0)%Z with (- n0)%Z. - -rewrite caseZ_diff_Neg. -reflexivity. - -simpl in |- *. -reflexivity. - -intro n0. -replace (S n0 - 0%nat)%Z with (Z_of_nat (S n0)). - -rewrite caseZ_diff_Pos. -reflexivity. - -simpl in |- *. -reflexivity. - -intros n0 m0 H0. -rewrite H with (S n0) (S m0) n0 m0. - -rewrite <- H0. -replace (S n0 - S m0)%Z with (n0 - m0)%Z. - -reflexivity. - -repeat rewrite Znat.inj_S. -auto with zarith. - -auto with zarith. +Proof. + intros A F H m n. + pattern m, n in |- *. + apply nat_double_ind. + intro n0. + replace (0%nat - n0)%Z with (- n0)%Z. + rewrite caseZ_diff_Neg. + reflexivity. + simpl in |- *. + reflexivity. + intro n0. + replace (S n0 - 0%nat)%Z with (Z_of_nat (S n0)). + rewrite caseZ_diff_Pos. + reflexivity. + simpl in |- *. + reflexivity. + intros n0 m0 H0. + rewrite H with (S n0) (S m0) n0 m0. + rewrite <- H0. + replace (S n0 - S m0)%Z with (n0 - m0)%Z. + reflexivity. + repeat rewrite Znat.inj_S. + auto with zarith. + auto with zarith. Qed. Lemma diff_Z_ind : forall P : Z -> Prop, (forall m n : nat, P (m - n)%Z) -> forall z : Z, P z. -intros P H z. -apply nats_Z_ind. - -intro n. -replace (Z_of_nat n) with (n - 0%nat)%Z. - -apply H. - -simpl in |- *. -auto with zarith. - -intro n. -replace (- n)%Z with (0%nat - n)%Z. - -apply H. - -simpl in |- *. -reflexivity. +Proof. + intros P H z. + apply nats_Z_ind. + intro n. + replace (Z_of_nat n) with (n - 0%nat)%Z. + apply H. + simpl in |- *. + auto with zarith. + intro n. + replace (- n)%Z with (0%nat - n)%Z. + apply H. + simpl in |- *. + reflexivity. Qed. Lemma Zlt_reg_mult_l : forall x y z : Z, @@ -640,28 +622,21 @@ Lemma Zlt_reg_mult_l : forall x y z : Z, Proof. intros x y z H H0. case (Zcompare_Gt_spec x 0). - - unfold Zgt in H. - assumption. - + unfold Zgt in H. + assumption. intros x0 H1. cut (x = Zpos x0). - - intro H2. - rewrite H2. - unfold Zlt in H0. - unfold Zlt in |- *. - cut ((Zpos x0 * y ?= Zpos x0 * z)%Z = (y ?= z)%Z). - - intro H3. - exact (trans_eq H3 H0). - - apply Zcompare_mult_compat. - + intro H2. + rewrite H2. + unfold Zlt in H0. + unfold Zlt in |- *. + cut ((Zpos x0 * y ?= Zpos x0 * z)%Z = (y ?= z)%Z). + intro H3. + exact (trans_eq H3 H0). + apply Zcompare_mult_compat. cut (x = (x + - (0))%Z). - intro H2. - exact (trans_eq H2 H1). - + intro H2. + exact (trans_eq H2 H1). simpl in |- *. apply (sym_eq (A:=Z)). exact (Zplus_0_r x). @@ -673,15 +648,11 @@ Proof. red in |- *. apply sym_eq. cut (Datatypes.Gt = (y ?= x)%Z). - - intro H0. - cut ((y ?= x)%Z = (- x ?= - y)%Z). - - intro H1. - exact (trans_eq H0 H1). - - exact (Zcompare_opp y x). - + intro H0. + cut ((y ?= x)%Z = (- x ?= - y)%Z). + intro H1. + exact (trans_eq H0 H1). + exact (Zcompare_opp y x). apply sym_eq. exact (Zlt_gt x y H). Qed. @@ -691,57 +662,39 @@ Lemma Zlt_conv_mult_l : forall x y z : Z, Proof. intros x y z H H0. cut (- x > 0)%Z. - - intro H1. - cut (- x * y < - x * z)%Z. - - intro H2. - cut (- (- x * y) > - (- x * z))%Z. - - intro H3. - cut (- - (x * y) > - - (x * z))%Z. - - intro H4. - cut ((- - (x * y))%Z = (x * y)%Z). - - intro H5. - rewrite H5 in H4. - cut ((- - (x * z))%Z = (x * z)%Z). - - intro H6. - rewrite H6 in H4. - assumption. - - exact (Zopp_involutive (x * z)). - - exact (Zopp_involutive (x * y)). - - cut ((- (- x * y))%Z = (- - (x * y))%Z). - intro H4. - rewrite H4 in H3. - cut ((- (- x * z))%Z = (- - (x * z))%Z). - - intro H5. - rewrite H5 in H3. - assumption. - - cut ((- x * z)%Z = (- (x * z))%Z). - intro H5. - exact (f_equal Zopp H5). - - exact (Zopp_mult_distr_l_reverse x z). - - cut ((- x * y)%Z = (- (x * y))%Z). - intro H4. - - exact (f_equal Zopp H4). - - exact (Zopp_mult_distr_l_reverse x y). - - exact (Zlt_opp (- x * y) (- x * z) H2). - - exact (Zlt_reg_mult_l (- x) y z H1 H0). - + intro H1. + cut (- x * y < - x * z)%Z. + intro H2. + cut (- (- x * y) > - (- x * z))%Z. + intro H3. + cut (- - (x * y) > - - (x * z))%Z. + intro H4. + cut ((- - (x * y))%Z = (x * y)%Z). + intro H5. + rewrite H5 in H4. + cut ((- - (x * z))%Z = (x * z)%Z). + intro H6. + rewrite H6 in H4. + assumption. + exact (Zopp_involutive (x * z)). + exact (Zopp_involutive (x * y)). + cut ((- (- x * y))%Z = (- - (x * y))%Z). + intro H4. + rewrite H4 in H3. + cut ((- (- x * z))%Z = (- - (x * z))%Z). + intro H5. + rewrite H5 in H3. + assumption. + cut ((- x * z)%Z = (- (x * z))%Z). + intro H5. + exact (f_equal Zopp H5). + exact (Zopp_mult_distr_l_reverse x z). + cut ((- x * y)%Z = (- (x * y))%Z). + intro H4. + exact (f_equal Zopp H4). + exact (Zopp_mult_distr_l_reverse x y). + exact (Zlt_opp (- x * y) (- x * z) H2). + exact (Zlt_reg_mult_l (- x) y z H1 H0). exact (Zlt_opp x 0 H). Qed. @@ -749,23 +702,17 @@ Lemma Zgt_not_eq : forall x y : Z, (x > y)%Z -> x <> y. Proof. intros x y H. cut (y < x)%Z. - - intro H0. - cut (y <> x). - - intro H1. - red in |- *. - intro H2. - cut (y = x). - - intro H3. - apply H1. - assumption. - - exact (sym_eq H2). - - exact (Zorder.Zlt_not_eq y x H0). - + intro H0. + cut (y <> x). + intro H1. + red in |- *. + intro H2. + cut (y = x). + intro H3. + apply H1. + assumption. + exact (sym_eq H2). + exact (Zorder.Zlt_not_eq y x H0). exact (Zgt_lt x y H). Qed. @@ -774,104 +721,70 @@ Lemma Zmult_absorb : forall x y z : Z, Proof. intros x y z H H0. case (dec_eq y z). - - intro H1. - assumption. - + intro H1. + assumption. intro H1. case (not_Zeq y z). - - assumption. - - intro H2. - case (not_Zeq x 0). - - assumption. - - intro H3. - elimtype False. - cut (x * y > x * z)%Z. - - intro H4. - cut ((x * y)%Z <> (x * z)%Z). - - intro H5. - apply H5. - assumption. - - exact (Zgt_not_eq (x * y) (x * z) H4). - - exact (Zlt_conv_mult_l x y z H3 H2). - - intro H3. - elimtype False. - cut (x * y < x * z)%Z. - - intro H4. - cut ((x * y)%Z <> (x * z)%Z). - - intro H5. - apply H5. - assumption. - - exact (Zorder.Zlt_not_eq (x * y) (x * z) H4). - - apply Zlt_reg_mult_l. - - exact (Zlt_gt 0 x H3). - - assumption. - + assumption. + intro H2. + case (not_Zeq x 0). + assumption. + intro H3. + elimtype False. + cut (x * y > x * z)%Z. + intro H4. + cut ((x * y)%Z <> (x * z)%Z). + intro H5. + apply H5. + assumption. + exact (Zgt_not_eq (x * y) (x * z) H4). + exact (Zlt_conv_mult_l x y z H3 H2). + intro H3. + elimtype False. + cut (x * y < x * z)%Z. + intro H4. + cut ((x * y)%Z <> (x * z)%Z). + intro H5. + apply H5. + assumption. + exact (Zorder.Zlt_not_eq (x * y) (x * z) H4). + apply Zlt_reg_mult_l. + exact (Zlt_gt 0 x H3). + assumption. intro H2. apply False_ind. cut (x * z < x * y)%Z. - - intro H3. - cut ((x * z)%Z <> (x * y)%Z). - - intro H4. - apply H4. - apply (sym_eq (A:=Z)). - assumption. - - exact (Zorder.Zlt_not_eq (x * z) (x * y) H3). - + intro H3. + cut ((x * z)%Z <> (x * y)%Z). + intro H4. + apply H4. + apply (sym_eq (A:=Z)). + assumption. + exact (Zorder.Zlt_not_eq (x * z) (x * y) H3). apply False_ind. case (not_Zeq x 0). - - assumption. - - intro H3. - cut (x * z > x * y)%Z. - - intro H4. - cut ((x * z)%Z <> (x * y)%Z). - - intro H5. - apply H5. - apply (sym_eq (A:=Z)). - assumption. - - exact (Zgt_not_eq (x * z) (x * y) H4). - - exact (Zlt_conv_mult_l x z y H3 H2). - + assumption. + intro H3. + cut (x * z > x * y)%Z. + intro H4. + cut ((x * z)%Z <> (x * y)%Z). + intro H5. + apply H5. + apply (sym_eq (A:=Z)). + assumption. + exact (Zgt_not_eq (x * z) (x * y) H4). + exact (Zlt_conv_mult_l x z y H3 H2). intro H3. cut (x * z < x * y)%Z. - - intro H4. - cut ((x * z)%Z <> (x * y)%Z). - - intro H5. - apply H5. - apply (sym_eq (A:=Z)). - assumption. - - exact (Zorder.Zlt_not_eq (x * z) (x * y) H4). - + intro H4. + cut ((x * z)%Z <> (x * y)%Z). + intro H5. + apply H5. + apply (sym_eq (A:=Z)). + assumption. + exact (Zorder.Zlt_not_eq (x * z) (x * y) H4). apply Zlt_reg_mult_l. - - exact (Zlt_gt 0 x H3). + exact (Zlt_gt 0 x H3). auto. Qed. @@ -899,10 +812,11 @@ Section AccIter. Variable P : A -> Type. Variable F : forall x : A, (forall y : A, R y x -> P y) -> P x. Lemma Acc_inv : forall x : A, Acc R x -> forall y : A, R y x -> Acc R y. - destruct 1; trivial. +Proof. + destruct 1; trivial. Defined. - Fixpoint Acc_iter (x : A) (a : Acc R x) {struct a} : + Fixpoint Acc_iter (x : A) (a : Acc R x) {struct a} : P x := F x (fun (y : A) (h : R y x) => Acc_iter y (Acc_inv x a y h)). End AccIter. @@ -912,8 +826,9 @@ Hypothesis Rwf : well_founded A R. 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. Proof. - intros; apply (Acc_iter P); auto. + intros; apply (Acc_iter P); auto. Defined. End IndT. @@ -925,23 +840,23 @@ Definition ltof (a b : A) := f a < f b. Theorem well_founded_ltof : well_founded A ltof. Proof. -red in |- *. -cut (forall (n : nat) (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. + red in |- *. + cut (forall (n : nat) (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 induction_ltof2T : forall P : A -> Type, (forall x : A, (forall y : A, ltof y x -> P y) -> P x) -> forall a : A, P a. Proof. -exact (well_founded_induction_type A ltof well_founded_ltof). + exact (well_founded_induction_type A ltof well_founded_ltof). Defined. End InductionT. @@ -949,10 +864,8 @@ Section InductionTT. Lemma lt_wf_rect : forall (p : nat) (P : nat -> Type), (forall n : nat, (forall m : nat, m < n -> P m) -> P n) -> P p. Proof. -exact - (fun (p : nat) (P : nat -> Type) - (F : forall n : nat, (forall m : nat, m < n -> P m) -> P n) => - induction_ltof2T nat (fun m : nat => m) P F p). + exact (fun (p : nat) (P : nat -> Type) (F : forall n : nat, (forall m : nat, m < n -> P m) -> P n) => + induction_ltof2T nat (fun m : nat => m) P F p). Defined. End InductionTT. @@ -963,14 +876,14 @@ Fixpoint positive_rect2_helper (P : positive -> Type) (c1 : forall p : positive, P (Psucc p) -> P p -> P (xI p)) (c2 : forall p : positive, P p -> P (xO p)) - (c3 : P 1%positive) + (c3 : P 1%positive) (b : bool) (p : positive) {struct p} : P (if b then Psucc p else p) := match p return (P (if b then Psucc p else p)) with | xH => if b return P (if b then (Psucc xH) else xH) then (c2 _ c3) else c3 - | xO p' => if b return P (if b then (Psucc (xO p')) else xO p') + | xO p' => if b return P (if b then (Psucc (xO p')) else xO p') then (c1 _ (positive_rect2_helper P c1 c2 c3 true _) (positive_rect2_helper P c1 c2 c3 false _)) else (c2 _ (positive_rect2_helper P c1 c2 c3 false _)) - | xI p' => if b return P (if b then (Psucc (xI p')) else xI p') + | xI p' => if b return P (if b then (Psucc (xI p')) else xI p') then (c2 _ (positive_rect2_helper P c1 c2 c3 true _)) else (c1 _ (positive_rect2_helper P c1 c2 c3 true _) (positive_rect2_helper P c1 c2 c3 false _)) end. @@ -986,39 +899,41 @@ Lemma positive_rect2_helper_bool : forall P c1 c2 c3 p, positive_rect2_helper P c1 c2 c3 true p = positive_rect2_helper P c1 c2 c3 false (Psucc p). Proof. -intros P c1 c2 c3. -induction p; try reflexivity. -simpl. -rewrite IHp. -reflexivity. + intros P c1 c2 c3. + induction p; try reflexivity. + simpl. + rewrite IHp. + reflexivity. Qed. Lemma positive_rect2_red1 : forall P c1 c2 c3 p, positive_rect2 P c1 c2 c3 (xI p) = c1 p (positive_rect2 P c1 c2 c3 (Psucc p)) (positive_rect2 P c1 c2 c3 p). Proof. -intros P c1 c2 c3 p. -unfold positive_rect2. -simpl. -rewrite positive_rect2_helper_bool. -reflexivity. + intros P c1 c2 c3 p. + unfold positive_rect2. + simpl. + rewrite positive_rect2_helper_bool. + reflexivity. Qed. Lemma positive_rect2_red2 : forall P c1 c2 c3 p, positive_rect2 P c1 c2 c3 (xO p) = c2 p (positive_rect2 P c1 c2 c3 p). -reflexivity. +Proof. + reflexivity. Qed. Lemma positive_rect2_red3 : forall P c1 c2 c3, positive_rect2 P c1 c2 c3 (xH) = c3. -reflexivity. +Proof. + reflexivity. Qed. (** Iteration for natural numbers. *) Fixpoint iterateN A (f:A -> A) (z:A) (n:nat) : list A := -match n with +match n with O => nil |S m => z :: (iterateN A f (f z) m) end. @@ -1027,12 +942,12 @@ Implicit Arguments iterateN [A]. (* end hide *) Lemma iterateN_f : forall A f (z:A) n, iterateN f (f z) n = map f (iterateN f z n). Proof. -intros A f z n. -revert f z. -induction n. + intros A f z n. + revert f z. + induction n. + reflexivity. + simpl. + intros f z. + rewrite <- IHn. reflexivity. -simpl. -intros f z. -rewrite <- IHn. -reflexivity. Qed. diff --git a/algebra/Bernstein.v b/algebra/Bernstein.v index a9b5f7346..29ba8f761 100644 --- a/algebra/Bernstein.v +++ b/algebra/Bernstein.v @@ -44,7 +44,7 @@ Variable R : CRing. Fixpoint Bernstein (n i:nat) {struct n}: (i <= n) -> cpoly_cring R := match n return (i <= n) -> cpoly_cring R with O => fun _ => One -|S n' => +|S n' => match i return (i <= S n') -> cpoly_cring R with O => fun _ => (One[-]_X_)[*](Bernstein (le_O_n n')) |S i' => fun p => @@ -59,24 +59,24 @@ end. Lemma Bernstein_inv1 : forall n i (H:i < n) (H0:S i <= S n), Bernstein H0[=](One[-]_X_)[*](Bernstein (lt_n_Sm_le _ _ (lt_n_S _ _ H)))[+]_X_[*](Bernstein (le_S_n _ _ H0)). Proof. -intros n i H H0. -simpl (Bernstein H0). -destruct (le_lt_eq_dec _ _ H0). - replace (lt_n_Sm_le (S i) n l) with (lt_n_Sm_le _ _ (lt_n_S _ _ H)) by apply le_irrelevent. - reflexivity. -elimtype False; omega. -Qed. + intros n i H H0. + simpl (Bernstein H0). + destruct (le_lt_eq_dec _ _ H0). + replace (lt_n_Sm_le (S i) n l) with (lt_n_Sm_le _ _ (lt_n_S _ _ H)) by apply le_irrelevent. + reflexivity. + elimtype False; omega. +Qed. Lemma Bernstein_inv2 : forall n (H:S n <= S n), Bernstein H[=]_X_[*](Bernstein (le_S_n _ _ H)). Proof. -intros n H. -simpl (Bernstein H). -destruct (le_lt_eq_dec _ _ H). - elimtype False; omega. -replace (lt_n_Sm_le n n H) with (le_S_n n n H) by apply le_irrelevent. -reflexivity. -Qed. + intros n H. + simpl (Bernstein H). + destruct (le_lt_eq_dec _ _ H). + elimtype False; omega. + replace (lt_n_Sm_le n n H) with (le_S_n n n H) by apply le_irrelevent. + reflexivity. +Qed. Lemma Bernstein_ind : forall n i (H:i<=n) (P : nat -> nat -> cpoly_cring R -> Prop), P 0 0 One -> @@ -85,221 +85,200 @@ P 0 0 One -> (forall i n p q, (i < n) -> P n i p -> P n (S i) q -> P (S n) (S i) ((One[-]_X_)[*]q[+]_X_[*]p)) -> P n i (Bernstein H). Proof. -intros n i H P H0 H1 H2 H3. -revert n i H. -induction n; - intros [|i] H. - apply H0. - elimtype False; auto with *. - apply H1. - apply IHn. -simpl. -destruct (le_lt_eq_dec (S i) (S n)). - apply H3; auto with *. -inversion e. -revert H. -rewrite H5. -intros H. -apply H2. -auto with *. + intros n i H P H0 H1 H2 H3. + revert n i H. + induction n; intros [|i] H. + apply H0. + elimtype False; auto with *. + apply H1. + apply IHn. + simpl. + destruct (le_lt_eq_dec (S i) (S n)). + apply H3; auto with *. + inversion e. + revert H. + rewrite H5. + intros H. + apply H2. + auto with *. Qed. (** One important property of the Bernstein basis is that its elements form a partition of unity *) Lemma partitionOfUnity : forall n, @Sumx (cpoly_cring R) _ (fun i H => Bernstein (lt_n_Sm_le i n H)) [=]One. Proof. -induction n. - reflexivity. -set (A:=(fun (i : nat) (H : i < S n) => Bernstein (lt_n_Sm_le i n H))) in *. -set (B:=(fun i => (One[-]_X_)[*](part_tot_nat_fun (cpoly_cring R) _ A i)[+]_X_[*]match i with O => Zero | S i' => (part_tot_nat_fun _ _ A i') end)). -rewrite (fun a b => Sumx_Sum0 _ a b B). - unfold B. - rewrite Sum0_plus_Sum0. - do 2 rewrite mult_distr_sum0_lft. - rewrite -> Sumx_to_Sum in IHn; auto with *. - setoid_replace (Sum0 (S (S n)) (part_tot_nat_fun (cpoly_cring R) (S n) A)) - with (Sum0 (S (S n)) (part_tot_nat_fun (cpoly_cring R) (S n) A)[-]Zero);[|rational]. - change (Sum0 (S (S n)) (part_tot_nat_fun (cpoly_cring R) (S n) A)[-]Zero) - with (Sum 0 (S n) (part_tot_nat_fun (cpoly_cring R) (S n) A)). - set (C:=(fun i : nat => - match i with - | 0 => (Zero : cpoly_cring R) - | S i' => part_tot_nat_fun (cpoly_cring R) (S n) A i' - end)). - setoid_replace (Sum0 (S (S n)) C) - with (Sum0 (S (S n)) C[-]Zero);[|rational]. - change (Sum0 (S (S n)) C[-]Zero) with (Sum 0 (S n) C). - rewrite Sum_last. - rewrite IHn. - replace (part_tot_nat_fun (cpoly_cring R) (S n) A (S n)) with (Zero:cpoly_cring R). - rewrite Sum_first. - change (C 0) with (Zero:cpoly_cring R). - rewrite <- (Sum_shift _ (part_tot_nat_fun (cpoly_cring R) (S n) A)). - rewrite IHn. - rational. - reflexivity. - unfold part_tot_nat_fun. - destruct (le_lt_dec (S n) (S n)). - reflexivity. - elimtype False; omega. - intros i j Hij. - rewrite Hij. - intros Hi Hj. - unfold A. - replace (lt_n_Sm_le j n Hi) with (lt_n_Sm_le j n Hj) by apply le_irrelevent. - apply eq_reflexive. -destruct i; - intros Hi; - unfold B, A, part_tot_nat_fun. - simpl (sumbool_rect (fun _ : {S n <= 0} + {0 < S n} => cpoly_cring R) - (fun _ : S n <= 0 => Zero) - (fun b : 0 < S n => Bernstein (lt_n_Sm_le 0 n b)) (le_lt_dec (S n) 0)). - generalize (lt_n_Sm_le 0 (S n) Hi) (lt_n_Sm_le 0 n (gt_le_S 0 (S n) (lt_O_Sn n))). - intros l l0. - simpl (Bernstein l). - replace l0 with (le_O_n n) by apply le_irrelevent. - rational. -destruct (le_lt_dec (S n) i). - elimtype False; omega. -destruct (le_lt_dec (S n) (S i)); - simpl (Bernstein (lt_n_Sm_le (S i) (S n) Hi)); - destruct (le_lt_eq_dec (S i) (S n) (lt_n_Sm_le (S i) (S n) Hi)). + induction n. + reflexivity. + set (A:=(fun (i : nat) (H : i < S n) => Bernstein (lt_n_Sm_le i n H))) in *. + set (B:=(fun i => (One[-]_X_)[*](part_tot_nat_fun (cpoly_cring R) _ A i)[+]_X_[*]match i with O => Zero | S i' => (part_tot_nat_fun _ _ A i') end)). + rewrite (fun a b => Sumx_Sum0 _ a b B). + unfold B. + rewrite Sum0_plus_Sum0. + do 2 rewrite mult_distr_sum0_lft. + rewrite -> Sumx_to_Sum in IHn; auto with *. + setoid_replace (Sum0 (S (S n)) (part_tot_nat_fun (cpoly_cring R) (S n) A)) + with (Sum0 (S (S n)) (part_tot_nat_fun (cpoly_cring R) (S n) A)[-]Zero);[|rational]. + change (Sum0 (S (S n)) (part_tot_nat_fun (cpoly_cring R) (S n) A)[-]Zero) + with (Sum 0 (S n) (part_tot_nat_fun (cpoly_cring R) (S n) A)). + set (C:=(fun i : nat => match i with | 0 => (Zero : cpoly_cring R) + | S i' => part_tot_nat_fun (cpoly_cring R) (S n) A i' end)). + setoid_replace (Sum0 (S (S n)) C) with (Sum0 (S (S n)) C[-]Zero);[|rational]. + change (Sum0 (S (S n)) C[-]Zero) with (Sum 0 (S n) C). + rewrite Sum_last. + rewrite IHn. + replace (part_tot_nat_fun (cpoly_cring R) (S n) A (S n)) with (Zero:cpoly_cring R). + rewrite Sum_first. + change (C 0) with (Zero:cpoly_cring R). + rewrite <- (Sum_shift _ (part_tot_nat_fun (cpoly_cring R) (S n) A)). + rewrite IHn. + rational. + reflexivity. + unfold part_tot_nat_fun. + destruct (le_lt_dec (S n) (S n)). + reflexivity. elimtype False; omega. - replace (lt_n_Sm_le i n (lt_n_Sm_le (S i) (S n) Hi)) - with (lt_n_Sm_le i n l) by apply le_irrelevent. - simpl. + intros i j Hij. + rewrite Hij. + intros Hi Hj. + unfold A. + replace (lt_n_Sm_le j n Hi) with (lt_n_Sm_le j n Hj) by apply le_irrelevent. + apply eq_reflexive. + destruct i; intros Hi; unfold B, A, part_tot_nat_fun. + simpl (sumbool_rect (fun _ : {S n <= 0} + {0 < S n} => cpoly_cring R) (fun _ : S n <= 0 => Zero) + (fun b : 0 < S n => Bernstein (lt_n_Sm_le 0 n b)) (le_lt_dec (S n) 0)). + generalize (lt_n_Sm_le 0 (S n) Hi) (lt_n_Sm_le 0 n (gt_le_S 0 (S n) (lt_O_Sn n))). + intros l l0. + simpl (Bernstein l). + replace l0 with (le_O_n n) by apply le_irrelevent. rational. - replace (le_S_n i n (lt_n_Sm_le (S i) (S n) Hi)) - with (lt_n_Sm_le i n l) by apply le_irrelevent. - replace l1 with l0 by apply le_irrelevent. - reflexivity. -elimtype False; omega. + destruct (le_lt_dec (S n) i). + elimtype False; omega. + destruct (le_lt_dec (S n) (S i)); simpl (Bernstein (lt_n_Sm_le (S i) (S n) Hi)); + destruct (le_lt_eq_dec (S i) (S n) (lt_n_Sm_le (S i) (S n) Hi)). + elimtype False; omega. + replace (lt_n_Sm_le i n (lt_n_Sm_le (S i) (S n) Hi)) with (lt_n_Sm_le i n l) by apply le_irrelevent. + simpl. + rational. + replace (le_S_n i n (lt_n_Sm_le (S i) (S n) Hi)) with (lt_n_Sm_le i n l) by apply le_irrelevent. + replace l1 with l0 by apply le_irrelevent. + reflexivity. + elimtype False; omega. Qed. Lemma RaiseDegreeA : forall n i (H:i<=n), (nring (S n))[*]_X_[*]Bernstein H[=](nring (S i))[*]Bernstein (le_n_S _ _ H). Proof. -induction n. - intros [|i] H; [|elimtype False; omega]. - repeat split; rational. -intros i H. -change (nring (S (S n)):cpoly_cring R) with (nring (S n)[+]One:cpoly_cring R). -rstepl (nring (S n)[*]_X_[*]Bernstein H[+]_X_[*]Bernstein H). -destruct i as [|i]. + induction n. + intros [|i] H; [|elimtype False; omega]. + repeat split; rational. + intros i H. + change (nring (S (S n)):cpoly_cring R) with (nring (S n)[+]One:cpoly_cring R). + rstepl (nring (S n)[*]_X_[*]Bernstein H[+]_X_[*]Bernstein H). + destruct i as [|i]. + simpl (Bernstein H) at 1. + rstepl ((One[-]_X_)[*](nring (S n)[*]_X_[*]Bernstein (le_O_n n))[+] _X_[*]Bernstein H). + rewrite IHn. + rstepl ((nring 1)[*]((One[-]_X_)[*]Bernstein (le_n_S _ _ (le_O_n n))[+]_X_[*]Bernstein H)). + set (l0:=(lt_n_Sm_le _ _ (le_n_S 1 (S n) (gt_le_S 0 (S n) (gt_Sn_O n))))). + replace (le_n_S 0 n (le_O_n n)) with l0 by apply le_irrelevent. + reflexivity. simpl (Bernstein H) at 1. - rstepl ((One[-]_X_)[*](nring (S n)[*]_X_[*]Bernstein (le_O_n n))[+] - _X_[*]Bernstein H). + destruct (le_lt_eq_dec _ _ H). + rstepl ((One[-]_X_)[*](nring (S n)[*]_X_[*]Bernstein (lt_n_Sm_le (S i) n l))[+] + _X_[*](nring (S n)[*]_X_[*]Bernstein (le_S_n i n H))[+] _X_[*]Bernstein H). + do 2 rewrite IHn. + change (nring (S (S i)):cpoly_cring R) with (nring (S i)[+]One:cpoly_cring R). + set (l0:= (le_n_S (S i) n (lt_n_Sm_le (S i) n l))). + replace (le_n_S i n (le_S_n i n H)) with H by apply le_irrelevent. + rstepl ((nring (S i)[+]One)[*]((One[-]_X_)[*]Bernstein l0[+]_X_[*]Bernstein H)). + rewrite (Bernstein_inv1 l). + replace (lt_n_Sm_le (S (S i)) (S n) (lt_n_S (S i) (S n) l)) with l0 by apply le_irrelevent. + replace (le_S_n (S i) (S n) (le_n_S (S i) (S n) H)) with H by apply le_irrelevent. + reflexivity. + rstepl (_X_[*](nring (S n)[*]_X_[*]Bernstein (lt_n_Sm_le _ _ H))[+] _X_[*]Bernstein H). rewrite IHn. - rstepl ((nring 1)[*]((One[-]_X_)[*]Bernstein (le_n_S _ _ (le_O_n n))[+]_X_[*]Bernstein H)). - set (l0:=(lt_n_Sm_le _ _ (le_n_S 1 (S n) (gt_le_S 0 (S n) (gt_Sn_O n))))). - replace (le_n_S 0 n (le_O_n n)) with l0 by apply le_irrelevent. - reflexivity. -simpl (Bernstein H) at 1. -destruct (le_lt_eq_dec _ _ H). - rstepl ((One[-]_X_)[*](nring (S n)[*]_X_[*]Bernstein (lt_n_Sm_le (S i) n l))[+] - _X_[*](nring (S n)[*]_X_[*]Bernstein (le_S_n i n H))[+] - _X_[*]Bernstein H). - do 2 rewrite IHn. - change (nring (S (S i)):cpoly_cring R) with (nring (S i)[+]One:cpoly_cring R). - set (l0:= (le_n_S (S i) n (lt_n_Sm_le (S i) n l))). - replace (le_n_S i n (le_S_n i n H)) with H by apply le_irrelevent. - rstepl ((nring (S i)[+]One)[*]((One[-]_X_)[*]Bernstein l0[+]_X_[*]Bernstein H)). - rewrite (Bernstein_inv1 l). - replace (lt_n_Sm_le (S (S i)) (S n) (lt_n_S (S i) (S n) l)) - with l0 by apply le_irrelevent. - replace (le_S_n (S i) (S n) (le_n_S (S i) (S n) H)) - with H by apply le_irrelevent. - reflexivity. -rstepl (_X_[*](nring (S n)[*]_X_[*]Bernstein (lt_n_Sm_le _ _ H))[+] - _X_[*]Bernstein H). -rewrite IHn. -replace (le_n_S i n (lt_n_Sm_le i n H)) with H by apply le_irrelevent. -revert H. -inversion_clear e. -intros H. -rewrite (Bernstein_inv2 (le_n_S _ _ H)). -replace (le_S_n (S n) (S n) (le_n_S (S n) (S n) H)) with H by apply le_irrelevent. -change (nring (S (S n)):cpoly_cring R) with (nring (S n)[+]One:cpoly_cring R). -rational. + replace (le_n_S i n (lt_n_Sm_le i n H)) with H by apply le_irrelevent. + revert H. + inversion_clear e. + intros H. + rewrite (Bernstein_inv2 (le_n_S _ _ H)). + replace (le_S_n (S n) (S n) (le_n_S (S n) (S n) H)) with H by apply le_irrelevent. + change (nring (S (S n)):cpoly_cring R) with (nring (S n)[+]One:cpoly_cring R). + rational. Qed. Lemma RaiseDegreeB : forall n i (H:i<=n), (nring (S n))[*](One[-]_X_)[*]Bernstein H[=](nring (S n - i))[*]Bernstein (le_S _ _ H). Proof. -induction n. - intros [|i] H; [|elimtype False; omega]. - repeat split; rational. -intros i H. -change (nring (S (S n)):cpoly_cring R) with (nring (S n)[+]One:cpoly_cring R). -set (X0:=(One[-](@cpoly_var R))) in *. -rstepl (nring (S n)[*]X0[*]Bernstein H[+]X0[*]Bernstein H). -destruct i as [|i]. + induction n. + intros [|i] H; [|elimtype False; omega]. + repeat split; rational. + intros i H. + change (nring (S (S n)):cpoly_cring R) with (nring (S n)[+]One:cpoly_cring R). + set (X0:=(One[-](@cpoly_var R))) in *. + rstepl (nring (S n)[*]X0[*]Bernstein H[+]X0[*]Bernstein H). + destruct i as [|i]. + simpl (Bernstein H) at 1. + fold X0. + rstepl (X0[*](nring (S n)[*]X0[*]Bernstein (le_O_n n))[+] X0[*]Bernstein H). + rewrite IHn. + replace (le_S 0 n (le_O_n n)) with H by apply le_irrelevent. + simpl (S n - 0). + change (nring (S (S n) - 0):cpoly_cring R) with (nring (S n)[+]One:cpoly_cring R). + rstepl ((nring (S n))[*](X0[*]Bernstein H)[+]X0[*]Bernstein H). + change (Bernstein (le_S _ _ H)) with (X0[*]Bernstein (le_O_n (S n))). + replace (le_O_n (S n)) with H by apply le_irrelevent. + rational. simpl (Bernstein H) at 1. + destruct (le_lt_eq_dec _ _ H). + fold X0. + rstepl (X0[*](nring (S n)[*]X0[*]Bernstein (lt_n_Sm_le (S i) n l))[+] + _X_[*](nring (S n)[*]X0[*]Bernstein (le_S_n i n H))[+] X0[*]Bernstein H). + do 2 rewrite IHn. + rewrite <- (minus_Sn_m n i) by auto with *. + rewrite <-(minus_Sn_m (S n) (S i)) by auto with *. + replace (S n - S i) with (n - i) by auto with *. + change (nring (S (n - i)):cpoly_cring R) with (nring (n - i)[+]One:cpoly_cring R). + replace (le_S (S i) n (lt_n_Sm_le (S i) n l)) with H by apply le_irrelevent. + set (l0:= (le_S i n (le_S_n i n H))). + rstepl ((nring (n - i)[+]One)[*](X0[*]Bernstein H[+]_X_[*]Bernstein l0)). + rewrite (Bernstein_inv1 H). + fold X0. + replace (lt_n_Sm_le _ _ (lt_n_S _ _ H)) with H by apply le_irrelevent. + replace (le_S_n _ _ (le_S (S i) (S n) H)) with l0 by apply le_irrelevent. + reflexivity. + revert H. + inversion e. + clear - IHn. + intros H. + assert (l:(n < (S n))) by auto. + rewrite (Bernstein_inv1 l). fold X0. - rstepl (X0[*](nring (S n)[*]X0[*]Bernstein (le_O_n n))[+] - X0[*]Bernstein H). + rstepl (_X_[*](nring (S n)[*]X0[*]Bernstein (lt_n_Sm_le _ _ H))[+] X0[*]Bernstein H). rewrite IHn. - replace (le_S 0 n (le_O_n n)) with H by apply le_irrelevent. - simpl (S n - 0). - change (nring (S (S n) - 0):cpoly_cring R) with (nring (S n)[+]One:cpoly_cring R). - rstepl ((nring (S n))[*](X0[*]Bernstein H)[+]X0[*]Bernstein H). - change (Bernstein (le_S _ _ H)) with (X0[*]Bernstein (le_O_n (S n))). - replace (le_O_n (S n)) with H by apply le_irrelevent. + replace (S n - n) with 1 by auto with *. + replace (S (S n) - S n) with 1 by auto with *. + replace (le_S_n n (S n) (le_S (S n) (S n) H)) + with (le_S n n (lt_n_Sm_le n n H)) by apply le_irrelevent. + replace (lt_n_Sm_le (S n) (S n) (lt_n_S n (S n) l)) with H by apply le_irrelevent. rational. -simpl (Bernstein H) at 1. -destruct (le_lt_eq_dec _ _ H). - fold X0. - rstepl (X0[*](nring (S n)[*]X0[*]Bernstein (lt_n_Sm_le (S i) n l))[+] - _X_[*](nring (S n)[*]X0[*]Bernstein (le_S_n i n H))[+] - X0[*]Bernstein H). - do 2 rewrite IHn. - rewrite <- (minus_Sn_m n i) by auto with *. - rewrite <-(minus_Sn_m (S n) (S i)) by auto with *. - replace (S n - S i) with (n - i) by auto with *. - change (nring (S (n - i)):cpoly_cring R) with (nring (n - i)[+]One:cpoly_cring R). - replace (le_S (S i) n (lt_n_Sm_le (S i) n l)) with H by apply le_irrelevent. - set (l0:= (le_S i n (le_S_n i n H))). - rstepl ((nring (n - i)[+]One)[*](X0[*]Bernstein H[+]_X_[*]Bernstein l0)). - rewrite (Bernstein_inv1 H). - fold X0. - replace (lt_n_Sm_le _ _ (lt_n_S _ _ H)) - with H by apply le_irrelevent. - replace (le_S_n _ _ (le_S (S i) (S n) H)) - with l0 by apply le_irrelevent. - reflexivity. -revert H. -inversion e. -clear - IHn. -intros H. -assert (l:(n < (S n))) by auto. -rewrite (Bernstein_inv1 l). -fold X0. -rstepl (_X_[*](nring (S n)[*]X0[*]Bernstein (lt_n_Sm_le _ _ H))[+] - X0[*]Bernstein H). -rewrite IHn. -replace (S n - n) with 1 by auto with *. -replace (S (S n) - S n) with 1 by auto with *. -replace (le_S_n n (S n) (le_S (S n) (S n) H)) - with (le_S n n (lt_n_Sm_le n n H)) by apply le_irrelevent. -replace (lt_n_Sm_le (S n) (S n) (lt_n_S n (S n) l)) with H by apply le_irrelevent. -rational. Qed. Lemma RaiseDegree : forall n i (H: i<=n), (nring (S n))[*]Bernstein H[=](nring (S n - i))[*]Bernstein (le_S _ _ H)[+](nring (S i))[*]Bernstein (le_n_S _ _ H). Proof. -intros n i H. -stepl ((nring (S n))[*](One[-]_X_)[*]Bernstein H[+](nring (S n))[*]_X_[*]Bernstein H) by rational. -rewrite RaiseDegreeA RaiseDegreeB. -reflexivity. + intros n i H. + stepl ((nring (S n))[*](One[-]_X_)[*]Bernstein H[+](nring (S n))[*]_X_[*]Bernstein H) by rational. + rewrite RaiseDegreeA RaiseDegreeB. + reflexivity. Qed. Opaque Bernstein. (** Given a vector of coefficents for a polynomial in the Bernstein basis, return the polynomial *) - + Fixpoint evalBernsteinBasisH (n i:nat) (v:vector R i) : i <= n -> cpoly_cring R := match v in vector _ i return i <= n -> cpoly_cring R with |Vnil => fun _ => Zero -|Vcons a i' v' => +|Vcons a i' v' => match n as n return (S i' <= n) -> cpoly_cring R with | O => fun p => False_rect _ (le_Sn_O _ p) | S n' => fun p => _C_ a[*]Bernstein (le_S_n _ _ p)[+]evalBernsteinBasisH v' (le_Sn_le _ _ p) @@ -315,64 +294,62 @@ Opaque polyconst. Lemma evalBernsteinBasisPlus : forall n (v1 v2: vector R n), evalBernsteinBasis (Vbinary _ (fun (x y:R)=>x[+]y) _ v1 v2)[=]evalBernsteinBasis v1[+]evalBernsteinBasis v2. Proof. -unfold evalBernsteinBasis. -intros n. -generalize (le_refl n). -generalize n at 1 3 4 6 7 9 11. -intros i. -induction i. + unfold evalBernsteinBasis. + intros n. + generalize (le_refl n). + generalize n at 1 3 4 6 7 9 11. + intros i. + induction i. + intros l v1 v2. + rewrite (V0_eq R v1) (V0_eq R v2). + simpl. + rational. intros l v1 v2. - rewrite (V0_eq R v1) (V0_eq R v2). + destruct n as [|n]. + elimtype False; auto with *. + rewrite (VSn_eq R _ v1) (VSn_eq R _ v2). simpl. + rewrite IHi. + rewrite c_plus. + unfold cpoly_constant. rational. -intros l v1 v2. -destruct n as [|n]. - elimtype False; auto with *. -rewrite (VSn_eq R _ v1) (VSn_eq R _ v2). -simpl. -rewrite IHi. -rewrite c_plus. -unfold cpoly_constant. -rational. Qed. Lemma evalBernsteinBasisConst : forall n c, evalBernsteinBasis (Vconst R c (S n))[=]_C_ c. Proof. -intros n c. -stepr (evalBernsteinBasis (Vconst R c (S n))[+]_C_ c[*]Sum (S n) n (part_tot_nat_fun _ _ (fun (i : nat) (H : i < S n) => Bernstein (lt_n_Sm_le i n H)))). - rewrite Sum_empty; auto with *. - rational. -unfold evalBernsteinBasis. -generalize (le_refl (S n)). -generalize (S n) at 1 4 5 6. -intros i l. -induction i. - rstepr (_C_ c[*]One). - rewrite <- (partitionOfUnity n). - rewrite Sumx_to_Sum; auto with *. - intros i j Hij. - rewrite Hij. - intros H H'. - replace (lt_n_Sm_le j n H) with (lt_n_Sm_le j n H') by apply le_irrelevent. - reflexivity. -simpl. -rstepl (evalBernsteinBasisH (Vconst R c i) (le_Sn_le i (S n) l)[+] -_C_ c[*](Bernstein (le_S_n i n l)[+] -Sum (S i) n - (part_tot_nat_fun (cpoly_cring R) (S n) + intros n c. + stepr (evalBernsteinBasis (Vconst R c (S n))[+]_C_ c[*]Sum (S n) n (part_tot_nat_fun _ _ (fun (i : nat) (H : i < S n) => Bernstein (lt_n_Sm_le i n H)))). + rewrite Sum_empty; auto with *. + rational. + unfold evalBernsteinBasis. + generalize (le_refl (S n)). + generalize (S n) at 1 4 5 6. + intros i l. + induction i. + rstepr (_C_ c[*]One). + rewrite <- (partitionOfUnity n). + rewrite Sumx_to_Sum; auto with *. + intros i j Hij. + rewrite Hij. + intros H H'. + replace (lt_n_Sm_le j n H) with (lt_n_Sm_le j n H') by apply le_irrelevent. + reflexivity. + simpl. + rstepl (evalBernsteinBasisH (Vconst R c i) (le_Sn_le i (S n) l)[+] + _C_ c[*](Bernstein (le_S_n i n l)[+] Sum (S i) n (part_tot_nat_fun (cpoly_cring R) (S n) (fun (i0 : nat) (H : i0 < S n) => Bernstein (lt_n_Sm_le i0 n H))))). -replace (Bernstein (le_S_n _ _ l)) with (part_tot_nat_fun (cpoly_cring R) (S n) - (fun (i0 : nat) (H : i0 < S n) => Bernstein (lt_n_Sm_le i0 n H)) i). - rewrite <- Sum_first. - apply IHi. -clear - i. -unfold part_tot_nat_fun. -destruct (le_lt_dec (S n) i). - elimtype False; auto with *. -simpl. -replace (lt_n_Sm_le _ _ l0) with (le_S_n _ _ l) by apply le_irrelevent. -reflexivity. + replace (Bernstein (le_S_n _ _ l)) with (part_tot_nat_fun (cpoly_cring R) (S n) + (fun (i0 : nat) (H : i0 < S n) => Bernstein (lt_n_Sm_le i0 n H)) i). + rewrite <- Sum_first. + apply IHi. + clear - i. + unfold part_tot_nat_fun. + destruct (le_lt_dec (S n) i). + elimtype False; auto with *. + simpl. + replace (lt_n_Sm_le _ _ l0) with (le_S_n _ _ l) by apply le_irrelevent. + reflexivity. Qed. Variable eta : RingHom Q_as_CRing R. @@ -402,89 +379,88 @@ BernsteinBasisTimesXH v (le_refl n). Lemma evalBernsteinBasisTimesX : forall n (v:vector R n), evalBernsteinBasis (BernsteinBasisTimesX v)[=]_X_[*]evalBernsteinBasis v. Proof. -intros n. -unfold evalBernsteinBasis, BernsteinBasisTimesX. -generalize (le_refl (S n)) (le_refl n). -generalize n at 1 3 5 7 9 11. -intros i. -induction i. - intros l l0 v. - rewrite (V0_eq R v). - simpl. - rewrite <- c_zero. - rational. -intros l l0 v. -destruct n as [|n]. - elimtype False; auto with *. -rewrite (VSn_eq R _ v). -simpl. -rewrite IHi. -rewrite c_mult. -rewrite ring_dist_unfolded. -apply csbf_wd; try reflexivity. -set (A:= (_C_ (eta (Qred - (Qmake (Zpos (P_of_succ_nat i)) (P_of_succ_nat n)))))). -rstepl (_C_ (Vhead R i v)[*](A[*]Bernstein (le_S_n (S i) (S n) l))). -rstepr (_C_ (Vhead R i v)[*](_X_[*]Bernstein (le_S_n i n l0))). -apply mult_wdr. -unfold A; clear A. -assert (Hn : (nring (S n):Q)[#]Zero). - stepl (S n:Q). + intros n. + unfold evalBernsteinBasis, BernsteinBasisTimesX. + generalize (le_refl (S n)) (le_refl n). + generalize n at 1 3 5 7 9 11. + intros i. + induction i. + intros l l0 v. + rewrite (V0_eq R v). simpl. - unfold Qap, Qeq. - auto with *. - symmetry; apply nring_Q. -setoid_replace (Qred (P_of_succ_nat i # P_of_succ_nat n)) - with ((One[/](nring (S n))[//]Hn)[*](nring (S i))). - set (eta':=RHcompose _ _ _ _C_ eta). - change (_C_ (eta ((One[/]nring (S n)[//]Hn)[*]nring (S i)))) - with ((eta' ((One[/]nring (S n)[//]Hn)[*]nring (S i))):cpoly_cring R). - rewrite rh_pres_mult. - rewrite rh_pres_nring. - rewrite <- mult_assoc_unfolded. - replace (le_S_n (S i) (S n) l) with (le_n_S _ _ (le_S_n i n l0)) by apply le_irrelevent. - rewrite <- RaiseDegreeA. - rewrite <- (@rh_pres_nring _ _ eta'). - rewrite <- mult_assoc_unfolded. - rewrite mult_assoc_unfolded. - rewrite <- rh_pres_mult. - setoid_replace (eta' ((One[/]nring (S n)[//]Hn)[*]nring (S n))) with (One:cpoly_cring R). + rewrite <- c_zero. rational. - rewrite <- (@rh_pres_unit _ _ eta'). - apply csf_wd. - apply (@div_1 Q_as_CField). -rewrite Qred_correct. -rewrite Qmake_Qdiv. -change (Zpos (P_of_succ_nat n)) with ((S n):Z). -rewrite <- (nring_Q (S n)). -change (Zpos (P_of_succ_nat i)) with ((S i):Z). -rewrite <- (nring_Q (S i)). -change (nring (S i)/nring (S n) == (1/(nring (S n)))*nring (S i))%Q. -field. -apply Hn. + intros l l0 v. + destruct n as [|n]. + elimtype False; auto with *. + rewrite (VSn_eq R _ v). + simpl. + rewrite IHi. + rewrite c_mult. + rewrite ring_dist_unfolded. + apply csbf_wd; try reflexivity. + set (A:= (_C_ (eta (Qred (Qmake (Zpos (P_of_succ_nat i)) (P_of_succ_nat n)))))). + rstepl (_C_ (Vhead R i v)[*](A[*]Bernstein (le_S_n (S i) (S n) l))). + rstepr (_C_ (Vhead R i v)[*](_X_[*]Bernstein (le_S_n i n l0))). + apply mult_wdr. + unfold A; clear A. + assert (Hn : (nring (S n):Q)[#]Zero). + stepl (S n:Q). + simpl. + unfold Qap, Qeq. + auto with *. + symmetry; apply nring_Q. + setoid_replace (Qred (P_of_succ_nat i # P_of_succ_nat n)) + with ((One[/](nring (S n))[//]Hn)[*](nring (S i))). + set (eta':=RHcompose _ _ _ _C_ eta). + change (_C_ (eta ((One[/]nring (S n)[//]Hn)[*]nring (S i)))) + with ((eta' ((One[/]nring (S n)[//]Hn)[*]nring (S i))):cpoly_cring R). + rewrite rh_pres_mult. + rewrite rh_pres_nring. + rewrite <- mult_assoc_unfolded. + replace (le_S_n (S i) (S n) l) with (le_n_S _ _ (le_S_n i n l0)) by apply le_irrelevent. + rewrite <- RaiseDegreeA. + rewrite <- (@rh_pres_nring _ _ eta'). + rewrite <- mult_assoc_unfolded. + rewrite mult_assoc_unfolded. + rewrite <- rh_pres_mult. + setoid_replace (eta' ((One[/]nring (S n)[//]Hn)[*]nring (S n))) with (One:cpoly_cring R). + rational. + rewrite <- (@rh_pres_unit _ _ eta'). + apply csf_wd. + apply (@div_1 Q_as_CField). + rewrite Qred_correct. + rewrite Qmake_Qdiv. + change (Zpos (P_of_succ_nat n)) with ((S n):Z). + rewrite <- (nring_Q (S n)). + change (Zpos (P_of_succ_nat i)) with ((S i):Z). + rewrite <- (nring_Q (S i)). + change (nring (S i)/nring (S n) == (1/(nring (S n)))*nring (S i))%Q. + field. + apply Hn. Qed. (** Convert a polynomial to the Bernstein basis *) Fixpoint BernsteinCoefficents (p:cpoly_cring R) : sigT (vector R) := match p with | cpoly_zero => existT _ _ (Vnil R) -| cpoly_linear c p' => +| cpoly_linear c p' => let (n', b') := (BernsteinCoefficents p') in existT _ _ (Vbinary _ (fun (x y:R)=>x[+]y) _ (Vconst R c _) (BernsteinBasisTimesX b')) end. Lemma evalBernsteinCoefficents : forall p, (let (n,b) := BernsteinCoefficents p in evalBernsteinBasis b)[=]p. Proof. -induction p. - reflexivity. -simpl. -destruct (BernsteinCoefficents p). -rewrite evalBernsteinBasisPlus. -rewrite evalBernsteinBasisConst. -rewrite evalBernsteinBasisTimesX. -rewrite -> IHp. -rewrite poly_linear. -rational. + induction p. + reflexivity. + simpl. + destruct (BernsteinCoefficents p). + rewrite evalBernsteinBasisPlus. + rewrite evalBernsteinBasisConst. + rewrite evalBernsteinBasisTimesX. + rewrite -> IHp. + rewrite poly_linear. + rational. Qed. End Bernstein. @@ -501,19 +477,16 @@ are all non-negative on the unit interval. *) Lemma BernsteinNonNeg : forall x:F, Zero [<=] x -> x [<=] One -> forall n i (p:le i n), Zero[<=](Bernstein F p)!x. Proof. -intros x Hx0 Hx1. -induction n. - intros i p. - simpl (Bernstein F p). - autorewrite with apply. - auto with *. -intros [|i] p; - simpl (Bernstein F p). - autorewrite with apply. - auto with *. -destruct (le_lt_eq_dec (S i) (S n) p); - autorewrite with apply; - auto with *. + intros x Hx0 Hx1. + induction n. + intros i p. + simpl (Bernstein F p). + autorewrite with apply. + auto with *. + intros [|i] p; simpl (Bernstein F p). + autorewrite with apply. + auto with *. + destruct (le_lt_eq_dec (S i) (S n) p); autorewrite with apply; auto with *. Qed. End BernsteinOrdField. diff --git a/algebra/CAbGroups.v b/algebra/CAbGroups.v index 433b7bd6c..63112d1c4 100644 --- a/algebra/CAbGroups.v +++ b/algebra/CAbGroups.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CGroups. Section Abelian_Groups. @@ -44,7 +44,7 @@ Now we introduce commutativity and add some results. Definition is_CAbGroup (G : CGroup) := commutes (csg_op (c:=G)). -Record CAbGroup : Type := +Record CAbGroup : Type := {cag_crr :> CGroup; cag_proof : is_CAbGroup cag_crr}. @@ -57,11 +57,13 @@ Variable G : CAbGroup. *) Lemma CAbGroup_is_CAbGroup : is_CAbGroup G. -elim G; auto. +Proof. + elim G; auto. Qed. Lemma cag_commutes : commutes (csg_op (c:=G)). -exact CAbGroup_is_CAbGroup. +Proof. + exact CAbGroup_is_CAbGroup. Qed. Lemma cag_commutes_unfolded : forall x y : G, x[+]y [=] y[+]x. @@ -90,7 +92,8 @@ that contains [Zero] and is closed under [[+]] and [[--]]. Let subcrr : CGroup := Build_SubCGroup _ _ Punit op_pres_P inv_pres_P. Lemma isabgrp_scrr : is_CAbGroup subcrr. -red in |- *. intros x y. case x. case y. intros. simpl in |- *. apply cag_commutes_unfolded. +Proof. + red in |- *. intros x y. case x. case y. intros. simpl in |- *. apply cag_commutes_unfolded. Qed. Definition Build_SubCAbGroup : CAbGroup := Build_CAbGroup subcrr isabgrp_scrr. @@ -100,7 +103,7 @@ End SubCAbGroups. Section Various. (** ** Basic properties of Abelian groups -*) +*) Hint Resolve cag_commutes_unfolded: algebra. Variable G : CAbGroup. @@ -110,47 +113,52 @@ Variable G : CAbGroup. *) Lemma cag_op_inv : forall x y : G, [--] (x[+]y) [=] [--]x[+] [--]y. -intros x y. -astepr ([--]y[+] [--]x). -apply cg_inv_op. +Proof. + intros x y. + astepr ([--]y[+] [--]x). + apply cg_inv_op. Qed. Hint Resolve cag_op_inv: algebra. Lemma assoc_1 : forall x y z : G, x[-] (y[-]z) [=] x[-]y[+]z. -intros x y z; unfold cg_minus in |- *. -astepr (x[+]([--]y[+]z)). -Step_final (x[+]([--]y[+] [--][--]z)). +Proof. + intros x y z; unfold cg_minus in |- *. + astepr (x[+]([--]y[+]z)). + Step_final (x[+]([--]y[+] [--][--]z)). Qed. Lemma minus_plus : forall x y z : G, x[-] (y[+]z) [=] x[-]y[-]z. -intros x y z. -unfold cg_minus in |- *. -Step_final (x[+]([--]y[+] [--]z)). +Proof. + intros x y z. + unfold cg_minus in |- *. + Step_final (x[+]([--]y[+] [--]z)). Qed. Lemma op_lft_resp_ap : forall x y z : G, y [#] z -> x[+]y [#] x[+]z. Proof. -intros x y z H. -astepl (y[+]x). -astepr (z[+]x). -apply op_rht_resp_ap; assumption. + intros x y z H. + astepl (y[+]x). + astepr (z[+]x). + apply op_rht_resp_ap; assumption. Qed. Lemma cag_ap_cancel_lft : forall x y z : G, x[+]y [#] x[+]z -> y [#] z. -intros x y z H. -apply ap_symmetric_unfolded. -apply cg_ap_cancel_rht with x. -apply ap_symmetric_unfolded. -astepl (x[+]y). -astepr (x[+]z). -auto. +Proof. + intros x y z H. + apply ap_symmetric_unfolded. + apply cg_ap_cancel_rht with x. + apply ap_symmetric_unfolded. + astepl (x[+]y). + astepr (x[+]z). + auto. Qed. Lemma plus_cancel_ap_lft : forall x y z : G, z[+]x [#] z[+]y -> x [#] y. -intros x y z H. -apply cag_ap_cancel_lft with z. -assumption. +Proof. + intros x y z H. + apply cag_ap_cancel_lft with z. + assumption. Qed. End Various. @@ -202,55 +210,63 @@ Variable inv : CSetoid_un_op S. Hypothesis inv_inv : forall x : S, plus x (inv x) [=] unit. Lemma plus_rext : forall x y z : S, plus x y [#] plus x z -> y [#] z. -intros x y z H. -apply plus_lext with x. -astepl (plus x y). -astepr (plus x z). -auto. +Proof. + intros x y z H. + apply plus_lext with x. + astepl (plus x y). + astepr (plus x z). + auto. Qed. Lemma plus_runit : forall x : S, plus x unit [=] x. -intro x. -Step_final (plus unit x). +Proof. + intro x. + Step_final (plus unit x). Qed. Lemma plus_is_fun : bin_fun_strext _ _ _ plus. -intros x x' y y' H. -elim (ap_cotransitive_unfolded _ _ _ H (plus x y')); intro H'. - right; apply plus_lext with x. - astepl (plus x y); astepr (plus x y'); auto. -left; eauto. +Proof. + intros x x' y y' H. + elim (ap_cotransitive_unfolded _ _ _ H (plus x y')); intro H'. + right; apply plus_lext with x. + astepl (plus x y); astepr (plus x y'); auto. + left; eauto. Qed. Lemma inv_inv' : forall x : S, plus (inv x) x [=] unit. -intro. -Step_final (plus x (inv x)). +Proof. + intro. + Step_final (plus x (inv x)). Qed. Definition plus_fun : CSetoid_bin_op S := Build_CSetoid_bin_fun _ _ _ plus plus_is_fun. Definition Build_CSemiGroup' : CSemiGroup. -apply Build_CSemiGroup with S plus_fun. -exact plus_assoc. +Proof. + apply Build_CSemiGroup with S plus_fun. + exact plus_assoc. Defined. Definition Build_CMonoid' : CMonoid. -apply Build_CMonoid with Build_CSemiGroup' unit. -apply Build_is_CMonoid. -exact plus_runit. -exact plus_lunit. +Proof. + apply Build_CMonoid with Build_CSemiGroup' unit. + apply Build_is_CMonoid. + exact plus_runit. + exact plus_lunit. Defined. Definition Build_CGroup' : CGroup. -apply Build_CGroup with Build_CMonoid' inv. -split. -auto. -apply inv_inv'. +Proof. + apply Build_CGroup with Build_CMonoid' inv. + split. + auto. + apply inv_inv'. Defined. Definition Build_CAbGroup' : CAbGroup. -apply Build_CAbGroup with Build_CGroup'. -exact plus_comm. +Proof. + apply Build_CAbGroup with Build_CGroup'. + exact plus_comm. Defined. End Nice_Char. @@ -271,56 +287,63 @@ Fixpoint nmult (a:G) (n:nat) {struct n} : G := end. Lemma nmult_wd : forall (x y:G) (n m:nat), (x [=] y) -> n = m -> nmult x n [=] nmult y m. -simple induction n; intros. -rewrite <- H0; algebra. -rewrite <- H1; simpl in |- *; algebra. +Proof. + simple induction n; intros. + rewrite <- H0; algebra. + rewrite <- H1; simpl in |- *; algebra. Qed. Lemma nmult_one : forall x:G, nmult x 1 [=] x. -simpl in |- *; algebra. +Proof. + simpl in |- *; algebra. Qed. Lemma nmult_Zero : forall n:nat, nmult Zero n [=] Zero. -intro n. -induction n. - algebra. -simpl in |- *; Step_final ((Zero:G)[+]Zero). +Proof. + intro n. + induction n. + algebra. + simpl in |- *; Step_final ((Zero:G)[+]Zero). Qed. Lemma nmult_plus : forall m n x, nmult x m[+]nmult x n [=] nmult x (m + n). -simple induction m. - simpl in |- *; algebra. -clear m; intro m. -intros. -simpl in |- *. Step_final (x[+](nmult x m[+]nmult x n)). +Proof. + simple induction m. + simpl in |- *; algebra. + clear m; intro m. + intros. + simpl in |- *. Step_final (x[+](nmult x m[+]nmult x n)). Qed. Lemma nmult_mult : forall n m x, nmult (nmult x m) n [=] nmult x (m * n). -simple induction n. - intro. rewrite mult_0_r. algebra. -clear n; intros. -simpl in |- *. -rewrite mult_comm. simpl in |- *. -eapply eq_transitive_unfolded. - 2: apply nmult_plus. -rewrite mult_comm. algebra. +Proof. + simple induction n. + intro. rewrite mult_0_r. algebra. + clear n; intros. + simpl in |- *. + rewrite mult_comm. simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply nmult_plus. + rewrite mult_comm. algebra. Qed. Lemma nmult_inv : forall n x, nmult [--]x n [=] [--] (nmult x n). -intro; induction n; simpl in |- *. - algebra. -intros. -Step_final ([--]x[+] [--](nmult x n)). +Proof. + intro; induction n; simpl in |- *. + algebra. + intros. + Step_final ([--]x[+] [--](nmult x n)). Qed. Lemma nmult_plus' : forall n x y, nmult x n[+]nmult y n [=] nmult (x[+]y) n. -intro; induction n; simpl in |- *; intros. - algebra. -astepr (x[+]y[+](nmult x n[+]nmult y n)). -astepr (x[+](y[+](nmult x n[+]nmult y n))). -astepr (x[+](y[+]nmult x n[+]nmult y n)). -astepr (x[+](nmult x n[+]y[+]nmult y n)). -Step_final (x[+](nmult x n[+](y[+]nmult y n))). +Proof. + intro; induction n; simpl in |- *; intros. + algebra. + astepr (x[+]y[+](nmult x n[+]nmult y n)). + astepr (x[+](y[+](nmult x n[+]nmult y n))). + astepr (x[+](y[+]nmult x n[+]nmult y n)). + astepr (x[+](nmult x n[+]y[+]nmult y n)). + Step_final (x[+](nmult x n[+](y[+]nmult y n))). Qed. Hint Resolve nmult_wd nmult_Zero nmult_inv nmult_plus nmult_plus': algebra. @@ -345,164 +368,150 @@ Qed. Lemma zmult_char : forall (m n:nat) z, z = (m - n)%Z -> forall x, zmult x z [=] nmult x m[-]nmult x n. -simple induction z; intros. - -simpl in |- *. -replace m with n. Step_final (Zero:G). auto with zarith. - -simpl in |- *. -astepl (nmult x (nat_of_P p)). -apply cg_cancel_rht with (nmult x n). -astepr (nmult x m). -astepl (nmult x (nat_of_P p + n)). -apply nmult_wd; algebra. -rewrite <- convert_is_POS in H. -auto with zarith. - -simpl in |- *. -astepl [--](nmult x (nat_of_P p)). -unfold cg_minus in |- *. -astepr ([--][--](nmult x m)[+] [--](nmult x n)). -astepr [--]([--](nmult x m)[+]nmult x n). -apply un_op_wd_unfolded. -apply cg_cancel_lft with (nmult x m). -astepr (nmult x m[+] [--](nmult x m)[+]nmult x n). -astepr (Zero[+]nmult x n). -astepr (nmult x n). -astepl (nmult x (m + nat_of_P p)). -apply nmult_wd; algebra. -rewrite <- min_convert_is_NEG in H. -auto with zarith. +Proof. + simple induction z; intros. + simpl in |- *. + replace m with n. Step_final (Zero:G). auto with zarith. + simpl in |- *. + astepl (nmult x (nat_of_P p)). + apply cg_cancel_rht with (nmult x n). + astepr (nmult x m). + astepl (nmult x (nat_of_P p + n)). + apply nmult_wd; algebra. + rewrite <- convert_is_POS in H. + auto with zarith. + simpl in |- *. + astepl [--](nmult x (nat_of_P p)). + unfold cg_minus in |- *. + astepr ([--][--](nmult x m)[+] [--](nmult x n)). + astepr [--]([--](nmult x m)[+]nmult x n). + apply un_op_wd_unfolded. + apply cg_cancel_lft with (nmult x m). + astepr (nmult x m[+] [--](nmult x m)[+]nmult x n). + astepr (Zero[+]nmult x n). + astepr (nmult x n). + astepl (nmult x (m + nat_of_P p)). + apply nmult_wd; algebra. + rewrite <- min_convert_is_NEG in H. + auto with zarith. Qed. Lemma zmult_wd : forall (x y:G) (n m:Z), (x [=] y) -> n = m -> zmult x n [=] zmult y m. -do 3 intro. -case n; intros; inversion H0. -algebra. -unfold zmult in |- *. -simpl in |- *. -astepl (nmult x (nat_of_P p)); Step_final (nmult y (nat_of_P p)). -simpl in |- *. -astepl [--](nmult x (nat_of_P p)). -Step_final [--](nmult y (nat_of_P p)). +Proof. + do 3 intro. + case n; intros; inversion H0. + algebra. + unfold zmult in |- *. + simpl in |- *. + astepl (nmult x (nat_of_P p)); Step_final (nmult y (nat_of_P p)). + simpl in |- *. + astepl [--](nmult x (nat_of_P p)). + Step_final [--](nmult y (nat_of_P p)). Qed. Lemma zmult_one : forall x:G, zmult x 1 [=] x. -simpl in |- *; algebra. +Proof. + simpl in |- *; algebra. Qed. Lemma zmult_min_one : forall x:G, zmult x (-1) [=] [--]x. -intros; simpl in |- *; Step_final (Zero[-]x). +Proof. + intros; simpl in |- *; Step_final (Zero[-]x). Qed. Lemma zmult_zero : forall x:G, zmult x 0 [=] Zero. -simpl in |- *; algebra. +Proof. + simpl in |- *; algebra. Qed. Lemma zmult_Zero : forall k:Z, zmult Zero k [=] Zero. -intro; induction k; simpl in |- *. - algebra. +Proof. + intro; induction k; simpl in |- *. + algebra. + Step_final ((Zero:G)[-]Zero). Step_final ((Zero:G)[-]Zero). -Step_final ((Zero:G)[-]Zero). Qed. Hint Resolve zmult_zero: algebra. Lemma zmult_plus : forall m n x, zmult x m[+]zmult x n [=] zmult x (m + n). -intros; case m; case n; intros. - -simpl in |- *; Step_final (Zero[+](Zero[-]Zero):G). - -simpl in |- *; Step_final (Zero[+](nmult x (nat_of_P p)[-]Zero)). - -simpl in |- *; Step_final (Zero[+](Zero[-]nmult x (nat_of_P p))). - -simpl in |- *; Step_final (nmult x (nat_of_P p)[-]Zero[+]Zero). - -simpl in |- *. -astepl (nmult x (nat_of_P p0)[+]nmult x (nat_of_P p)). -astepr (nmult x (nat_of_P (p0 + p))). -rewrite nat_of_P_plus_morphism. apply nmult_plus. - -simpl (zmult x (Zpos p0)[+]zmult x (Zneg p)) in |- *. -astepl (nmult x (nat_of_P p0)[+] [--](nmult x (nat_of_P p))). -astepl (nmult x (nat_of_P p0)[-]nmult x (nat_of_P p)). -apply eq_symmetric_unfolded; - apply zmult_char with (z := (Zpos p0 + Zneg p)%Z). -rewrite convert_is_POS. unfold Zminus in |- *. rewrite min_convert_is_NEG; auto. - -rewrite <- Zplus_0_r_reverse. Step_final (zmult x (Zneg p)[+]Zero). - -simpl (zmult x (Zneg p0)[+]zmult x (Zpos p)) in |- *. -astepl ([--](nmult x (nat_of_P p0))[+]nmult x (nat_of_P p)). -astepl (nmult x (nat_of_P p)[+] [--](nmult x (nat_of_P p0))). -astepl (nmult x (nat_of_P p)[-]nmult x (nat_of_P p0)). -rewrite Zplus_comm. -apply eq_symmetric_unfolded; - apply zmult_char with (z := (Zpos p + Zneg p0)%Z). -rewrite convert_is_POS. unfold Zminus in |- *. rewrite min_convert_is_NEG; auto. - -simpl in |- *. -astepl ([--](nmult x (nat_of_P p0))[+] [--](nmult x (nat_of_P p))). -astepl [--](nmult x (nat_of_P p0)[+]nmult x (nat_of_P p)). -astepr [--](nmult x (nat_of_P (p0 + p))). -apply un_op_wd_unfolded. -rewrite nat_of_P_plus_morphism. apply nmult_plus. +Proof. + intros; case m; case n; intros. + simpl in |- *; Step_final (Zero[+](Zero[-]Zero):G). + simpl in |- *; Step_final (Zero[+](nmult x (nat_of_P p)[-]Zero)). + simpl in |- *; Step_final (Zero[+](Zero[-]nmult x (nat_of_P p))). + simpl in |- *; Step_final (nmult x (nat_of_P p)[-]Zero[+]Zero). + simpl in |- *. + astepl (nmult x (nat_of_P p0)[+]nmult x (nat_of_P p)). + astepr (nmult x (nat_of_P (p0 + p))). + rewrite nat_of_P_plus_morphism. apply nmult_plus. + simpl (zmult x (Zpos p0)[+]zmult x (Zneg p)) in |- *. + astepl (nmult x (nat_of_P p0)[+] [--](nmult x (nat_of_P p))). + astepl (nmult x (nat_of_P p0)[-]nmult x (nat_of_P p)). + apply eq_symmetric_unfolded; apply zmult_char with (z := (Zpos p0 + Zneg p)%Z). + rewrite convert_is_POS. unfold Zminus in |- *. rewrite min_convert_is_NEG; auto. + rewrite <- Zplus_0_r_reverse. Step_final (zmult x (Zneg p)[+]Zero). + simpl (zmult x (Zneg p0)[+]zmult x (Zpos p)) in |- *. + astepl ([--](nmult x (nat_of_P p0))[+]nmult x (nat_of_P p)). + astepl (nmult x (nat_of_P p)[+] [--](nmult x (nat_of_P p0))). + astepl (nmult x (nat_of_P p)[-]nmult x (nat_of_P p0)). + rewrite Zplus_comm. + apply eq_symmetric_unfolded; apply zmult_char with (z := (Zpos p + Zneg p0)%Z). + rewrite convert_is_POS. unfold Zminus in |- *. rewrite min_convert_is_NEG; auto. + simpl in |- *. + astepl ([--](nmult x (nat_of_P p0))[+] [--](nmult x (nat_of_P p))). + astepl [--](nmult x (nat_of_P p0)[+]nmult x (nat_of_P p)). + astepr [--](nmult x (nat_of_P (p0 + p))). + apply un_op_wd_unfolded. + rewrite nat_of_P_plus_morphism. apply nmult_plus. Qed. Lemma zmult_mult : forall m n x, zmult (zmult x m) n [=] zmult x (m * n). -simple induction m; simple induction n; simpl in |- *; intros. - -Step_final (Zero[-]Zero[+](Zero:G)). - -astepr (Zero:G). astepl (nmult (Zero[-]Zero) (nat_of_P p)). -Step_final (nmult Zero (nat_of_P p)). - -astepr [--](Zero:G). astepl [--](nmult (Zero[-]Zero) (nat_of_P p)). -Step_final [--](nmult Zero (nat_of_P p)). - -algebra. - -astepr (nmult x (nat_of_P (p * p0))). -astepl (nmult (nmult x (nat_of_P p)) (nat_of_P p0)[-]Zero). -astepl (nmult (nmult x (nat_of_P p)) (nat_of_P p0)). -rewrite nat_of_P_mult_morphism. apply nmult_mult. - -astepr [--](nmult x (nat_of_P (p * p0))). -astepl (Zero[-]nmult (nmult x (nat_of_P p)) (nat_of_P p0)). -astepl [--](nmult (nmult x (nat_of_P p)) (nat_of_P p0)). -rewrite nat_of_P_mult_morphism. apply un_op_wd_unfolded. apply nmult_mult. - -algebra. - -astepr [--](nmult x (nat_of_P (p * p0))). -astepl (nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)[-]Zero). -astepl (nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)). -rewrite nat_of_P_mult_morphism. eapply eq_transitive_unfolded. -apply nmult_inv. apply un_op_wd_unfolded. apply nmult_mult. - -astepr (nmult x (nat_of_P (p * p0))). -astepr [--][--](nmult x (nat_of_P (p * p0))). -astepl (Zero[-]nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)). -astepl [--](nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)). -rewrite nat_of_P_mult_morphism. apply un_op_wd_unfolded. eapply eq_transitive_unfolded. -apply nmult_inv. apply un_op_wd_unfolded. apply nmult_mult. +Proof. + simple induction m; simple induction n; simpl in |- *; intros. + Step_final (Zero[-]Zero[+](Zero:G)). + astepr (Zero:G). astepl (nmult (Zero[-]Zero) (nat_of_P p)). + Step_final (nmult Zero (nat_of_P p)). + astepr [--](Zero:G). astepl [--](nmult (Zero[-]Zero) (nat_of_P p)). + Step_final [--](nmult Zero (nat_of_P p)). + algebra. + astepr (nmult x (nat_of_P (p * p0))). + astepl (nmult (nmult x (nat_of_P p)) (nat_of_P p0)[-]Zero). + astepl (nmult (nmult x (nat_of_P p)) (nat_of_P p0)). + rewrite nat_of_P_mult_morphism. apply nmult_mult. + astepr [--](nmult x (nat_of_P (p * p0))). + astepl (Zero[-]nmult (nmult x (nat_of_P p)) (nat_of_P p0)). + astepl [--](nmult (nmult x (nat_of_P p)) (nat_of_P p0)). + rewrite nat_of_P_mult_morphism. apply un_op_wd_unfolded. apply nmult_mult. + algebra. + astepr [--](nmult x (nat_of_P (p * p0))). + astepl (nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)[-]Zero). + astepl (nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)). + rewrite nat_of_P_mult_morphism. eapply eq_transitive_unfolded. + apply nmult_inv. apply un_op_wd_unfolded. apply nmult_mult. + astepr (nmult x (nat_of_P (p * p0))). + astepr [--][--](nmult x (nat_of_P (p * p0))). + astepl (Zero[-]nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)). + astepl [--](nmult [--](nmult x (nat_of_P p)) (nat_of_P p0)). + rewrite nat_of_P_mult_morphism. apply un_op_wd_unfolded. eapply eq_transitive_unfolded. + apply nmult_inv. apply un_op_wd_unfolded. apply nmult_mult. Qed. Lemma zmult_plus' : forall z x y, zmult x z[+]zmult y z [=] zmult (x[+]y) z. -intro z; pattern z in |- *. -apply nats_Z_ind. - intro n; case n. +Proof. + intro z; pattern z in |- *. + apply nats_Z_ind. + intro n; case n. + intros; simpl in |- *. Step_final ((Zero:G)[+](Zero[-]Zero)). + clear n; intros. + rewrite POS_anti_convert; simpl in |- *. set (p := nat_of_P (P_of_succ_nat n)) in *. + astepl (nmult x p[+]nmult y p). Step_final (nmult (x[+]y) p). + intro n; case n. intros; simpl in |- *. Step_final ((Zero:G)[+](Zero[-]Zero)). - clear n; intros. - rewrite POS_anti_convert; simpl in |- *. set (p := nat_of_P (P_of_succ_nat n)) in *. - astepl (nmult x p[+]nmult y p). Step_final (nmult (x[+]y) p). -intro n; case n. - intros; simpl in |- *. Step_final ((Zero:G)[+](Zero[-]Zero)). -clear n; intros. -rewrite NEG_anti_convert; simpl in |- *. set (p := nat_of_P (P_of_succ_nat n)) in *. -astepl ([--](nmult x p)[+] [--](nmult y p)). astepr [--](nmult (x[+]y) p). -Step_final [--](nmult x p[+]nmult y p). + clear n; intros. + rewrite NEG_anti_convert; simpl in |- *. set (p := nat_of_P (P_of_succ_nat n)) in *. + astepl ([--](nmult x p)[+] [--](nmult y p)). astepr [--](nmult (x[+]y) p). + Step_final [--](nmult x p[+]nmult y p). Qed. End Group_Extras. diff --git a/algebra/CAbMonoids.v b/algebra/CAbMonoids.v index 8545a020a..f7cee7f49 100644 --- a/algebra/CAbMonoids.v +++ b/algebra/CAbMonoids.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CMonoids. Section Abelian_Monoids. @@ -44,7 +44,7 @@ Now we introduce commutativity and add some results. Definition is_CAbMonoid (G : CMonoid) := commutes (csg_op (c:=G)). -Record CAbMonoid : Type := +Record CAbMonoid : Type := {cam_crr :> CMonoid; cam_proof : is_CAbMonoid cam_crr}. @@ -57,11 +57,13 @@ Variable M : CAbMonoid. *) Lemma CAbMonoid_is_CAbMonoid : is_CAbMonoid M. -elim M; auto. +Proof. + elim M; auto. Qed. Lemma cam_commutes : commutes (csg_op (c:=M)). -exact CAbMonoid_is_CAbMonoid. +Proof. + exact CAbMonoid_is_CAbMonoid. Qed. Lemma cam_commutes_unfolded : forall x y : M, x[+]y [=] y[+]x. @@ -89,8 +91,9 @@ that contains [Zero] and is closed under [[+]] and [[--]]. Let subcrr : CMonoid := Build_SubCMonoid _ _ Punit op_pres_P. Lemma isabgrp_scrr : is_CAbMonoid subcrr. -red in |- *. intros x y. case x. case y. intros. -simpl in |- *. apply cam_commutes_unfolded. +Proof. + red in |- *. intros x y. case x. case y. intros. + simpl in |- *. apply cam_commutes_unfolded. Qed. Definition Build_SubCAbMonoid : CAbMonoid := Build_CAbMonoid _ isabgrp_scrr. diff --git a/algebra/CFields.v b/algebra/CFields.v index a2a7cc8c4..94908b7b8 100644 --- a/algebra/CFields.v +++ b/algebra/CFields.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing [/] %\ensuremath{/}% #/# *) (** printing [//] %\ensuremath\ddagger% #‡# *) @@ -79,7 +79,7 @@ Transparent nexp_op. Definition is_CField (R : CRing) (cf_rcpcl : forall x : R, x [#] Zero -> R) : Prop := forall x Hx, is_inverse cr_mult One x (cf_rcpcl x Hx). -Record CField : Type := +Record CField : Type := {cf_crr :> CRing; cf_rcpcl : forall x : cf_crr, x [#] Zero -> cf_crr; cf_proof : is_CField cf_crr cf_rcpcl; @@ -87,10 +87,11 @@ Record CField : Type := (* End_SpecReals *) Definition f_rcpcl' (F : CField) : PartFunct F. -intro F. -apply Build_PartFunct with (fun x : F => x [#] Zero) (cf_rcpcl F). - red in |- *; intros; astepl x. auto. -exact (cf_rcpsx F). +Proof. + intro F. + apply Build_PartFunct with (fun x : F => x [#] Zero) (cf_rcpcl F). + red in |- *; intros; astepl x. auto. + exact (cf_rcpsx F). Defined. Definition f_rcpcl F x x_ := f_rcpcl' F x x_. @@ -142,11 +143,13 @@ Section Field_axioms. Variable F : CField. Lemma CField_is_CField : is_CField F (cf_rcpcl F). -elim F; auto. +Proof. + elim F; auto. Qed. Lemma rcpcl_is_inverse : forall x x_, is_inverse cr_mult One x (cf_rcpcl F x x_). -apply CField_is_CField. +Proof. + apply CField_is_CField. Qed. End Field_axioms. @@ -161,8 +164,9 @@ Section Field_basics. Variable F : CField. Lemma rcpcl_is_inverse_unfolded : forall x x_, x[*]cf_rcpcl F x x_ [=] One. -intros x x_. -elim (rcpcl_is_inverse F x x_); auto. +Proof. + intros x x_. + elim (rcpcl_is_inverse F x x_); auto. Qed. Lemma field_mult_inv : forall (x : F) x_, x[*]f_rcpcl x x_ [=] One. @@ -170,8 +174,9 @@ Proof rcpcl_is_inverse_unfolded. Hint Resolve field_mult_inv: algebra. Lemma field_mult_inv_op : forall (x : F) x_, f_rcpcl x x_[*]x [=] One. -intros x x_. -elim (rcpcl_is_inverse F x x_); auto. +Proof. + intros x x_. + elim (rcpcl_is_inverse F x x_); auto. Qed. End Field_basics. @@ -188,194 +193,193 @@ Section Field_multiplication. Variable F : CField. Lemma mult_resp_ap_zero : forall x y : F, x [#] Zero -> y [#] Zero -> x[*]y [#] Zero. -intros x y Hx Hy. -apply cring_mult_ap_zero with (f_rcpcl y Hy). -astepl x. -auto. -astepl (x[*]One). -eapply eq_transitive_unfolded. -2: apply CRings.mult_assoc. -algebra. +Proof. + intros x y Hx Hy. + apply cring_mult_ap_zero with (f_rcpcl y Hy). + astepl x. + auto. + astepl (x[*]One). + eapply eq_transitive_unfolded. + 2: apply CRings.mult_assoc. + algebra. Qed. Lemma mult_lft_resp_ap : forall x y z : F, x [#] y -> z [#] Zero -> z[*]x [#] z[*]y. -intros x y z H Hz. -apply zero_minus_apart. -unfold cg_minus in |- *. -astepl (z[*]x[+]z[*][--]y). -astepl (z[*] (x[+][--]y)). -astepl (z[*] (x[-]y)). -apply mult_resp_ap_zero; algebra. +Proof. + intros x y z H Hz. + apply zero_minus_apart. + unfold cg_minus in |- *. + astepl (z[*]x[+]z[*][--]y). + astepl (z[*] (x[+][--]y)). + astepl (z[*] (x[-]y)). + apply mult_resp_ap_zero; algebra. Qed. Lemma mult_rht_resp_ap : forall x y z : F, x [#] y -> z [#] Zero -> x[*]z [#] y[*]z. -intros x y z H Hz. -astepl (z[*]x). -astepr (z[*]y). -apply mult_lft_resp_ap; assumption. +Proof. + intros x y z H Hz. + astepl (z[*]x). + astepr (z[*]y). + apply mult_lft_resp_ap; assumption. Qed. Lemma mult_resp_neq_zero : forall x y : F, x[~=]Zero -> y[~=]Zero -> x[*]y[~=]Zero. -intros x y Hx Hy. -cut (~ Not (x [#] Zero)). -intro H. -cut (~ Not (y [#] Zero)). -intro H0. -apply notnot_ap_imp_neq. -cut (x [#] Zero -> y [#] Zero -> x[*]y [#] Zero). -intro H1. -intro. -apply H0; intro H3. -apply H; intro H4. -apply H2; auto. - -intros; apply mult_resp_ap_zero; auto. - -apply neq_imp_notnot_ap; auto. - -apply neq_imp_notnot_ap; auto. +Proof. + intros x y Hx Hy. + cut (~ Not (x [#] Zero)). + intro H. + cut (~ Not (y [#] Zero)). + intro H0. + apply notnot_ap_imp_neq. + cut (x [#] Zero -> y [#] Zero -> x[*]y [#] Zero). + intro H1. + intro. + apply H0; intro H3. + apply H; intro H4. + apply H2; auto. + intros; apply mult_resp_ap_zero; auto. + apply neq_imp_notnot_ap; auto. + apply neq_imp_notnot_ap; auto. Qed. Lemma mult_resp_neq : forall x y z : F, x[~=]y -> z[~=]Zero -> x[*]z[~=]y[*]z. -intros x y z H Hz. -generalize (neq_imp_notnot_ap _ _ _ H). -generalize (neq_imp_notnot_ap _ _ _ Hz). -generalize (mult_rht_resp_ap x y z). -intros H1 H2 H3. -apply notnot_ap_imp_neq. -intro H4. -apply H2; intro. -apply H3; intro. -apply H4. -auto. +Proof. + intros x y z H Hz. + generalize (neq_imp_notnot_ap _ _ _ H). + generalize (neq_imp_notnot_ap _ _ _ Hz). + generalize (mult_rht_resp_ap x y z). + intros H1 H2 H3. + apply notnot_ap_imp_neq. + intro H4. + apply H2; intro. + apply H3; intro. + apply H4. + auto. Qed. Lemma mult_eq_zero : forall x y : F, x[~=]Zero -> x[*]y [=] Zero -> y [=] Zero. -intros x y Hx Hxy. -apply not_ap_imp_eq. - -intro H. -elim (eq_imp_not_neq _ _ _ Hxy). -apply mult_resp_neq_zero. +Proof. + intros x y Hx Hxy. + apply not_ap_imp_eq. + intro H. + elim (eq_imp_not_neq _ _ _ Hxy). + apply mult_resp_neq_zero. + assumption. + apply ap_imp_neq. assumption. -apply ap_imp_neq. -assumption. Qed. Lemma mult_cancel_lft : forall x y z : F, z [#] Zero -> z[*]x [=] z[*]y -> x [=] y. -intros x y z Hz H. -apply not_ap_imp_eq. -intro H2. -elim (eq_imp_not_ap _ _ _ H). -apply mult_lft_resp_ap; assumption. +Proof. + intros x y z Hz H. + apply not_ap_imp_eq. + intro H2. + elim (eq_imp_not_ap _ _ _ H). + apply mult_lft_resp_ap; assumption. Qed. Lemma mult_cancel_rht : forall x y z : F, z [#] Zero -> x[*]z [=] y[*]z -> x [=] y. -intros x y z Hz H. -apply (mult_cancel_lft x y z). - assumption. -astepr (y[*]z). -Step_final (x[*]z). +Proof. + intros x y z Hz H. + apply (mult_cancel_lft x y z). + assumption. + astepr (y[*]z). + Step_final (x[*]z). Qed. Lemma square_eq_aux : forall x a : F, x[^]2 [=] a[^]2 -> (x[+]a) [*] (x[-]a) [=] Zero. -intros x a H. -astepl (x[^]2[-]a[^]2). -Step_final (a[^]2[-]a[^]2). +Proof. + intros x a H. + astepl (x[^]2[-]a[^]2). + Step_final (a[^]2[-]a[^]2). Qed. Lemma square_eq_weak : forall x a : F, x[^]2 [=] a[^]2 -> Not (x [#] a and x [#] [--]a). -intros x a H. -intro H0. -elim H0; intros H1 H2. -generalize (square_eq_aux _ _ H); intro H3. -generalize (eq_imp_not_ap _ _ _ H3); intro H4. -apply H4. -apply mult_resp_ap_zero. - astepr ([--]a[+]a). apply op_rht_resp_ap. auto. -astepr (a[-]a). -apply minus_resp_ap_rht. -assumption. +Proof. + intros x a H. + intro H0. + elim H0; intros H1 H2. + generalize (square_eq_aux _ _ H); intro H3. + generalize (eq_imp_not_ap _ _ _ H3); intro H4. + apply H4. + apply mult_resp_ap_zero. + astepr ([--]a[+]a). apply op_rht_resp_ap. auto. + astepr (a[-]a). + apply minus_resp_ap_rht. + assumption. Qed. Lemma cond_square_eq : forall x a : F, (Two:F) [#] Zero -> a [#] Zero -> x[^]2 [=] a[^]2 -> x [=] a or x [=] [--]a. -intros x a H Ha H0. -cut (a [#] [--]a). -intro H1. -elim (ap_cotransitive_unfolded _ _ _ H1 x); intro H2. - right. - apply not_ap_imp_eq. - intro H3. - elim (square_eq_weak _ _ H0). - split; auto. - apply ap_symmetric_unfolded; auto. -left. -apply not_ap_imp_eq. -intro H3. -elim (square_eq_weak _ _ H0); auto. - -apply plus_cancel_ap_lft with a. -astepr (Zero:F). -astepl (Two[*]a). -apply mult_resp_ap_zero; auto. +Proof. + intros x a H Ha H0. + cut (a [#] [--]a). + intro H1. + elim (ap_cotransitive_unfolded _ _ _ H1 x); intro H2. + right. + apply not_ap_imp_eq. + intro H3. + elim (square_eq_weak _ _ H0). + split; auto. + apply ap_symmetric_unfolded; auto. + left. + apply not_ap_imp_eq. + intro H3. + elim (square_eq_weak _ _ H0); auto. + apply plus_cancel_ap_lft with a. + astepr (Zero:F). + astepl (Two[*]a). + apply mult_resp_ap_zero; auto. Qed. End Field_multiplication. Section x_square. Lemma x_xminone : forall (F : CField) (x : F), x[^]2 [=] x -> x[*] (x[-]One) [=] Zero. -intros H x h. -astepl (x[*]x[-]x[*]One). -astepl (x[*]x[-]x). -apply cg_cancel_rht with x. -astepl (x[*]x[+][--]x[+]x). -astepl (x[*]x[+]([--]x[+]x)). -astepl (x[*]x[+]Zero). -astepl (x[*]x). -astepr x. -astepl (x[^]2). -exact h. +Proof. + intros H x h. + astepl (x[*]x[-]x[*]One). + astepl (x[*]x[-]x). + apply cg_cancel_rht with x. + astepl (x[*]x[+][--]x[+]x). + astepl (x[*]x[+]([--]x[+]x)). + astepl (x[*]x[+]Zero). + astepl (x[*]x). + astepr x. + astepl (x[^]2). + exact h. Qed. Lemma square_id : forall (F : CField) (x : F), x[^]2 [=] x -> {x [=] Zero} + {x [=] One}. -intros F x H. -cut ((Zero:F) [#] (One:F)). -intro H0. -elim (ap_cotransitive_unfolded _ _ _ H0 x). -intro H1. -right. -apply not_ap_imp_eq. -red in |- *. -intro H2. -set (H3 := minus_resp_ap_rht F x One One H2) in *. -set - (H4 := - ap_wdr_unfolded F (x[-]One) (One[-]One) Zero H3 - (cg_minus_correct F One)) in *. -set (H5 := ap_symmetric_unfolded F Zero x H1) in *. -set (H6 := mult_resp_ap_zero F x (x[-]One) H5 H4) in *. -simpl in |- *. - -set (H7 := x_xminone F x H) in *. -set (H8 := eq_imp_not_ap F (x[*] (x[-]One)) Zero H7) in *. -intuition. - -left. -apply not_ap_imp_eq. -red in |- *. -intro H2. -set (H3 := minus_resp_ap_rht F x One One b) in *. -set - (H4 := - ap_wdr_unfolded F (x[-]One) (One[-]One) Zero H3 - (cg_minus_correct F One)) in *. -set (H6 := mult_resp_ap_zero F x (x[-]One) H2 H4) in *. -set (H7 := x_xminone F x H) in *. -set (H8 := eq_imp_not_ap F (x[*] (x[-]One)) Zero H7) in *. -intuition. - -apply ap_symmetric_unfolded. -apply ring_non_triv. +Proof. + intros F x H. + cut ((Zero:F) [#] (One:F)). + intro H0. + elim (ap_cotransitive_unfolded _ _ _ H0 x). + intro H1. + right. + apply not_ap_imp_eq. + red in |- *. + intro H2. + set (H3 := minus_resp_ap_rht F x One One H2) in *. + set (H4 := ap_wdr_unfolded F (x[-]One) (One[-]One) Zero H3 (cg_minus_correct F One)) in *. + set (H5 := ap_symmetric_unfolded F Zero x H1) in *. + set (H6 := mult_resp_ap_zero F x (x[-]One) H5 H4) in *. + simpl in |- *. + set (H7 := x_xminone F x H) in *. + set (H8 := eq_imp_not_ap F (x[*] (x[-]One)) Zero H7) in *. + intuition. + left. + apply not_ap_imp_eq. + red in |- *. + intro H2. + set (H3 := minus_resp_ap_rht F x One One b) in *. + set (H4 := ap_wdr_unfolded F (x[-]One) (One[-]One) Zero H3 (cg_minus_correct F One)) in *. + set (H6 := mult_resp_ap_zero F x (x[-]One) H2 H4) in *. + set (H7 := x_xminone F x H) in *. + set (H8 := eq_imp_not_ap F (x[*] (x[-]One)) Zero H7) in *. + intuition. + apply ap_symmetric_unfolded. + apply ring_non_triv. Qed. End x_square. @@ -393,41 +397,46 @@ Section Rcpcl_properties. Variable F : CField. Lemma inv_one : f_rcpcl One (ring_non_triv F) [=] One. -astepl (One[*]f_rcpcl One (ring_non_triv F)). -apply field_mult_inv. +Proof. + astepl (One[*]f_rcpcl One (ring_non_triv F)). + apply field_mult_inv. Qed. Lemma f_rcpcl_wd : forall (x y : F) x_ y_, x [=] y -> f_rcpcl x x_ [=] f_rcpcl y y_. -intros x y H. -unfold f_rcpcl in |- *; algebra. +Proof. + intros x y H. + unfold f_rcpcl in |- *; algebra. Qed. Lemma f_rcpcl_mult : forall (y z : F) y_ z_ yz_, f_rcpcl (y[*]z) yz_ [=] f_rcpcl y y_[*]f_rcpcl z z_. -intros y z nzy nzz nzyz. -apply mult_cancel_lft with (y[*]z). - assumption. -astepl (One:F). -astepr (y[*]z[*] (f_rcpcl z nzz[*]f_rcpcl y nzy)). -astepr (y[*] (z[*] (f_rcpcl z nzz[*]f_rcpcl y nzy))). -astepr (y[*] (z[*]f_rcpcl z nzz[*]f_rcpcl y nzy)). -astepr (y[*] (One[*]f_rcpcl y nzy)). -astepr (y[*]f_rcpcl y nzy). -Step_final (One:F). +Proof. + intros y z nzy nzz nzyz. + apply mult_cancel_lft with (y[*]z). + assumption. + astepl (One:F). + astepr (y[*]z[*] (f_rcpcl z nzz[*]f_rcpcl y nzy)). + astepr (y[*] (z[*] (f_rcpcl z nzz[*]f_rcpcl y nzy))). + astepr (y[*] (z[*]f_rcpcl z nzz[*]f_rcpcl y nzy)). + astepr (y[*] (One[*]f_rcpcl y nzy)). + astepr (y[*]f_rcpcl y nzy). + Step_final (One:F). Qed. Lemma f_rcpcl_resp_ap_zero : forall (y : F) y_, f_rcpcl y y_ [#] Zero. -intros y nzy. -apply cring_mult_ap_zero_op with y. -astepl (One:F). apply one_ap_zero. +Proof. + intros y nzy. + apply cring_mult_ap_zero_op with y. + astepl (One:F). apply one_ap_zero. Qed. Lemma f_rcpcl_f_rcpcl : forall (x : F) x_ r_, f_rcpcl (f_rcpcl x x_) r_ [=] x. -intros x nzx nzr. -apply mult_cancel_rht with (f_rcpcl x nzx). - assumption. -astepr (One:F). -Step_final (f_rcpcl x nzx[*]f_rcpcl (f_rcpcl x nzx) nzr). +Proof. + intros x nzx nzr. + apply mult_cancel_rht with (f_rcpcl x nzx). + assumption. + astepr (One:F). + Step_final (f_rcpcl x nzx[*]f_rcpcl (f_rcpcl x nzx) nzr). Qed. End Rcpcl_properties. @@ -449,38 +458,35 @@ Definition NonZeroMonoid : CMonoid := Build_SubCMonoid (Build_multCMonoid F) (nonZeroP (M:=F)) (one_ap_zero F) (mult_resp_ap_zero F). Definition fmg_cs_inv : CSetoid_un_op NonZeroMonoid. -red in |- *. -cut - (forall x : NonZeroMonoid, - nonZeroP (cf_rcpcl F (scs_elem _ _ x) (scs_prf _ _ x))). -intro H. -apply - Build_CSetoid_fun - with - (fun x : NonZeroMonoid => - Build_subcsetoid_crr _ _ (cf_rcpcl F (scs_elem _ _ x) (scs_prf _ _ x)) - (H x)). -red in |- *. -simpl in |- *. -simple destruct x; simple destruct y. intros scs_elem0 scs_prf0 H0. -apply (cf_rcpsx _ _ _ _ _ H0). -intro; simpl in |- *. -red in |- *. -astepl (f_rcpcl (scs_elem _ _ x) (scs_prf _ _ x)). -apply f_rcpcl_resp_ap_zero. +Proof. + red in |- *. + cut (forall x : NonZeroMonoid, nonZeroP (cf_rcpcl F (scs_elem _ _ x) (scs_prf _ _ x))). + intro H. + apply Build_CSetoid_fun with (fun x : NonZeroMonoid => + Build_subcsetoid_crr _ _ (cf_rcpcl F (scs_elem _ _ x) (scs_prf _ _ x)) (H x)). + red in |- *. + simpl in |- *. + simple destruct x; simple destruct y. intros scs_elem0 scs_prf0 H0. + apply (cf_rcpsx _ _ _ _ _ H0). + intro; simpl in |- *. + red in |- *. + astepl (f_rcpcl (scs_elem _ _ x) (scs_prf _ _ x)). + apply f_rcpcl_resp_ap_zero. Defined. Lemma plus_nonzeros_eq_mult_dom : forall x y : NonZeroMonoid, scs_elem _ _ (x[+]y) [=] scs_elem _ _ x[*]scs_elem _ _ y. -simple destruct x; simple destruct y; algebra. +Proof. + simple destruct x; simple destruct y; algebra. Qed. Lemma cfield_to_mult_cgroup : CGroup. -apply (Build_CGroup NonZeroMonoid fmg_cs_inv). -intro x. -red in |- *. -elim x; intros x_ Hx. -simpl in |- *; apply cf_proof. +Proof. + apply (Build_CGroup NonZeroMonoid fmg_cs_inv). + intro x. + red in |- *. + elim x; intros x_ Hx. + simpl in |- *; apply cf_proof. Qed. End MultipGroup. @@ -500,47 +506,53 @@ In the names of lemmas, we denote [[/]] by [div], and Variable F : CField. Lemma div_prop : forall (x : F) x_, (Zero[/] x[//]x_) [=] Zero. -unfold cf_div in |- *; algebra. +Proof. + unfold cf_div in |- *; algebra. Qed. Lemma div_1 : forall (x y : F) y_, (x[/] y[//]y_) [*]y [=] x. -intros x y y_. -astepl (x[*]f_rcpcl y y_[*]y). -astepl (x[*] (f_rcpcl y y_[*]y)). -Step_final (x[*]One). +Proof. + intros x y y_. + astepl (x[*]f_rcpcl y y_[*]y). + astepl (x[*] (f_rcpcl y y_[*]y)). + Step_final (x[*]One). Qed. Lemma div_1' : forall (x y : F) y_, y[*] (x[/] y[//]y_) [=] x. -intros x y y_. -astepl ((x[/] y[//]y_) [*]y). -apply div_1. +Proof. + intros x y y_. + astepl ((x[/] y[//]y_) [*]y). + apply div_1. Qed. Lemma div_1'' : forall (x y : F) y_, (x[*]y[/] y[//]y_) [=] x. -intros x y y_. -unfold cf_div in |- *. -astepl (y[*]x[*]f_rcpcl y y_). -astepl (y[*] (x[*]f_rcpcl y y_)). -change (y[*] (x[/] y[//]y_) [=] x) in |- *. -apply div_1'. +Proof. + intros x y y_. + unfold cf_div in |- *. + astepl (y[*]x[*]f_rcpcl y y_). + astepl (y[*] (x[*]f_rcpcl y y_)). + change (y[*] (x[/] y[//]y_) [=] x) in |- *. + apply div_1'. Qed. Hint Resolve div_1: algebra. Lemma x_div_x : forall (x : F) x_, (x[/] x[//]x_) [=] One. -intros x x_. -unfold cf_div in |- *. -apply field_mult_inv. +Proof. + intros x x_. + unfold cf_div in |- *. + apply field_mult_inv. Qed. Hint Resolve x_div_x: algebra. Lemma x_div_one : forall x : F, (x[/] One[//]ring_non_triv F) [=] x. -intro x. -unfold cf_div in |- *. -generalize inv_one; intro H. -astepl (x[*]One). -apply mult_one. +Proof. + intro x. + unfold cf_div in |- *. + generalize inv_one; intro H. + astepl (x[*]One). + apply mult_one. Qed. (** @@ -549,21 +561,22 @@ The next lemma says $x\cdot\frac{y}{z} = \frac{x\cdot y}{z}$ *) Lemma x_mult_y_div_z : forall (x y z : F) z_, x[*] (y[/] z[//]z_) [=] (x[*]y[/] z[//]z_). -unfold cf_div in |- *; algebra. +Proof. + unfold cf_div in |- *; algebra. Qed. Hint Resolve x_mult_y_div_z: algebra. Lemma div_wd : forall (x x' y y' : F) y_ y'_, x [=] x' -> y [=] y' -> (x[/] y[//]y_) [=] (x'[/] y'[//]y'_). -intros x x' y y' nzy nzy' H H0. -unfold cf_div in |- *. -cut (f_rcpcl y nzy [=] f_rcpcl y' nzy'). -intro H1. -algebra. - -apply f_rcpcl_wd. -assumption. +Proof. + intros x x' y y' nzy nzy' H H0. + unfold cf_div in |- *. + cut (f_rcpcl y nzy [=] f_rcpcl y' nzy'). + intro H1. + algebra. + apply f_rcpcl_wd. + assumption. Qed. Hint Resolve div_wd: algebra_c. @@ -574,27 +587,30 @@ The next lemma says $\frac{\frac{x}{y}}{z} = \frac{x}{y\cdot z}$ *) Lemma div_div : forall (x y z : F) y_ z_ yz_, ((x[/] y[//]y_) [/] z[//]z_) [=] (x[/] y[*]z[//]yz_). -intros x y z nzy nzz nzyz. -unfold cf_div in |- *. -astepl (x[*] (f_rcpcl y nzy[*]f_rcpcl z nzz)). -apply mult_wdr. -apply eq_symmetric_unfolded. -apply f_rcpcl_mult. +Proof. + intros x y z nzy nzz nzyz. + unfold cf_div in |- *. + astepl (x[*] (f_rcpcl y nzy[*]f_rcpcl z nzz)). + apply mult_wdr. + apply eq_symmetric_unfolded. + apply f_rcpcl_mult. Qed. Lemma div_resp_ap_zero_rev : forall (x y : F) y_, x [#] Zero -> (x[/] y[//]y_) [#] Zero. -intros x y nzy Hx. -unfold cf_div in |- *. -apply mult_resp_ap_zero. - assumption. -apply f_rcpcl_resp_ap_zero. +Proof. + intros x y nzy Hx. + unfold cf_div in |- *. + apply mult_resp_ap_zero. + assumption. + apply f_rcpcl_resp_ap_zero. Qed. Lemma div_resp_ap_zero : forall (x y : F) y_, (x[/] y[//]y_) [#] Zero -> x [#] Zero. -intros x y nzy Hxy. -astepl ((x[/] y[//]nzy) [*]y). algebra. +Proof. + intros x y nzy Hxy. + astepl ((x[/] y[//]nzy) [*]y). algebra. Qed. (** @@ -603,20 +619,19 @@ The next lemma says $\frac{x}{\frac{y}{z}} = \frac{x\cdot z}{y}$ *) Lemma div_div2 : forall (x y z : F) y_ z_ yz_, (x[/] y[/] z[//]z_[//]yz_) [=] (x[*]z[/] y[//]y_). -intros x y z nzy nzz nzyz. -unfold cf_div in |- *. -astepr (x[*] (z[*]f_rcpcl y nzy)). -apply mult_wdr. -cut (f_rcpcl z nzz [#] Zero). -intro nzrz. -apply - eq_transitive_unfolded with (f_rcpcl y nzy[*]f_rcpcl (f_rcpcl z nzz) nzrz). - apply f_rcpcl_mult. -astepr (f_rcpcl y nzy[*]z). -apply mult_wdr. -apply f_rcpcl_f_rcpcl. - -apply f_rcpcl_resp_ap_zero. +Proof. + intros x y z nzy nzz nzyz. + unfold cf_div in |- *. + astepr (x[*] (z[*]f_rcpcl y nzy)). + apply mult_wdr. + cut (f_rcpcl z nzz [#] Zero). + intro nzrz. + apply eq_transitive_unfolded with (f_rcpcl y nzy[*]f_rcpcl (f_rcpcl z nzz) nzrz). + apply f_rcpcl_mult. + astepr (f_rcpcl y nzy[*]z). + apply mult_wdr. + apply f_rcpcl_f_rcpcl. + apply f_rcpcl_resp_ap_zero. Qed. (** @@ -626,55 +641,61 @@ The next lemma says $\frac{x\cdot p}{y\cdot q} = \frac{x}{y}\cdot \frac{p}{q}$ Lemma mult_of_divs : forall (x y p q : F) y_ q_ yq_, (x[*]p[/] y[*]q[//]yq_) [=] (x[/] y[//]y_) [*] (p[/] q[//]q_). -intros x y p q nzy nzq nzyq. -unfold cf_div in |- *. -astepl (x[*] (p[*]f_rcpcl (y[*]q) nzyq)). -astepr (x[*] (f_rcpcl y nzy[*] (p[*]f_rcpcl q nzq))). -apply mult_wdr. -astepr (f_rcpcl y nzy[*]p[*]f_rcpcl q nzq). -astepr (p[*]f_rcpcl y nzy[*]f_rcpcl q nzq). -astepr (p[*] (f_rcpcl y nzy[*]f_rcpcl q nzq)). -apply mult_wdr. -apply f_rcpcl_mult. +Proof. + intros x y p q nzy nzq nzyq. + unfold cf_div in |- *. + astepl (x[*] (p[*]f_rcpcl (y[*]q) nzyq)). + astepr (x[*] (f_rcpcl y nzy[*] (p[*]f_rcpcl q nzq))). + apply mult_wdr. + astepr (f_rcpcl y nzy[*]p[*]f_rcpcl q nzq). + astepr (p[*]f_rcpcl y nzy[*]f_rcpcl q nzq). + astepr (p[*] (f_rcpcl y nzy[*]f_rcpcl q nzq)). + apply mult_wdr. + apply f_rcpcl_mult. Qed. Lemma div_dist : forall (x y z : F) z_, (x[+]y[/] z[//]z_) [=] (x[/] z[//]z_) [+] (y[/] z[//]z_). -unfold cf_div in |- *; algebra. +Proof. + unfold cf_div in |- *; algebra. Qed. Lemma div_dist' : forall (x y z : F) z_, (x[-]y[/] z[//]z_) [=] (x[/] z[//]z_) [-] (y[/] z[//]z_). -unfold cf_div in |- *; algebra. +Proof. + unfold cf_div in |- *; algebra. Qed. Lemma div_semi_sym : forall (x y z : F) y_ z_, ((x[/] y[//]y_) [/] z[//]z_) [=] ((x[/] z[//]z_) [/] y[//]y_). -intros. -unfold cf_div in |- *. -astepl (x[*] ((f_rcpcl y y_) [*] (f_rcpcl z z_))). -Step_final (x[*] ((f_rcpcl z z_) [*] (f_rcpcl y y_))). +Proof. + intros. + unfold cf_div in |- *. + astepl (x[*] ((f_rcpcl y y_) [*] (f_rcpcl z z_))). + Step_final (x[*] ((f_rcpcl z z_) [*] (f_rcpcl y y_))). Qed. Hint Resolve div_semi_sym: algebra. Lemma eq_div : forall (x y u v : F) y_ v_, x[*]v [=] u[*]y -> (x[/] y[//]y_) [=] (u[/] v[//]v_). -intros x y u v Hy Hv H. -astepl (x[*]One[/] y[//]Hy). -astepl (x[*] (v[/] v[//]Hv) [/] y[//]Hy). -astepl ((x[*]v[/] v[//]Hv) [/] y[//]Hy). -astepl ((u[*]y[/] v[//]Hv) [/] y[//]Hy). -astepl ((u[*]y[/] y[//]Hy) [/] v[//]Hv). -astepl (u[*] (y[/] y[//]Hy) [/] v[//]Hv). -Step_final (u[*]One[/] v[//]Hv). +Proof. + intros x y u v Hy Hv H. + astepl (x[*]One[/] y[//]Hy). + astepl (x[*] (v[/] v[//]Hv) [/] y[//]Hy). + astepl ((x[*]v[/] v[//]Hv) [/] y[//]Hy). + astepl ((u[*]y[/] v[//]Hv) [/] y[//]Hy). + astepl ((u[*]y[/] y[//]Hy) [/] v[//]Hv). + astepl (u[*] (y[/] y[//]Hy) [/] v[//]Hv). + Step_final (u[*]One[/] v[//]Hv). Qed. Lemma div_strext : forall (x x' y y' : F) y_ y'_, (x[/] y[//]y_) [#] (x'[/] y'[//]y'_) -> x [#] x' or y [#] y'. -intros x x' y y' Hy Hy' H. -unfold cf_div in H. -elim (cs_bin_op_strext F cr_mult _ _ _ _ H). - auto. -intro H1. -right. -unfold f_rcpcl in H1. -exact (pfstrx _ _ _ _ _ _ H1). +Proof. + intros x x' y y' Hy Hy' H. + unfold cf_div in H. + elim (cs_bin_op_strext F cr_mult _ _ _ _ H). + auto. + intro H1. + right. + unfold f_rcpcl in H1. + exact (pfstrx _ _ _ _ _ _ H1). Qed. End Div_properties. @@ -694,50 +715,53 @@ Section Mult_Cancel_Ap_Zero. Variable F : CField. Lemma mult_cancel_ap_zero_lft : forall x y : F, x[*]y [#] Zero -> x [#] Zero. -intros x y H. -cut (x[*]y [#] Zero[*]Zero). -intro H0. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H0); intro H1. - 3: astepr (Zero:F); auto. -assumption. - -astepl (x[*]y[/] y[//]H1). -apply div_resp_ap_zero_rev. -assumption. +Proof. + intros x y H. + cut (x[*]y [#] Zero[*]Zero). + intro H0. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H0); intro H1. + 3: astepr (Zero:F); auto. + assumption. + astepl (x[*]y[/] y[//]H1). + apply div_resp_ap_zero_rev. + assumption. Qed. Lemma mult_cancel_ap_zero_rht : forall x y : F, x[*]y [#] Zero -> y [#] Zero. -intros x y H. -apply mult_cancel_ap_zero_lft with x. -astepl (x[*]y). auto. +Proof. + intros x y H. + apply mult_cancel_ap_zero_lft with x. + astepl (x[*]y). auto. Qed. Lemma recip_ap_zero : forall (x : F) x_, (One[/] x[//]x_) [#] Zero. -intros; apply cring_mult_ap_zero with x. -astepl (One:F). algebra. +Proof. + intros; apply cring_mult_ap_zero with x. + astepl (One:F). algebra. Qed. Lemma recip_resp_ap : forall (x y : F) x_ y_, x [#] y -> (One[/] x[//]x_) [#] (One[/] y[//]y_). -intros x y x_ y_ H. -apply zero_minus_apart. -apply mult_cancel_ap_zero_lft with (x[*]y). -apply ap_wdl with (y[-]x). - apply minus_ap_zero. - apply ap_symmetric_unfolded; assumption. -eapply eq_transitive_unfolded. - 2: apply eq_symmetric_unfolded; apply dist_2b. -apply cg_minus_wd. - astepr (x[*]y[*] (One[/] x[//]x_)). - astepr (x[*]y[*]One[/] x[//]x_). - astepr (x[*]y[/] x[//]x_). - astepr (y[*]x[/] x[//]x_). - astepr (y[*] (x[/] x[//]x_)). - Step_final (y[*]One). -astepr (x[*]y[*] (One[/] y[//]y_)). -astepr (x[*]y[*]One[/] y[//]y_). -astepr (x[*]y[/] y[//]y_). -astepr (x[*] (y[/] y[//]y_)). -Step_final (x[*]One). +Proof. + intros x y x_ y_ H. + apply zero_minus_apart. + apply mult_cancel_ap_zero_lft with (x[*]y). + apply ap_wdl with (y[-]x). + apply minus_ap_zero. + apply ap_symmetric_unfolded; assumption. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply dist_2b. + apply cg_minus_wd. + astepr (x[*]y[*] (One[/] x[//]x_)). + astepr (x[*]y[*]One[/] x[//]x_). + astepr (x[*]y[/] x[//]x_). + astepr (y[*]x[/] x[//]x_). + astepr (y[*] (x[/] x[//]x_)). + Step_final (y[*]One). + astepr (x[*]y[*] (One[/] y[//]y_)). + astepr (x[*]y[*]One[/] y[//]y_). + astepr (x[*]y[/] y[//]y_). + astepr (x[*] (y[/] y[//]y_)). + Step_final (x[*]One). Qed. End Mult_Cancel_Ap_Zero. @@ -779,17 +803,19 @@ Let Ext2R := ext2 (S:=X) (P:=Q) (R:=fun x Hx => G x Hx [#] Zero). Lemma part_function_recip_strext : forall x y Hx Hy, (One[/] _[//]Ext2R x Hx) [#] (One[/] _[//]Ext2R y Hy) -> x [#] y. -intros x y Hx Hy H. -elim (div_strext _ _ _ _ _ _ _ H); intro H1. - elimtype False; apply ap_irreflexive_unfolded with (x := One:X); auto. -exact (pfstrx _ _ _ _ _ _ H1). +Proof. + intros x y Hx Hy H. + elim (div_strext _ _ _ _ _ _ _ H); intro H1. + elimtype False; apply ap_irreflexive_unfolded with (x := One:X); auto. + exact (pfstrx _ _ _ _ _ _ H1). Qed. Lemma part_function_recip_pred_wd : pred_wd X R. -red in |- *; intros x y H H0. -elim H; intros H1 H2; split. - apply (dom_wd X G x y H1 H0). -intro H3; astepl (G x H1). auto. +Proof. + red in |- *; intros x y H H0. + elim H; intros H1 H2; split. + apply (dom_wd X G x y H1 H0). + intro H3; astepl (G x H1). auto. Qed. Definition Frecip := Build_PartFunct X _ part_function_recip_pred_wd @@ -809,21 +835,22 @@ Let Ext2R := ext2 (S:=X) (P:=Q) (R:=fun x Hx => G x Hx [#] Zero). Lemma part_function_div_strext : forall x y Hx Hy, (F x (prj1 X _ _ _ Hx) [/] _[//]Ext2R x (prj2 X _ _ _ Hx)) [#] - (F y (prj1 X _ _ _ Hy) [/] _[//]Ext2R y (prj2 X _ _ _ Hy)) -> + (F y (prj1 X _ _ _ Hy) [/] _[//]Ext2R y (prj2 X _ _ _ Hy)) -> x [#] y. -intros x y Hx Hy H. -elim (div_strext _ _ _ _ _ _ _ H); intro H1; - exact (pfstrx _ _ _ _ _ _ H1). +Proof. + intros x y Hx Hy H. + elim (div_strext _ _ _ _ _ _ _ H); intro H1; exact (pfstrx _ _ _ _ _ _ H1). Qed. Lemma part_function_div_pred_wd : pred_wd X R. -red in |- *; intros x y H H0. -elim H; intros H1 H2; split. - apply (dom_wd X F x y H1 H0). -clear H1. -elim H2; intros H1 H3; split. - apply (dom_wd X G x y H1 H0). -intro H4; astepl (G x H1). auto. +Proof. + red in |- *; intros x y H H0. + elim H; intros H1 H2; split. + apply (dom_wd X F x y H1 H0). + clear H1. + elim H2; intros H1 H3; split. + apply (dom_wd X G x y H1 H0). + intro H4; astepl (G x H1). auto. Qed. Definition Fdiv := Build_PartFunct X _ part_function_div_pred_wd @@ -840,37 +867,40 @@ Variable R:X -> CProp. Lemma included_FRecip : included R Q -> (forall x, R x -> forall Hx, G x Hx [#] Zero) -> included R (Dom Frecip). -intros H H0. -simpl in |- *. -unfold extend in |- *. -split. -apply H; assumption. -intros; apply H0; assumption. +Proof. + intros H H0. + simpl in |- *. + unfold extend in |- *. + split. + apply H; assumption. + intros; apply H0; assumption. Qed. Lemma included_FRecip' : included R (Dom Frecip) -> included R Q. -intro H; simpl in H; eapply included_extend; apply H. +Proof. + intro H; simpl in H; eapply included_extend; apply H. Qed. Lemma included_FDiv : included R P -> included R Q -> (forall x, R x -> forall Hx, G x Hx [#] Zero) -> included R (Dom Fdiv). -intros HP HQ Hx. -simpl in |- *. -apply included_conj. -assumption. -unfold extend in |- *. -split. -apply HQ; assumption. -intros; apply Hx; assumption. +Proof. + intros HP HQ Hx. + simpl in |- *. + apply included_conj. + assumption. + unfold extend in |- *. + split. + apply HQ; assumption. + intros; apply Hx; assumption. Qed. Lemma included_FDiv' : included R (Dom Fdiv) -> included R P. -intro H; simpl in H; eapply included_conj_lft; apply H. +Proof. + intro H; simpl in H; eapply included_conj_lft; apply H. Qed. Lemma included_FDiv'' : included R (Dom Fdiv) -> included R Q. -intro H; simpl in H; eapply included_extend; eapply included_conj_rht; - apply H. + intro H; simpl in H; eapply included_extend; eapply included_conj_rht; apply H. Qed. End CField_Ops. diff --git a/algebra/CGroups.v b/algebra/CGroups.v index 0fd50acf7..a4c7cc599 100644 --- a/algebra/CGroups.v +++ b/algebra/CGroups.v @@ -19,21 +19,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing [-] %\ensuremath-% #−# *) (** printing [--] %\ensuremath-% #−# *) @@ -53,7 +53,7 @@ Require Export CMonoids. Definition is_CGroup (G : CMonoid) (inv : CSetoid_un_op G) := forall x, is_inverse csg_op Zero x (inv x). -Record CGroup : Type := +Record CGroup : Type := {cg_crr :> CMonoid; cg_inv : CSetoid_un_op cg_crr; cg_proof : is_CGroup cg_crr cg_inv}. @@ -103,136 +103,147 @@ Section CGroup_basics. Variable G : CGroup. Lemma cg_rht_inv_unfolded : forall x : G, x[+] [--] x [=] Zero. -intro x; elim (cg_inverse G x); auto. +Proof. + intro x; elim (cg_inverse G x); auto. Qed. Lemma cg_lft_inv_unfolded : forall x : G, [--] x[+]x [=] Zero. -intro x; elim (cg_inverse G x); auto. +Proof. + intro x; elim (cg_inverse G x); auto. Qed. Lemma cg_minus_correct : forall x : G, x [-] x [=] Zero. -intro x. -unfold cg_minus in |- *. -apply cg_rht_inv_unfolded. +Proof. + intro x. + unfold cg_minus in |- *. + apply cg_rht_inv_unfolded. Qed. Hint Resolve cg_rht_inv_unfolded cg_lft_inv_unfolded cg_minus_correct: algebra. Lemma cg_inverse' : forall x : G, is_inverse csg_op Zero [--] x x. -intro x. -split; algebra. +Proof. + intro x. + split; algebra. Qed. (* Hints for Auto *) Lemma cg_minus_unfolded : forall x y : G, x [-] y [=] x[+] [--] y. -algebra. +Proof. + algebra. Qed. Hint Resolve cg_minus_unfolded: algebra. Lemma cg_minus_wd : forall x x' y y' : G, x [=] x' -> y [=] y' -> x [-] y [=] x' [-] y'. -intros x x' y y' H H0. -unfold cg_minus in |- *. -Step_final (x[+] [--] y'). +Proof. + intros x x' y y' H H0. + unfold cg_minus in |- *. + Step_final (x[+] [--] y'). Qed. Hint Resolve cg_minus_wd: algebra_c. Lemma cg_minus_strext : forall x x' y y' : G, x [-] y [#] x' [-] y' -> x [#] x' or y [#] y'. -intros x x' y y' H. cut (x [#] x' or [--] y [#] [--] y'). -intro H0. elim H0. - left; trivial. -intro H1. -right; exact (cs_un_op_strext G cg_inv y y' H1). - -apply bin_op_strext_unfolded with (csg_op (c:=G)). trivial. +Proof. + intros x x' y y' H. cut (x [#] x' or [--] y [#] [--] y'). + intro H0. elim H0. + left; trivial. + intro H1. + right; exact (cs_un_op_strext G cg_inv y y' H1). + apply bin_op_strext_unfolded with (csg_op (c:=G)). trivial. Qed. Definition cg_minus_is_csetoid_bin_op : CSetoid_bin_op G := Build_CSetoid_bin_op G (cg_minus (G:=G)) cg_minus_strext. Lemma grp_inv_assoc : forall x y : G, x[+]y [-] y [=] x. -intros x y; unfold cg_minus in |- *. -astepl (x[+](y[+] [--] y)). -Step_final (x[+]Zero). +Proof. + intros x y; unfold cg_minus in |- *. + astepl (x[+](y[+] [--] y)). + Step_final (x[+]Zero). Qed. Hint Resolve grp_inv_assoc: algebra. Lemma cg_inv_unique : forall x y : G, x[+]y [=] Zero -> y [=] [--] x. Proof. -intros x y H. -astepl (Zero[+]y). -astepl ([--] x[+]x[+]y). -astepl ([--] x[+](x[+]y)). -Step_final ([--] x[+]Zero). + intros x y H. + astepl (Zero[+]y). + astepl ([--] x[+]x[+]y). + astepl ([--] x[+](x[+]y)). + Step_final ([--] x[+]Zero). Qed. Lemma cg_inv_inv : forall x : G, [--] [--] x [=] x. Proof. -intro x. -astepl (Zero[+] [--] [--] x). -astepl (x[+] [--] x[+] [--] [--] x). -astepl (x[+]([--] x[+] [--] [--] x)). -Step_final (x[+]Zero). + intro x. + astepl (Zero[+] [--] [--] x). + astepl (x[+] [--] x[+] [--] [--] x). + astepl (x[+]([--] x[+] [--] [--] x)). + Step_final (x[+]Zero). Qed. Hint Resolve cg_inv_inv: algebra. Lemma cg_cancel_lft : forall x y z : G, x[+]y [=] x[+]z -> y [=] z. Proof. -intros x y z H. -astepl (Zero[+]y). -astepl ([--] x[+]x[+]y). -astepl ([--] x[+](x[+]y)). -astepl ([--] x[+](x[+]z)). -astepl ([--] x[+]x[+]z). -Step_final (Zero[+]z). + intros x y z H. + astepl (Zero[+]y). + astepl ([--] x[+]x[+]y). + astepl ([--] x[+](x[+]y)). + astepl ([--] x[+](x[+]z)). + astepl ([--] x[+]x[+]z). + Step_final (Zero[+]z). Qed. Lemma cg_cancel_rht : forall x y z : G, y[+]x [=] z[+]x -> y [=] z. Proof. -intros x y z H. -astepl (y[+]Zero). -astepl (y[+](x[+] [--] x)). -astepl (y[+]x[+] [--] x). -astepl (z[+]x[+] [--] x). -astepl (z[+](x[+] [--] x)). -Step_final (z[+]Zero). + intros x y z H. + astepl (y[+]Zero). + astepl (y[+](x[+] [--] x)). + astepl (y[+]x[+] [--] x). + astepl (z[+]x[+] [--] x). + astepl (z[+](x[+] [--] x)). + Step_final (z[+]Zero). Qed. Lemma cg_inv_unique' : forall x y : G, x[+]y [=] Zero -> x [=] [--] y. Proof. -intros x y H. -astepl (x[+]Zero). -astepl (x[+](y[+] [--] y)). -astepl (x[+]y[+] [--] y). -Step_final (Zero[+] [--] y). + intros x y H. + astepl (x[+]Zero). + astepl (x[+](y[+] [--] y)). + astepl (x[+]y[+] [--] y). + Step_final (Zero[+] [--] y). Qed. Lemma cg_inv_unique_2 : forall x y : G, x [-] y [=] Zero -> x [=] y. -intros x y H. -generalize (cg_inv_unique _ _ H); intro H0. -astepl ([--] [--] x). -Step_final ([--] [--] y). +Proof. + intros x y H. + generalize (cg_inv_unique _ _ H); intro H0. + astepl ([--] [--] x). + Step_final ([--] [--] y). Qed. Lemma cg_zero_inv : [--] (Zero:G) [=] Zero. -apply eq_symmetric_unfolded; apply cg_inv_unique; algebra. +Proof. + apply eq_symmetric_unfolded; apply cg_inv_unique; algebra. Qed. Hint Resolve cg_zero_inv: algebra. Lemma cg_inv_zero : forall x : G, x [-] Zero [=] x. -intro x. -unfold cg_minus in |- *. -Step_final (x[+]Zero). +Proof. + intro x. + unfold cg_minus in |- *. + Step_final (x[+]Zero). Qed. Lemma cg_inv_op : forall x y : G, [--] (x[+]y) [=] [--] y[+] [--] x. -intros x y. -apply (eq_symmetric G). -apply cg_inv_unique. -astepl (x[+]y[+] [--] y[+] [--] x). -astepl (x[+](y[+] [--] y)[+] [--] x). -astepl (x[+]Zero[+] [--] x). -Step_final (x[+] [--] x). +Proof. + intros x y. + apply (eq_symmetric G). + apply cg_inv_unique. + astepl (x[+]y[+] [--] y[+] [--] x). + astepl (x[+](y[+] [--] y)[+] [--] x). + astepl (x[+]Zero[+] [--] x). + Step_final (x[+] [--] x). Qed. (** @@ -240,7 +251,8 @@ Useful for interactive proof development. *) Lemma x_minus_x : forall x y : G, x [=] y -> x [-] y [=] Zero. -intros x y H; Step_final (x [-] x). +Proof. + intros x y H; Step_final (x [-] x). Qed. (** @@ -259,7 +271,8 @@ Let subcrr : CMonoid := Build_SubCMonoid _ _ Punit op_pres_P. Let subinv : CSetoid_un_op subcrr := Build_SubCSetoid_un_op _ _ _ inv_pres_P. Lemma isgrp_scrr : is_CGroup subcrr subinv. -red in |- *. intro x. case x. intros. split; simpl in |- *; algebra. +Proof. + red in |- *. intro x. case x. intros. split; simpl in |- *; algebra. Qed. Definition Build_SubCGroup : CGroup := Build_CGroup subcrr _ isgrp_scrr. @@ -269,8 +282,9 @@ End SubCGroups. End CGroup_basics. Add Parametric Morphism c : (@cg_minus c) with signature (@cs_eq (cg_crr c)) ==> (@cs_eq c) ==> (@cs_eq c) as cg_minus_wd_morph. -intros. -apply cg_minus_wd; assumption. +Proof. + intros. + apply cg_minus_wd; assumption. Qed. Hint Resolve cg_rht_inv_unfolded cg_lft_inv_unfolded: algebra. @@ -287,16 +301,19 @@ Section Assoc_properties. Variable G : CGroup. Lemma assoc_2 : forall x y z : G, x[+] (y [-] z) [=] x[+]y [-] z. -intros x y z; unfold cg_minus in |- *; algebra. +Proof. + intros x y z; unfold cg_minus in |- *; algebra. Qed. Lemma zero_minus : forall x : G, Zero [-] x [=] [--] x. -intro x. -unfold cg_minus in |- *. -algebra. +Proof. + intro x. + unfold cg_minus in |- *. + algebra. Qed. Lemma cg_cancel_mixed : forall x y : G, x [=] x [-] y[+]y. +Proof. intros x y. unfold cg_minus in |- *. astepr (x[+]([--] y[+]y)). @@ -304,7 +321,8 @@ Lemma cg_cancel_mixed : forall x y : G, x [=] x [-] y[+]y. Qed. Lemma plus_resp_eq : forall x y z : G, y [=] z -> x[+]y [=] x[+]z. -algebra. +Proof. + algebra. Qed. End Assoc_properties. @@ -323,91 +341,99 @@ Section cgroups_apartness. Variable G : CGroup. Lemma cg_add_ap_zero : forall x y : G, x[+]y [#] Zero -> x [#] Zero or y [#] Zero. -intros x y H. -apply (cs_bin_op_strext _ csg_op x Zero y Zero). -astepr (Zero:G). -auto. +Proof. + intros x y H. + apply (cs_bin_op_strext _ csg_op x Zero y Zero). + astepr (Zero:G). + auto. Qed. Lemma op_rht_resp_ap : forall x y z : G, x [#] y -> x[+]z [#] y[+]z. -intros x y z H. -cut (x[+]z [-] z [#] y[+]z [-] z). -intros h. -case (cs_bin_op_strext _ _ _ _ _ _ h). - auto. -intro contra; elim (ap_irreflexive _ _ contra). - -astepl x; astepr y. auto. +Proof. + intros x y z H. + cut (x[+]z [-] z [#] y[+]z [-] z). + intros h. + case (cs_bin_op_strext _ _ _ _ _ _ h). + auto. + intro contra; elim (ap_irreflexive _ _ contra). + astepl x; astepr y. auto. Qed. Lemma cg_ap_cancel_rht : forall x y z : G, x[+]z [#] y[+]z -> x [#] y. -intros x y z H. -apply ap_wdr_unfolded with (y[+]z [-] z). - apply ap_wdl_unfolded with (x[+]z [-] z). - apply (op_rht_resp_ap _ _ [--] z H). - astepr (x[+]Zero). - Step_final (x[+](z [-] z)). -astepr (y[+]Zero). -Step_final (y[+](z [-] z)). +Proof. + intros x y z H. + apply ap_wdr_unfolded with (y[+]z [-] z). + apply ap_wdl_unfolded with (x[+]z [-] z). + apply (op_rht_resp_ap _ _ [--] z H). + astepr (x[+]Zero). + Step_final (x[+](z [-] z)). + astepr (y[+]Zero). + Step_final (y[+](z [-] z)). Qed. Lemma plus_cancel_ap_rht : forall x y z : G, x[+]z [#] y[+]z -> x [#] y. Proof cg_ap_cancel_rht. Lemma minus_ap_zero : forall x y : G, x [#] y -> x [-] y [#] Zero. -intros x y H. -astepr (y [-] y). -unfold cg_minus in |- *. -apply op_rht_resp_ap; assumption. +Proof. + intros x y H. + astepr (y [-] y). + unfold cg_minus in |- *. + apply op_rht_resp_ap; assumption. Qed. Lemma zero_minus_apart : forall x y : G, x [-] y [#] Zero -> x [#] y. -unfold cg_minus in |- *. intros x y H. -cut (x[+] [--] y [#] y[+] [--] y). intros h. -apply (cg_ap_cancel_rht _ _ _ h). - -astepr (Zero:G). auto. +Proof. + unfold cg_minus in |- *. intros x y H. + cut (x[+] [--] y [#] y[+] [--] y). intros h. + apply (cg_ap_cancel_rht _ _ _ h). + astepr (Zero:G). auto. Qed. Lemma inv_resp_ap_zero : forall x : G, x [#] Zero -> [--] x [#] Zero. -intros x H. -astepl (Zero[+] [--] x). -astepl (Zero [-] x). -apply minus_ap_zero. -apply (ap_symmetric G). -auto. +Proof. + intros x H. + astepl (Zero[+] [--] x). + astepl (Zero [-] x). + apply minus_ap_zero. + apply (ap_symmetric G). + auto. Qed. Lemma inv_resp_ap : forall x y : G, x [#] y -> [--] x [#] [--] y. -intros x y H. -apply (csf_strext _ _ (cg_inv (c:=G))). -astepl x. -astepr y. -auto. +Proof. + intros x y H. + apply (csf_strext _ _ (cg_inv (c:=G))). + astepl x. + astepr y. + auto. Qed. Lemma minus_resp_ap_rht : forall x y z : G, x [#] y -> x [-] z [#] y [-] z. -intros x y z H. -unfold cg_minus in |- *. -apply op_rht_resp_ap. -assumption. +Proof. + intros x y z H. + unfold cg_minus in |- *. + apply op_rht_resp_ap. + assumption. Qed. Lemma minus_resp_ap_lft : forall x y z : G, x [#] y -> z [-] x [#] z [-] y. -intros x y z H. -astepl ([--] (x [-] z)). - 2: unfold cg_minus in |- *; Step_final ([--] [--] z[+] [--] x). -astepr ([--] (y [-] z)). - 2: unfold cg_minus in |- *; Step_final ([--] [--] z[+] [--] y). -apply inv_resp_ap. -apply minus_resp_ap_rht. -auto. +Proof. + intros x y z H. + astepl ([--] (x [-] z)). + 2: unfold cg_minus in |- *; Step_final ([--] [--] z[+] [--] x). + astepr ([--] (y [-] z)). + 2: unfold cg_minus in |- *; Step_final ([--] [--] z[+] [--] y). + apply inv_resp_ap. + apply minus_resp_ap_rht. + auto. Qed. Lemma minus_cancel_ap_rht : forall x y z : G, x [-] z [#] y [-] z -> x [#] y. -unfold cg_minus in |- *. -intros x y z H. -exact (plus_cancel_ap_rht _ _ _ H). +Proof. + unfold cg_minus in |- *. + intros x y z H. + exact (plus_cancel_ap_rht _ _ _ H). Qed. End cgroups_apartness. @@ -421,74 +447,76 @@ Section CGroup_Ops. *) Definition PS_Inv (A : CSetoid) : PS_as_CMonoid A -> PS_as_CMonoid A. -intro A. -simpl in |- *. -intros f. -elim f. -intros fo prfo. -set (H0 := Inv fo prfo) in *. -apply Build_subcsetoid_crr with H0. -unfold H0 in |- *. -apply Inv_bij. +Proof. + intro A. + simpl in |- *. + intros f. + elim f. + intros fo prfo. + set (H0 := Inv fo prfo) in *. + apply Build_subcsetoid_crr with H0. + unfold H0 in |- *. + apply Inv_bij. Defined. Definition Inv_as_un_op (A : CSetoid) : CSetoid_un_op (PS_as_CMonoid A). -intro A. -unfold CSetoid_un_op in |- *. -apply Build_CSetoid_fun with (PS_Inv A). -unfold fun_strext in |- *. -intros x y. -case x. -case y. -simpl in |- *. -intros f H g H0. -unfold ap_fun in |- *. -intro H1. -elim H1. -clear H1. -intros a H1. -exists (Inv g H0 a). -astepl a. -2: simpl in |- *. -2: apply eq_symmetric_unfolded. -2: apply inv1. -unfold bijective in H. -elim H. -unfold injective in |- *. -intros H2 H3. -astepl (f (Inv f H a)). -apply H2. -apply ap_symmetric_unfolded. -exact H1. -simpl in |- *. -apply inv1. +Proof. + intro A. + unfold CSetoid_un_op in |- *. + apply Build_CSetoid_fun with (PS_Inv A). + unfold fun_strext in |- *. + intros x y. + case x. + case y. + simpl in |- *. + intros f H g H0. + unfold ap_fun in |- *. + intro H1. + elim H1. + clear H1. + intros a H1. + exists (Inv g H0 a). + astepl a. + 2: simpl in |- *. + 2: apply eq_symmetric_unfolded. + 2: apply inv1. + unfold bijective in H. + elim H. + unfold injective in |- *. + intros H2 H3. + astepl (f (Inv f H a)). + apply H2. + apply ap_symmetric_unfolded. + exact H1. + simpl in |- *. + apply inv1. Defined. Lemma PS_is_CGroup : - forall A : CSetoid, is_CGroup (PS_as_CMonoid A) (Inv_as_un_op A). -intro A. -unfold is_CGroup in |- *. -intro x. -unfold is_inverse in |- *. -simpl in |- *. -split. -case x. -simpl in |- *. -intros f H. -unfold eq_fun in |- *. -intro a. -unfold comp in |- *. -simpl in |- *. -apply inv2. - -case x. -simpl in |- *. -intros f H. -unfold eq_fun in |- *. -intro a. -unfold comp in |- *. -simpl in |- *. -apply inv1. + forall A : CSetoid, is_CGroup (PS_as_CMonoid A) (Inv_as_un_op A). +Proof. + intro A. + unfold is_CGroup in |- *. + intro x. + unfold is_inverse in |- *. + simpl in |- *. + split. + case x. + simpl in |- *. + intros f H. + unfold eq_fun in |- *. + intro a. + unfold comp in |- *. + simpl in |- *. + apply inv2. + case x. + simpl in |- *. + intros f H. + unfold eq_fun in |- *. + intro a. + unfold comp in |- *. + simpl in |- *. + apply inv1. Qed. Definition PS_as_CGroup (A : CSetoid) := @@ -518,9 +546,10 @@ Section Part_Function_Inv. Lemma part_function_inv_strext : forall x y (Hx : P x) (Hy : P y), [--] (F x Hx) [#] [--] (F y Hy) -> x [#] y. -intros x y Hx Hy H. -apply pfstrx with F Hx Hy. -apply un_op_strext_unfolded with (cg_inv (c:=G)); assumption. +Proof. + intros x y Hx Hy H. + apply pfstrx with F Hx Hy. + apply un_op_strext_unfolded with (cg_inv (c:=G)); assumption. Qed. Definition Finv := Build_PartFunct _ _ @@ -532,13 +561,12 @@ Section Part_Function_Minus. Lemma part_function_minus_strext : forall x y (Hx : Conj P Q x) (Hy : Conj P Q y), F x (Prj1 Hx) [-] F' x (Prj2 Hx) [#] F y (Prj1 Hy) [-] F' y (Prj2 Hy) -> x [#] y. -intros x y Hx Hy H. -cut - (F x (Prj1 Hx) [#] F y (Prj1 Hy) or F' x (Prj2 Hx) [#] F' y (Prj2 Hy)). -intro H0. -elim H0; intro H1; exact (pfstrx _ _ _ _ _ _ H1). - -apply cg_minus_strext; auto. +Proof. + intros x y Hx Hy H. + cut (F x (Prj1 Hx) [#] F y (Prj1 Hy) or F' x (Prj2 Hx) [#] F' y (Prj2 Hy)). + intro H0. + elim H0; intro H1; exact (pfstrx _ _ _ _ _ _ H1). + apply cg_minus_strext; auto. Qed. Definition Fminus := Build_PartFunct G _ (conj_wd (dom_wd _ F) (dom_wd _ F')) @@ -554,23 +582,28 @@ End Part_Function_Minus. Variable R:G -> CProp. Lemma included_FInv : included R P -> included R (Dom Finv). -intro; simpl in |- *; assumption. +Proof. + intro; simpl in |- *; assumption. Qed. Lemma included_FInv' : included R (Dom Finv) -> included R P. -intro; simpl in |- *; assumption. +Proof. + intro; simpl in |- *; assumption. Qed. Lemma included_FMinus : included R P -> included R Q -> included R (Dom Fminus). -intros; simpl in |- *; apply included_conj; assumption. +Proof. + intros; simpl in |- *; apply included_conj; assumption. Qed. Lemma included_FMinus' : included R (Dom Fminus) -> included R P. -intro H; simpl in H; eapply included_conj_lft; apply H. +Proof. + intro H; simpl in H; eapply included_conj_lft; apply H. Qed. Lemma included_FMinus'' : included R (Dom Fminus) -> included R Q. -intro H; simpl in H; eapply included_conj_rht; apply H. +Proof. + intro H; simpl in H; eapply included_conj_rht; apply H. Qed. End CGroup_Ops. diff --git a/algebra/CHomomorphism_Theorems.v b/algebra/CHomomorphism_Theorems.v index 906b9a61e..02b4e2669 100644 --- a/algebra/CHomomorphism_Theorems.v +++ b/algebra/CHomomorphism_Theorems.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* Homomorphism_Theorems.v, v1.0, 28april2004, Bart Kirkels *) (** printing [+] %\ensuremath+% #+# *) @@ -80,33 +80,35 @@ Variable sigma : ModHom A B. Definition cspred (x:A) : CProp := (sigma x) [#] Zero. Definition cswdpred : (wd_pred A). -apply (Build_wd_pred A cspred). -unfold pred_wd; intros x y. -unfold cspred; auto. -intros H0 H1. -assert ((hommap A B sigma) x [=] (hommap A B sigma) y). -apply (csf_wd A B (hommap A B sigma) x y H1). -astepl ((hommap A B sigma) x). -assumption. +Proof. + apply (Build_wd_pred A cspred). + unfold pred_wd; intros x y. + unfold cspred; auto. + intros H0 H1. + assert ((hommap A B sigma) x [=] (hommap A B sigma) y). + apply (csf_wd A B (hommap A B sigma) x y H1). + astepl ((hommap A B sigma) x). + assumption. Defined. Lemma cs_is_comod : is_comod A cswdpred. -unfold cswdpred. -apply Build_is_comod; simpl in |-*; unfold cspred. -(* cm_apzero *) -apply mh_apzero. -(* cm_plus *) -intros x y X. -cut ((sigma x)[+](sigma y)[#]Zero). -intro X0. -apply cg_add_ap_zero; auto. -astepl (sigma (x[+]y)); algebra. -(* cm_mult *) -intros x a X. -cut ((rm_mu B)a (sigma x)[#]Zero). -intro X0. -apply (mu_axap0_xap0 R B a (sigma x)); assumption. -astepl ((hommap A B sigma) ((rm_mu A) a x)); assumption. +Proof. + unfold cswdpred. + apply Build_is_comod; simpl in |-*; unfold cspred. + (* cm_apzero *) + apply mh_apzero. + (* cm_plus *) + intros x y X. + cut ((sigma x)[+](sigma y)[#]Zero). + intro X0. + apply cg_add_ap_zero; auto. + astepl (sigma (x[+]y)); algebra. + (* cm_mult *) + intros x a X. + cut ((rm_mu B)a (sigma x)[#]Zero). + intro X0. + apply (mu_axap0_xap0 R B a (sigma x)); assumption. + astepl ((hommap A B sigma) ((rm_mu A) a x)); assumption. Qed. Definition cs_as_comod := Build_comod R A cswdpred cs_is_comod. @@ -132,55 +134,59 @@ Definition tau (x:A) := (x:AdivCs). (* begin hide *) Lemma tau_strext : fun_strext tau. -red in |-*; intros x y; unfold tau; simpl in |-*. -unfold ap_quotmod; simpl in |-*; unfold cspred. -intro X; cut ((x[-]y)[#]Zero); algebra. -apply (mh_apzero A B sigma (x[-]y)); assumption. +Proof. + red in |-*; intros x y; unfold tau; simpl in |-*. + unfold ap_quotmod; simpl in |-*; unfold cspred. + intro X; cut ((x[-]y)[#]Zero); algebra. + apply (mh_apzero A B sigma (x[-]y)); assumption. Qed. (* end hide *) Definition tau_is_fun := Build_CSetoid_fun A AdivCs tau tau_strext. Lemma tau_surj : surjective tau_is_fun. -red in |-*; intro b. -exists b. -simpl in |-*. -apply eq_quotmod_wd. -unfold tau; intuition. +Proof. + red in |-*; intro b. + exists b. + simpl in |-*. + apply eq_quotmod_wd. + unfold tau; intuition. Qed. Definition sigst (x:AdivCs) := (sigma x). (* begin hide *) Lemma sigst_strext : fun_strext sigst. -red in |-*; intros x y; unfold sigst; simpl in |-*. -unfold ap_quotmod; simpl in |-*; unfold cspred. -intro X. -astepl (sigma (x[+]([--]y))); simpl in |-*. -astepl ((sigma x)[+](sigma ([--]y))); simpl in |-*. -astepl ((sigma x)[+][--](sigma y)). -astepl ((sigma x)[-](sigma y)). -apply minus_ap_zero; assumption. +Proof. + red in |-*; intros x y; unfold sigst; simpl in |-*. + unfold ap_quotmod; simpl in |-*; unfold cspred. + intro X. + astepl (sigma (x[+]([--]y))); simpl in |-*. + astepl ((sigma x)[+](sigma ([--]y))); simpl in |-*. + astepl ((sigma x)[+][--](sigma y)). + astepl ((sigma x)[-](sigma y)). + apply minus_ap_zero; assumption. Qed. (* end hide *) Definition sigst_is_fun := Build_CSetoid_fun AdivCs B sigst sigst_strext. Lemma sigst_inj : injective sigst_is_fun. -red in |-*; intros x y. -simpl in |-*. -unfold ap_quotmod. -simpl in |-*. -unfold cspred. -intro X. -unfold sigst. -apply (cg_ap_cancel_rht B (sigma x) (sigma y) [--](sigma y)). -astepr (Zero:B). -astepl ((sigma x)[+](sigma [--]y)); simpl. -astepl (sigma (x[+][--]y)); simpl. -assumption. -apply mh_pres_plus. -apply plus_resp_eq; apply mh_pres_minus. +Proof. + red in |-*; intros x y. + simpl in |-*. + unfold ap_quotmod. + simpl in |-*. + unfold cspred. + intro X. + unfold sigst. + apply (cg_ap_cancel_rht B (sigma x) (sigma y) [--](sigma y)). + astepr (Zero:B). + astepl ((sigma x)[+](sigma [--]y)); simpl. + astepl (sigma (x[+][--]y)); simpl. + assumption. + apply mh_pres_plus. + apply plus_resp_eq; apply mh_pres_minus. Qed. (** @@ -190,9 +196,10 @@ the homomorphism theorem for modules. Lemma ModHomTheorem : {tau : CSetoid_fun A AdivCs | surjective tau} and {sigst : CSetoid_fun AdivCs B | injective sigst}. -split. -exists tau_is_fun; apply tau_surj. -exists sigst_is_fun; apply sigst_inj. +Proof. + split. + exists tau_is_fun; apply tau_surj. + exists sigst_is_fun; apply sigst_inj. Qed. End Theorem_on_Modules. @@ -214,36 +221,38 @@ Variable sigma : RingHom R S. Definition cspredR (x:R) : CProp := (sigma x) [#] Zero. Definition cswdpredR : (wd_pred R). -apply (Build_wd_pred R cspredR). -unfold pred_wd; intros x y. -unfold cspredR; auto. -intros H0 H1. -assert ((rhmap R S sigma) x [=] (rhmap R S sigma) y). -apply (csf_wd R S (rhmap R S sigma) x y H1). -astepl ((rhmap R S sigma) x). -assumption. +Proof. + apply (Build_wd_pred R cspredR). + unfold pred_wd; intros x y. + unfold cspredR; auto. + intros H0 H1. + assert ((rhmap R S sigma) x [=] (rhmap R S sigma) y). + apply (csf_wd R S (rhmap R S sigma) x y H1). + astepl ((rhmap R S sigma) x). + assumption. Defined. Lemma cs_is_coideal : is_coideal cswdpredR. -unfold cswdpredR. -apply Build_is_coideal; simpl in |-*; unfold cspredR. -(* C_apzero *) -apply rh_apzero. -(* C_plus *) -intros x y X. -cut ((sigma x)[+](sigma y)[#]Zero). -intro X0. -apply cg_add_ap_zero; auto. -astepl (sigma (x[+]y)); algebra. -(* C_mult *) -intros x y X. -cut ((sigma x)[*](sigma y)[#]Zero). -intro X0; split; algebra. -apply (cring_mult_ap_zero S (sigma x) (sigma y)); auto. -apply (cring_mult_ap_zero_op S (sigma x) (sigma y)); auto. -astepl (sigma (x[*]y)); assumption. -(* C_non_triv *) -astepl (One:S); algebra. +Proof. + unfold cswdpredR. + apply Build_is_coideal; simpl in |-*; unfold cspredR. + (* C_apzero *) + apply rh_apzero. + (* C_plus *) + intros x y X. + cut ((sigma x)[+](sigma y)[#]Zero). + intro X0. + apply cg_add_ap_zero; auto. + astepl (sigma (x[+]y)); algebra. + (* C_mult *) + intros x y X. + cut ((sigma x)[*](sigma y)[#]Zero). + intro X0; split; algebra. + apply (cring_mult_ap_zero S (sigma x) (sigma y)); auto. + apply (cring_mult_ap_zero_op S (sigma x) (sigma y)); auto. + astepl (sigma (x[*]y)); assumption. + (* C_non_triv *) + astepl (One:S); algebra. Qed. Definition cs_as_coideal := Build_coideal R cswdpredR cs_is_coideal. @@ -268,53 +277,57 @@ We now define the functions of which we want to prove the existence. Definition Rtau (x:R) := (x:RdivCsR). Lemma Rtau_strext : fun_strext Rtau. -red in |-*; intros x y; unfold Rtau; simpl in |-*. -unfold ap_quotring; simpl in |-*; unfold cspred. -intro X; cut ((x[-]y)[#]Zero); algebra. -apply (rh_apzero R S sigma (x[-]y)); assumption. +Proof. + red in |-*; intros x y; unfold Rtau; simpl in |-*. + unfold ap_quotring; simpl in |-*; unfold cspred. + intro X; cut ((x[-]y)[#]Zero); algebra. + apply (rh_apzero R S sigma (x[-]y)); assumption. Qed. Definition Rtau_is_fun := Build_CSetoid_fun R RdivCsR Rtau Rtau_strext. Lemma Rtau_surj : surjective Rtau_is_fun. -red in |-*; intro b. -exists b. -simpl in |-*. -apply eq_quotring_wd. -unfold Rtau; intuition. +Proof. + red in |-*; intro b. + exists b. + simpl in |-*. + apply eq_quotring_wd. + unfold Rtau; intuition. Qed. Definition Rsigst (x:RdivCsR) := (sigma x). Lemma Rsigst_strext : fun_strext Rsigst. -red in |-*; intros x y; unfold Rsigst; simpl in |-*. -unfold ap_quotring; simpl in |-*; unfold cspredR. -intro X. -astepl (sigma (x[+]([--]y))); simpl in |-*. -astepl ((sigma x)[+](sigma ([--]y))); simpl in |-*. -astepl ((sigma x)[+][--](sigma y)). -astepl ((sigma x)[-](sigma y)). -apply minus_ap_zero; assumption. +Proof. + red in |-*; intros x y; unfold Rsigst; simpl in |-*. + unfold ap_quotring; simpl in |-*; unfold cspredR. + intro X. + astepl (sigma (x[+]([--]y))); simpl in |-*. + astepl ((sigma x)[+](sigma ([--]y))); simpl in |-*. + astepl ((sigma x)[+][--](sigma y)). + astepl ((sigma x)[-](sigma y)). + apply minus_ap_zero; assumption. Qed. Definition Rsigst_is_fun := Build_CSetoid_fun RdivCsR S Rsigst Rsigst_strext. Lemma Rsigst_inj : injective Rsigst_is_fun. -red in |-*; intros x y. -simpl in |-*. -unfold ap_quotring. -simpl in |-*. -unfold cspred. -intro X. -unfold Rsigst. -apply (cg_ap_cancel_rht S (sigma x) (sigma y) [--](sigma y)). -astepr (Zero:S). -astepl ((sigma x)[+](sigma [--]y)); simpl. -astepl (sigma (x[+][--]y)); simpl. -assumption. -apply rh_pres_plus. -autorewrite with ringHomPush. -reflexivity. +Proof. + red in |-*; intros x y. + simpl in |-*. + unfold ap_quotring. + simpl in |-*. + unfold cspred. + intro X. + unfold Rsigst. + apply (cg_ap_cancel_rht S (sigma x) (sigma y) [--](sigma y)). + astepr (Zero:S). + astepl ((sigma x)[+](sigma [--]y)); simpl. + astepl (sigma (x[+][--]y)); simpl. + assumption. + apply rh_pres_plus. + autorewrite with ringHomPush. + reflexivity. Qed. (** @@ -324,9 +337,10 @@ the homomorphism theorem for rings. Lemma RingHomTheorem : {Rtau : CSetoid_fun R RdivCsR | surjective Rtau} and {Rsigst : CSetoid_fun RdivCsR S | injective Rsigst}. -split. -exists Rtau_is_fun; apply Rtau_surj. -exists Rsigst_is_fun; apply Rsigst_inj. +Proof. + split. + exists Rtau_is_fun; apply Rtau_surj. + exists Rsigst_is_fun; apply Rsigst_inj. Qed. End Theorem_on_Rings. diff --git a/algebra/CIdeals.v b/algebra/CIdeals.v index 6e6374a3c..29bfa14dd 100644 --- a/algebra/CIdeals.v +++ b/algebra/CIdeals.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* Ideals.v, v1.0, 28april2004, Bart Kirkels *) (** printing [+] %\ensuremath+% #+# *) @@ -48,11 +48,11 @@ Require Export CRings. (** -* Ideals and coideals +* Ideals and coideals ** Definition of ideals and coideals Let [R] be a ring. At this moment all CRings are commutative and -non-trivial. So our ideals are automatically two-sided. As soon -as non-commutative rings are represented in CoRN left and +non-trivial. So our ideals are automatically two-sided. As soon +as non-commutative rings are represented in CoRN left and right ideals should be defined. *) @@ -63,7 +63,7 @@ Variable R : CRing. Record is_ideal (idP : wd_pred R) : CProp := { idax : forall a x:R, idP a -> idP (a[*]x); idprpl : forall x y : R, idP x -> idP y -> idP (x[+]y)}. - + Record ideal : Type := { idpred :> wd_pred R; idproof : is_ideal idpred}. @@ -73,8 +73,8 @@ Variable I : ideal. Definition ideal_as_CSetoid := Build_SubCSetoid R I. (* end hide *) -(** -We actually define strongly non-trivival co-ideals. +(** +We actually define strongly non-trivival co-ideals. *) Record is_coideal (ciP : wd_pred R) : CProp := @@ -82,11 +82,11 @@ Record is_coideal (ciP : wd_pred R) : CProp := ciplus : forall x y:R, ciP (x[+]y) -> ciP x or ciP y; cimult : forall x y:R, ciP (x[*]y) -> ciP x and ciP y; cinontriv : ciP One}. - + Record coideal : Type := { cipred :> wd_pred R; ciproof : is_coideal cipred}. - + (* begin hide *) Variable C : coideal. Definition coideal_as_CSetoid := Build_SubCSetoid R C. @@ -110,39 +110,47 @@ Variable I : ideal R. Variable C : coideal R. Lemma ideal_is_ideal : is_ideal I. -elim I; auto. +Proof. + elim I; auto. Qed. Lemma coideal_is_coideal : is_coideal C. -elim C; auto. +Proof. + elim C; auto. Qed. Lemma coideal_apzero : forall x:R, C x -> x[#]Zero. -elim C. intuition elim ciproof0. +Proof. + elim C. intuition elim ciproof0. Qed. Lemma coideal_nonzero : Not (C Zero). -intro. -cut ((Zero:R)[#](Zero:R)); try apply coideal_apzero; try assumption. -apply ap_irreflexive. +Proof. + intro. + cut ((Zero:R)[#](Zero:R)); try apply coideal_apzero; try assumption. + apply ap_irreflexive. Qed. Lemma coideal_plus : forall x y:R, C (x[+]y) -> C x or C y. -elim C. intuition elim ciproof0. +Proof. + elim C. intuition elim ciproof0. Qed. Lemma coideal_mult : forall x y:R, C (x[*]y) -> C x and C y. -elim C. intuition elim ciproof0. +Proof. + elim C. intuition elim ciproof0. Qed. Lemma coideal_nontriv : C One. -elim C. intuition elim ciproof0. +Proof. + elim C. intuition elim ciproof0. Qed. Lemma coideal_wd : forall x y:R, x[=]y -> C x -> C y. -elim C. simpl in |-*. intro. -elim cipred0. intros. -apply (wdp_well_def x y); auto. +Proof. + elim C. simpl in |-*. intro. + elim cipred0. intros. + apply (wdp_well_def x y); auto. Qed. End Ideal_Axioms. diff --git a/algebra/CModule_Homomorphisms.v b/algebra/CModule_Homomorphisms.v index b797fa7dc..54affc9f1 100644 --- a/algebra/CModule_Homomorphisms.v +++ b/algebra/CModule_Homomorphisms.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* CModule_Homomorphisms.v, v1.0, 28april2004, Bart Kirkels *) (** printing [+] %\ensuremath+% #+# *) @@ -86,7 +86,7 @@ Implicit Arguments hom3 [R]. (** ** Lemmas on Module Homomorphisms -Let [R] be a ring, [A] and [B] [R]-Modules +Let [R] be a ring, [A] and [B] [R]-Modules and [f] a module homomorphism from [A] to [B]. *** Axioms on Module Homomorphisms *) @@ -101,20 +101,24 @@ Section ModHom_Axioms. Variable f : ModHom A B. Lemma mh_strext : forall x y:A, (f x) [#] (f y) -> x [#] y. -elim f; intuition. -assert (fun_strext hommap0); elim hommap0; intuition. +Proof. + elim f; intuition. + assert (fun_strext hommap0); elim hommap0; intuition. Qed. Lemma mh_pres_plus : forall x y:A, f (x[+]y) [=] (f x) [+] (f y). -elim f; auto. +Proof. + elim f; auto. Qed. Lemma mh_pres_unit : (f (cm_unit A)) [=] (cm_unit B). -elim f; auto. +Proof. + elim f; auto. Qed. Lemma mh_pres_mult : forall (a:R)(x:A), f (rm_mu A a x) [=] rm_mu B a (f x). -elim f; auto. +Proof. + elim f; auto. Qed. End ModHom_Axioms. @@ -131,26 +135,29 @@ Section ModHom_Basics. Variable f : ModHom A B. Lemma mh_pres_zero : (f (Zero:A)) [=] (Zero:B). -astepr ((f Zero)[-](f Zero)). -astepr ((f (Zero[+]Zero))[-](f Zero)). -Step_final ((f Zero[+]f Zero)[-]f Zero). +Proof. + astepr ((f Zero)[-](f Zero)). + astepr ((f (Zero[+]Zero))[-](f Zero)). + Step_final ((f Zero[+]f Zero)[-]f Zero). Qed. Lemma mh_pres_minus : forall x:A, (f [--]x) [=] [--] (f x). -intro x; apply (cg_cancel_lft B (f x)). -astepr (Zero:B). -astepl (f (x[+][--]x)). -Step_final (f (Zero:A)); try apply mh_pres_zero. +Proof. + intro x; apply (cg_cancel_lft B (f x)). + astepr (Zero:B). + astepl (f (x[+][--]x)). + Step_final (f (Zero:A)); try apply mh_pres_zero. Qed. Lemma mh_apzero : forall x:A, (f x) [#] Zero -> x [#] Zero. -intros x X; apply (cg_ap_cancel_rht A x (Zero:A) x). -astepr x. -apply (mh_strext f (x[+]x) x). -astepl ((f x)[+](f x)). -astepr ((Zero:B) [+] (f x)). -apply (op_rht_resp_ap B (f x) (Zero:B) (f x)). -assumption. +Proof. + intros x X; apply (cg_ap_cancel_rht A x (Zero:A) x). + astepr x. + apply (mh_strext f (x[+]x) x). + astepl ((f x)[+](f x)). + astepr ((Zero:B) [+] (f x)). + apply (op_rht_resp_ap B (f x) (Zero:B) (f x)). + assumption. Qed. End ModHom_Basics. diff --git a/algebra/CModules.v b/algebra/CModules.v index 0d66e70fd..7836505c5 100644 --- a/algebra/CModules.v +++ b/algebra/CModules.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* CModules.v, v1.0, 28april2004, Bart Kirkels *) (** printing [+] %\ensuremath+% #+# *) @@ -66,7 +66,7 @@ Record is_RModule (A : CAbGroup) (mu : CSetoid_bin_fun R A A) : Prop := (mu a (mu b x)); rm_one : forall x:A, (mu One x)[=]x}. -Record RModule : Type := +Record RModule : Type := {rm_crr :> CAbGroup; rm_mu : CSetoid_bin_fun R rm_crr rm_crr; rm_proof: is_RModule rm_crr rm_mu}. @@ -103,26 +103,31 @@ Section Module_Axioms. Variable A : RModule R. Lemma RModule_is_RModule : is_RModule (rm_crr A) (rm_mu A). -elim A; intuition. +Proof. + elim A; intuition. Qed. - + Lemma mu_plus1 : forall (a : R) (x y : A), a['](x[+]y) [=] a[']x [+] a[']y. -elim RModule_is_RModule; intuition. +Proof. + elim RModule_is_RModule; intuition. Qed. Lemma mu_plus2 : forall (a b : R) (x : A), (a[+]b) ['] x [=] a[']x [+] b[']x. -elim RModule_is_RModule; intuition. +Proof. + elim RModule_is_RModule; intuition. Qed. Lemma mu_mult : forall (a b : R) (x : A), (a[*]b)['] x [=] a[']b[']x. -elim RModule_is_RModule; intuition. +Proof. + elim RModule_is_RModule; intuition. Qed. Lemma mu_one : forall x : A, One[']x [=] x. -elim RModule_is_RModule; intuition. +Proof. + elim RModule_is_RModule; intuition. Qed. End Module_Axioms. @@ -140,15 +145,17 @@ Variable A : RModule R. (* begin hide *) Lemma mu0help : forall (a:R) (x:A), Zero[']x [=] a[']Zero[']x. -intros a x; astepl ((a[*]Zero)[']x); algebra. +Proof. + intros a x; astepl ((a[*]Zero)[']x); algebra. Qed. Hint Resolve mu0help : algebra. Lemma mu0help2 : forall x:A, Zero[']x [=] Zero[']x [+] Zero[']x. -intro x; astepl ((One[+]One)[']Zero[']x); algebra. -astepl (One[']Zero[']x [+] One['](Zero[']x)). -algebra. +Proof. + intro x; astepl ((One[+]One)[']Zero[']x); algebra. + astepl (One[']Zero[']x [+] One['](Zero[']x)). + algebra. Qed. Hint Resolve mu0help2 : algebra. @@ -156,79 +163,87 @@ Hint Resolve mu0help2 : algebra. (* end hide *) Lemma mu_zerox : forall x : A, Zero[']x [=] Zero. -intro x; apply eq_symmetric. -apply (cg_cancel_lft _ (Zero[']x)); algebra. -astepl (Zero[']x); algebra. +Proof. + intro x; apply eq_symmetric. + apply (cg_cancel_lft _ (Zero[']x)); algebra. + astepl (Zero[']x); algebra. Qed. Hint Resolve mu_zerox : algebra. Lemma mu_minusonex : forall x:A, [--]One[']x [=] [--]x. -intro x; apply (cg_cancel_rht A x ([--]One[']x) [--]x). -astepr (Zero:A). -astepl ([--]One[']x [+] One[']x). -astepl (([--]One[+]One)['] x). -astepl (Zero[']x); algebra. +Proof. + intro x; apply (cg_cancel_rht A x ([--]One[']x) [--]x). + astepr (Zero:A). + astepl ([--]One[']x [+] One[']x). + astepl (([--]One[+]One)['] x). + astepl (Zero[']x); algebra. Qed. Hint Resolve mu_minusonex : algebra. Lemma mu_azero : forall a:R, a['](Zero:A) [=] Zero. -intro a; apply (cg_cancel_rht A (a['](Zero:A))). -astepr (a['](Zero:A)). -astepl (a[']((Zero:A)[+](Zero:A))). -Step_final (a['](Zero:A)). +Proof. + intro a; apply (cg_cancel_rht A (a['](Zero:A))). + astepr (a['](Zero:A)). + astepl (a[']((Zero:A)[+](Zero:A))). + Step_final (a['](Zero:A)). Qed. Lemma mu_aminusx : forall (a:R)(x:A), a['][--]x [=] [--] (a[']x). -intros a x; apply (cg_cancel_rht A (a[']x)). -astepr (Zero:A). -astepl (a[']([--]x[+]x)). -astepl (a['](Zero:A)). -apply mu_azero. +Proof. + intros a x; apply (cg_cancel_rht A (a[']x)). + astepr (Zero:A). + astepl (a[']([--]x[+]x)). + astepl (a['](Zero:A)). + apply mu_azero. Qed. Lemma mu_minusax : forall (a:R)(x:A), [--]a[']x [=] [--] (a[']x). -intros a x; apply (cg_cancel_rht A (a[']x)). -astepr (Zero:A). -astepl (([--]a[+]a)[']x). -astepl ((Zero:R)[']x). -apply mu_zerox. +Proof. + intros a x; apply (cg_cancel_rht A (a[']x)). + astepr (Zero:A). + astepl (([--]a[+]a)[']x). + astepl ((Zero:R)[']x). + apply mu_zerox. Qed. Hint Resolve mu_azero mu_aminusx mu_minusax: algebra. (* begin hide *) -Lemma mu_strext : forall (a1 a2:R)(x1 x2:A), a1[']x1[#]a2[']x2 -> +Lemma mu_strext : forall (a1 a2:R)(x1 x2:A), a1[']x1[#]a2[']x2 -> a1[#]a2 or x1[#]x2. -elim (rm_mu A); intuition. +Proof. + elim (rm_mu A); intuition. Qed. (* end hide *) Lemma mu_axap0_aap0 : forall (a:R)(x:A), a[']x [#] (Zero:A) -> a [#] (Zero:R). -intros a x X; apply (cg_ap_cancel_rht R a (Zero:R) a). -astepr a. -cut (a[+]a[#]a or x[#]x); intuition. -assert False; try apply (ap_irreflexive_unfolded A x); try assumption. -elim H. -apply mu_strext. -astepl ((a[']x)[+](a[']x)). -astepr ((Zero:A)[+](a[']x)). -apply op_rht_resp_ap; assumption. +Proof. + intros a x X; apply (cg_ap_cancel_rht R a (Zero:R) a). + astepr a. + cut (a[+]a[#]a or x[#]x); intuition. + assert False; try apply (ap_irreflexive_unfolded A x); try assumption. + elim H. + apply mu_strext. + astepl ((a[']x)[+](a[']x)). + astepr ((Zero:A)[+](a[']x)). + apply op_rht_resp_ap; assumption. Qed. Lemma mu_axap0_xap0 : forall (a:R)(x:A), a[']x [#] (Zero:A) -> x [#] (Zero:A). -intros a x X; apply (cg_ap_cancel_rht A x (Zero:A) x). -astepr x. -cut (a[#]a or x[+]x[#]x); intuition. -assert False; try apply (ap_irreflexive_unfolded R a); try assumption. -elim H. -apply mu_strext. -astepl ((a[']x)[+](a[']x)). -astepr ((Zero:A)[+](a[']x)). -apply op_rht_resp_ap; assumption. +Proof. + intros a x X; apply (cg_ap_cancel_rht A x (Zero:A) x). + astepr x. + cut (a[#]a or x[+]x[#]x); intuition. + assert False; try apply (ap_irreflexive_unfolded R a); try assumption. + elim H. + apply mu_strext. + astepl ((a[']x)[+](a[']x)). + astepr ((Zero:A)[+](a[']x)). + apply op_rht_resp_ap; assumption. Qed. Hint Resolve mu_strext mu_axap0_aap0 mu_axap0_xap0 : algebra. @@ -242,7 +257,8 @@ End Module_Basics. Section Rings. Lemma R_is_RModule : is_RModule R cr_mult. -apply Build_is_RModule; intuition. +Proof. + apply Build_is_RModule; intuition. Qed. Definition R_as_RModule := Build_RModule R R cr_mult R_is_RModule. @@ -263,8 +279,8 @@ Record is_submod (subP : wd_pred A) : CProp := smplus : forall x y:A, subP x and subP y -> subP (x[+]y); smmult : forall (x:A)(a:R), subP x -> subP(a[']x)}. -Record submod : Type := - {smpred :> wd_pred A; +Record submod : Type := + {smpred :> wd_pred A; smproof: is_submod smpred}. (* begin hide *) @@ -277,8 +293,8 @@ Record is_comod (coP : wd_pred A) : CProp := cmplus : forall x y:A, coP (x[+]y) -> coP x or coP y; cmmult : forall (x:A)(a:R), coP (a[']x) -> coP x}. -Record comod : Type := - {cmpred :> wd_pred A; +Record comod : Type := + {cmpred :> wd_pred A; cmproof: is_comod cmpred}. (* begin hide *) @@ -304,38 +320,45 @@ Variable sm : submod A. Variable cm : comod A. Lemma submod_is_submod : is_submod sm. -elim sm; auto. +Proof. + elim sm; auto. Qed. Lemma comod_is_comod : is_comod cm. -elim cm; auto. +Proof. + elim cm; auto. Qed. Lemma comod_apzero : forall x:A, cm x -> x[#]Zero. -elim cm. intuition elim cmproof0. +Proof. + elim cm. intuition elim cmproof0. Qed. Lemma comod_nonzero : Not (cm Zero). -intro. -cut ((Zero:A)[#](Zero:A)); try apply comod_apzero; try assumption. -apply ap_irreflexive. +Proof. + intro. + cut ((Zero:A)[#](Zero:A)); try apply comod_apzero; try assumption. + apply ap_irreflexive. Qed. Lemma comod_plus : forall x y:A, cm (x[+]y) -> cm x or cm y. -elim cm. intuition elim cmproof0. +Proof. + elim cm. intuition elim cmproof0. Qed. Lemma comod_mult : forall (x:A)(a:R), cm (a[']x) -> cm x. -elim cm. intuition elim cmproof0. +Proof. + elim cm. intuition elim cmproof0. Qed. Lemma comod_wd : forall x y:A, x[=]y -> cm x -> cm y. -elim cm. -simpl in |-*. -intro. -elim cmpred0. -intros. -apply (wdp_well_def x y); auto. +Proof. + elim cm. + simpl in |-*. + intro. + elim cmpred0. + intros. + apply (wdp_well_def x y); auto. Qed. End CoSubModule_Axioms. diff --git a/algebra/CMonoids.v b/algebra/CMonoids.v index fe91b77cb..b493173c5 100644 --- a/algebra/CMonoids.v +++ b/algebra/CMonoids.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Zero %\ensuremath{\mathbf0}% #0# *) @@ -49,11 +49,11 @@ Require Export Nsec. ** Definition of monoids *) -Record is_CMonoid (M : CSemiGroup) (Zero : M) : Prop := +Record is_CMonoid (M : CSemiGroup) (Zero : M) : Prop := {runit : is_rht_unit (csg_op (c:=M)) Zero; lunit : is_lft_unit (csg_op (c:=M)) Zero}. -Record CMonoid : Type := +Record CMonoid : Type := {cm_crr :> CSemiGroup; cm_unit : cm_crr; cm_proof : is_CMonoid cm_crr cm_unit}. @@ -92,15 +92,18 @@ Section CMonoid_axioms. Variable M : CMonoid. Lemma CMonoid_is_CMonoid : is_CMonoid M (cm_unit M). -elim M; auto. +Proof. + elim M; auto. Qed. Lemma cm_rht_unit : is_rht_unit csg_op (Zero:M). -elim CMonoid_is_CMonoid; auto. +Proof. + elim CMonoid_is_CMonoid; auto. Qed. Lemma cm_lft_unit : is_lft_unit csg_op (Zero:M). -elim CMonoid_is_CMonoid; auto. +Proof. + elim CMonoid_is_CMonoid; auto. Qed. End CMonoid_axioms. @@ -122,13 +125,15 @@ Proof cm_lft_unit M. Hint Resolve cm_rht_unit_unfolded cm_lft_unit_unfolded: algebra. Lemma cm_unit_unique_lft : forall x : M, is_lft_unit csg_op x -> x [=] Zero. -intros x h. red in h. -Step_final (x[+]Zero). +Proof. + intros x h. red in h. + Step_final (x[+]Zero). Qed. Lemma cm_unit_unique_rht : forall x : M, is_rht_unit csg_op x -> x [=] Zero. -intros x h. red in h. -Step_final (Zero[+]x). +Proof. + intros x h. red in h. + Step_final (Zero[+]x). Qed. (* Begin_SpecReals *) @@ -140,11 +145,12 @@ The proof component of the monoid is irrelevant. Lemma is_CMonoid_proof_irr : forall (S:CSetoid) (Zero:S) (plus : CSetoid_bin_op S) (p q : associative plus), is_CMonoid (Build_CSemiGroup S plus p) Zero -> is_CMonoid (Build_CSemiGroup S plus q) Zero. -intros S one mult p q H. -elim H; intros runit0 lunit0. -simpl in runit0. -simpl in lunit0. -apply Build_is_CMonoid; simpl in |- *; assumption. +Proof. + intros S one mult p q H. + elim H; intros runit0 lunit0. + simpl in runit0. + simpl in lunit0. + apply Build_is_CMonoid; simpl in |- *; assumption. Qed. (* End_SpecReals *) @@ -164,15 +170,14 @@ Variable op_pres_P : bin_op_pres_pred _ P csg_op. Let subcrr : CSemiGroup := Build_SubCSemiGroup _ _ op_pres_P. Lemma ismon_scrr : is_CMonoid subcrr (Build_subcsetoid_crr _ _ _ Punit). -split; red in |- *. - -(* right unit *) -intro x. case x. intros scs_elem scs_prf. -apply (cm_rht_unit_unfolded scs_elem). - -(* left unit *) -intro x. case x. intros scs_elem scs_prf. -apply (cm_lft_unit_unfolded scs_elem). +Proof. + split; red in |- *. + (* right unit *) + intro x. case x. intros scs_elem scs_prf. + apply (cm_rht_unit_unfolded scs_elem). + (* left unit *) + intro x. case x. intros scs_elem scs_prf. + apply (cm_lft_unit_unfolded scs_elem). Qed. Definition Build_SubCMonoid : CMonoid := Build_CMonoid subcrr _ ismon_scrr. @@ -219,41 +224,42 @@ Variable f: (CSetoid_fun M1 M2). Variable isof: (isomorphism M1 M2 f). Lemma iso_imp_bij: (bijective f). -unfold isomorphism in isof. -intuition. +Proof. + unfold isomorphism in isof. + intuition. Qed. Lemma iso_inv: (isomorphism M2 M1 (Inv f (iso_imp_bij))). -unfold isomorphism. -split. -unfold morphism. -split. -unfold isomorphism in isof. -unfold morphism in isof. -elim isof. -intros H0 H1. -elim H0. -clear H0. -intros H3 H4. -astepl ((Inv f iso_imp_bij) (f Zero)). -unfold Inv. -simpl. -apply inv2. - - intros a b. elim isof. intros H0 H1. move: H1 => [H1 H2]. -(* set (Ha:= (H2 a)). set (Hb:= (H2 b)).*) - move: (H2 a) => [a' fa'a]. move: (H2 b) => [b' fb'b]. - unfold morphism in H0. +Proof. + unfold isomorphism. + split. + unfold morphism. + split. + unfold isomorphism in isof. + unfold morphism in isof. + elim isof. + intros H0 H1. + elim H0. + clear H0. + intros H3 H4. + astepl ((Inv f iso_imp_bij) (f Zero)). + unfold Inv. + simpl. + apply inv2. + intros a b. elim isof. intros H0 H1. move: H1 => [H1 H2]. + (* set (Ha:= (H2 a)). set (Hb:= (H2 b)).*) + move: (H2 a) => [a' fa'a]. move: (H2 b) => [b' fb'b]. + unfold morphism in H0. astepl ((Inv f iso_imp_bij) (f a' [+] f b')). - astepl ((Inv f iso_imp_bij) ( f ( a'[+] b'))). + astepl ((Inv f iso_imp_bij) ( f ( a'[+] b'))). set (H3:= (inv2 M1 M2 f iso_imp_bij (a'[+]b'))). astepl (a'[+]b'). astepr (a'[+] b'). intuition. set (H4:=(inv2 M1 M2 f iso_imp_bij a')). - apply csbf_wd. + apply csbf_wd. astepr (Inv f iso_imp_bij (f a')); intuition. astepr (Inv f iso_imp_bij (f b')). set (H5:= (inv2 M1 M2 f iso_imp_bij b')); intuition. - intuition. -apply Inv_bij. + intuition. + apply Inv_bij. Qed. End Th14. @@ -278,7 +284,7 @@ Variable M:CMonoid. Variable c:M. Fixpoint power_CMonoid (m:M)(n:nat){struct n}:M:= -match n with +match n with |0 => (cm_unit M) |(S p) => m [+] (power_CMonoid m p) end. @@ -289,17 +295,17 @@ Implicit Arguments power_CMonoid [M]. Lemma power_plus:forall (M:CMonoid)(a:M)(m n:nat), (power_CMonoid a (m+n))[=] - (power_CMonoid a m)[+](power_CMonoid a n). -intros M a m n. -induction m. -simpl. -apply eq_symmetric. -apply cm_lft_unit. - -simpl. -astepl (csbf_fun M M M (csg_op (c:=M)) a ((csbf_fun M M M (csg_op (c:=M)) (power_CMonoid a m) - (power_CMonoid a n)))). -algebra. + (power_CMonoid a m)[+](power_CMonoid a n). +Proof. + intros M a m n. + induction m. + simpl. + apply eq_symmetric. + apply cm_lft_unit. + simpl. + astepl (csbf_fun M M M (csg_op (c:=M)) a ((csbf_fun M M M (csg_op (c:=M)) (power_CMonoid a m) + (power_CMonoid a n)))). + algebra. Qed. @@ -311,323 +317,299 @@ Definition is_generator (M:CMonoid)(u:M):CProp:= forall (m:M),{n:nat | (power_CMonoid u n)[=]m}. Definition cyclic : CMonoid -> CProp := - fun M => + fun M => {u:M | (forall (m:M),{n:nat | (power_CMonoid u n)[=]m}):CProp}. Section gen_cyc. Lemma power_k:forall (M:CMonoid)(u:M)(k l s:nat),(is_generator M u)-> - ((kl0 and (k0 + and ((forall (k0 l0:nat), (k0<>l0 and (k0 (power_CMonoid u k0 [#] power_CMonoid u l0)))):CProp)-> (power_CMonoid u k)[=](power_CMonoid u (k+(s*(l-k)))). -intros M u k l s H. -unfold is_generator in H. -intros H0. -induction s. -simpl. -replace (k+0) with k. -intuition. - -intuition. - -simpl. -replace (k+((l-k)+s*(l-k))) with (l + s*(l-k)). -2:intuition. -set (H1:= (power_plus M u l (s*(l-k)))). -astepr (csbf_fun (csg_crr (cm_crr M)) (csg_crr (cm_crr M)) - (csg_crr (cm_crr M)) (csg_op (c:=cm_crr M)) - (power_CMonoid u l) (power_CMonoid u (s * (l - k)))). -elim H0. -clear H0. -intros H0 H0'. -elim H0'. -clear H0'. -intros H0' H0''. -cut ( power_CMonoid u l[=]power_CMonoid u k). -intro H4. -csetoid_rewrite H4. -2:apply eq_symmetric. -2:exact H0'. -set (H5:=(power_plus M u k (s*(l-k)))). -cut (csbf_fun M M M (csg_op (c:=M)) (power_CMonoid u k) - (power_CMonoid u (s * (l - k)))[=]power_CMonoid u (k + s * (l - k))). -intros H6. -csetoid_rewrite H6. -exact IHs. - -apply eq_symmetric. -exact H5. +Proof. + intros M u k l s H. + unfold is_generator in H. + intros H0. + induction s. + simpl. + replace (k+0) with k. + intuition. + intuition. + simpl. + replace (k+((l-k)+s*(l-k))) with (l + s*(l-k)). + 2:intuition. + set (H1:= (power_plus M u l (s*(l-k)))). + astepr (csbf_fun (csg_crr (cm_crr M)) (csg_crr (cm_crr M)) + (csg_crr (cm_crr M)) (csg_op (c:=cm_crr M)) (power_CMonoid u l) (power_CMonoid u (s * (l - k)))). + elim H0. + clear H0. + intros H0 H0'. + elim H0'. + clear H0'. + intros H0' H0''. + cut ( power_CMonoid u l[=]power_CMonoid u k). + intro H4. + csetoid_rewrite H4. + 2:apply eq_symmetric. + 2:exact H0'. + set (H5:=(power_plus M u k (s*(l-k)))). + cut (csbf_fun M M M (csg_op (c:=M)) (power_CMonoid u k) + (power_CMonoid u (s * (l - k)))[=]power_CMonoid u (k + s * (l - k))). + intros H6. + csetoid_rewrite H6. + exact IHs. + apply eq_symmetric. + exact H5. Qed. Lemma power_k_n:forall (M:CMonoid)(u:M)(k l n :nat) (H2:((Z_of_nat (l-k)>0)%Z)),(is_generator M u)->(k - ((k l0 and (k0 + and ((forall (k0 l0:nat), (k0<> l0 and (k0 (power_CMonoid u k0 [#] power_CMonoid u l0)))):CProp)-> (power_CMonoid u n)[=](power_CMonoid u (k+(mod_nat (n-k) (l-k) H2))). -intros M u k l n H2 H H15. -set (H13:=(power_k M u k l)). -intros H4. -cut ((l-k)>0)%Z. -intro H5. -set (H6:=(Z_div_mod_eq (n-k)(l-k) H5)). -2:intuition. -cut (((n - k) mod (l - k))= (n-k)%Z -((l - k) * ((n - k) / (l - k))))%Z. -2:intuition. -set (H7:=(mod_nat_correct (n-k) (l-k) H2)). -intro H8. -cut {s:nat | (mod_nat (n-k)(l-k) H2)=(n-k)-s*(l-k) and s*(l-k)<=(n-k)}. -intro H9. -elim H9. -clear H9. -intros s H9. -elim H9. -clear H9. -intros H9 H9'. -rewrite H9. -replace (power_CMonoid u n) with (power_CMonoid u ((k+s*(l-k))+((n-k)-s*(l-k)))). -2: replace ((k + s * (l - k))+((n - k) - s * (l - k))) with n. -2:reflexivity. - -set (H10:=(power_plus M u (k+(s*(l-k))) ((n-k)-s*(l-k)))). -csetoid_rewrite H10. -set (H11:=(power_plus M u k (n-k-s*(l-k)))). -csetoid_rewrite H11. -csetoid_replace (power_CMonoid u (k + s * (l - k))) - (power_CMonoid u k). -apply eq_reflexive. - -intuition. - -cut (n=k+(n-k)). -intro H10. -cut (n=((k+(n-k))+(s*(l-k)-s*(l-k)))). -intro H11. -cut ((k+(n-k))+(s*(l-k)-s*(l-k)) = (k + s * (l - k) + (n - k - s * (l - k)))). -intro H12. -rewrite<- H11 in H12. -exact H12. - -apply minus4. -split. -intuition. -exact H9'. -rewrite<- H10. -cut ((s*(l-k)-s*(l-k))=0). -intro H11. -rewrite H11. -intuition. -intuition. - -cut (n=n+(k-k)). -intro H10. -cut (n+(k-k)=k+(n-k)). -intro H11. -rewrite<- H10 in H11. -exact H11. - -apply minus3. -split. -intuition. -intuition. -cut ((k-k)=0). -intro H10. -rewrite H10. -intuition. -intuition. -simpl. -cut (l-k>0). -intro H9. -set (H10:=(quotient (l-k) H9 (n-k))). -elim H10. -clear H10. -intros q H10. -exists q. -split. -elim H10. -clear H10. -intros r H10'. -elim H10'. -clear H10'. -intros H10' H10''. -3:intuition. -cut ((n-k)= q*(l-k)+ (mod_nat (n-k)(l-k) H2)). -intro H11. -intuition. -cut (r= (mod_nat (n-k)(l-k)H2)). -intro H11. -rewrite<- H11. -exact H10'. - -simpl. -cut ((Z_of_nat r)=(mod_nat (n - k) (l - k) H2)). -intro H11. -intuition. - -rewrite<- H7. -apply nat_Z_div with (n-k) q (l-k) ((Z_of_nat n - Z_of_nat k) / (Z_of_nat l - Z_of_nat k))%Z. -exact H10'. -intuition. -cut (k<=l). -intro H11. -set (H12:=(inj_minus1 l k H11)). -rewrite H12. -cut (k<=n). -intro H14. -set (H16:=(inj_minus1 n k H14)). -rewrite H16. -exact H6. -intuition. -intuition. -set (H17:=(Z_mod_lt (Z_of_nat (n-k)) (Z_of_nat (l-k)))). -intuition. -elim H10. -clear H10. -intros r H10. -elim H10. -clear H10. -intros H10 H10'. -intuition. +Proof. + intros M u k l n H2 H H15. + set (H13:=(power_k M u k l)). + intros H4. + cut ((l-k)>0)%Z. + intro H5. + set (H6:=(Z_div_mod_eq (n-k)(l-k) H5)). + 2:intuition. + cut (((n - k) mod (l - k))= (n-k)%Z -((l - k) * ((n - k) / (l - k))))%Z. + 2:intuition. + set (H7:=(mod_nat_correct (n-k) (l-k) H2)). + intro H8. + cut {s:nat | (mod_nat (n-k)(l-k) H2)=(n-k)-s*(l-k) and s*(l-k)<=(n-k)}. + intro H9. + elim H9. + clear H9. + intros s H9. + elim H9. + clear H9. + intros H9 H9'. + rewrite H9. + replace (power_CMonoid u n) with (power_CMonoid u ((k+s*(l-k))+((n-k)-s*(l-k)))). + 2: replace ((k + s * (l - k))+((n - k) - s * (l - k))) with n. + 2:reflexivity. + set (H10:=(power_plus M u (k+(s*(l-k))) ((n-k)-s*(l-k)))). + csetoid_rewrite H10. + set (H11:=(power_plus M u k (n-k-s*(l-k)))). + csetoid_rewrite H11. + csetoid_replace (power_CMonoid u (k + s * (l - k))) (power_CMonoid u k). + apply eq_reflexive. + intuition. + cut (n=k+(n-k)). + intro H10. + cut (n=((k+(n-k))+(s*(l-k)-s*(l-k)))). + intro H11. + cut ((k+(n-k))+(s*(l-k)-s*(l-k)) = (k + s * (l - k) + (n - k - s * (l - k)))). + intro H12. + rewrite<- H11 in H12. + exact H12. + apply minus4. + split. + intuition. + exact H9'. + rewrite<- H10. + cut ((s*(l-k)-s*(l-k))=0). + intro H11. + rewrite H11. + intuition. + intuition. + cut (n=n+(k-k)). + intro H10. + cut (n+(k-k)=k+(n-k)). + intro H11. + rewrite<- H10 in H11. + exact H11. + apply minus3. + split. + intuition. + intuition. + cut ((k-k)=0). + intro H10. + rewrite H10. + intuition. + intuition. + simpl. + cut (l-k>0). + intro H9. + set (H10:=(quotient (l-k) H9 (n-k))). + elim H10. + clear H10. + intros q H10. + exists q. + split. + elim H10. + clear H10. + intros r H10'. + elim H10'. + clear H10'. + intros H10' H10''. + 3:intuition. + cut ((n-k)= q*(l-k)+ (mod_nat (n-k)(l-k) H2)). + intro H11. + intuition. + cut (r= (mod_nat (n-k)(l-k)H2)). + intro H11. + rewrite<- H11. + exact H10'. + simpl. + cut ((Z_of_nat r)=(mod_nat (n - k) (l - k) H2)). + intro H11. + intuition. + rewrite<- H7. + apply nat_Z_div with (n-k) q (l-k) ((Z_of_nat n - Z_of_nat k) / (Z_of_nat l - Z_of_nat k))%Z. + exact H10'. + intuition. + cut (k<=l). + intro H11. + set (H12:=(inj_minus1 l k H11)). + rewrite H12. + cut (k<=n). + intro H14. + set (H16:=(inj_minus1 n k H14)). + rewrite H16. + exact H6. + intuition. + intuition. + set (H17:=(Z_mod_lt (Z_of_nat (n-k)) (Z_of_nat (l-k)))). + intuition. + elim H10. + clear H10. + intros r H10. + elim H10. + clear H10. + intros H10 H10'. + intuition. Qed. -Lemma cyc_imp_comm: forall (M:CMonoid)(H:(cyclic M)), (commutes (@csg_op M)). -intros M H. -unfold commutes. -intros x y. -unfold cyclic in H. -elim H. -clear H. -intros c0 H. -elim (H x). -intros nx Hx. -elim (H y). -intros ny Hy. -csetoid_rewrite_rev Hx. -csetoid_rewrite_rev Hy. -csetoid_rewrite_rev (power_plus M c0 nx ny). -replace (nx+ny) with (ny+nx). -csetoid_rewrite (power_plus M c0 ny nx). -apply eq_reflexive. -intuition. +Lemma cyc_imp_comm: forall (M:CMonoid)(H:(cyclic M)), (commutes (@csg_op M)). +Proof. + intros M H. + unfold commutes. + intros x y. + unfold cyclic in H. + elim H. + clear H. + intros c0 H. + elim (H x). + intros nx Hx. + elim (H y). + intros ny Hy. + csetoid_rewrite_rev Hx. + csetoid_rewrite_rev Hy. + csetoid_rewrite_rev (power_plus M c0 nx ny). + replace (nx+ny) with (ny+nx). + csetoid_rewrite (power_plus M c0 ny nx). + apply eq_reflexive. + intuition. Qed. Lemma weakly_inj1: forall (M:CMonoid)(u:M)(k l a b:nat),(is_generator M u)->(a(b (kl0 and (k0 + and (forall (k0 l0:nat),k0<>l0 and (k0 (power_CMonoid u k0 [#] power_CMonoid u l0)))-> (power_CMonoid u a)[=](power_CMonoid u b) -> a=b. -intros M u k l a b H H0 H1. -unfold is_generator in H. -intros H3 H4. -elim (eq_nat_dec a b). -tauto. - -intro H5. -elim (not_or a b H5). -clear H5. -intro H5. -cut False. -intuition. - -set (H6:= (eq_imp_not_ap M (power_CMonoid u a)(power_CMonoid u b) H4)). -unfold Not in H6. -cut (k<>a+(l-b) or k=a+(l-b)). -intro orex. -elim orex. -clear orex. -intro orex. -cut ((power_CMonoid u a[#]power_CMonoid u b) or - (power_CMonoid u (l-b)[#]power_CMonoid u (l-b))). -intro H7. -elim H7. -tauto. -clear H7. -intro H7. -set (H8:= (ap_irreflexive_unfolded M (power_CMonoid u (l-b)) H7)). -intuition. - -apply bin_op_strext_unfolded with (@csg_op M). -csetoid_rewrite_rev (power_plus M u b (l-b)). -csetoid_rewrite_rev (power_plus M u a (l-b)). -elim H3. -clear H3. -intros H3 H7. -elim H7. -clear H7. -intros H7 H8. -replace (b+(l-b)) with l. -csetoid_rewrite_rev H7. -apply ap_symmetric_unfolded. -apply H8. -split. -intuition. -right. -intuition. - -intuition. - -clear orex. -intro orex. -intuition. - -intuition. - -clear H5. -intro H5. -cut False. -intuition. - -cut (power_CMonoid (M:=M) u b[=]power_CMonoid (M:=M) u a). -intro H4'. -set (H6:= (eq_imp_not_ap M (power_CMonoid u a)(power_CMonoid u b) H4)). -set (H6':= (eq_imp_not_ap M (power_CMonoid u b)(power_CMonoid u a) H4')). -unfold Not in H6. -cut (k<>b+(l-a) or k=b+(l-a)). -intro orex. -elim orex. -clear orex. -intro orex. -cut ((power_CMonoid u a[#]power_CMonoid u b) or - (power_CMonoid u (l-a)[#]power_CMonoid u (l-a))). -intro H7. -elim H7. -tauto. -clear H7. -intro H7. -set (H8:= (ap_irreflexive_unfolded M (power_CMonoid u (l-a)) H7)). -intuition. - -apply bin_op_strext_unfolded with (@csg_op M). -csetoid_rewrite_rev (power_plus M u b (l-a)). -csetoid_rewrite_rev (power_plus M u a (l-a)). -elim H3. -clear H3. -intros H3 H7. -elim H7. -clear H7. -intros H7 H8. -replace (a+(l-a)) with l. -csetoid_rewrite_rev H7. -apply H8. -split. -intuition. -right. -intuition. - -intuition. - -clear orex. -intro orex. -intuition. - -intuition. - -intuition. +Proof. + intros M u k l a b H H0 H1. + unfold is_generator in H. + intros H3 H4. + elim (eq_nat_dec a b). + tauto. + intro H5. + elim (not_or a b H5). + clear H5. + intro H5. + cut False. + intuition. + set (H6:= (eq_imp_not_ap M (power_CMonoid u a)(power_CMonoid u b) H4)). + unfold Not in H6. + cut (k<>a+(l-b) or k=a+(l-b)). + intro orex. + elim orex. + clear orex. + intro orex. + cut ((power_CMonoid u a[#]power_CMonoid u b) or (power_CMonoid u (l-b)[#]power_CMonoid u (l-b))). + intro H7. + elim H7. + tauto. + clear H7. + intro H7. + set (H8:= (ap_irreflexive_unfolded M (power_CMonoid u (l-b)) H7)). + intuition. + apply bin_op_strext_unfolded with (@csg_op M). + csetoid_rewrite_rev (power_plus M u b (l-b)). + csetoid_rewrite_rev (power_plus M u a (l-b)). + elim H3. + clear H3. + intros H3 H7. + elim H7. + clear H7. + intros H7 H8. + replace (b+(l-b)) with l. + csetoid_rewrite_rev H7. + apply ap_symmetric_unfolded. + apply H8. + split. + intuition. + right. + intuition. + intuition. + clear orex. + intro orex. + intuition. + intuition. + clear H5. + intro H5. + cut False. + intuition. + cut (power_CMonoid (M:=M) u b[=]power_CMonoid (M:=M) u a). + intro H4'. + set (H6:= (eq_imp_not_ap M (power_CMonoid u a)(power_CMonoid u b) H4)). + set (H6':= (eq_imp_not_ap M (power_CMonoid u b)(power_CMonoid u a) H4')). + unfold Not in H6. + cut (k<>b+(l-a) or k=b+(l-a)). + intro orex. + elim orex. + clear orex. + intro orex. + cut ((power_CMonoid u a[#]power_CMonoid u b) or (power_CMonoid u (l-a)[#]power_CMonoid u (l-a))). + intro H7. + elim H7. + tauto. + clear H7. + intro H7. + set (H8:= (ap_irreflexive_unfolded M (power_CMonoid u (l-a)) H7)). + intuition. + apply bin_op_strext_unfolded with (@csg_op M). + csetoid_rewrite_rev (power_plus M u b (l-a)). + csetoid_rewrite_rev (power_plus M u a (l-a)). + elim H3. + clear H3. + intros H3 H7. + elim H7. + clear H7. + intros H7 H8. + replace (a+(l-a)) with l. + csetoid_rewrite_rev H7. + apply H8. + split. + intuition. + right. + intuition. + intuition. + clear orex. + intro orex. + intuition. + intuition. + intuition. Qed. @@ -641,10 +623,11 @@ Variable M:CMonoid. Lemma generator_imp_cyclic: (forall (u:M), (is_generator M u)-> (cyclic M)):CProp. -intros u H. -unfold is_generator in H. -exists u. -exact H. +Proof. + intros u H. + unfold is_generator in H. + exists u. + exact H. Qed. End gen_cyc. @@ -671,27 +654,29 @@ Let [M1 M2:CMonoid] Variable M1 M2: CMonoid. -Lemma e1e2_is_rht_unit: +Lemma e1e2_is_rht_unit: (is_rht_unit (dprod_as_csb_fun M1 M2)(pairT (@cm_unit M1)(@cm_unit M2))). -unfold is_rht_unit. -intro x. -case x. -intros x1 x2. -simpl. -split. -apply cm_rht_unit_unfolded. -apply cm_rht_unit_unfolded. +Proof. + unfold is_rht_unit. + intro x. + case x. + intros x1 x2. + simpl. + split. + apply cm_rht_unit_unfolded. + apply cm_rht_unit_unfolded. Qed. -Lemma e1e2_is_lft_unit: +Lemma e1e2_is_lft_unit: (is_lft_unit (dprod_as_csb_fun M1 M2)(pairT (@cm_unit M1)(@cm_unit M2))). -intro x. -case x. -intros x1 x2. -simpl. -split. -apply cm_lft_unit_unfolded. -apply cm_lft_unit_unfolded. +Proof. + intro x. + case x. + intros x1 x2. + simpl. + split. + apply cm_lft_unit_unfolded. + apply cm_lft_unit_unfolded. Qed. Definition direct_product_is_CMonoid:= @@ -712,66 +697,67 @@ Variable M2:CMonoid. Let f: (direct_product_as_CMonoid M1 M2)-> (direct_product_as_CMonoid M2 M1). -simpl. -intro x. -elim x. -intros x1 x2. -exact (pairT x2 x1). +Proof. + simpl. + intro x. + elim x. + intros x1 x2. + exact (pairT x2 x1). Defined. Lemma f_strext': (fun_strext f ). -unfold fun_strext. -simpl. -intros x y. -case x. -intros x1 x2. -case y. -intros y1 y2. -simpl. -intuition. +Proof. + unfold fun_strext. + simpl. + intros x y. + case x. + intros x1 x2. + case y. + intros y1 y2. + simpl. + intuition. Qed. Definition f_as_CSetoid_fun_:= (Build_CSetoid_fun _ _ f f_strext'). Lemma isomorphic_PM1M2_PM2M1: - (isomorphic (direct_product_as_CMonoid M1 M2) + (isomorphic (direct_product_as_CMonoid M1 M2) (direct_product_as_CMonoid M2 M1)):CProp. -unfold isomorphic. -simpl. -exists f_as_CSetoid_fun_. -unfold isomorphism. -unfold morphism. -simpl. -split. -split. -intuition. -intros a b. -case a. -intros a0 a1. -case b. -intros b0 b1. -simpl. -intuition. - -unfold bijective. -split. -unfold injective. -simpl. -intros a0 a1. -elim a0. -intros b0 b1. -elim a1. -intros c0 c1. -simpl. -intuition. - -unfold surjective. -intro b. -elim b. -intros a0 a1. -exists (pairT a1 a0). -simpl. -intuition. +Proof. + unfold isomorphic. + simpl. + exists f_as_CSetoid_fun_. + unfold isomorphism. + unfold morphism. + simpl. + split. + split. + intuition. + intros a b. + case a. + intros a0 a1. + case b. + intros b0 b1. + simpl. + intuition. + unfold bijective. + split. + unfold injective. + simpl. + intros a0 a1. + elim a0. + intros b0 b1. + elim a1. + intros c0 c1. + simpl. + intuition. + unfold surjective. + intro b. + elim b. + intros a0 a1. + exists (pairT a1 a0). + simpl. + intuition. Qed. End p71E2b2. @@ -782,34 +768,37 @@ End p71E2b2. *) Definition FS_id (A : CSetoid) : FS_as_CSetoid A A. -intro A. -unfold FS_as_CSetoid in |- *. -simpl in |- *. -exact (id_un_op A). +Proof. + intro A. + unfold FS_as_CSetoid in |- *. + simpl in |- *. + exact (id_un_op A). Defined. Lemma id_is_rht_unit : forall A : CSetoid, is_rht_unit (comp_as_bin_op A) (FS_id A). -unfold is_rht_unit in |- *. -unfold comp_as_bin_op in |- *. -unfold FS_id in |- *. -simpl in |- *. -unfold eq_fun in |- *. -unfold id_un_op in |- *. -simpl in |- *. -intuition. +Proof. + unfold is_rht_unit in |- *. + unfold comp_as_bin_op in |- *. + unfold FS_id in |- *. + simpl in |- *. + unfold eq_fun in |- *. + unfold id_un_op in |- *. + simpl in |- *. + intuition. Qed. Lemma id_is_lft_unit : forall A : CSetoid, is_lft_unit (comp_as_bin_op A) (FS_id A). -unfold is_lft_unit in |- *. -unfold comp_as_bin_op in |- *. -unfold FS_id in |- *. -simpl in |- *. -unfold eq_fun in |- *. -unfold id_un_op in |- *. -simpl in |- *. -intuition. +Proof. + unfold is_lft_unit in |- *. + unfold comp_as_bin_op in |- *. + unfold FS_id in |- *. + simpl in |- *. + unfold eq_fun in |- *. + unfold id_un_op in |- *. + simpl in |- *. + intuition. Qed. Definition FS_is_CMonoid (A : CSetoid) := @@ -822,7 +811,7 @@ Definition FS_as_CMonoid (A : CSetoid) := Definition PS_as_CMonoid (A : CSetoid) := Build_SubCMonoid (FS_as_CMonoid A) (bijective (A:=A) (B:=A)) ( - id_is_bij A) (comp_resp_bij A A A). + id_is_bij A) (comp_resp_bij A A A). (** ** The free Monoid @@ -830,24 +819,23 @@ Definition PS_as_CMonoid (A : CSetoid) := Lemma is_unit_Astar_empty_word: forall (A:CSetoid), (is_unit (Astar_as_CSemiGroup A)(empty_word A)). -intro A. -unfold is_unit. -simpl. -intro a. -split. -apply eq_fm_reflexive. - -unfold empty_word. -induction a. -apply eq_fm_reflexive. - -simpl. -intuition. +Proof. + intro A. + unfold is_unit. + simpl. + intro a. + split. + apply eq_fm_reflexive. + unfold empty_word. + induction a. + apply eq_fm_reflexive. + simpl. + intuition. Qed. Section Th12. -(** +(** %\begin{convention}% Let [A:CSetoid]. %\end{convention}% @@ -856,32 +844,32 @@ Let [A:CSetoid]. Variable A:CSetoid. Lemma nil_is_rht_unit: (is_rht_unit (app_as_csb_fun A) (empty_word A)). -unfold is_rht_unit. -simpl. -intro x. -induction x. -simpl. -intuition. - -simpl. -intuition. +Proof. + unfold is_rht_unit. + simpl. + intro x. + induction x. + simpl. + intuition. + simpl. + intuition. Qed. Lemma nil_is_lft_unit: (is_lft_unit (app_as_csb_fun A) (empty_word A)). -unfold is_lft_unit. -simpl. -intro x. -induction x. -simpl. -intuition. - -simpl. -intuition. +Proof. + unfold is_lft_unit. + simpl. + intro x. + induction x. + simpl. + intuition. + simpl. + intuition. Qed. -Definition free_monoid_is_CMonoid: +Definition free_monoid_is_CMonoid: is_CMonoid (Astar_as_CSemiGroup A) (empty_word A):= - (Build_is_CMonoid (Astar_as_CSemiGroup A) (empty_word A) + (Build_is_CMonoid (Astar_as_CSemiGroup A) (empty_word A) nil_is_rht_unit nil_is_lft_unit). Definition free_monoid_as_CMonoid:CMonoid:= @@ -899,13 +887,14 @@ Let [X:CSetoid]. Section p67R2. Variable X: CSetoid. Lemma is_unit_FS_id:(is_unit (FS_as_CSemiGroup X) (FS_id X)). -unfold is_unit. -intros a. -set (H:= (id_is_rht_unit X a)). -set (H0:= (id_is_lft_unit X a)). -split. -exact H0. -exact H. +Proof. + unfold is_unit. + intros a. + set (H:= (id_is_rht_unit X a)). + set (H0:= (id_is_lft_unit X a)). + split. + exact H0. + exact H. Qed. End p67R2. @@ -931,13 +920,14 @@ Definition K : M -> CProp := (fun m => forall (i:I), (C i m)). Lemma op_pres_K: bin_op_pres_pred (cm_crr M) K (csg_op (c:=M)). -unfold K. -unfold bin_op_pres_pred. -unfold bin_op_pres_pred in op_pres_C. -intros x y Cx Cy i. -apply op_pres_C. -apply Cx. -apply Cy. +Proof. + unfold K. + unfold bin_op_pres_pred. + unfold bin_op_pres_pred in op_pres_C. + intros x y Cx Cy i. + apply op_pres_C. + apply Cx. + apply Cy. Qed. Definition K_is_Monoid :CMonoid := (Build_SubCMonoid M K Cunit op_pres_K). @@ -961,68 +951,68 @@ end. Variable D : M -> CProp. -Definition Dbrack : M -> CProp := - fun m => {l: (list M)| (forall (a:M) , member a l -> (D a)) and - (cm_Sum l)[=]m}. +Definition Dbrack : M -> CProp := + fun m => {l: (list M)| (forall (a:M) , member a l -> (D a)) and + (cm_Sum l)[=]m}. Lemma Dbrack_unit: (Dbrack Zero). -unfold Dbrack. -exists (@nil M). -simpl. -intuition. +Proof. + unfold Dbrack. + exists (@nil M). + simpl. + intuition. Qed. -Lemma cm_Sum_app: +Lemma cm_Sum_app: forall (k l : (list M)), (cm_Sum (app k l))[=] (cm_Sum k)[+](cm_Sum l). -intros k l. -induction k. -simpl. -apply eq_symmetric. -apply cm_lft_unit_unfolded. - -simpl. -astepr (a [+] ( (cm_Sum k)[+](cm_Sum l))). -apply csbf_wd_unfolded. -intuition. - -exact IHk. +Proof. + intros k l. + induction k. + simpl. + apply eq_symmetric. + apply cm_lft_unit_unfolded. + simpl. + astepr (a [+] ( (cm_Sum k)[+](cm_Sum l))). + apply csbf_wd_unfolded. + intuition. + exact IHk. Qed. Lemma op_pres_Dbrack : bin_op_pres_pred _ Dbrack csg_op. -unfold bin_op_pres_pred. -intros x y. -unfold Dbrack. -intros Hx Hy. -elim Hx. -clear Hx. -intros lx Hx. -elim Hy. -clear Hy. -intros ly Hy. -exists (app lx ly). -split. -intro a. -set (H:= (member_app M a ly lx)). -elim H. -intros H0 H1. -intros H2. -set (H3:= (H0 H2)). -elim H3. -(generalize Hx). -intuition. - -(generalize Hy). -intuition. -elim Hx. -clear Hx. -intros Hx1 Hx2. -astepr ((cm_Sum lx)[+] y). -elim Hy. -clear Hy. -intros Hy1 Hy2. -astepr ( (cm_Sum lx)[+](cm_Sum ly) ). -apply cm_Sum_app. +Proof. + unfold bin_op_pres_pred. + intros x y. + unfold Dbrack. + intros Hx Hy. + elim Hx. + clear Hx. + intros lx Hx. + elim Hy. + clear Hy. + intros ly Hy. + exists (app lx ly). + split. + intro a. + set (H:= (member_app M a ly lx)). + elim H. + intros H0 H1. + intros H2. + set (H3:= (H0 H2)). + elim H3. + (generalize Hx). + intuition. + (generalize Hy). + intuition. + elim Hx. + clear Hx. + intros Hx1 Hx2. + astepr ((cm_Sum lx)[+] y). + elim Hy. + clear Hy. + intros Hy1 Hy2. + astepr ( (cm_Sum lx)[+](cm_Sum ly) ). + apply cm_Sum_app. Qed. Definition Dbrack_as_CMonoid : CMonoid := diff --git a/algebra/COrdAbs.v b/algebra/COrdAbs.v index 2ea6923cf..3eabbdde8 100644 --- a/algebra/COrdAbs.v +++ b/algebra/COrdAbs.v @@ -57,16 +57,16 @@ Section AbsSmall_properties. Variable R : COrdField. Lemma AbsSmall_wdr : rel_wdr R (AbsSmall (R:=R)). -unfold rel_wdr in |- *. -unfold AbsSmall in |- *. -intros. -elim H; intros. -split. -astepr y. -assumption. - -astepl y. -assumption. +Proof. + unfold rel_wdr in |- *. + unfold AbsSmall in |- *. + intros. + elim H; intros. + split. + astepr y. + assumption. + astepl y. + assumption. Qed. Lemma AbsSmall_wdr_unfolded : forall x y z : R, @@ -74,16 +74,16 @@ Lemma AbsSmall_wdr_unfolded : forall x y z : R, Proof AbsSmall_wdr. Lemma AbsSmall_wdl : rel_wdl R (AbsSmall (R:=R)). -unfold rel_wdl in |- *. -unfold AbsSmall in |- *. -intros. -elim H; intros. -split. -astepl ([--]x). -assumption. - -astepr x. -assumption. +Proof. + unfold rel_wdl in |- *. + unfold AbsSmall in |- *. + intros. + elim H; intros. + split. + astepl ([--]x). + assumption. + astepr x. + assumption. Qed. Lemma AbsSmall_wdl_unfolded : forall x y z : R, @@ -99,242 +99,252 @@ Notation ZeroR := (Zero:R). Lemma AbsSmall_leEq_trans : forall e1 e2 d : R, e1 [<=] e2 -> AbsSmall e1 d -> AbsSmall e2 d. -unfold AbsSmall in |- *. -intros. -elim H0; intros. -split. -apply leEq_transitive with ([--]e1). -apply inv_resp_leEq. -assumption. - -assumption. - -apply leEq_transitive with e1. -assumption. - -assumption. +Proof. + unfold AbsSmall in |- *. + intros. + elim H0; intros. + split. + apply leEq_transitive with ([--]e1). + apply inv_resp_leEq. + assumption. + assumption. + apply leEq_transitive with e1. + assumption. + assumption. Qed. Lemma zero_AbsSmall : forall e : R, Zero [<=] e -> AbsSmall e Zero. -intros. -unfold AbsSmall in |- *. -split. -astepr ([--]ZeroR). -apply inv_resp_leEq. -assumption. -assumption. +Proof. + intros. + unfold AbsSmall in |- *. + split. + astepr ([--]ZeroR). + apply inv_resp_leEq. + assumption. + assumption. Qed. Lemma AbsSmall_reflexive : forall (e : R), Zero [<=] e -> AbsSmall e e. -intros. -unfold AbsSmall. -split. -apply leEq_transitive with (Zero:R); auto. -astepr ([--]Zero:R). -apply inv_resp_leEq. -auto. -apply leEq_reflexive. +Proof. + intros. + unfold AbsSmall. + split. + apply leEq_transitive with (Zero:R); auto. + astepr ([--]Zero:R). + apply inv_resp_leEq. + auto. + apply leEq_reflexive. Qed. Lemma AbsSmall_trans : forall e1 e2 d : R, e1 [<] e2 -> AbsSmall e1 d -> AbsSmall e2 d. -intros. -apply AbsSmall_leEq_trans with e1. -apply less_leEq. -assumption. -assumption. +Proof. + intros. + apply AbsSmall_leEq_trans with e1. + apply less_leEq. + assumption. + assumption. Qed. Lemma leEq_imp_AbsSmall : forall e d : R, Zero [<=] e -> e [<=] d -> AbsSmall d e. -intros. -unfold AbsSmall in |- *. -split; try assumption. -apply leEq_transitive with ZeroR; try assumption. -astepr ([--]ZeroR). -apply inv_resp_leEq. -apply leEq_transitive with e; assumption. +Proof. + intros. + unfold AbsSmall in |- *. + split; try assumption. + apply leEq_transitive with ZeroR; try assumption. + astepr ([--]ZeroR). + apply inv_resp_leEq. + apply leEq_transitive with e; assumption. Qed. Lemma inv_resp_AbsSmall : forall x y : R, AbsSmall x y -> AbsSmall x [--]y. -unfold AbsSmall in |- *. -intros. -elim H; intros. -split. -apply inv_resp_leEq. -assumption. -astepr ([--][--]x). -apply inv_resp_leEq. -assumption. +Proof. + unfold AbsSmall in |- *. + intros. + elim H; intros. + split. + apply inv_resp_leEq. + assumption. + astepr ([--][--]x). + apply inv_resp_leEq. + assumption. Qed. Lemma mult_resp_AbsSmall: forall (R: COrdField) (x y e : R) (H: Zero[<=]y), AbsSmall e x -> AbsSmall (y[*]e) (y[*]x). -unfold AbsSmall. -intros. -destruct H0. -split. -rstepl (y[*]([--]e)). -apply mult_resp_leEq_lft; auto. -apply mult_resp_leEq_lft; auto. +Proof. + unfold AbsSmall. + intros. + destruct H0. + split. + rstepl (y[*]([--]e)). + apply mult_resp_leEq_lft; auto. + apply mult_resp_leEq_lft; auto. Qed. Lemma div_resp_AbsSmall: forall (R: COrdField) (x y e : R) (H: Zero[<]y), AbsSmall e x -> AbsSmall (e[/]y[//]pos_ap_zero _ _ H) (x[/]y[//]pos_ap_zero _ _ H). -unfold AbsSmall. -intros. -destruct H0. -split. -rstepl (([--]e)[/]y[//]pos_ap_zero _ _ H). -apply div_resp_leEq; auto. -apply div_resp_leEq; auto. +Proof. + unfold AbsSmall. + intros. + destruct H0. + split. + rstepl (([--]e)[/]y[//]pos_ap_zero _ _ H). + apply div_resp_leEq; auto. + apply div_resp_leEq; auto. Qed. Lemma sum_resp_AbsSmall : forall (x y : nat -> R) (n m: nat) (H1 : m <= n) (H2 : forall i : nat, m <= i -> i <= n -> AbsSmall (y i) (x i)), AbsSmall (Sum m n y) (Sum m n x). -unfold AbsSmall. -intros. -assert (H3 : forall i : nat, m <= i -> i <= n -> [--](y i)[<=]x i). -intros. -elim (H2 i H H0). auto. -assert (H4 : forall i : nat, m <= i -> i <= n -> x i[<=]y i). -intros. -elim (H2 i H H0). auto. -split. -astepl (Sum m n (fun k: nat => [--](y k))). -apply Sum_resp_leEq . -auto with arith. intros. auto. -apply Sum_resp_leEq . -auto with arith. intros. auto. +Proof. + unfold AbsSmall. + intros. + assert (H3 : forall i : nat, m <= i -> i <= n -> [--](y i)[<=]x i). + intros. + elim (H2 i H H0). auto. + assert (H4 : forall i : nat, m <= i -> i <= n -> x i[<=]y i). + intros. + elim (H2 i H H0). auto. + split. + astepl (Sum m n (fun k: nat => [--](y k))). + apply Sum_resp_leEq . + auto with arith. intros. auto. + apply Sum_resp_leEq . + auto with arith. intros. auto. Qed. Lemma AbsSmall_minus : forall e x1 x2 : R, AbsSmall e (x1[-]x2) -> AbsSmall e (x2[-]x1). -intros. -rstepr ([--](x1[-]x2)). -apply inv_resp_AbsSmall. -assumption. +Proof. + intros. + rstepr ([--](x1[-]x2)). + apply inv_resp_AbsSmall. + assumption. Qed. Lemma AbsSmall_plus : forall e1 e2 x1 x2 : R, AbsSmall e1 x1 -> AbsSmall e2 x2 -> AbsSmall (e1[+]e2) (x1[+]x2). -unfold AbsSmall in |- *. -intros. -elim H; intros. -elim H0; intros. -split. -rstepl ([--]e1[+][--]e2). -apply plus_resp_leEq_both; assumption. -apply plus_resp_leEq_both; assumption. +Proof. + unfold AbsSmall in |- *. + intros. + elim H; intros. + elim H0; intros. + split. + rstepl ([--]e1[+][--]e2). + apply plus_resp_leEq_both; assumption. + apply plus_resp_leEq_both; assumption. Qed. Lemma AbsSmall_eps_div_two : forall e x1 x2 : R, AbsSmall (e [/]TwoNZ) x1 -> AbsSmall (e [/]TwoNZ) x2 -> AbsSmall e (x1[+]x2). -intros. -rstepl (e [/]TwoNZ[+]e [/]TwoNZ). -apply AbsSmall_plus. -assumption. -assumption. +Proof. + intros. + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_plus. + assumption. + assumption. Qed. Lemma AbsSmall_x_plus_delta : forall x eps delta : R, Zero [<=] eps -> Zero [<=] delta -> delta [<=] eps -> AbsSmall eps (x[-] (x[+]delta)). -intros. -(* astepr ((x[-]x)[-]delta). -astepr (Zero[-]delta). *) -rstepr ([--]delta). -apply inv_resp_AbsSmall. -apply leEq_imp_AbsSmall. -assumption. -assumption. +Proof. + intros. + (* astepr ((x[-]x)[-]delta). + astepr (Zero[-]delta). *) + rstepr ([--]delta). + apply inv_resp_AbsSmall. + apply leEq_imp_AbsSmall. + assumption. + assumption. Qed. Lemma AbsSmall_x_minus_delta : forall x eps delta : R, Zero [<=] eps -> Zero [<=] delta -> delta [<=] eps -> AbsSmall eps (x[-] (x[-]delta)). -intros. -(* astepr ((x[-]x)[+]delta). - astepr (Zero[+]delta). *) -rstepr delta. -apply leEq_imp_AbsSmall. -assumption. -assumption. +Proof. + intros. + (* astepr ((x[-]x)[+]delta). + astepr (Zero[+]delta). *) + rstepr delta. + apply leEq_imp_AbsSmall. + assumption. + assumption. Qed. Lemma AbsSmall_x_plus_eps_div2 : forall x eps : R, Zero [<=] eps -> AbsSmall eps (x[-] (x[+]eps [/]TwoNZ)). -intros. -apply AbsSmall_x_plus_delta. -assumption. - -apply nonneg_div_two. -assumption. - -apply nonneg_div_two'. -assumption. +Proof. + intros. + apply AbsSmall_x_plus_delta. + assumption. + apply nonneg_div_two. + assumption. + apply nonneg_div_two'. + assumption. Qed. Lemma AbsSmall_x_minus_eps_div2 : forall x eps : R, Zero [<=] eps -> AbsSmall eps (x[-] (x[-]eps [/]TwoNZ)). -intros. -apply AbsSmall_x_minus_delta. -assumption. - -apply nonneg_div_two. -assumption. - -apply eps_div_leEq_eps. -assumption. - -apply less_leEq. -apply one_less_two. +Proof. + intros. + apply AbsSmall_x_minus_delta. + assumption. + apply nonneg_div_two. + assumption. + apply eps_div_leEq_eps. + assumption. + apply less_leEq. + apply one_less_two. Qed. Lemma AbsSmall_intermediate : forall x y z eps : R, x [<=] y -> y [<=] z -> AbsSmall eps (z[-]x) -> AbsSmall eps (z[-]y). -intros. -apply leEq_imp_AbsSmall. -apply shift_leEq_minus; astepl y. -assumption. -unfold AbsSmall in H1. -elim H1; intros. -apply leEq_transitive with (z[-]x); try assumption. -apply minus_resp_leEq_rht. -assumption. +Proof. + intros. + apply leEq_imp_AbsSmall. + apply shift_leEq_minus; astepl y. + assumption. + unfold AbsSmall in H1. + elim H1; intros. + apply leEq_transitive with (z[-]x); try assumption. + apply minus_resp_leEq_rht. + assumption. Qed. Lemma AbsSmall_eps_div2 : forall eps : R, Zero [<=] eps -> AbsSmall eps (eps [/]TwoNZ). -intros. -apply leEq_imp_AbsSmall. -apply nonneg_div_two. -assumption. - -apply eps_div_leEq_eps. -assumption. - -apply less_leEq. -apply one_less_two. +Proof. + intros. + apply leEq_imp_AbsSmall. + apply nonneg_div_two. + assumption. + apply eps_div_leEq_eps. + assumption. + apply less_leEq. + apply one_less_two. Qed. Lemma AbsSmall_nonneg : forall e x : R, AbsSmall e x -> Zero [<=] e. +Proof. unfold AbsSmall in |- *. intros. elim H. intros. cut ([--]e [<=] e). - intros. - apply mult_cancel_leEq with (z := Two:R). - apply pos_two. - apply plus_cancel_leEq_rht with (z := [--]e). - rstepl ([--]e). - rstepr e. - assumption. + intros. + apply mult_cancel_leEq with (z := Two:R). + apply pos_two. + apply plus_cancel_leEq_rht with (z := [--]e). + rstepl ([--]e). + rstepr e. + assumption. apply leEq_transitive with (y := x). - assumption. + assumption. assumption. Qed. Lemma AbsSmall_mult : forall e1 e2 x1 x2 : R, AbsSmall e1 x1 -> AbsSmall e2 x2 -> AbsSmall (Three[*] (e1[*]e2)) (x1[*]x2). +Proof. unfold AbsSmall in |- *. intros. elim H. @@ -342,90 +352,83 @@ Lemma AbsSmall_mult : forall e1 e2 x1 x2 : R, elim H0. intros. cut (Zero [<=] e1). - intro. - cut (Zero [<=] e2). - intro. - split. - - apply plus_cancel_leEq_rht with (z := Three[*] (e1[*]e2)). - rstepl ZeroR. - rstepr (x1[*]x2[+]e1[*]e2[+]e1[*]e2[+]e1[*]e2). - apply leEq_transitive with (y := x1[*]x2[+]e1[*]e2[+]x1[*]e2[+]e1[*]x2). - rstepr ((e1[+]x1)[*](e2[+]x2)). - apply mult_resp_nonneg. - apply plus_cancel_leEq_rht with (z := [--]x1). - rstepl ([--]x1). - rstepr ([--][--]e1). - apply inv_resp_leEq. - assumption. - - apply plus_cancel_leEq_rht with (z := [--]x2). - rstepl ([--]x2). - rstepr ([--][--]e2). - apply inv_resp_leEq. - assumption. - - rstepl (x1[*]x2[+]e1[*]e2[+](x1[*]e2[+]e1[*]x2)). - rstepr (x1[*]x2[+]e1[*]e2[+](e1[*]e2[+]e1[*]e2)). - apply plus_resp_leEq_lft. - apply plus_resp_leEq_both. - apply mult_resp_leEq_rht. - assumption. - assumption. - apply mult_resp_leEq_lft. - assumption. - assumption. - - apply plus_cancel_leEq_rht with (z := [--](x1[*]x2)). - rstepl ZeroR. - rstepr ([--](x1[*]x2)[+]e1[*]e2[+](e1[*]e2[+]e1[*]e2)). - apply - leEq_transitive with (y := [--](x1[*]x2)[+]e1[*]e2[+](x1[*]e2[-]e1[*]x2)). - rstepr ((e1[+]x1)[*](e2[-]x2)). - apply mult_resp_nonneg. - apply plus_cancel_leEq_rht with (z := [--]x1). - rstepl ([--]x1). - rstepr ([--][--]e1). - apply inv_resp_leEq. - assumption. - - apply plus_cancel_leEq_rht with (z := x2). - rstepl x2. - rstepr e2. - assumption. - - apply plus_resp_leEq_lft. - rstepl (x1[*]e2[+][--]e1[*]x2). - apply plus_resp_leEq_both. - apply mult_resp_leEq_rht. - assumption. - assumption. - rstepl (e1[*][--]x2). - apply mult_resp_leEq_lft. - rstepr ([--][--]e2). - apply inv_resp_leEq. - assumption. - assumption. - - apply AbsSmall_nonneg with (e := e2) (x := x2). - assumption. + intro. + cut (Zero [<=] e2). + intro. + split. + apply plus_cancel_leEq_rht with (z := Three[*] (e1[*]e2)). + rstepl ZeroR. + rstepr (x1[*]x2[+]e1[*]e2[+]e1[*]e2[+]e1[*]e2). + apply leEq_transitive with (y := x1[*]x2[+]e1[*]e2[+]x1[*]e2[+]e1[*]x2). + rstepr ((e1[+]x1)[*](e2[+]x2)). + apply mult_resp_nonneg. + apply plus_cancel_leEq_rht with (z := [--]x1). + rstepl ([--]x1). + rstepr ([--][--]e1). + apply inv_resp_leEq. + assumption. + apply plus_cancel_leEq_rht with (z := [--]x2). + rstepl ([--]x2). + rstepr ([--][--]e2). + apply inv_resp_leEq. + assumption. + rstepl (x1[*]x2[+]e1[*]e2[+](x1[*]e2[+]e1[*]x2)). + rstepr (x1[*]x2[+]e1[*]e2[+](e1[*]e2[+]e1[*]e2)). + apply plus_resp_leEq_lft. + apply plus_resp_leEq_both. + apply mult_resp_leEq_rht. + assumption. + assumption. + apply mult_resp_leEq_lft. + assumption. + assumption. + apply plus_cancel_leEq_rht with (z := [--](x1[*]x2)). + rstepl ZeroR. + rstepr ([--](x1[*]x2)[+]e1[*]e2[+](e1[*]e2[+]e1[*]e2)). + apply leEq_transitive with (y := [--](x1[*]x2)[+]e1[*]e2[+](x1[*]e2[-]e1[*]x2)). + rstepr ((e1[+]x1)[*](e2[-]x2)). + apply mult_resp_nonneg. + apply plus_cancel_leEq_rht with (z := [--]x1). + rstepl ([--]x1). + rstepr ([--][--]e1). + apply inv_resp_leEq. + assumption. + apply plus_cancel_leEq_rht with (z := x2). + rstepl x2. + rstepr e2. + assumption. + apply plus_resp_leEq_lft. + rstepl (x1[*]e2[+][--]e1[*]x2). + apply plus_resp_leEq_both. + apply mult_resp_leEq_rht. + assumption. + assumption. + rstepl (e1[*][--]x2). + apply mult_resp_leEq_lft. + rstepr ([--][--]e2). + apply inv_resp_leEq. + assumption. + assumption. + apply AbsSmall_nonneg with (e := e2) (x := x2). + assumption. apply AbsSmall_nonneg with (e := e1) (x := x1). assumption. Qed. Lemma AbsSmall_cancel_mult : forall e x z : R, Zero [<] z -> AbsSmall (e[*]z) (x[*]z) -> AbsSmall e x. +Proof. unfold AbsSmall in |- *. intros. elim H. intros. split. + apply mult_cancel_leEq with (z := z). + assumption. + rstepl ([--](e[*]z)). + assumption. apply mult_cancel_leEq with (z := z). - assumption. - rstepl ([--](e[*]z)). - assumption. - apply mult_cancel_leEq with (z := z). - assumption. + assumption. assumption. Qed. @@ -435,15 +438,14 @@ Proof. apply not_ap_imp_eq. intro H0. elim (ap_imp_less _ _ _ H0). - change (Not (x [<] Zero)). - rewrite <- leEq_def. - apply inv_cancel_leEq. - astepr ZeroR. - apply approach_zero_weak. - intros. - apply inv_cancel_leEq; astepr x. - elim (H e); auto. - + change (Not (x [<] Zero)). + rewrite <- leEq_def. + apply inv_cancel_leEq. + astepr ZeroR. + apply approach_zero_weak. + intros. + apply inv_cancel_leEq; astepr x. + elim (H e); auto. change (Not (Zero [<] x)). rewrite <- leEq_def. apply approach_zero_weak. @@ -453,95 +455,98 @@ Qed. Lemma mult_AbsSmall'_rht : forall x y C : R, Zero [<=] C -> [--]C [<=] x -> x [<=] C -> [--]C [<=] y -> y [<=] C -> x[*]y [<=] Three[*]C[^]2. -intros. -astepl (Zero[+]x[*]y). apply shift_plus_leEq. -apply leEq_transitive with ((C[+]x)[*](C[-]y)). -apply mult_resp_nonneg. -apply shift_leEq_plus. astepl ([--]x). astepr ([--][--]C). -apply inv_resp_leEq. auto. -apply shift_leEq_minus. astepl y. auto. -rstepl (C[^]2[-]x[*]y[+]C[*](x[-]y)). -rstepr (C[^]2[-]x[*]y[+]C[*](C[-][--]C)). -apply plus_resp_leEq_lft. -apply mult_resp_leEq_lft. -apply minus_resp_leEq_both. -auto. auto. auto. +Proof. + intros. + astepl (Zero[+]x[*]y). apply shift_plus_leEq. + apply leEq_transitive with ((C[+]x)[*](C[-]y)). + apply mult_resp_nonneg. + apply shift_leEq_plus. astepl ([--]x). astepr ([--][--]C). + apply inv_resp_leEq. auto. + apply shift_leEq_minus. astepl y. auto. + rstepl (C[^]2[-]x[*]y[+]C[*](x[-]y)). + rstepr (C[^]2[-]x[*]y[+]C[*](C[-][--]C)). + apply plus_resp_leEq_lft. + apply mult_resp_leEq_lft. + apply minus_resp_leEq_both. + auto. auto. auto. Qed. Lemma mult_AbsSmall_rht : forall x y X Y : R, Zero [<=] X -> Zero [<=] Y -> [--]X [<=] x -> x [<=] X -> [--]Y [<=] y -> y [<=] Y -> x[*]y [<=] X[*]Y. -intros. -rewrite leEq_def. -intro. -cut (Zero [<] x[*]y); intros. -2: apply leEq_less_trans with (X[*]Y); auto. -rewrite -> leEq_def in *. -cut (x[*]y [#] Zero); intros. -2: apply pos_ap_zero; auto. -cut (x [#] Zero); intros. -2: apply mult_cancel_ap_zero_lft with y; auto. -elim (ap_imp_less _ _ _ X3); intro. -cut (y [<] Zero); intros. -2: astepl ([--][--]y); astepr ([--](Zero:R)); apply inv_resp_less. -2: apply mult_cancel_pos_rht with ([--]x). -2: astepr (x[*]y); auto. -2: astepl ([--](Zero:R)); apply less_leEq; apply inv_resp_less; auto. -apply (less_irreflexive_unfolded R One). -apply leEq_less_trans with (X[*]Y[/] _[//]X2). -rstepr - ((X[/] [--]x[//]inv_resp_ap_zero _ _ X3)[*] - (Y[/] [--]y[//]inv_resp_ap_zero _ _ (less_imp_ap _ _ _ X4))). -astepl (One[*](One:R)). -apply mult_resp_leEq_both. -apply less_leEq; apply pos_one. -apply less_leEq; apply pos_one. -apply shift_leEq_div. -astepl ([--](Zero:R)); apply inv_resp_less; auto. -astepl ([--]x); astepr ([--][--]X); apply inv_resp_leEq; firstorder using leEq_def. -apply shift_leEq_div. -astepl ([--](Zero:R)); apply inv_resp_less; auto. -astepl ([--]y); astepr ([--][--]Y); apply inv_resp_leEq; firstorder using leEq_def. -apply shift_div_less; auto. -astepr (x[*]y); auto. -cut (Zero [<] y); intros. -2: apply mult_cancel_pos_rht with x; try apply less_leEq; auto. -apply (less_irreflexive_unfolded R One). -apply leEq_less_trans with (X[*]Y[/] _[//]X2). -rstepr ((X[/] x[//]X3)[*](Y[/] y[//]pos_ap_zero _ _ X4)). -astepl (One[*](One:R)). -apply mult_resp_leEq_both. -apply less_leEq; apply pos_one. -apply less_leEq; apply pos_one. -apply shift_leEq_div; auto. -astepl x; firstorder using leEq_def. -apply shift_leEq_div; auto. -astepl y; firstorder using leEq_def. -apply shift_div_less; auto. -astepr (x[*]y); firstorder using leEq_def. +Proof. + intros. + rewrite leEq_def. + intro. + cut (Zero [<] x[*]y); intros. + 2: apply leEq_less_trans with (X[*]Y); auto. + rewrite -> leEq_def in *. + cut (x[*]y [#] Zero); intros. + 2: apply pos_ap_zero; auto. + cut (x [#] Zero); intros. + 2: apply mult_cancel_ap_zero_lft with y; auto. + elim (ap_imp_less _ _ _ X3); intro. + cut (y [<] Zero); intros. + 2: astepl ([--][--]y); astepr ([--](Zero:R)); apply inv_resp_less. + 2: apply mult_cancel_pos_rht with ([--]x). + 2: astepr (x[*]y); auto. + 2: astepl ([--](Zero:R)); apply less_leEq; apply inv_resp_less; auto. + apply (less_irreflexive_unfolded R One). + apply leEq_less_trans with (X[*]Y[/] _[//]X2). + rstepr ((X[/] [--]x[//]inv_resp_ap_zero _ _ X3)[*] + (Y[/] [--]y[//]inv_resp_ap_zero _ _ (less_imp_ap _ _ _ X4))). + astepl (One[*](One:R)). + apply mult_resp_leEq_both. + apply less_leEq; apply pos_one. + apply less_leEq; apply pos_one. + apply shift_leEq_div. + astepl ([--](Zero:R)); apply inv_resp_less; auto. + astepl ([--]x); astepr ([--][--]X); apply inv_resp_leEq; firstorder using leEq_def. + apply shift_leEq_div. + astepl ([--](Zero:R)); apply inv_resp_less; auto. + astepl ([--]y); astepr ([--][--]Y); apply inv_resp_leEq; firstorder using leEq_def. + apply shift_div_less; auto. + astepr (x[*]y); auto. + cut (Zero [<] y); intros. + 2: apply mult_cancel_pos_rht with x; try apply less_leEq; auto. + apply (less_irreflexive_unfolded R One). + apply leEq_less_trans with (X[*]Y[/] _[//]X2). + rstepr ((X[/] x[//]X3)[*](Y[/] y[//]pos_ap_zero _ _ X4)). + astepl (One[*](One:R)). + apply mult_resp_leEq_both. + apply less_leEq; apply pos_one. + apply less_leEq; apply pos_one. + apply shift_leEq_div; auto. + astepl x; firstorder using leEq_def. + apply shift_leEq_div; auto. + astepl y; firstorder using leEq_def. + apply shift_div_less; auto. + astepr (x[*]y); firstorder using leEq_def. Qed. Lemma mult_AbsSmall_lft : forall x y X Y : R, Zero [<=] X -> Zero [<=] Y -> [--]X [<=] x -> x [<=] X -> [--]Y [<=] y -> y [<=] Y -> [--](X[*]Y) [<=] x[*]y. -intros. -rstepr ([--]([--]x[*]y)). -apply inv_resp_leEq. -apply mult_AbsSmall_rht; auto. -apply inv_resp_leEq. auto. -rstepr ([--][--]X). -apply inv_resp_leEq. auto. +Proof. + intros. + rstepr ([--]([--]x[*]y)). + apply inv_resp_leEq. + apply mult_AbsSmall_rht; auto. + apply inv_resp_leEq. auto. + rstepr ([--][--]X). + apply inv_resp_leEq. auto. Qed. Lemma mult_AbsSmall : forall x y X Y : R, AbsSmall X x -> AbsSmall Y y -> AbsSmall (X[*]Y) (x[*]y). -unfold AbsSmall in |- *. -intros. -elim H. intros. elim H0. intros. -cut (Zero [<=] X). intro. cut (Zero [<=] Y). intro. -split. -apply mult_AbsSmall_lft; auto. -apply mult_AbsSmall_rht; auto. -apply AbsSmall_nonneg with y; auto. -apply AbsSmall_nonneg with x; auto. +Proof. + unfold AbsSmall in |- *. + intros. + elim H. intros. elim H0. intros. + cut (Zero [<=] X). intro. cut (Zero [<=] Y). intro. + split. + apply mult_AbsSmall_lft; auto. + apply mult_AbsSmall_rht; auto. + apply AbsSmall_nonneg with y; auto. + apply AbsSmall_nonneg with x; auto. Qed. End AbsSmall_properties. @@ -563,31 +568,27 @@ Proof. intros. unfold absBig in |- *. split. - - apply plus_cancel_less with (z := e2). - rstepl e2. - rstepr e1. - assumption. - + apply plus_cancel_less with (z := e2). + rstepl e2. + rstepr e1. + assumption. unfold absBig in X0. elim X0. intros H2 H3. case H3. - - intro H4. - left. - unfold AbsSmall in H. - elim H. - intros. - rstepl (e1[+][--]e2). - rstepr (x1[+][--]x2). - apply plus_resp_leEq_both. - assumption. - apply inv_cancel_leEq. - rstepl x2. - rstepr e2. - assumption. - + intro H4. + left. + unfold AbsSmall in H. + elim H. + intros. + rstepl (e1[+][--]e2). + rstepr (x1[+][--]x2). + apply plus_resp_leEq_both. + assumption. + apply inv_cancel_leEq. + rstepl x2. + rstepr e2. + assumption. intro H4. right. unfold AbsSmall in H. @@ -596,7 +597,7 @@ Proof. rstepr ([--]e1[+]e2). rstepl (x1[+][--]x2). apply plus_resp_leEq_both. - assumption. + assumption. apply inv_cancel_leEq. rstepr x2. rstepl ([--]e2). @@ -621,46 +622,39 @@ Proof. elim X. intros H1 H2. split. - assumption. - - case H2. - - intro H3. - left. - apply leEq_wdr with y. - assumption. - assumption. - - intro H3. - right. - apply leEq_wdl with y. - assumption. + case H2. + intro H3. + left. + apply leEq_wdr with y. assumption. + assumption. + intro H3. + right. + apply leEq_wdl with y. + assumption. + assumption. Qed. Lemma AbsBig_wdl : Crel_wdl R AbsBig. +Proof. red in |- *. unfold absBig in |- *. intros. elim X. intros H1 H2. split. - astepr x. assumption. - - case H2. - - intro H3. - left. - astepl x. - assumption. - - intro H3. - right. - astepr ([--]x). - assumption. + case H2. + intro H3. + left. + astepl x. + assumption. + intro H3. + right. + astepr ([--]x). + assumption. Qed. Lemma AbsBig_wdr_unfolded : forall x y z : R, AbsBig x y -> y [=] z -> AbsBig x z. @@ -675,15 +669,13 @@ Declare Left Step AbsBig_wdl_unfolded. Declare Right Step AbsBig_wdr_unfolded. Add Parametric Morphism c : (@AbsSmall c) with signature (@cs_eq (cof_crr c)) ==> (@cs_eq c) ==> iff as AbsSmall_morph_wd. -intros x1 x2 xeq y1 y2 yeq. -split; -intro H. -stepr y1 by assumption. -stepl x1 by assumption. -assumption. -stepr y2 by symmetry; -assumption. -stepl x2 by symmetry; -assumption. -assumption. +Proof. + intros x1 x2 xeq y1 y2 yeq. + split; intro H. + stepr y1 by assumption. + stepl x1 by assumption. + assumption. + stepr y2 by symmetry; assumption. + stepl x2 by symmetry; assumption. + assumption. Qed. diff --git a/algebra/COrdCauchy.v b/algebra/COrdCauchy.v index 3f7f668c7..cce247217 100644 --- a/algebra/COrdCauchy.v +++ b/algebra/COrdCauchy.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export COrdAbs. (* Begin_SpecReals *) @@ -67,7 +67,7 @@ Implicit arguments turned off, because Coq makes a mess of it in combination with the coercions *) -Record CauchySeq : Type := +Record CauchySeq : Type := {CS_seq :> nat -> R; CS_proof : Cauchy_prop CS_seq}. @@ -88,39 +88,36 @@ hold). Theorem CS_seq_bounded : forall g : nat -> R, Cauchy_prop g -> {K : R | Zero [<] K | {N : nat | forall m, N <= m -> AbsSmall K (g m)}}. +Proof. intros g Hg. unfold Cauchy_prop in |- *. elim (Hg _ (pos_one _)). intros N H1. exists (g N[^]2[-]g N[+]Two). - - apply less_leEq_trans with (nring (R:=R) 7 [/]FourNZ). - apply pos_div_four; apply nring_pos; auto with arith. - astepl (Zero[+]nring (R:=R) 7 [/]FourNZ). - apply shift_plus_leEq. - rstepr ((g N[-]One [/]TwoNZ)[^]2). - apply sqr_nonneg. - + apply less_leEq_trans with (nring (R:=R) 7 [/]FourNZ). + apply pos_div_four; apply nring_pos; auto with arith. + astepl (Zero[+]nring (R:=R) 7 [/]FourNZ). + apply shift_plus_leEq. + rstepr ((g N[-]One [/]TwoNZ)[^]2). + apply sqr_nonneg. exists N. intros m Hm. elim (H1 m Hm); intros. split. - - apply plus_cancel_leEq_rht with (z := [--](g N)). - rstepr (g m[-]g N). - rstepl ([--](g N[^]2[+]Two)). - apply leEq_transitive with ([--](One:R)). - apply inv_cancel_leEq. - rstepl (One:R). - rstepr (g N[^]2[+]Two). - apply plus_cancel_leEq_rht with ([--]One:R). - rstepl (Zero:R). - rstepr (g N[^]2[+]One). - apply leEq_transitive with (y := g N[^]2). - apply sqr_nonneg. - apply less_leEq; apply less_plusOne. - assumption. - + apply plus_cancel_leEq_rht with (z := [--](g N)). + rstepr (g m[-]g N). + rstepl ([--](g N[^]2[+]Two)). + apply leEq_transitive with ([--](One:R)). + apply inv_cancel_leEq. + rstepl (One:R). + rstepr (g N[^]2[+]Two). + apply plus_cancel_leEq_rht with ([--]One:R). + rstepl (Zero:R). + rstepr (g N[^]2[+]One). + apply leEq_transitive with (y := g N[^]2). + apply sqr_nonneg. + apply less_leEq; apply less_plusOne. + assumption. apply plus_cancel_leEq_rht with (g N[-]Two). rstepr (g N[^]2). astepr (g N[*]g N). @@ -128,19 +125,20 @@ Theorem CS_seq_bounded : forall g : nat -> R, Cauchy_prop g -> rstepl (g m[-]g N). rstepr (g N[*]g N[+]One[-]Two[*]g N[+]One). apply leEq_transitive with (y := One:R). - assumption. + assumption. rstepl (Zero[+](One:R)). apply plus_resp_leEq with (z := One:R). rstepr ((g N[-]One)[*](g N[-]One)). apply leEq_wdr with (y := (g N[-]One)[^]2). - apply sqr_nonneg. + apply sqr_nonneg. algebra. Qed. Lemma CS_seq_const : forall c : R, Cauchy_prop (fun n => c). -exists 0. -intros; astepr (Zero:R); apply zero_AbsSmall. -apply less_leEq; auto. +Proof. + exists 0. + intros; astepr (Zero:R); apply zero_AbsSmall. + apply less_leEq; auto. Qed. (** @@ -154,14 +152,13 @@ Hypothesis Hf : Cauchy_prop f. Hypothesis Hg : Cauchy_prop g. Lemma CS_seq_plus : Cauchy_prop (fun m => f m[+]g m). +Proof. unfold Cauchy_prop in |- *. intros. set (e_div_4 := e [/]FourNZ) in *. - cut (Zero [<] e_div_4); - [ intro Heps | unfold e_div_4 in |- *; apply pos_div_four; auto ]. + cut (Zero [<] e_div_4); [ intro Heps | unfold e_div_4 in |- *; apply pos_div_four; auto ]. unfold Cauchy_prop in Hf. unfold Cauchy_prop in Hg. - elim (Hf e_div_4 Heps); intros N1 H21. elim (Hg e_div_4 Heps); intros N2 H31. exists (max N1 N2). @@ -169,71 +166,58 @@ Lemma CS_seq_plus : Cauchy_prop (fun m => f m[+]g m). rstepl (e [/]TwoNZ[+]e [/]TwoNZ). rstepr (f m[-]f (max N1 N2)[+](g m[-]g (max N1 N2))). apply AbsSmall_plus. - rstepr (f m[-]f N1[+](f N1[-]f (max N1 N2))). rstepl (e [/]FourNZ[+]e [/]FourNZ). apply AbsSmall_plus. - apply H21; eauto with arith. + apply H21; eauto with arith. apply AbsSmall_minus. apply H21; eauto with arith. - - rstepr (g m[-]g N2[+](g N2[-]g (max N1 N2))). - rstepl (e [/]FourNZ[+]e [/]FourNZ). - apply AbsSmall_plus. - apply H31; eauto with arith. - apply AbsSmall_minus. + rstepr (g m[-]g N2[+](g N2[-]g (max N1 N2))). + rstepl (e [/]FourNZ[+]e [/]FourNZ). + apply AbsSmall_plus. apply H31; eauto with arith. + apply AbsSmall_minus. + apply H31; eauto with arith. Qed. Lemma CS_seq_inv : Cauchy_prop (fun n => [--] (f n)). -red in |- *; intros e H. -elim (Hf e H); intros N Hn. -exists N; intros m Hm. -apply AbsSmall_minus. -rstepr (f m[-]f N). -auto. +Proof. + red in |- *; intros e H. + elim (Hf e H); intros N Hn. + exists N; intros m Hm. + apply AbsSmall_minus. + rstepr (f m[-]f N). + auto. Qed. Lemma CS_seq_mult : Cauchy_prop (fun n => f n[*]g n). -red in |- *; intros e He. -elim (CS_seq_bounded f Hf); intros Mf HMf H. -elim (CS_seq_bounded g Hg); intros Mg HMg H'. -elim H; clear H; intros Nf HNf. -elim H'; clear H'; intros Ng HNg. -set (Mf_ap_zero := pos_ap_zero _ _ HMf) in *. -set (Mg_ap_zero := pos_ap_zero _ _ HMg) in *. -set (ef := e[/] _[//]mult_resp_ap_zero _ _ _ (twelve_ap_zero _) Mf_ap_zero) - in *. -set (eg := e[/] _[//]mult_resp_ap_zero _ _ _ (twelve_ap_zero _) Mg_ap_zero) - in *. -cut (Zero [<] ef); - [ intro Hef - | unfold ef in |- *; apply div_resp_pos; try apply mult_resp_pos; auto; - apply pos_twelve ]. -cut (Zero [<] eg); - [ intro Heg - | unfold eg in |- *; apply div_resp_pos; try apply mult_resp_pos; auto; - apply pos_twelve ]. -elim (Hf eg Heg); intros Pf HPf. -elim (Hg ef Hef); intros Pg HPg. -set (N := max (max Nf Pf) (max Ng Pg)) in *; exists N; intros m Hm. -rstepr - ((f m[-]f Pf[+][--](f N[-]f Pf))[*]g m[+] - (g m[-]g Pg[+][--](g N[-]g Pg))[*]f N). -apply - AbsSmall_wdl_unfolded - with (Three[*]((eg[+]eg)[*]Mg)[+]Three[*]((ef[+]ef)[*]Mf)). -2: unfold eg, ef in |- *; rational. -apply AbsSmall_plus; apply AbsSmall_mult; try apply AbsSmall_plus; - try apply inv_resp_AbsSmall. -apply HPf; apply le_trans with N; auto; unfold N in |- *; eauto with arith. -apply HPf; apply le_trans with N; auto; unfold N in |- *; eauto with arith. -apply HNg; auto; apply le_trans with N; auto; unfold N in |- *; - eauto with arith. -apply HPg; apply le_trans with N; auto; unfold N in |- *; eauto with arith. -apply HPg; apply le_trans with N; auto; unfold N in |- *; eauto with arith. -apply HNf; auto; apply le_trans with N; auto; unfold N in |- *; - eauto with arith. +Proof. + red in |- *; intros e He. + elim (CS_seq_bounded f Hf); intros Mf HMf H. + elim (CS_seq_bounded g Hg); intros Mg HMg H'. + elim H; clear H; intros Nf HNf. + elim H'; clear H'; intros Ng HNg. + set (Mf_ap_zero := pos_ap_zero _ _ HMf) in *. + set (Mg_ap_zero := pos_ap_zero _ _ HMg) in *. + set (ef := e[/] _[//]mult_resp_ap_zero _ _ _ (twelve_ap_zero _) Mf_ap_zero) in *. + set (eg := e[/] _[//]mult_resp_ap_zero _ _ _ (twelve_ap_zero _) Mg_ap_zero) in *. + cut (Zero [<] ef); [ intro Hef + | unfold ef in |- *; apply div_resp_pos; try apply mult_resp_pos; auto; apply pos_twelve ]. + cut (Zero [<] eg); [ intro Heg + | unfold eg in |- *; apply div_resp_pos; try apply mult_resp_pos; auto; apply pos_twelve ]. + elim (Hf eg Heg); intros Pf HPf. + elim (Hg ef Hef); intros Pg HPg. + set (N := max (max Nf Pf) (max Ng Pg)) in *; exists N; intros m Hm. + rstepr ((f m[-]f Pf[+][--](f N[-]f Pf))[*]g m[+] (g m[-]g Pg[+][--](g N[-]g Pg))[*]f N). + apply AbsSmall_wdl_unfolded with (Three[*]((eg[+]eg)[*]Mg)[+]Three[*]((ef[+]ef)[*]Mf)). + 2: unfold eg, ef in |- *; rational. + apply AbsSmall_plus; apply AbsSmall_mult; try apply AbsSmall_plus; try apply inv_resp_AbsSmall. + apply HPf; apply le_trans with N; auto; unfold N in |- *; eauto with arith. + apply HPf; apply le_trans with N; auto; unfold N in |- *; eauto with arith. + apply HNg; auto; apply le_trans with N; auto; unfold N in |- *; eauto with arith. + apply HPg; apply le_trans with N; auto; unfold N in |- *; eauto with arith. + apply HPg; apply le_trans with N; auto; unfold N in |- *; eauto with arith. + apply HNf; auto; apply le_trans with N; auto; unfold N in |- *; eauto with arith. Qed. (** @@ -255,46 +239,49 @@ Variable N : nat. Hypothesis f_bnd : forall n : nat, N <= n -> e [<=] f n. Lemma CS_seq_recip_def : forall n : nat, N <= n -> f n [#] Zero. -intros. -apply pos_ap_zero. -apply less_leEq_trans with e; auto with arith. +Proof. + intros. + apply pos_ap_zero. + apply less_leEq_trans with e; auto with arith. Qed. Definition CS_seq_recip_seq (n : nat) : R. -intro n; elim (lt_le_dec n N); intro Hdec. -apply (One:R). -apply (One[/] _[//]CS_seq_recip_def n Hdec). +Proof. + intro n; elim (lt_le_dec n N); intro Hdec. + apply (One:R). + apply (One[/] _[//]CS_seq_recip_def n Hdec). Defined. Lemma CS_seq_recip : Cauchy_prop CS_seq_recip_seq. -red in |- *; intros d Hd. -elim (Hf ((d[*]e[*]e) [/]TwoNZ)); - [ intros K HK | apply pos_div_two; repeat apply mult_resp_pos; auto ]. -exists (max K N); intros n Hn. -apply AbsSmall_cancel_mult with (f (max K N)). -apply less_leEq_trans with e; auto with arith. -apply AbsSmall_cancel_mult with (f n). -apply less_leEq_trans with e; eauto with arith. -unfold CS_seq_recip_seq in |- *. -elim lt_le_dec; intro; simpl in |- *. -elimtype False; apply le_not_lt with N n; eauto with arith. -elim lt_le_dec; intro; simpl in |- *. -elimtype False; apply le_not_lt with N (max K N); eauto with arith. -rstepr (f (max K N)[-]f n). -apply AbsSmall_leEq_trans with (d[*]e[*]e). -apply mult_resp_leEq_both. -apply less_leEq; apply mult_resp_pos; auto. -apply less_leEq; auto. -apply mult_resp_leEq_lft. -auto with arith. -apply less_leEq; auto. -auto with arith. -auto with arith. -rstepr (f (max K N)[-]f K[+](f K[-]f n)). -apply AbsSmall_eps_div_two. -auto with arith. -apply AbsSmall_minus; apply HK. -eauto with arith. +Proof. + red in |- *; intros d Hd. + elim (Hf ((d[*]e[*]e) [/]TwoNZ)); + [ intros K HK | apply pos_div_two; repeat apply mult_resp_pos; auto ]. + exists (max K N); intros n Hn. + apply AbsSmall_cancel_mult with (f (max K N)). + apply less_leEq_trans with e; auto with arith. + apply AbsSmall_cancel_mult with (f n). + apply less_leEq_trans with e; eauto with arith. + unfold CS_seq_recip_seq in |- *. + elim lt_le_dec; intro; simpl in |- *. + elimtype False; apply le_not_lt with N n; eauto with arith. + elim lt_le_dec; intro; simpl in |- *. + elimtype False; apply le_not_lt with N (max K N); eauto with arith. + rstepr (f (max K N)[-]f n). + apply AbsSmall_leEq_trans with (d[*]e[*]e). + apply mult_resp_leEq_both. + apply less_leEq; apply mult_resp_pos; auto. + apply less_leEq; auto. + apply mult_resp_leEq_lft. + auto with arith. + apply less_leEq; auto. + auto with arith. + auto with arith. + rstepr (f (max K N)[-]f K[+](f K[-]f n)). + apply AbsSmall_eps_div_two. + auto with arith. + apply AbsSmall_minus; apply HK. + eauto with arith. Qed. End OrdField_Cauchy. @@ -308,49 +295,49 @@ well here anyway. Lemma maj_upto_eps : forall (F : COrdField) (a : nat -> F) (n : nat) (eps : F), 0 < n -> Zero [<] eps -> {k : nat | 1 <= k /\ k <= n /\ (forall i : nat, 1 <= i -> i <= n -> a i[-]eps [<=] a k)}. -intros F a n eps Hn Heps. -induction n as [| n Hrecn]. - elim (lt_irrefl _ Hn). -clear Hrecn Hn. -induction n as [| n Hrecn]. - exists 1. - repeat split; try auto with arith. - intros. - rewrite <- (le_antisym _ _ H H0). - astepr (a 1[+]Zero). - unfold cg_minus in |- *. - apply plus_resp_leEq_lft. - astepr ([--](Zero:F)). - apply less_leEq; apply inv_resp_less; auto. -elim Hrecn; intros k Hk. -cut (a (S (S n))[-]eps [<] a (S (S n))). -intro H. -elim (less_cotransitive_unfolded _ _ _ H (a k)); intro H4. - exists k. - elim Hk; intros H0 H2. - elim H2; clear H2; intros H1 H2. - repeat split. - assumption. - auto with arith. - intros i H3 H5. - elim (Cle_le_S_eq _ _ H5); intro H6. - auto with arith. - rewrite H6. - apply less_leEq; assumption. -exists (S (S n)). -repeat split; auto with arith. -intros i H0 H1. -elim (Cle_le_S_eq _ _ H1); intro H2. - apply leEq_transitive with (a k). - elim Hk; intros H3 H5. - elim H5; clear H5; intros H6 H7. - auto with arith. - apply less_leEq; assumption. -rewrite H2; apply less_leEq; auto. - -rstepr (a (S (S n))[-]Zero). -apply minus_resp_less_rht. -assumption. +Proof. + intros F a n eps Hn Heps. + induction n as [| n Hrecn]. + elim (lt_irrefl _ Hn). + clear Hrecn Hn. + induction n as [| n Hrecn]. + exists 1. + repeat split; try auto with arith. + intros. + rewrite <- (le_antisym _ _ H H0). + astepr (a 1[+]Zero). + unfold cg_minus in |- *. + apply plus_resp_leEq_lft. + astepr ([--](Zero:F)). + apply less_leEq; apply inv_resp_less; auto. + elim Hrecn; intros k Hk. + cut (a (S (S n))[-]eps [<] a (S (S n))). + intro H. + elim (less_cotransitive_unfolded _ _ _ H (a k)); intro H4. + exists k. + elim Hk; intros H0 H2. + elim H2; clear H2; intros H1 H2. + repeat split. + assumption. + auto with arith. + intros i H3 H5. + elim (Cle_le_S_eq _ _ H5); intro H6. + auto with arith. + rewrite H6. + apply less_leEq; assumption. + exists (S (S n)). + repeat split; auto with arith. + intros i H0 H1. + elim (Cle_le_S_eq _ _ H1); intro H2. + apply leEq_transitive with (a k). + elim Hk; intros H3 H5. + elim H5; clear H5; intros H6 H7. + auto with arith. + apply less_leEq; assumption. + rewrite H2; apply less_leEq; auto. + rstepr (a (S (S n))[-]Zero). + apply minus_resp_less_rht. + assumption. Qed. Section Mult_Continuous. @@ -364,84 +351,84 @@ Variable R : COrdField. Lemma smaller : forall x y : R, Zero [<] x -> Zero [<] y -> {z : R | Zero [<] z | z [<=] x /\ z [<=] y}. -intros x y H H0. -elim (less_cotransitive_unfolded _ _ _ (half_3 _ _ H) y); intro. -exists (Half[*]x). -apply mult_resp_pos. apply pos_half. auto. -split; apply less_leEq. apply half_3. auto. auto. -cut (Half[*]y [<] y). intro. exists (Half[*]y). -apply mult_resp_pos. apply pos_half. auto. -split; apply less_leEq. apply less_transitive_unfolded with y. auto. auto. -auto. -apply half_3. auto. +Proof. + intros x y H H0. + elim (less_cotransitive_unfolded _ _ _ (half_3 _ _ H) y); intro. + exists (Half[*]x). + apply mult_resp_pos. apply pos_half. auto. + split; apply less_leEq. apply half_3. auto. auto. + cut (Half[*]y [<] y). intro. exists (Half[*]y). + apply mult_resp_pos. apply pos_half. auto. + split; apply less_leEq. apply less_transitive_unfolded with y. auto. auto. + auto. + apply half_3. auto. Qed. Lemma estimate_abs : forall x : R, {X : R | Zero [<] X | AbsSmall X x}. -intros. -unfold AbsSmall in |- *. -cut (x [<] x[+]One). intro H. -elim (less_cotransitive_unfolded _ x (x[+]One) H [--]x); intro. -exists ([--]x[+]One). -apply leEq_less_trans with ([--]x). -2: apply less_plusOne. -apply less_leEq; apply mult_cancel_less with (Two:R). -apply pos_two. -astepl (Zero:R); rstepr ([--]x[-]x). -apply shift_less_minus. -astepl x; auto. -split; apply less_leEq. -astepr ([--][--]x). apply inv_resp_less. apply less_plusOne. -apply less_transitive_unfolded with ([--]x). auto. apply less_plusOne. -exists (x[+]One). -apply less_leEq_trans with ((One:R) [/]TwoNZ). -apply pos_div_two; apply pos_one. -apply shift_leEq_plus; rstepl (([--]One:R) [/]TwoNZ). -apply shift_div_leEq. -apply pos_two. -rstepr (x[+]x); apply shift_leEq_plus. -unfold cg_minus in |- *; apply shift_plus_leEq'. -rstepr (x[+]One); apply less_leEq; auto. -split; apply less_leEq. -astepr ([--][--]x). apply inv_resp_less. auto. auto. -apply less_plusOne. +Proof. + intros. + unfold AbsSmall in |- *. + cut (x [<] x[+]One). intro H. + elim (less_cotransitive_unfolded _ x (x[+]One) H [--]x); intro. + exists ([--]x[+]One). + apply leEq_less_trans with ([--]x). + 2: apply less_plusOne. + apply less_leEq; apply mult_cancel_less with (Two:R). + apply pos_two. + astepl (Zero:R); rstepr ([--]x[-]x). + apply shift_less_minus. + astepl x; auto. + split; apply less_leEq. + astepr ([--][--]x). apply inv_resp_less. apply less_plusOne. + apply less_transitive_unfolded with ([--]x). auto. apply less_plusOne. + exists (x[+]One). + apply less_leEq_trans with ((One:R) [/]TwoNZ). + apply pos_div_two; apply pos_one. + apply shift_leEq_plus; rstepl (([--]One:R) [/]TwoNZ). + apply shift_div_leEq. + apply pos_two. + rstepr (x[+]x); apply shift_leEq_plus. + unfold cg_minus in |- *; apply shift_plus_leEq'. + rstepr (x[+]One); apply less_leEq; auto. + split; apply less_leEq. + astepr ([--][--]x). apply inv_resp_less. auto. auto. + apply less_plusOne. Qed. Lemma mult_contin : forall x y e : R, Zero [<] e -> {c : R | Zero [<] c | {d : R | Zero [<] d | forall x' y' : R, AbsSmall c (x[-]x') -> AbsSmall d (y[-]y') -> AbsSmall e (x[*]y[-]x'[*]y')}}. -intros x y e H. -set (e2 := e [/]TwoNZ) in *. -cut (Zero [<] e2). intro H0. 2: unfold e2 in |- *; apply pos_div_two; auto. -elim (estimate_abs x). intro X. intros H1a H1b. -elim (estimate_abs y). intro Y. intros H2 H3. -cut (Y [#] Zero). intro H4. -set (eY := e2[/] Y[//]H4) in *; exists eY. -unfold eY in |- *. apply div_resp_pos. auto. auto. -cut (Zero [<] X[+]eY). intro H5. -cut (X[+]eY [#] Zero). intro H6. -exists (e2[/] X[+]eY[//]H6). -apply div_resp_pos. auto. auto. -intros. -apply AbsSmall_wdr_unfolded with ((x[-]x')[*]y[+]x'[*](y[-]y')). -apply AbsSmall_eps_div_two. -apply AbsSmall_wdl_unfolded with ((e [/]TwoNZ[/] Y[//]H4)[*]Y). -apply mult_AbsSmall; auto. -rational. -apply - AbsSmall_wdl_unfolded - with - ((X[+](e [/]TwoNZ[/] Y[//]H4))[*] - (e [/]TwoNZ[/] X[+](e [/]TwoNZ[/] Y[//]H4)[//]H6)). -apply mult_AbsSmall; auto. -apply AbsSmall_wdr_unfolded with (x[+](x'[-]x)). -apply AbsSmall_plus; auto. apply AbsSmall_minus. auto. -rational. -rational. -rational. -apply Greater_imp_ap. auto. -apply plus_resp_pos; auto. -unfold eY in |- *; apply div_resp_pos; auto. -apply Greater_imp_ap. auto. +Proof. + intros x y e H. + set (e2 := e [/]TwoNZ) in *. + cut (Zero [<] e2). intro H0. 2: unfold e2 in |- *; apply pos_div_two; auto. + elim (estimate_abs x). intro X. intros H1a H1b. + elim (estimate_abs y). intro Y. intros H2 H3. + cut (Y [#] Zero). intro H4. + set (eY := e2[/] Y[//]H4) in *; exists eY. + unfold eY in |- *. apply div_resp_pos. auto. auto. + cut (Zero [<] X[+]eY). intro H5. + cut (X[+]eY [#] Zero). intro H6. + exists (e2[/] X[+]eY[//]H6). + apply div_resp_pos. auto. auto. + intros. + apply AbsSmall_wdr_unfolded with ((x[-]x')[*]y[+]x'[*](y[-]y')). + apply AbsSmall_eps_div_two. + apply AbsSmall_wdl_unfolded with ((e [/]TwoNZ[/] Y[//]H4)[*]Y). + apply mult_AbsSmall; auto. + rational. + apply AbsSmall_wdl_unfolded with ((X[+](e [/]TwoNZ[/] Y[//]H4))[*] + (e [/]TwoNZ[/] X[+](e [/]TwoNZ[/] Y[//]H4)[//]H6)). + apply mult_AbsSmall; auto. + apply AbsSmall_wdr_unfolded with (x[+](x'[-]x)). + apply AbsSmall_plus; auto. apply AbsSmall_minus. auto. + rational. + rational. + rational. + apply Greater_imp_ap. auto. + apply plus_resp_pos; auto. + unfold eY in |- *; apply div_resp_pos; auto. + apply Greater_imp_ap. auto. Qed. (** Addition is also continuous. *) @@ -449,15 +436,16 @@ Qed. Lemma plus_contin : forall (x y e : R), Zero [<] e -> {c : R | Zero [<] c | {d : R | Zero [<] d | forall x' y', AbsSmall c (x[-]x') -> AbsSmall d (y[-]y') -> AbsSmall e (x[+]y[-] (x'[+]y'))}}. -intros. -cut (Zero [<] e [/]TwoNZ). intro. -exists (e [/]TwoNZ). auto. -exists (e [/]TwoNZ). auto. -intros. -apply AbsSmall_wdr_unfolded with (x[-]x'[+](y[-]y')). -apply AbsSmall_eps_div_two; auto. -rational. -apply div_resp_pos. apply pos_two. auto. +Proof. + intros. + cut (Zero [<] e [/]TwoNZ). intro. + exists (e [/]TwoNZ). auto. + exists (e [/]TwoNZ). auto. + intros. + apply AbsSmall_wdr_unfolded with (x[-]x'[+](y[-]y')). + apply AbsSmall_eps_div_two; auto. + rational. + apply div_resp_pos. apply pos_two. auto. Qed. End Mult_Continuous. @@ -483,47 +471,51 @@ in terms of preservation of less or equal (less). Lemma resp_less_char' : forall (P : R -> CProp) (f : forall x, P x -> R) x y Hx Hy, (x [#] y -> f x Hx [#] f y Hy) -> (x [<=] y -> f x Hx [<=] f y Hy) -> x [<] y -> f x Hx [<] f y Hy. -intros. -elim (ap_imp_less _ _ _ (X (less_imp_ap _ _ _ X0))); intros. -auto. -elimtype False. -apply less_irreflexive_unfolded with (x := f x Hx). -apply leEq_less_trans with (f y Hy); auto. -apply H; apply less_leEq; auto. +Proof. + intros. + elim (ap_imp_less _ _ _ (X (less_imp_ap _ _ _ X0))); intros. + auto. + elimtype False. + apply less_irreflexive_unfolded with (x := f x Hx). + apply leEq_less_trans with (f y Hy); auto. + apply H; apply less_leEq; auto. Qed. Lemma resp_less_char : forall (f : R -> R) x y, (x [#] y -> f x [#] f y) -> (x [<=] y -> f x [<=] f y) -> x [<] y -> f x [<] f y. -intros. -set (f' := fun (x : R) (H : CTrue) => f x) in *. -change (f' x CI [<] f' y CI) in |- *. -apply resp_less_char' with (P := fun x : R => CTrue); auto. +Proof. + intros. + set (f' := fun (x : R) (H : CTrue) => f x) in *. + change (f' x CI [<] f' y CI) in |- *. + apply resp_less_char' with (P := fun x : R => CTrue); auto. Qed. Lemma resp_leEq_char' : forall (P : R -> CProp) (f : forall x : R, P x -> R) x y Hx Hy, (x [=] y -> f x Hx [=] f y Hy) -> (x [<] y -> f x Hx [<] f y Hy) -> x [<=] y -> f x Hx [<=] f y Hy. -intros. -rewrite leEq_def. -intro. -cut (Not (x [<] y) /\ ~ x [=] y); intros. -inversion_clear H1. -apply H3. -apply leEq_imp_eq; firstorder using leEq_def. -split; intro. -apply less_irreflexive_unfolded with (x := f y Hy). -apply less_transitive_unfolded with (f x Hx); auto. -apply less_irreflexive_unfolded with (x := f y Hy). -apply less_leEq_trans with (f x Hx); auto. -apply eq_imp_leEq; auto. +Proof. + intros. + rewrite leEq_def. + intro. + cut (Not (x [<] y) /\ ~ x [=] y); intros. + inversion_clear H1. + apply H3. + apply leEq_imp_eq; firstorder using leEq_def. + split; intro. + apply less_irreflexive_unfolded with (x := f y Hy). + apply less_transitive_unfolded with (f x Hx); auto. + apply less_irreflexive_unfolded with (x := f y Hy). + apply less_leEq_trans with (f x Hx); auto. + apply eq_imp_leEq; auto. Qed. Lemma resp_leEq_char : forall (f : R -> R) x y, (x [=] y -> f x [=] f y) -> (x [<] y -> f x [<] f y) -> x [<=] y -> f x [<=] f y. -intros. -set (f' := fun (x : R) (H : CTrue) => f x) in *. -change (f' x CI [<=] f' y CI) in |- *. -apply resp_leEq_char' with (P := fun x : R => CTrue); auto. +Proof. + intros. + set (f' := fun (x : R) (H : CTrue) => f x) in *. + change (f' x CI [<=] f' y CI) in |- *. + apply resp_leEq_char' with (P := fun x : R => CTrue); auto. Qed. (** @@ -537,199 +529,212 @@ Also, strictly monotonous functions are injective. Lemma local_mon_imp_mon : forall f : nat -> R, (forall i, f i [<] f (S i)) -> forall i j, i < j -> f i [<] f j. -simple induction j. -intros H0; elimtype False; inversion H0. -clear j; intro j; intros H0 H1. -elim (le_lt_eq_dec _ _ H1); intro. -apply leEq_less_trans with (f j). -apply less_leEq; apply H0; auto with arith. -auto. -rewrite <- b; apply X. +Proof. + simple induction j. + intros H0; elimtype False; inversion H0. + clear j; intro j; intros H0 H1. + elim (le_lt_eq_dec _ _ H1); intro. + apply leEq_less_trans with (f j). + apply less_leEq; apply H0; auto with arith. + auto. + rewrite <- b; apply X. Qed. Lemma local_mon_imp_mon' : forall f : nat -> R, (forall i, f i [<] f (S i)) -> forall i j, i <= j -> f i [<=] f j. -intros f H i j H0. -elim (le_lt_eq_dec _ _ H0); intro. -apply less_leEq; apply local_mon_imp_mon with (f := f); assumption. -apply eq_imp_leEq; rewrite b; algebra. +Proof. + intros f H i j H0. + elim (le_lt_eq_dec _ _ H0); intro. + apply less_leEq; apply local_mon_imp_mon with (f := f); assumption. + apply eq_imp_leEq; rewrite b; algebra. Qed. Lemma local_mon'_imp_mon' : forall f : nat -> R, (forall i, f i [<=] f (S i)) -> forall i j, i <= j -> f i [<=] f j. -intros; induction j as [| j Hrecj]. -cut (i = 0); [ intro | auto with arith ]. -rewrite H1; apply leEq_reflexive. -elim (le_lt_eq_dec _ _ H0); intro. -apply leEq_transitive with (f j). -apply Hrecj; auto with arith. -apply H. -rewrite b; apply leEq_reflexive. +Proof. + intros; induction j as [| j Hrecj]. + cut (i = 0); [ intro | auto with arith ]. + rewrite H1; apply leEq_reflexive. + elim (le_lt_eq_dec _ _ H0); intro. + apply leEq_transitive with (f j). + apply Hrecj; auto with arith. + apply H. + rewrite b; apply leEq_reflexive. Qed. Lemma mon_imp_mon' : forall f : nat -> R, (forall i j, i < j -> f i [<] f j) -> forall i j, i <= j -> f i [<=] f j. -intros f H i j H0. -elim (le_lt_eq_dec _ _ H0); intro. -apply less_leEq; apply H; assumption. -rewrite b; apply leEq_reflexive. +Proof. + intros f H i j H0. + elim (le_lt_eq_dec _ _ H0); intro. + apply less_leEq; apply H; assumption. + rewrite b; apply leEq_reflexive. Qed. Lemma mon_imp_inj : forall f : nat -> R, (forall i j, i < j -> f i [<] f j) -> forall i j, f i [=] f j -> i = j. -intros. -cut (~ i <> j); [ omega | intro ]. -cut (i < j \/ j < i); [ intro | apply not_eq; auto ]. -inversion_clear H1; - (elimtype False; cut (f i [#] f j); - [ apply eq_imp_not_ap; assumption | idtac ]). -apply less_imp_ap; apply X; assumption. -apply Greater_imp_ap; apply X; assumption. +Proof. + intros. + cut (~ i <> j); [ omega | intro ]. + cut (i < j \/ j < i); [ intro | apply not_eq; auto ]. + inversion_clear H1; (elimtype False; cut (f i [#] f j); [ apply eq_imp_not_ap; assumption | idtac ]). + apply less_imp_ap; apply X; assumption. + apply Greater_imp_ap; apply X; assumption. Qed. Lemma local_mon_imp_mon_lt : forall n (f : forall i, i < n -> R), (forall i H H', f i H [<] f (S i) H') -> forall i j Hi Hj, i < j -> f i Hi [<] f j Hj. -simple induction j. -intros Hi Hj H0; elimtype False; inversion H0. -clear j; intro j; intros. -elim (le_lt_eq_dec _ _ H); intro. -cut (j < n); [ intro | auto with arith ]. -apply leEq_less_trans with (f j H0). -apply less_leEq; apply X0; auto with arith. -apply X. -generalize Hj; rewrite <- b. -intro; apply X. +Proof. + simple induction j. + intros Hi Hj H0; elimtype False; inversion H0. + clear j; intro j; intros. + elim (le_lt_eq_dec _ _ H); intro. + cut (j < n); [ intro | auto with arith ]. + apply leEq_less_trans with (f j H0). + apply less_leEq; apply X0; auto with arith. + apply X. + generalize Hj; rewrite <- b. + intro; apply X. Qed. Lemma local_mon_imp_mon'_lt : forall n (f : forall i, i < n -> R), (forall i H H', f i H [<] f (S i) H') -> nat_less_n_fun f -> forall i j Hi Hj, i <= j -> f i Hi [<=] f j Hj. -intros. -elim (le_lt_eq_dec _ _ H0); intros. -apply less_leEq; apply local_mon_imp_mon_lt with n; auto. -apply eq_imp_leEq; apply H; assumption. +Proof. + intros. + elim (le_lt_eq_dec _ _ H0); intros. + apply less_leEq; apply local_mon_imp_mon_lt with n; auto. + apply eq_imp_leEq; apply H; assumption. Qed. Lemma local_mon'_imp_mon'_lt : forall n (f : forall i, i < n -> R), (forall i H H', f i H [<=] f (S i) H') -> nat_less_n_fun f -> forall i j Hi Hj, i <= j -> f i Hi [<=] f j Hj. -simple induction j. -intros. -cut (i = 0); [ intro | auto with arith ]. -apply eq_imp_leEq; apply H0; auto. -intro m; intros. -elim (le_lt_eq_dec _ _ H2); intro. -cut (m < n); [ intro | auto with arith ]. -apply leEq_transitive with (f m H3); auto. -apply H1; auto with arith. -apply eq_imp_leEq; apply H0; assumption. +Proof. + simple induction j. + intros. + cut (i = 0); [ intro | auto with arith ]. + apply eq_imp_leEq; apply H0; auto. + intro m; intros. + elim (le_lt_eq_dec _ _ H2); intro. + cut (m < n); [ intro | auto with arith ]. + apply leEq_transitive with (f m H3); auto. + apply H1; auto with arith. + apply eq_imp_leEq; apply H0; assumption. Qed. Lemma local_mon'_imp_mon'2_lt : forall n (f : forall i, i < n -> R), (forall i H H', f i H [<=] f (S i) H') -> forall i j Hi Hj, i < j -> f i Hi [<=] f j Hj. -intros; induction j as [| j Hrecj]. -elimtype False; inversion H0. -elim (le_lt_eq_dec _ _ H0); intro. -cut (j < n); [ intro | auto with arith ]. -apply leEq_transitive with (f j H1). -apply Hrecj; auto with arith. -apply H. -generalize Hj; rewrite <- b. -intro; apply H. +Proof. + intros; induction j as [| j Hrecj]. + elimtype False; inversion H0. + elim (le_lt_eq_dec _ _ H0); intro. + cut (j < n); [ intro | auto with arith ]. + apply leEq_transitive with (f j H1). + apply Hrecj; auto with arith. + apply H. + generalize Hj; rewrite <- b. + intro; apply H. Qed. Lemma mon_imp_mon'_lt : forall n (f : forall i, i < n -> R), nat_less_n_fun f -> (forall i j Hi Hj, i < j -> f i Hi [<] f j Hj) -> forall i j Hi Hj, i <= j -> f i Hi [<=] f j Hj. -intros. -elim (le_lt_eq_dec _ _ H0); intro. -apply less_leEq; auto. -apply eq_imp_leEq; auto. +Proof. + intros. + elim (le_lt_eq_dec _ _ H0); intro. + apply less_leEq; auto. + apply eq_imp_leEq; auto. Qed. Lemma mon_imp_inj_lt : forall n (f : forall i, i < n -> R), (forall i j Hi Hj, i < j -> f i Hi [<] f j Hj) -> forall i j Hi Hj, f i Hi [=] f j Hj -> i = j. -intros. -cut (~ i <> j); intro. -clear X H Hj Hi; omega. -cut (i < j \/ j < i); [ intro | apply not_eq; auto ]. -inversion_clear H1; - (elimtype False; cut (f i Hi [#] f j Hj); +Proof. + intros. + cut (~ i <> j); intro. + clear X H Hj Hi; omega. + cut (i < j \/ j < i); [ intro | apply not_eq; auto ]. + inversion_clear H1; (elimtype False; cut (f i Hi [#] f j Hj); [ apply eq_imp_not_ap; assumption | idtac ]). -apply less_imp_ap; auto. -apply Greater_imp_ap; auto. + apply less_imp_ap; auto. + apply Greater_imp_ap; auto. Qed. Lemma local_mon_imp_mon_le : forall n (f : forall i, i <= n -> R), (forall i H H', f i H [<] f (S i) H') -> forall i j Hi Hj, i < j -> f i Hi [<] f j Hj. -simple induction j. -intros Hi Hj H0; elimtype False; inversion H0. -clear j; intro j; intros. -elim (le_lt_eq_dec _ _ H); intro. -cut (j <= n); [ intro | auto with arith ]. -apply leEq_less_trans with (f j H0). -apply less_leEq; auto with arith. -apply X. -generalize Hj; rewrite <- b. -auto. +Proof. + simple induction j. + intros Hi Hj H0; elimtype False; inversion H0. + clear j; intro j; intros. + elim (le_lt_eq_dec _ _ H); intro. + cut (j <= n); [ intro | auto with arith ]. + apply leEq_less_trans with (f j H0). + apply less_leEq; auto with arith. + apply X. + generalize Hj; rewrite <- b. + auto. Qed. Lemma local_mon_imp_mon'_le : forall n (f : forall i, i <= n -> R), (forall i H H', f i H [<] f (S i) H') -> nat_less_n_fun' f -> forall i j Hi Hj, i <= j -> f i Hi [<=] f j Hj. -intros. -elim (le_lt_eq_dec _ _ H0); intros. -apply less_leEq; apply local_mon_imp_mon_le with n; auto. -apply eq_imp_leEq; auto. +Proof. + intros. + elim (le_lt_eq_dec _ _ H0); intros. + apply less_leEq; apply local_mon_imp_mon_le with n; auto. + apply eq_imp_leEq; auto. Qed. Lemma local_mon'_imp_mon'_le : forall n (f : forall i, i <= n -> R), (forall i H H', f i H [<=] f (S i) H') -> nat_less_n_fun' f -> forall i j Hi Hj, i <= j -> f i Hi [<=] f j Hj. -simple induction j. -intros. -cut (i = 0); [ intro | auto with arith ]. -apply eq_imp_leEq; apply H0; auto. -intro m; intros. -elim (le_lt_eq_dec _ _ H2); intro. -cut (m <= n); [ intro | auto with arith ]. -apply leEq_transitive with (f m H3); auto. -apply H1; auto with arith. -apply eq_imp_leEq; apply H0; assumption. +Proof. + simple induction j. + intros. + cut (i = 0); [ intro | auto with arith ]. + apply eq_imp_leEq; apply H0; auto. + intro m; intros. + elim (le_lt_eq_dec _ _ H2); intro. + cut (m <= n); [ intro | auto with arith ]. + apply leEq_transitive with (f m H3); auto. + apply H1; auto with arith. + apply eq_imp_leEq; apply H0; assumption. Qed. Lemma local_mon'_imp_mon'2_le : forall n (f : forall i, i <= n -> R), (forall i H H', f i H [<=] f (S i) H') -> forall i j Hi Hj, i < j -> f i Hi [<=] f j Hj. -intros; induction j as [| j Hrecj]. -elimtype False; inversion H0. -elim (le_lt_eq_dec _ _ H0); intro. -cut (j <= n); [ intro | auto with arith ]. -apply leEq_transitive with (f j H1). -apply Hrecj; auto with arith. -apply H. -generalize Hj; rewrite <- b. -intro; apply H. +Proof. + intros; induction j as [| j Hrecj]. + elimtype False; inversion H0. + elim (le_lt_eq_dec _ _ H0); intro. + cut (j <= n); [ intro | auto with arith ]. + apply leEq_transitive with (f j H1). + apply Hrecj; auto with arith. + apply H. + generalize Hj; rewrite <- b. + intro; apply H. Qed. Lemma mon_imp_mon'_le : forall n (f : forall i, i <= n -> R), nat_less_n_fun' f -> (forall i j Hi Hj, i < j -> f i Hi [<] f j Hj) -> forall i j Hi Hj, i <= j -> f i Hi [<=] f j Hj. -intros. -elim (le_lt_eq_dec _ _ H0); intro. -apply less_leEq; auto. -apply eq_imp_leEq; auto. +Proof. + intros. + elim (le_lt_eq_dec _ _ H0); intro. + apply less_leEq; auto. + apply eq_imp_leEq; auto. Qed. Lemma mon_imp_inj_le : forall n (f : forall i, i <= n -> R), (forall i j Hi Hj, i < j -> f i Hi [<] f j Hj) -> forall i j Hi Hj, f i Hi [=] f j Hj -> i = j. -intros. -cut (~ i <> j); intro. -clear H X Hj Hi; omega. -cut (i < j \/ j < i); [ intro | apply not_eq; auto ]. -inversion_clear H1; - (elimtype False; cut (f i Hi [#] f j Hj); +Proof. + intros. + cut (~ i <> j); intro. + clear H X Hj Hi; omega. + cut (i < j \/ j < i); [ intro | apply not_eq; auto ]. + inversion_clear H1; (elimtype False; cut (f i Hi [#] f j Hj); [ apply eq_imp_not_ap; assumption | idtac ]). -apply less_imp_ap; auto. -apply Greater_imp_ap; auto. + apply less_imp_ap; auto. + apply Greater_imp_ap; auto. Qed. (** @@ -739,18 +744,19 @@ A similar result for %{\em %partial%}% functions. Lemma part_mon_imp_mon' : forall F (I : R -> CProp), (forall x, I x -> Dom F x) -> (forall x y Hx Hy, I x -> I y -> x [<] y -> F x Hx [<] F y Hy) -> forall x y Hx Hy, I x -> I y -> x [<=] y -> F x Hx [<=] F y Hy. -intros. -rewrite leEq_def. -intro. -cut (x [=] y); intros. -apply (less_irreflexive_unfolded _ (F x Hx)). -astepl (F y Hy); auto. -apply leEq_imp_eq. -firstorder using leEq_def. -rewrite leEq_def. -intro. -apply (less_irreflexive_unfolded _ (F x Hx)). -apply less_transitive_unfolded with (F y Hy); firstorder using leEq_def. +Proof. + intros. + rewrite leEq_def. + intro. + cut (x [=] y); intros. + apply (less_irreflexive_unfolded _ (F x Hx)). + astepl (F y Hy); auto. + apply leEq_imp_eq. + firstorder using leEq_def. + rewrite leEq_def. + intro. + apply (less_irreflexive_unfolded _ (F x Hx)). + apply less_transitive_unfolded with (F y Hy); firstorder using leEq_def. Qed. End Monotonous_functions. diff --git a/algebra/COrdFields.v b/algebra/COrdFields.v index 2407308d1..6bd69a154 100644 --- a/algebra/COrdFields.v +++ b/algebra/COrdFields.v @@ -19,21 +19,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing [<] %\ensuremath<% #<# *) (** printing [<=] %\ensuremath{\leq}% #≤# *) @@ -64,7 +64,7 @@ Require Export Rational. (* Begin_SpecReals *) -Record strictorder (A : Type)(R : A -> A -> CProp) : CProp := +Record strictorder (A : Type)(R : A -> A -> CProp) : CProp := {so_trans : Ctransitive R; so_asym : antisymmetric R}. @@ -84,7 +84,7 @@ Record is_COrdField (F : CField) def_greater : forall x y, Iff (greater x y) (less y x); def_grEq : forall x y, (grEq x y) <-> (leEq y x)}. -Record COrdField : Type := +Record COrdField : Type := {cof_crr :> CField; cof_less : CCSetoid_relation cof_crr; cof_leEq : cof_crr -> cof_crr -> Prop; @@ -112,14 +112,15 @@ Implicit Arguments cof_grEq [c]. Infix "[>=]" := cof_grEq (at level 70, no associativity). Definition default_greater (X:CField) (lt:CCSetoid_relation X) : CCSetoid_relation X. -intros. -exists (fun x y => lt y x). -destruct lt. -unfold Crel_strext in *. -simpl. -intros. -pose (Ccsr_strext _ y2 _ x2 X0). -tauto. +Proof. + intros. + exists (fun x y => lt y x). + destruct lt. + unfold Crel_strext in *. + simpl. + intros. + pose (Ccsr_strext _ y2 _ x2 X0). + tauto. Defined. Definition default_leEq (X:CField) (lt:CCSetoid_relation X) : Relation X := @@ -147,56 +148,67 @@ Let [F] be a field. Variable F : COrdField. Lemma COrdField_is_COrdField : is_COrdField F cof_less (@cof_leEq F) cof_greater (@cof_grEq F). -elim F; auto. +Proof. + elim F; auto. Qed. Lemma less_strorder : strictorder (cof_less (c:=F)). -elim COrdField_is_COrdField; auto. +Proof. + elim COrdField_is_COrdField; auto. Qed. Lemma less_transitive_unfolded : forall x y z : F, x [<] y -> y [<] z -> x [<] z. -elim less_strorder; auto. +Proof. + elim less_strorder; auto. Qed. Lemma less_antisymmetric_unfolded : forall x y : F, x [<] y -> Not (y [<] x). -elim less_strorder. -intros H1 H2 x y H. -intro H0. -elim (H2 _ _ H). -assumption. +Proof. + elim less_strorder. + intros H1 H2 x y H. + intro H0. + elim (H2 _ _ H). + assumption. Qed. Lemma less_irreflexive : irreflexive (cof_less (c:=F)). -red in |- *. -intro x; intro H. -elim (less_antisymmetric_unfolded _ _ H H). +Proof. + red in |- *. + intro x; intro H. + elim (less_antisymmetric_unfolded _ _ H H). Qed. Lemma less_irreflexive_unfolded : forall x : F, Not (x [<] x). Proof less_irreflexive. Lemma plus_resp_less_rht : forall x y z : F, x [<] y -> x[+]z [<] y[+]z. -elim COrdField_is_COrdField; auto. +Proof. + elim COrdField_is_COrdField; auto. Qed. Lemma mult_resp_pos : forall x y : F, Zero [<] x -> Zero [<] y -> Zero [<] x[*]y. -elim COrdField_is_COrdField; auto. +Proof. + elim COrdField_is_COrdField; auto. Qed. Lemma less_conf_ap : forall x y : F, Iff (x [#] y) (x [<] y or y [<] x). -elim COrdField_is_COrdField; auto. +Proof. + elim COrdField_is_COrdField; auto. Qed. Lemma leEq_def : forall x y : F, (x [<=] y) <-> (Not (y [<] x)). -elim COrdField_is_COrdField; auto. +Proof. + elim COrdField_is_COrdField; auto. Qed. Lemma greater_def : forall x y : F, Iff (x [>] y) (y [<] x). -elim COrdField_is_COrdField; auto. +Proof. + elim COrdField_is_COrdField; auto. Qed. Lemma grEq_def : forall x y : F, (x [>=] y) <-> (y [<=] x). -elim COrdField_is_COrdField; auto. +Proof. + elim COrdField_is_COrdField; auto. Qed. Lemma less_wdr : forall x y z : F, x [<] y -> y [=] z -> x [<] z. @@ -226,20 +238,23 @@ Variable R : COrdField. Lemma less_imp_ap : forall x y : R, x [<] y -> x [#] y. -intros x y H. -elim (less_conf_ap _ x y); intros. -apply b. left. auto. +Proof. + intros x y H. + elim (less_conf_ap _ x y); intros. + apply b. left. auto. Qed. Lemma Greater_imp_ap : forall x y : R, y [<] x -> x [#] y. -intros x y H. -elim (less_conf_ap _ x y); intros. -apply b. right. auto. +Proof. + intros x y H. + elim (less_conf_ap _ x y); intros. + apply b. right. auto. Qed. Lemma ap_imp_less : forall x y : R, x [#] y -> x [<] y or y [<] x. -intros x y. -elim (less_conf_ap _ x y); auto. +Proof. + intros x y. + elim (less_conf_ap _ x y); auto. Qed. (** @@ -247,38 +262,41 @@ Now properties which can be derived. *) Lemma less_cotransitive : cotransitive (cof_less (c:=R)). -red in |- *. -intros x y H z. -generalize (less_imp_ap _ _ H); intro H0. -elim (ap_cotransitive_unfolded _ _ _ H0 z); intro H1. +Proof. + red in |- *. + intros x y H z. + generalize (less_imp_ap _ _ H); intro H0. + elim (ap_cotransitive_unfolded _ _ _ H0 z); intro H1. + elim (ap_imp_less _ _ H1). + auto. + intro H2. + right. + apply (less_transitive_unfolded _ _ _ _ H2 H). elim (ap_imp_less _ _ H1). auto. intro H2. - right. - apply (less_transitive_unfolded _ _ _ _ H2 H). -elim (ap_imp_less _ _ H1). - auto. -intro H2. -left. -apply (less_transitive_unfolded _ _ _ _ H H2). + left. + apply (less_transitive_unfolded _ _ _ _ H H2). Qed. Lemma less_cotransitive_unfolded : forall x y : R, x [<] y -> forall z, x [<] z or z [<] y. Proof less_cotransitive. Lemma pos_ap_zero : forall x : R, Zero [<] x -> x [#] Zero. -intros x H. -apply Greater_imp_ap. -assumption. +Proof. + intros x H. + apply Greater_imp_ap. + assumption. Defined. (* Main characterization of less *) Lemma leEq_not_eq : forall x y : R, x [<=] y -> x [#] y -> x [<] y. -intros x y H H0. -elim (ap_imp_less _ _ H0); intro H1; auto. -rewrite -> leEq_def in H. -elim (H H1). +Proof. + intros x y H H0. + elim (ap_imp_less _ _ H0); intro H1; auto. + rewrite -> leEq_def in H. + elim (H H1). Qed. End OrdField_basics. @@ -294,109 +312,119 @@ Section Basic_Properties_of_leEq. Variable R : COrdField. Lemma leEq_wdr : forall x y z : R, x [<=] y -> y [=] z -> x [<=] z. -intros x y z H H0. -rewrite -> leEq_def in *. -intro H1. -apply H. -astepl z; assumption. +Proof. + intros x y z H H0. + rewrite -> leEq_def in *. + intro H1. + apply H. + astepl z; assumption. Qed. Lemma leEq_wdl : forall x y z : R, x [<=] y -> x [=] z -> z [<=] y. -intros x y z H H0. -rewrite -> leEq_def in *. -intro H1. -apply H. -astepr z;auto. +Proof. + intros x y z H H0. + rewrite -> leEq_def in *. + intro H1. + apply H. + astepr z;auto. Qed. Lemma leEq_reflexive : forall x : R, x [<=] x. -intro x. -rewrite leEq_def. -apply less_irreflexive_unfolded. +Proof. + intro x. + rewrite leEq_def. + apply less_irreflexive_unfolded. Qed. Declare Left Step leEq_wdl. Declare Right Step leEq_wdr. Lemma eq_imp_leEq : forall x y : R, x [=] y -> x [<=] y. -intros x y H. -astepr x. -exact (leEq_reflexive _). +Proof. + intros x y H. + astepr x. + exact (leEq_reflexive _). Qed. Lemma leEq_imp_eq : forall x y : R, x [<=] y -> y [<=] x -> x [=] y. -intros x y H H0. rewrite -> leEq_def in *|-. -apply not_ap_imp_eq. intro H1. apply H0. -elim (ap_imp_less _ _ _ H1); intro H2. auto. -elim (H H2). +Proof. + intros x y H H0. rewrite -> leEq_def in *|-. + apply not_ap_imp_eq. intro H1. apply H0. + elim (ap_imp_less _ _ _ H1); intro H2. auto. + elim (H H2). Qed. Lemma lt_equiv_imp_eq : forall x x' : R, (forall y, x [<] y -> x' [<] y) -> (forall y, x' [<] y -> x [<] y) -> x [=] x'. -intros x x' H H0. -apply leEq_imp_eq; rewrite leEq_def in |- *; intro H1. -apply (less_irreflexive_unfolded _ x); auto. -apply (less_irreflexive_unfolded _ x'); auto. +Proof. + intros x x' H H0. + apply leEq_imp_eq; rewrite leEq_def in |- *; intro H1. + apply (less_irreflexive_unfolded _ x); auto. + apply (less_irreflexive_unfolded _ x'); auto. Qed. Lemma less_leEq_trans : forall x y z : R, x [<] y -> y [<=] z -> x [<] z. -intros x y z. -intros H H0. -elim (less_cotransitive_unfolded _ _ _ H z); intro H1. -assumption. -destruct (leEq_def _ y z). -elim ((H2 H0) H1). +Proof. + intros x y z. + intros H H0. + elim (less_cotransitive_unfolded _ _ _ H z); intro H1. + assumption. + destruct (leEq_def _ y z). + elim ((H2 H0) H1). Qed. Lemma leEq_less_trans : forall x y z : R, x [<=] y -> y [<] z -> x [<] z. -intros x y z. -intros H H0. -elim (less_cotransitive_unfolded _ _ _ H0 x); intro H1; try assumption. -destruct (leEq_def _ x y) as [H2 H3]. -elim ((H2 H) H1). +Proof. + intros x y z. + intros H H0. + elim (less_cotransitive_unfolded _ _ _ H0 x); intro H1; try assumption. + destruct (leEq_def _ x y) as [H2 H3]. + elim ((H2 H) H1). Qed. Lemma leEq_transitive : forall x y z : R, x [<=] y -> y [<=] z -> x [<=] z. -intros x y z. -repeat rewrite leEq_def. -intros H H0 H1. -apply H. -apply leEq_less_trans with (y := z); firstorder using leEq_def. +Proof. + intros x y z. + repeat rewrite leEq_def. + intros H H0 H1. + apply H. + apply leEq_less_trans with (y := z); firstorder using leEq_def. Qed. Lemma less_leEq : forall x y : R, x [<] y -> x [<=] y. -intros. -rewrite leEq_def. -apply less_antisymmetric_unfolded. -assumption. +Proof. + intros. + rewrite leEq_def. + apply less_antisymmetric_unfolded. + assumption. Qed. Lemma leEq_or_leEq : forall x y:R, Not (Not (x[<=]y or y[<=]x)). Proof. -intros x y H. -apply H. -right. -rewrite leEq_def. -intros H0. -apply H. -left. -apply less_leEq. -assumption. + intros x y H. + apply H. + right. + rewrite leEq_def. + intros H0. + apply H. + left. + apply less_leEq. + assumption. Qed. Lemma leEq_less_or_equal : forall x y:R, x[<=]y -> Not (Not (x[<]y or x[=]y)). Proof. -intros x y Hxy H. move: Hxy. -rewrite leEq_def. intro Hxy. apply H. -right. -apply (not_ap_imp_eq). -intros H0. -destruct (ap_imp_less _ _ _ H0). - apply H. - left. + intros x y Hxy H. move: Hxy. + rewrite leEq_def. intro Hxy. apply H. + right. + apply (not_ap_imp_eq). + intros H0. + destruct (ap_imp_less _ _ _ H0). + apply H. + left. + assumption. + apply Hxy. assumption. -apply Hxy. -assumption. Qed. End Basic_Properties_of_leEq. @@ -420,83 +448,91 @@ e.g.%\% [x[/]TwoNZ]. Variable R : COrdField. Lemma pos_one : (Zero:R) [<] One. +Proof. (* 0 [#] 1, so 0<1 (and we are done) or 1<0; so assume 1<0. *) -elim (ap_imp_less _ _ _ (ring_non_triv R)). - 2: auto. -intro H. -elimtype False. -apply (less_irreflexive_unfolded R One). -apply less_transitive_unfolded with (Zero:R). -auto. + elim (ap_imp_less _ _ _ (ring_non_triv R)). + 2: auto. + intro H. + elimtype False. + apply (less_irreflexive_unfolded R One). + apply less_transitive_unfolded with (Zero:R). + auto. (* By plus_resp_less, 0=(1-1)<(0-1)=-1. *) -cut ((Zero:R) [<] [--]One). - 2: astepl ((One:R)[+][--]One). - 2: astepr ((Zero:R)[+][--]One). - 2: apply plus_resp_less_rht; auto. -intro H0. + cut ((Zero:R) [<] [--]One). + 2: astepl ((One:R)[+][--]One). + 2: astepr ((Zero:R)[+][--]One). + 2: apply plus_resp_less_rht; auto. + intro H0. (* By mult_resp_pos, 0<(-1).(-1)=1. *) -rstepr ([--](One:R)[*][--]One). -apply (mult_resp_pos _ _ _ H0 H0). + rstepr ([--](One:R)[*][--]One). + apply (mult_resp_pos _ _ _ H0 H0). Qed. Lemma nring_less_succ : forall m : nat, (nring m:R) [<] nring (S m). -intro m. -simpl in |- *. -astepr (One[+]nring (R:=R) m). -astepl (Zero[+]nring (R:=R) m). -apply plus_resp_less_rht. -apply pos_one. +Proof. + intro m. + simpl in |- *. + astepr (One[+]nring (R:=R) m). + astepl (Zero[+]nring (R:=R) m). + apply plus_resp_less_rht. + apply pos_one. Qed. Lemma nring_less : forall m n : nat, m < n -> (nring m:R) [<] nring n. -intros m n H. -generalize (toCProp_lt _ _ H); intro H0. -elim H0. +Proof. + intros m n H. + generalize (toCProp_lt _ _ H); intro H0. + elim H0. + apply nring_less_succ. + clear H0 H n; intros n H H0. + apply less_transitive_unfolded with (nring (R:=R) n). + assumption. apply nring_less_succ. -clear H0 H n; intros n H H0. -apply less_transitive_unfolded with (nring (R:=R) n). - assumption. -apply nring_less_succ. Qed. Lemma nring_leEq : forall m n : nat, m <= n -> (nring m:R) [<=] nring n. -intros m n H. -elim (le_lt_eq_dec _ _ H); intro H1. - rewrite leEq_def in |- *. apply less_antisymmetric_unfolded. - apply nring_less. auto. -rewrite H1. -rewrite leEq_def in |- *. apply less_irreflexive_unfolded. +Proof. + intros m n H. + elim (le_lt_eq_dec _ _ H); intro H1. + rewrite leEq_def in |- *. apply less_antisymmetric_unfolded. + apply nring_less. auto. + rewrite H1. + rewrite leEq_def in |- *. apply less_irreflexive_unfolded. Qed. Lemma nring_apart : forall m n : nat, m <> n -> (nring m:R) [#] nring n. -intros m n H. -elim (lt_eq_lt_dec m n); intro H0. - elim H0; intro H1. - apply less_imp_ap. - apply nring_less. +Proof. + intros m n H. + elim (lt_eq_lt_dec m n); intro H0. + elim H0; intro H1. + apply less_imp_ap. + apply nring_less. + assumption. + elim (H H1). + apply Greater_imp_ap. + apply nring_less. assumption. - elim (H H1). -apply Greater_imp_ap. -apply nring_less. -assumption. Qed. Lemma nring_ap_zero : forall n : nat, n <> 0 -> nring (R:=R) n [#] Zero. -intros n H. -exact (nring_apart _ _ H). +Proof. + intros n H. + exact (nring_apart _ _ H). Qed. Lemma nring_ap_zero' : forall n : nat, 0 <> n -> nring (R:=R) n [#] Zero. -intros. -apply nring_ap_zero; auto. +Proof. + intros. + apply nring_ap_zero; auto. Qed. Lemma nring_ap_zero_imp : forall n : nat, nring (R:=R) n [#] Zero -> 0 <> n. -intros n H. -induction n as [| n Hrecn]. -simpl in H. -elim (ap_irreflexive_unfolded _ _ H). -apply O_S. +Proof. + intros n H. + induction n as [| n Hrecn]. + simpl in H. + elim (ap_irreflexive_unfolded _ _ H). + apply O_S. Qed. Definition Snring (n : nat) := nring (R:=R) (S n). @@ -504,25 +540,28 @@ Definition Snring (n : nat) := nring (R:=R) (S n). Load "Transparent_algebra". Lemma pos_Snring : forall n : nat, (Zero:R) [<] Snring n. -intro n. -apply less_leEq_trans with (One:R). -apply pos_one. -stepl (nring (R:=R) 1). 2: simpl in |- *; algebra. -unfold Snring in |- *. -apply nring_leEq. -auto with arith. +Proof. + intro n. + apply less_leEq_trans with (One:R). + apply pos_one. + stepl (nring (R:=R) 1). 2: simpl in |- *; algebra. + unfold Snring in |- *. + apply nring_leEq. + auto with arith. Qed. Lemma nringS_ap_zero : forall m : nat, nring (R:=R) (S m) [#] Zero. -intros. -apply pos_ap_zero. -exact (pos_Snring m). +Proof. + intros. + apply pos_ap_zero. + exact (pos_Snring m). Qed. Lemma nring_fac_ap_zero : forall n : nat, nring (R:=R) (fac n) [#] Zero. -intro n; apply nring_ap_zero. cut (0 < fac n). +Proof. + intro n; apply nring_ap_zero. cut (0 < fac n). omega. -apply nat_fac_gtzero. + apply nat_fac_gtzero. Qed. Load "Opaque_algebra". @@ -538,94 +577,108 @@ In the names of lemmas, we denote the numbers 0,1,2,3,4 and so on, by *) Lemma less_plusOne : forall x : R, x [<] x[+]One. +Proof. (* by plus_resp_less_rht and pos_one *) -intros x. -astepl (Zero[+]x); astepr (One[+]x). -apply plus_resp_less_rht. -exact pos_one. + intros x. + astepl (Zero[+]x); astepr (One[+]x). + apply plus_resp_less_rht. + exact pos_one. Qed. Lemma zero_lt_posplus1 : forall x : R, Zero [<=] x -> Zero [<] x[+]One. Proof. -intros x zltx. -apply leEq_less_trans with x. -assumption. -exact (less_plusOne x). + intros x zltx. + apply leEq_less_trans with x. + assumption. + exact (less_plusOne x). Qed. Lemma plus_one_ext_less : forall x y : R, x [<] y -> x [<] y[+]One. +Proof. (* By transitivity of less and less_plusOne *) -intros x y H. -apply less_leEq_trans with y. -assumption. -apply less_leEq; apply less_plusOne. + intros x y H. + apply less_leEq_trans with y. + assumption. + apply less_leEq; apply less_plusOne. Qed. Lemma one_less_two : (One:R) [<] Two. -simpl in |- *. -astepr ((One:R)[+]One). -apply less_plusOne. +Proof. + simpl in |- *. + astepr ((One:R)[+]One). + apply less_plusOne. Qed. Lemma two_less_three : (Two:R) [<] Three. -simpl in |- *. -apply less_plusOne. +Proof. + simpl in |- *. + apply less_plusOne. Qed. Lemma three_less_four : (Three:R) [<] Four. -simpl in |- *. -apply less_plusOne. +Proof. + simpl in |- *. + apply less_plusOne. Qed. Lemma pos_two : (Zero:R) [<] Two. -apply less_leEq_trans with (One:R). -exact pos_one. -apply less_leEq; exact one_less_two. +Proof. + apply less_leEq_trans with (One:R). + exact pos_one. + apply less_leEq; exact one_less_two. Qed. Lemma one_less_three : (One:R) [<] Three. -apply less_leEq_trans with (Two:R). -exact one_less_two. -apply less_leEq; exact two_less_three. +Proof. + apply less_leEq_trans with (Two:R). + exact one_less_two. + apply less_leEq; exact two_less_three. Qed. Lemma two_less_four : (Two:R) [<] Four. -apply less_leEq_trans with (Three:R). -exact two_less_three. -apply less_leEq; exact three_less_four. +Proof. + apply less_leEq_trans with (Three:R). + exact two_less_three. + apply less_leEq; exact three_less_four. Qed. Lemma pos_three : (Zero:R) [<] Three. -apply less_leEq_trans with (One:R). -exact pos_one. -apply less_leEq; exact one_less_three. +Proof. + apply less_leEq_trans with (One:R). + exact pos_one. + apply less_leEq; exact one_less_three. Qed. Lemma one_less_four : (One:R) [<] Four. -apply less_leEq_trans with (Three:R). -exact one_less_three. -apply less_leEq; exact three_less_four. +Proof. + apply less_leEq_trans with (Three:R). + exact one_less_three. + apply less_leEq; exact three_less_four. Qed. Lemma pos_four : (Zero:R) [<] Four. -apply less_leEq_trans with (One:R). -exact pos_one. -apply less_leEq; exact one_less_four. +Proof. + apply less_leEq_trans with (One:R). + exact pos_one. + apply less_leEq; exact one_less_four. Qed. Lemma two_ap_zero : Two [#] (Zero:R). -apply pos_ap_zero. -apply pos_two. +Proof. + apply pos_ap_zero. + apply pos_two. Qed. Lemma three_ap_zero : Three [#] (Zero:R). -apply pos_ap_zero. -apply pos_three. +Proof. + apply pos_ap_zero. + apply pos_three. Qed. Lemma four_ap_zero : Four [#] (Zero:R). -apply pos_ap_zero. -apply pos_four. +Proof. + apply pos_ap_zero. + apply pos_four. Qed. End up_to_four. @@ -636,67 +689,83 @@ Section More_than_four. *** Properties of some other numbers *) Lemma pos_six : (Zero:R) [<] Six. -exact (pos_Snring 5). +Proof. + exact (pos_Snring 5). Qed. Lemma pos_eight : (Zero:R) [<] Eight. -exact (pos_Snring 7). +Proof. + exact (pos_Snring 7). Qed. Lemma pos_nine : (Zero:R) [<] Nine. -exact (pos_Snring 8). +Proof. + exact (pos_Snring 8). Qed. Lemma pos_twelve : (Zero:R) [<] Twelve. -exact (pos_Snring 11). +Proof. + exact (pos_Snring 11). Qed. Lemma pos_sixteen : (Zero:R) [<] Sixteen. -exact (pos_Snring 15). +Proof. + exact (pos_Snring 15). Qed. Lemma pos_eighteen : (Zero:R) [<] Eighteen. -exact (pos_Snring 17). +Proof. + exact (pos_Snring 17). Qed. Lemma pos_twentyfour : (Zero:R) [<] TwentyFour. -exact (pos_Snring 23). +Proof. + exact (pos_Snring 23). Qed. Lemma pos_fortyeight : (Zero:R) [<] FortyEight. -exact (pos_Snring 47). +Proof. + exact (pos_Snring 47). Qed. Lemma six_ap_zero : Six [#] (Zero:R). -apply pos_ap_zero; apply pos_six. +Proof. + apply pos_ap_zero; apply pos_six. Qed. Lemma eight_ap_zero : Eight [#] (Zero:R). -apply pos_ap_zero; apply pos_eight. +Proof. + apply pos_ap_zero; apply pos_eight. Qed. Lemma nine_ap_zero : Nine [#] (Zero:R). -apply pos_ap_zero; apply pos_nine. +Proof. + apply pos_ap_zero; apply pos_nine. Qed. Lemma twelve_ap_zero : Twelve [#] (Zero:R). -apply pos_ap_zero; apply pos_twelve. +Proof. + apply pos_ap_zero; apply pos_twelve. Qed. Lemma sixteen_ap_zero : Sixteen [#] (Zero:R). -apply pos_ap_zero; apply pos_sixteen. +Proof. + apply pos_ap_zero; apply pos_sixteen. Qed. Lemma eighteen_ap_zero : Eighteen [#] (Zero:R). -apply pos_ap_zero; apply pos_eighteen. +Proof. + apply pos_ap_zero; apply pos_eighteen. Qed. Lemma twentyfour_ap_zero : TwentyFour [#] (Zero:R). -apply pos_ap_zero; apply pos_twentyfour. +Proof. + apply pos_ap_zero; apply pos_twentyfour. Qed. Lemma fortyeight_ap_zero : FortyEight [#] (Zero:R). -apply pos_ap_zero; apply pos_fortyeight. +Proof. + apply pos_ap_zero; apply pos_fortyeight. Qed. End More_than_four. @@ -730,9 +799,10 @@ Section consequences_of_infinity. Variable F : COrdField. Lemma square_eq : forall x a : F, a [#] Zero -> x[^]2 [=] a[^]2 -> {x [=] a} + {x [=] [--]a}. -intros x a a_ H. -elim (cond_square_eq F x a); auto. -apply two_ap_zero. +Proof. + intros x a a_ H. + elim (cond_square_eq F x a); auto. + apply two_ap_zero. Qed. (** @@ -740,10 +810,11 @@ Ordered fields have characteristic zero. *) Lemma char0_OrdField : Char0 F. -unfold Char0 in |- *. -intros. -apply nring_ap_zero. -omega. +Proof. + unfold Char0 in |- *. + intros. + apply nring_ap_zero. + omega. Qed. End consequences_of_infinity. @@ -774,46 +845,51 @@ Section addition. *) Lemma plus_resp_less_lft : forall x y z : R, x [<] y -> z[+]x [<] z[+]y. -intros x y z H. -astepl (x[+]z). -astepr (y[+]z). -apply plus_resp_less_rht. -assumption. +Proof. + intros x y z H. + astepl (x[+]z). + astepr (y[+]z). + apply plus_resp_less_rht. + assumption. Qed. Lemma inv_resp_less : forall x y : R, x [<] y -> [--]y [<] [--]x. -intros x y H. -rstepl (x[+]([--]x[+][--]y)). -rstepr (y[+]([--]x[+][--]y)). -apply plus_resp_less_rht. -assumption. +Proof. + intros x y H. + rstepl (x[+]([--]x[+][--]y)). + rstepr (y[+]([--]x[+][--]y)). + apply plus_resp_less_rht. + assumption. Qed. Lemma minus_resp_less : forall x y z : R, x [<] y -> x[-]z [<] y[-]z. -Transparent cg_minus. -unfold cg_minus in |- *. -intros x y z H. -apply plus_resp_less_rht. -assumption. +Proof. + Transparent cg_minus. + unfold cg_minus in |- *. + intros x y z H. + apply plus_resp_less_rht. + assumption. Qed. Lemma minus_resp_less_rht : forall x y z : R, y [<] x -> z[-]x [<] z[-]y. -intros. -Transparent cg_minus. -unfold cg_minus in |- *. -apply plus_resp_less_lft. -apply inv_resp_less. -assumption. +Proof. + intros. + Transparent cg_minus. + unfold cg_minus in |- *. + apply plus_resp_less_lft. + apply inv_resp_less. + assumption. Qed. Lemma plus_resp_less_both : forall a b c d : R, a [<] b -> c [<] d -> a[+]c [<] b[+]d. -intros. -apply less_leEq_trans with (a[+]d). -apply plus_resp_less_lft. -assumption. -apply less_leEq. -apply plus_resp_less_rht. -assumption. +Proof. + intros. + apply less_leEq_trans with (a[+]d). + apply plus_resp_less_lft. + assumption. + apply less_leEq. + apply plus_resp_less_rht. + assumption. Qed. (** @@ -825,23 +901,25 @@ Cancellation laws *) Lemma plus_cancel_less : forall x y z : R, x[+]z [<] y[+]z -> x [<] y. -intros. -(* astepl (x[+]Zero). - astepl (x[+](z[+]([--] z))). *) -rstepl (x[+]z[+][--]z). -(* astepr (y[+]Zero). - astepr (y[+](z[+]([--] z))). *) -rstepr (y[+]z[+][--]z). -apply plus_resp_less_rht. -assumption. +Proof. + intros. + (* astepl (x[+]Zero). + astepl (x[+](z[+]([--] z))). *) + rstepl (x[+]z[+][--]z). + (* astepr (y[+]Zero). + astepr (y[+](z[+]([--] z))). *) + rstepr (y[+]z[+][--]z). + apply plus_resp_less_rht. + assumption. Qed. Lemma inv_cancel_less : forall x y : R, [--]x [<] [--]y -> y [<] x. -intros. -apply plus_cancel_less with ([--]x[-]y). -rstepl ([--]x). -rstepr ([--]y). -assumption. +Proof. + intros. + apply plus_cancel_less with ([--]x[-]y). + rstepl ([--]x). + rstepr ([--]y). + assumption. Qed. (** @@ -862,59 +940,67 @@ Coq%(see the Coq shortcoming in Section~\ref{section:setoid-basics})%. *) Lemma shift_less_plus : forall x y z : R, x[-]z [<] y -> x [<] y[+]z. -intros. -rstepl (x[-]z[+]z). -apply plus_resp_less_rht. -assumption. +Proof. + intros. + rstepl (x[-]z[+]z). + apply plus_resp_less_rht. + assumption. Qed. Lemma shift_less_plus' : forall x y z : R, x[-]y [<] z -> x [<] y[+]z. -intros. -astepr (z[+]y). -apply shift_less_plus. -assumption. +Proof. + intros. + astepr (z[+]y). + apply shift_less_plus. + assumption. Qed. Lemma shift_less_minus : forall x y z : R, x[+]z [<] y -> x [<] y[-]z. -intros. -rstepl (x[+]z[-]z). -apply minus_resp_less. -assumption. +Proof. + intros. + rstepl (x[+]z[-]z). + apply minus_resp_less. + assumption. Qed. Lemma shift_less_minus' : forall x y z : R, z[+]x [<] y -> x [<] y[-]z. -intros. -apply shift_less_minus. -astepl (z[+]x). -assumption. +Proof. + intros. + apply shift_less_minus. + astepl (z[+]x). + assumption. Qed. Lemma shift_plus_less : forall x y z : R, x [<] z[-]y -> x[+]y [<] z. -intros. -rstepr (z[-]y[+]y). -apply plus_resp_less_rht. -assumption. +Proof. + intros. + rstepr (z[-]y[+]y). + apply plus_resp_less_rht. + assumption. Qed. Lemma shift_plus_less' : forall x y z : R, y [<] z[-]x -> x[+]y [<] z. -intros. -astepl (y[+]x). -apply shift_plus_less. -assumption. +Proof. + intros. + astepl (y[+]x). + apply shift_plus_less. + assumption. Qed. Lemma shift_minus_less : forall x y z : R, x [<] z[+]y -> x[-]y [<] z. -intros. -astepr (z[+]y[-]y). -apply minus_resp_less. -assumption. +Proof. + intros. + astepr (z[+]y[-]y). + apply minus_resp_less. + assumption. Qed. Lemma shift_minus_less' : forall x y z : R, x [<] y[+]z -> x[-]y [<] z. -intros. -apply shift_minus_less. -astepr (y[+]z). -assumption. +Proof. + intros. + apply shift_minus_less. + astepr (y[+]z). + assumption. Qed. (** @@ -922,25 +1008,28 @@ Some special cases of laws for shifting. *) Lemma shift_zero_less_minus : forall x y : R, x [<] y -> Zero [<] y[-]x. -intros. -rstepl (x[-]x). -apply minus_resp_less. -assumption. +Proof. + intros. + rstepl (x[-]x). + apply minus_resp_less. + assumption. Qed. Lemma shift_zero_less_minus' : forall x y : R, Zero [<] y[-]x -> x [<] y. -intros. -apply plus_cancel_less with ([--]x). -rstepl (Zero:R). -assumption. +Proof. + intros. + apply plus_cancel_less with ([--]x). + rstepl (Zero:R). + assumption. Qed. Lemma qltone : forall q : R, q [<] One -> q[-]One [#] Zero. -intros. -apply less_imp_ap. -apply shift_minus_less. -astepr (One:R). -auto. +Proof. + intros. + apply less_imp_ap. + apply shift_minus_less. + astepr (One:R). + auto. Qed. End addition. @@ -962,107 +1051,122 @@ We do this to keep it easy to use such lemmas. *) Lemma mult_resp_less : forall x y z : R, x [<] y -> Zero [<] z -> x[*]z [<] y[*]z. -intros. -apply plus_cancel_less with ([--](x[*]z)). -astepl (Zero:R). -(* astepr ((y[*]z)[-](x[*]z)). *) -rstepr ((y[-]x)[*]z). -apply mult_resp_pos. -astepl (x[-]x). -apply minus_resp_less. -assumption. - -assumption. +Proof. + intros. + apply plus_cancel_less with ([--](x[*]z)). + astepl (Zero:R). + (* astepr ((y[*]z)[-](x[*]z)). *) + rstepr ((y[-]x)[*]z). + apply mult_resp_pos. + astepl (x[-]x). + apply minus_resp_less. + assumption. + assumption. Qed. Lemma recip_resp_pos : forall (y : R) y_, Zero [<] y -> Zero [<] (One[/] y[//]y_). -intros. -cut (Zero [<] (One[/] y[//]y_) or (One[/] y[//]y_) [<] Zero). -intros H0. elim H0; clear H0; intros H0. -auto. -elimtype False. -apply (less_irreflexive_unfolded R Zero). -eapply less_transitive_unfolded. -2: apply H0. -cut (One [<] (Zero:R)). intro H1. -elim (less_antisymmetric_unfolded _ _ _ (pos_one _) H1). -astepl ([--]([--]One:R)). astepr ([--](Zero:R)). -apply inv_resp_less. -rstepr (y[*][--](One[/] y[//]y_)). -apply mult_resp_pos. auto. -astepl ([--](Zero:R)). -apply inv_resp_less. auto. -apply ap_imp_less. -apply ap_symmetric_unfolded. apply div_resp_ap_zero_rev. -apply ring_non_triv. +Proof. + intros. + cut (Zero [<] (One[/] y[//]y_) or (One[/] y[//]y_) [<] Zero). + intros H0. elim H0; clear H0; intros H0. + auto. + elimtype False. + apply (less_irreflexive_unfolded R Zero). + eapply less_transitive_unfolded. + 2: apply H0. + cut (One [<] (Zero:R)). intro H1. + elim (less_antisymmetric_unfolded _ _ _ (pos_one _) H1). + astepl ([--]([--]One:R)). astepr ([--](Zero:R)). + apply inv_resp_less. + rstepr (y[*][--](One[/] y[//]y_)). + apply mult_resp_pos. auto. + astepl ([--](Zero:R)). + apply inv_resp_less. auto. + apply ap_imp_less. + apply ap_symmetric_unfolded. apply div_resp_ap_zero_rev. + apply ring_non_triv. Qed. Lemma div_resp_less_rht : forall (x y z : R) z_, x [<] y -> Zero [<] z -> (x[/] z[//]z_) [<] (y[/] z[//]z_). -intros. -rstepl (x[*](One[/] z[//]z_)). -rstepr (y[*](One[/] z[//]z_)). -apply mult_resp_less. auto. -apply recip_resp_pos. -auto. +Proof. + intros. + rstepl (x[*](One[/] z[//]z_)). + rstepr (y[*](One[/] z[//]z_)). + apply mult_resp_less. auto. + apply recip_resp_pos. + auto. Qed. Lemma div_resp_pos : forall (x y : R) x_, Zero [<] x -> Zero [<] y -> Zero [<] (y[/] x[//]x_). -intros. -astepl (Zero[/] x[//]x_). -apply div_resp_less_rht; auto. +Proof. + intros. + astepl (Zero[/] x[//]x_). + apply div_resp_less_rht; auto. Qed. Lemma mult_resp_less_lft : forall x y z : R, x [<] y -> Zero [<] z -> z[*]x [<] z[*]y. -intros. -astepl (x[*]z). -astepr (y[*]z). -apply mult_resp_less. -assumption. -assumption. +Proof. + intros. + astepl (x[*]z). + astepr (y[*]z). + apply mult_resp_less. + assumption. + assumption. Qed. Lemma mult_resp_less_both : forall x y u v : R, Zero [<=] x -> x [<] y -> Zero [<=] u -> u [<] v -> x[*]u [<] y[*]v. -cut (forall x y z : R, x [<=] y -> Zero [<=] z -> x[*]z [<=] y[*]z). -intro resp_leEq. -intros. -apply leEq_less_trans with (y[*]u). -apply resp_leEq; auto. -apply less_leEq; auto. -apply mult_resp_less_lft; auto. -apply leEq_less_trans with x; auto. - -(* Cut *) -intros x y z. -repeat rewrite leEq_def in |- *. -intros H H0 H1. -generalize (shift_zero_less_minus _ _ H1); intro H2. -cut (Zero [<] (x[-]y)[*]z). -intro H3. - 2: rstepr (x[*]z[-]y[*]z); auto. -cut - (forall a b : R, - Zero [<] a[*]b -> Zero [<] a and Zero [<] b or a [<] Zero and b [<] Zero). -intro H4. -generalize (H4 _ _ H3); intro H5. -elim H5; intro H6; elim H6; intros H7 H8. - apply H. - astepl (Zero[+]y). - apply shift_plus_less. - assumption. -apply H0. -assumption. - -intros a b H4. -generalize (Greater_imp_ap _ _ _ H4); intro H5. -generalize (mult_cancel_ap_zero_lft _ _ _ H5); intro H6. -generalize (mult_cancel_ap_zero_rht _ _ _ H5); intro H7. -elim (ap_imp_less _ _ _ H6); intro H8. - right. +Proof. + cut (forall x y z : R, x [<=] y -> Zero [<=] z -> x[*]z [<=] y[*]z). + intro resp_leEq. + intros. + apply leEq_less_trans with (y[*]u). + apply resp_leEq; auto. + apply less_leEq; auto. + apply mult_resp_less_lft; auto. + apply leEq_less_trans with x; auto. + (* Cut *) + intros x y z. + repeat rewrite leEq_def in |- *. + intros H H0 H1. + generalize (shift_zero_less_minus _ _ H1); intro H2. + cut (Zero [<] (x[-]y)[*]z). + intro H3. + 2: rstepr (x[*]z[-]y[*]z); auto. + cut (forall a b : R, Zero [<] a[*]b -> Zero [<] a and Zero [<] b or a [<] Zero and b [<] Zero). + intro H4. + generalize (H4 _ _ H3); intro H5. + elim H5; intro H6; elim H6; intros H7 H8. + apply H. + astepl (Zero[+]y). + apply shift_plus_less. + assumption. + apply H0. + assumption. + intros a b H4. + generalize (Greater_imp_ap _ _ _ H4); intro H5. + generalize (mult_cancel_ap_zero_lft _ _ _ H5); intro H6. + generalize (mult_cancel_ap_zero_rht _ _ _ H5); intro H7. + elim (ap_imp_less _ _ _ H6); intro H8. + right. + split; auto. + elim (ap_imp_less _ _ _ H7); auto. + intro H9. + elimtype False. + apply (less_irreflexive_unfolded R Zero). + apply less_leEq_trans with (a[*]b); auto. + apply less_leEq. + apply inv_cancel_less. + astepl (Zero:R). + astepr ([--]a[*]b). + apply mult_resp_pos; auto. + astepl ([--](Zero:R)). + apply inv_resp_less; auto. + left. split; auto. elim (ap_imp_less _ _ _ H7); auto. intro H9. @@ -1072,63 +1176,52 @@ elim (ap_imp_less _ _ _ H6); intro H8. apply less_leEq. apply inv_cancel_less. astepl (Zero:R). - astepr ([--]a[*]b). + astepr (a[*][--]b). apply mult_resp_pos; auto. astepl ([--](Zero:R)). apply inv_resp_less; auto. -left. -split; auto. -elim (ap_imp_less _ _ _ H7); auto. -intro H9. -elimtype False. -apply (less_irreflexive_unfolded R Zero). -apply less_leEq_trans with (a[*]b); auto. -apply less_leEq. -apply inv_cancel_less. -astepl (Zero:R). -astepr (a[*][--]b). -apply mult_resp_pos; auto. -astepl ([--](Zero:R)). -apply inv_resp_less; auto. Qed. Lemma recip_resp_less : forall (x y : R) x_ y_, Zero [<] x -> x [<] y -> (One[/] y[//]y_) [<] (One[/] x[//]x_). -intros. -cut (Zero [<] x[*]y). intro. -cut (x[*]y [#] Zero). intro H2. -rstepl (x[*](One[/] x[*]y[//]H2)). -rstepr (y[*](One[/] x[*]y[//]H2)). -apply mult_resp_less. auto. -apply recip_resp_pos. auto. -apply Greater_imp_ap. auto. -apply mult_resp_pos. auto. -apply less_leEq_trans with x; try apply less_leEq; auto. +Proof. + intros. + cut (Zero [<] x[*]y). intro. + cut (x[*]y [#] Zero). intro H2. + rstepl (x[*](One[/] x[*]y[//]H2)). + rstepr (y[*](One[/] x[*]y[//]H2)). + apply mult_resp_less. auto. + apply recip_resp_pos. auto. + apply Greater_imp_ap. auto. + apply mult_resp_pos. auto. + apply less_leEq_trans with x; try apply less_leEq; auto. Qed. Lemma div_resp_less : forall (x y z : R) z_, Zero [<] z -> x [<] y -> (x[/] z[//]z_) [<] (y[/] z[//]z_). -intros. -rstepl (x[*](One[/] z[//]z_)). -rstepr (y[*](One[/] z[//]z_)). -apply mult_resp_less. -assumption. -apply recip_resp_pos. -auto. +Proof. + intros. + rstepl (x[*](One[/] z[//]z_)). + rstepr (y[*](One[/] z[//]z_)). + apply mult_resp_less. + assumption. + apply recip_resp_pos. + auto. Qed. (** Cancellation laws *) Lemma mult_cancel_less : forall x y z : R, Zero [<] z -> x[*]z [<] y[*]z -> x [<] y. -intros x y z H H0. -generalize (Greater_imp_ap _ _ _ H); intro H1. -rstepl (x[*]z[*](One[/] z[//]H1)). -rstepr (y[*]z[*](One[/] z[//]H1)). -apply mult_resp_less. -assumption. -rstepl (Zero[/] z[//]H1). -apply div_resp_less_rht. -apply pos_one. -assumption. +Proof. + intros x y z H H0. + generalize (Greater_imp_ap _ _ _ H); intro H1. + rstepl (x[*]z[*](One[/] z[//]H1)). + rstepr (y[*]z[*](One[/] z[//]H1)). + apply mult_resp_less. + assumption. + rstepl (Zero[/] z[//]H1). + apply div_resp_less_rht. + apply pos_one. + assumption. Qed. (** @@ -1139,86 +1232,93 @@ on plus and minus.% *) Lemma shift_div_less : forall (x y z : R) y_, Zero [<] y -> x [<] z[*]y -> (x[/] y[//]y_) [<] z. -intros. -apply mult_cancel_less with y. auto. -astepl x. auto. +Proof. + intros. + apply mult_cancel_less with y. auto. + astepl x. auto. Qed. Lemma shift_div_less' : forall (x y z : R) y_, Zero [<] y -> x [<] y[*]z -> (x[/] y[//]y_) [<] z. -intros. -apply shift_div_less; auto. -astepr (y[*]z). auto. +Proof. + intros. + apply shift_div_less; auto. + astepr (y[*]z). auto. Qed. Lemma shift_less_div : forall (x y z : R) y_, Zero [<] y -> x[*]y [<] z -> x [<] (z[/] y[//]y_). -intros. -apply mult_cancel_less with y. auto. -astepr z. auto. +Proof. + intros. + apply mult_cancel_less with y. auto. + astepr z. auto. Qed. Lemma shift_less_mult : forall (x y z : R) z_, Zero [<] z -> (x[/] z[//]z_) [<] y -> x [<] y[*]z. -intros. -astepl ((x[/] z[//]z_)[*]z). -apply mult_resp_less; auto. +Proof. + intros. + astepl ((x[/] z[//]z_)[*]z). + apply mult_resp_less; auto. Qed. Lemma shift_less_mult' : forall (x y z : R) y_, Zero [<] y -> (x[/] y[//]y_) [<] z -> x [<] y[*]z. -intros. -astepl (y[*](x[/] y[//]y_)). -apply mult_resp_less_lft; auto. +Proof. + intros. + astepl (y[*](x[/] y[//]y_)). + apply mult_resp_less_lft; auto. Qed. Lemma shift_mult_less : forall (x y z : R) y_, Zero [<] y -> x [<] (z[/] y[//]y_) -> x[*]y [<] z. -intros. -astepr ((z[/] y[//]y_)[*]y). -apply mult_resp_less; auto. +Proof. + intros. + astepr ((z[/] y[//]y_)[*]y). + apply mult_resp_less; auto. Qed. (** Other properties of multiplication and division *) Lemma minusOne_less : forall x : R, x[-]One [<] x. -intros; apply shift_minus_less; apply less_plusOne. +Proof. + intros; apply shift_minus_less; apply less_plusOne. Qed. Lemma swap_div : forall (x y z : R) y_ z_, Zero [<] y -> Zero [<] z -> (x[/] z[//]z_) [<] y -> (x[/] y[//]y_) [<] z. -intros. -rstepl ((x[/] z[//]z_)[*](z[/] y[//]y_)). -astepr (y[*](z[/] y[//]y_)). -apply mult_resp_less. auto. -apply div_resp_pos; auto. +Proof. + intros. + rstepl ((x[/] z[//]z_)[*](z[/] y[//]y_)). + astepr (y[*](z[/] y[//]y_)). + apply mult_resp_less. auto. + apply div_resp_pos; auto. Qed. Lemma eps_div_less_eps : forall (eps d : R) d_, Zero [<] eps -> One [<] d -> (eps[/] d[//]d_) [<] eps. -intros. -apply shift_div_less'. -apply leEq_less_trans with (One:R). -apply less_leEq; apply pos_one. - -assumption. - -astepl (One[*]eps). -apply mult_resp_less. -assumption. - -assumption. +Proof. + intros. + apply shift_div_less'. + apply leEq_less_trans with (One:R). + apply less_leEq; apply pos_one. + assumption. + astepl (One[*]eps). + apply mult_resp_less. + assumption. + assumption. Qed. Lemma pos_div_two : forall eps : R, Zero [<] eps -> Zero [<] eps [/]TwoNZ. -intros. -apply shift_less_div. -apply pos_two. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_two. + astepl (Zero:R). + assumption. Qed. Lemma pos_div_two' : forall eps : R, Zero [<] eps -> eps [/]TwoNZ [<] eps. -intros. -apply plus_cancel_less with ([--](eps [/]TwoNZ)). -astepl (Zero:R). -rstepr (eps [/]TwoNZ). -apply pos_div_two; assumption. +Proof. + intros. + apply plus_cancel_less with ([--](eps [/]TwoNZ)). + astepl (Zero:R). + rstepr (eps [/]TwoNZ). + apply pos_div_two; assumption. Qed. (* @@ -1231,110 +1331,114 @@ Qed. *) Lemma pos_div_three : forall eps : R, Zero [<] eps -> Zero [<] eps [/]ThreeNZ. -intros. -apply mult_cancel_less with (Three:R). -apply pos_three. -astepl (Zero:R); rstepr eps. -assumption. +Proof. + intros. + apply mult_cancel_less with (Three:R). + apply pos_three. + astepl (Zero:R); rstepr eps. + assumption. Qed. Lemma pos_div_three' : forall eps : R, Zero [<] eps -> eps [/]ThreeNZ [<] eps. -intros. -apply mult_cancel_less with (Three:R). -apply pos_three. -rstepl (eps[+]Zero); rstepr (eps[+]Two[*]eps). -apply plus_resp_less_lft. -apply mult_resp_pos; auto. -apply pos_two. +Proof. + intros. + apply mult_cancel_less with (Three:R). + apply pos_three. + rstepl (eps[+]Zero); rstepr (eps[+]Two[*]eps). + apply plus_resp_less_lft. + apply mult_resp_pos; auto. + apply pos_two. Qed. Lemma pos_div_four : forall eps : R, Zero [<] eps -> Zero [<] eps [/]FourNZ. -intros. -rstepr ((eps [/]TwoNZ) [/]TwoNZ). -apply pos_div_two; apply pos_div_two; assumption. +Proof. + intros. + rstepr ((eps [/]TwoNZ) [/]TwoNZ). + apply pos_div_two; apply pos_div_two; assumption. Qed. Lemma pos_div_four' : forall eps : R, Zero [<] eps -> eps [/]FourNZ [<] eps. -intros. -rstepl ((eps [/]TwoNZ) [/]TwoNZ). -apply leEq_less_trans with (eps [/]TwoNZ). -2: apply pos_div_two'; assumption. -apply less_leEq. -apply pos_div_two'. -apply pos_div_two. -assumption. +Proof. + intros. + rstepl ((eps [/]TwoNZ) [/]TwoNZ). + apply leEq_less_trans with (eps [/]TwoNZ). + 2: apply pos_div_two'; assumption. + apply less_leEq. + apply pos_div_two'. + apply pos_div_two. + assumption. Qed. Lemma pos_div_six : forall eps : R, Zero [<] eps -> Zero [<] eps [/]SixNZ. -intros. -apply shift_less_div. -apply pos_six. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_six. + astepl (Zero:R). + assumption. Qed. Lemma pos_div_eight : forall eps : R, Zero [<] eps -> Zero [<] eps [/]EightNZ. -intros. -apply shift_less_div. -apply pos_eight. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_eight. + astepl (Zero:R). + assumption. Qed. Lemma pos_div_nine : forall eps : R, Zero [<] eps -> Zero [<] eps [/]NineNZ. -intros. -apply shift_less_div. -apply pos_nine. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_nine. + astepl (Zero:R). + assumption. Qed. Lemma pos_div_twelve : forall eps : R, Zero [<] eps -> Zero [<] eps [/]TwelveNZ. -intros. -apply shift_less_div. -apply pos_twelve. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_twelve. + astepl (Zero:R). + assumption. Qed. Lemma pos_div_sixteen : forall eps : R, Zero [<] eps -> Zero [<] eps [/]SixteenNZ. -intros. -apply shift_less_div. -apply pos_sixteen. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_sixteen. + astepl (Zero:R). + assumption. Qed. Lemma pos_div_eighteen : forall eps : R, Zero [<] eps -> Zero [<] eps [/]EighteenNZ. -intros. -apply shift_less_div. -apply pos_eighteen. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_eighteen. + astepl (Zero:R). + assumption. Qed. Lemma pos_div_twentyfour : forall eps : R, Zero [<] eps -> Zero [<] eps [/]TwentyFourNZ. -intros. -apply shift_less_div. -apply pos_twentyfour. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_twentyfour. + astepl (Zero:R). + assumption. Qed. Lemma pos_div_fortyeight : forall eps : R, Zero [<] eps -> Zero [<] eps [/]FortyEightNZ. -intros. -apply shift_less_div. -apply pos_fortyeight. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_fortyeight. + astepl (Zero:R). + assumption. Qed. End multiplication. @@ -1346,187 +1450,191 @@ Section misc. *) Lemma nring_pos : forall m : nat, 0 < m -> Zero [<] nring (R:=R) m. -intro m. elim m. -intro; elim (lt_irrefl 0 H). -clear m; intros. -apply leEq_less_trans with (nring (R:=R) n). -astepl (nring (R:=R) 0). -apply nring_leEq; auto with arith. -simpl in |- *; apply less_plusOne. +Proof. + intro m. elim m. + intro; elim (lt_irrefl 0 H). + clear m; intros. + apply leEq_less_trans with (nring (R:=R) n). + astepl (nring (R:=R) 0). + apply nring_leEq; auto with arith. + simpl in |- *; apply less_plusOne. Qed. Lemma less_nring : forall n m : nat, nring (R:=R) n [<] nring m -> n < m. -intro n; induction n as [| n Hrecn]. -intros m H. -induction m as [| m Hrecm]. -elimtype False; generalize H; apply less_irreflexive_unfolded. -auto with arith. -intros m H. -induction m as [| m Hrecm]. -elimtype False. -cut (nring (R:=R) 0 [<] nring (S n)). -apply less_antisymmetric_unfolded; assumption. -apply nring_less; auto with arith. -cut (n < m). -auto with arith. -apply Hrecn. -rstepr (nring (R:=R) m[+]One[-]One). -apply shift_less_minus. -apply H. +Proof. + intro n; induction n as [| n Hrecn]. + intros m H. + induction m as [| m Hrecm]. + elimtype False; generalize H; apply less_irreflexive_unfolded. + auto with arith. + intros m H. + induction m as [| m Hrecm]. + elimtype False. + cut (nring (R:=R) 0 [<] nring (S n)). + apply less_antisymmetric_unfolded; assumption. + apply nring_less; auto with arith. + cut (n < m). + auto with arith. + apply Hrecn. + rstepr (nring (R:=R) m[+]One[-]One). + apply shift_less_minus. + apply H. Qed. Lemma pos_nring_fac : forall n : nat, Zero [<] nring (R:=R) (fac n). -intro. -astepl (nring (R:=R) 0). -apply nring_less. -apply nat_fac_gtzero. +Proof. + intro. + astepl (nring (R:=R) 0). + apply nring_less. + apply nat_fac_gtzero. Qed. Lemma Smallest_less_Average : forall a b : R, a [<] b -> a [<] (a[+]b) [/]TwoNZ. -intros. -apply shift_less_div. -apply pos_two. -rstepl (a[+]a). -apply plus_resp_less_lft. -assumption. +Proof. + intros. + apply shift_less_div. + apply pos_two. + rstepl (a[+]a). + apply plus_resp_less_lft. + assumption. Qed. Lemma Average_less_Greatest : forall a b : R, a [<] b -> (a[+]b) [/]TwoNZ [<] b. -intros. -apply shift_div_less'. -apply pos_two. -rstepr (b[+]b). -apply plus_resp_less_rht. -assumption. +Proof. + intros. + apply shift_div_less'. + apply pos_two. + rstepr (b[+]b). + apply plus_resp_less_rht. + assumption. Qed. Lemma Sum_resp_less : forall (f g : nat -> R) a b, a <= b -> (forall i, a <= i -> i <= b -> f i [<] g i) -> Sum a b f [<] Sum a b g. -intros. -induction b as [| b Hrecb]; intros. -replace a with 0. -astepl (f 0). astepr (g 0). -auto. -inversion H. auto. -elim (le_lt_eq_dec _ _ H); intro H1. -apply less_wdl with (Sum a b f[+]f (S b)). -apply less_wdr with (Sum a b g[+]g (S b)). -apply plus_resp_less_both. -apply Hrecb. auto with arith. auto. -apply X; auto. -apply eq_symmetric_unfolded. apply Sum_last. -apply eq_symmetric_unfolded. apply Sum_last. -rewrite H1. -astepl (f (S b)). -astepr (g (S b)). -apply X; auto. +Proof. + intros. + induction b as [| b Hrecb]; intros. + replace a with 0. + astepl (f 0). astepr (g 0). + auto. + inversion H. auto. + elim (le_lt_eq_dec _ _ H); intro H1. + apply less_wdl with (Sum a b f[+]f (S b)). + apply less_wdr with (Sum a b g[+]g (S b)). + apply plus_resp_less_both. + apply Hrecb. auto with arith. auto. + apply X; auto. + apply eq_symmetric_unfolded. apply Sum_last. + apply eq_symmetric_unfolded. apply Sum_last. + rewrite H1. + astepl (f (S b)). + astepr (g (S b)). + apply X; auto. Qed. Lemma Sumx_resp_less : forall n, 0 < n -> forall f g : forall i, i < n -> R, (forall i H, f i H [<] g i H) -> Sumx f [<] Sumx g. -simple induction n. -intros; simpl in |- *; elimtype False; inversion H. -simple induction n0. -intros. -clear H. -simpl in |- *; apply plus_resp_less_lft. -apply X0. -intros. -simpl in |- *. -apply plus_resp_less_both. -astepl (Sumx (fun (i : nat) (l : i < S n1) => f i (lt_S _ _ l))). -astepr (Sumx (fun (i : nat) (l : i < S n1) => g i (lt_S _ _ l))). -apply X0. -auto with arith. -intros. apply X1. -apply X1. +Proof. + simple induction n. + intros; simpl in |- *; elimtype False; inversion H. + simple induction n0. + intros. + clear H. + simpl in |- *; apply plus_resp_less_lft. + apply X0. + intros. + simpl in |- *. + apply plus_resp_less_both. + astepl (Sumx (fun (i : nat) (l : i < S n1) => f i (lt_S _ _ l))). + astepr (Sumx (fun (i : nat) (l : i < S n1) => g i (lt_S _ _ l))). + apply X0. + auto with arith. + intros. apply X1. + apply X1. Qed. Lemma positive_Sum_two : forall x y : R, Zero [<] x[+]y -> Zero [<] x or Zero [<] y. -intros. -cut ([--]x [<] Zero or Zero [<] y). -intro; inversion_clear X0. -left; astepl ([--](Zero:R)); astepr ([--][--]x); apply inv_resp_less; - assumption. -right; assumption. -apply less_cotransitive_unfolded. -astepl (Zero[-]x); apply shift_minus_less'; assumption. +Proof. + intros. + cut ([--]x [<] Zero or Zero [<] y). + intro; inversion_clear X0. + left; astepl ([--](Zero:R)); astepr ([--][--]x); apply inv_resp_less; assumption. + right; assumption. + apply less_cotransitive_unfolded. + astepl (Zero[-]x); apply shift_minus_less'; assumption. Qed. Lemma positive_Sumx : forall n (f : forall i, i < n -> R), nat_less_n_fun f -> Zero [<] Sumx f -> {i : nat | {H : i < n | Zero [<] f i H}}. -simple induction n. -simpl in |- *. -intros; elimtype False; generalize X; apply less_irreflexive_unfolded. -simple induction n0. -simpl in |- *. -intros. -exists 0. -exists (lt_n_Sn 0). -eapply less_wdr. -apply X0. -astepl (f _ (lt_n_Sn 0)). -apply H; auto. -simpl in |- *; intros. -clear X. -cut - (Zero [<] f _ (lt_n_Sn (S n1)) - or Zero [<] - Sumx (fun (i : nat) (l : i < n1) => f i (lt_S i (S n1) (lt_S i n1 l)))[+] +Proof. + simple induction n. + simpl in |- *. + intros; elimtype False; generalize X; apply less_irreflexive_unfolded. + simple induction n0. + simpl in |- *. + intros. + exists 0. + exists (lt_n_Sn 0). + eapply less_wdr. + apply X0. + astepl (f _ (lt_n_Sn 0)). + apply H; auto. + simpl in |- *; intros. + clear X. + cut (Zero [<] f _ (lt_n_Sn (S n1)) or Zero [<] + Sumx (fun (i : nat) (l : i < n1) => f i (lt_S i (S n1) (lt_S i n1 l)))[+] f n1 (lt_S n1 (S n1) (lt_n_Sn n1))). -intro X. inversion_clear X. -exists (S n1). -exists (lt_n_Sn (S n1)). -eapply less_wdr. -apply X2. -apply H; auto. -set (f' := fun (i : nat) (H : i < S n1) => f i (lt_S _ _ H)) in *. -cut {i : nat | {H : i < S n1 | Zero [<] f' i H}}; intros. -elim X; intros i Hi; elim Hi; clear X2 Hi; intros Hi Hi'. -exists i. -exists (lt_S _ _ Hi). -eapply less_wdr. -apply Hi'. -unfold f' in |- *; simpl in |- *. -apply H; auto. -apply X0. -red in |- *. intros i j Hij. rewrite Hij. unfold f' in |- *. -intros H0 H'. -apply H; auto. -apply X2; assumption. -apply positive_Sum_two. -eapply less_wdr. -2: apply cag_commutes_unfolded. -assumption. + intro X. inversion_clear X. + exists (S n1). + exists (lt_n_Sn (S n1)). + eapply less_wdr. + apply X2. + apply H; auto. + set (f' := fun (i : nat) (H : i < S n1) => f i (lt_S _ _ H)) in *. + cut {i : nat | {H : i < S n1 | Zero [<] f' i H}}; intros. + elim X; intros i Hi; elim Hi; clear X2 Hi; intros Hi Hi'. + exists i. + exists (lt_S _ _ Hi). + eapply less_wdr. + apply Hi'. + unfold f' in |- *; simpl in |- *. + apply H; auto. + apply X0. + red in |- *. intros i j Hij. rewrite Hij. unfold f' in |- *. + intros H0 H'. + apply H; auto. + apply X2; assumption. + apply positive_Sum_two. + eapply less_wdr. + 2: apply cag_commutes_unfolded. + assumption. Qed. Lemma negative_Sumx : forall n (f : forall i, i < n -> R), nat_less_n_fun f -> Sumx f [<] Zero -> {i : nat | {H : i < n | f i H [<] Zero}}. -intros. -cut {i : nat | {H : i < n | Zero [<] [--](f i H)}}. -intro H1. -elim H1; intros i Hi; elim Hi; clear X Hi; intros Hi Hi'. -exists i; exists Hi. -astepl ([--][--](f i Hi)); astepr ([--](Zero:R)); apply inv_resp_less; - assumption. -apply positive_Sumx with (f := fun (i : nat) (H : i < n) => [--](f i H)). -red in |- *; intros. -apply un_op_wd_unfolded; apply H; assumption. -astepl ([--](Zero:R)); apply less_wdr with ([--](Sumx f)). -apply inv_resp_less; assumption. -generalize f H; clear X H f. -induction n as [| n Hrecn]. -simpl in |- *. -intros; algebra. -intros. -simpl in |- *. -rstepl - ([--](Sumx (fun (i : nat) (l : i < n) => f i (lt_S i n l)))[+] - [--](f n (lt_n_Sn n))). -apply bin_op_wd_unfolded. -2: algebra. -apply Hrecn with (f := fun (i : nat) (l : i < n) => f i (lt_S i n l)). -red in |- *; intros; apply H; auto. +Proof. + intros. + cut {i : nat | {H : i < n | Zero [<] [--](f i H)}}. + intro H1. + elim H1; intros i Hi; elim Hi; clear X Hi; intros Hi Hi'. + exists i; exists Hi. + astepl ([--][--](f i Hi)); astepr ([--](Zero:R)); apply inv_resp_less; assumption. + apply positive_Sumx with (f := fun (i : nat) (H : i < n) => [--](f i H)). + red in |- *; intros. + apply un_op_wd_unfolded; apply H; assumption. + astepl ([--](Zero:R)); apply less_wdr with ([--](Sumx f)). + apply inv_resp_less; assumption. + generalize f H; clear X H f. + induction n as [| n Hrecn]. + simpl in |- *. + intros; algebra. + intros. + simpl in |- *. + rstepl ([--](Sumx (fun (i : nat) (l : i < n) => f i (lt_S i n l)))[+] [--](f n (lt_n_Sn n))). + apply bin_op_wd_unfolded. + 2: algebra. + apply Hrecn with (f := fun (i : nat) (l : i < n) => f i (lt_S i n l)). + red in |- *; intros; apply H; auto. Qed. End misc. @@ -1534,12 +1642,13 @@ End misc. End Properties_of_Ordering. Add Parametric Morphism c : (@cof_leEq c) with signature (@cs_eq (cof_crr c)) ==> (@cs_eq c) ==> iff as cof_leEq_wd. -intros x1 x2 Hx y1 y2 Hy. -split; intros. -stepl x1 by assumption. -stepr y1 by assumption. -assumption. -stepl x2 by symmetry;assumption. -stepr y2 by symmetry;assumption. -assumption. +Proof. + intros x1 x2 Hx y1 y2 Hy. + split; intros. + stepl x1 by assumption. + stepr y1 by assumption. + assumption. + stepl x2 by symmetry;assumption. + stepr y2 by symmetry;assumption. + assumption. Qed. diff --git a/algebra/COrdFields2.v b/algebra/COrdFields2.v index cbb209efe..dc32aa6d0 100644 --- a/algebra/COrdFields2.v +++ b/algebra/COrdFields2.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export COrdFields. (** printing one_div_succ %\ensuremath{\frac1{\cdot+1}}% *) @@ -56,97 +56,109 @@ Section addition. *) Lemma plus_resp_leEq : forall x y z : R, x [<=] y -> x[+]z [<=] y[+]z. -intros x y z. -do 2 rewrite leEq_def. -intros. intro. -apply H. -apply (plus_cancel_less _ _ _ _ X). +Proof. + intros x y z. + do 2 rewrite leEq_def. + intros. intro. + apply H. + apply (plus_cancel_less _ _ _ _ X). Qed. Lemma plus_resp_leEq_lft : forall x y z : R, x [<=] y -> z[+]x [<=] z[+]y. -intros. -astepl (x[+]z). -astepr (y[+]z). -apply plus_resp_leEq; auto. +Proof. + intros. + astepl (x[+]z). + astepr (y[+]z). + apply plus_resp_leEq; auto. Qed. Lemma minus_resp_leEq : forall x y z : R, x [<=] y -> x[-]z [<=] y[-]z. -intros. -astepl (x[+][--]z). -astepr (y[+][--]z). -apply plus_resp_leEq; auto. +Proof. + intros. + astepl (x[+][--]z). + astepr (y[+][--]z). + apply plus_resp_leEq; auto. Qed. Lemma inv_resp_leEq : forall x y : R, x [<=] y -> [--]y [<=] [--]x. -intros x y. -repeat rewrite leEq_def. -do 2 intro. -apply H. -apply inv_cancel_less. -assumption. +Proof. + intros x y. + repeat rewrite leEq_def. + do 2 intro. + apply H. + apply inv_cancel_less. + assumption. Qed. Lemma minus_resp_leEq_rht : forall x y z : R, y [<=] x -> z[-]x [<=] z[-]y. -intros. -Transparent cg_minus. -unfold cg_minus in |- *. -apply plus_resp_leEq_lft. -apply inv_resp_leEq. -assumption. +Proof. + intros. + Transparent cg_minus. + unfold cg_minus in |- *. + apply plus_resp_leEq_lft. + apply inv_resp_leEq. + assumption. Qed. Lemma plus_resp_leEq_both : forall x y a b : R, x [<=] y -> a [<=] b -> x[+]a [<=] y[+]b. +Proof. intros. apply leEq_transitive with (y := x[+]b). - rstepl (a[+]x). - rstepr (b[+]x). - apply plus_resp_leEq. - assumption. + rstepl (a[+]x). + rstepr (b[+]x). + apply plus_resp_leEq. + assumption. apply plus_resp_leEq. assumption. Qed. Lemma plus_resp_less_leEq : forall a b c d : R, a [<] b -> c [<=] d -> a[+]c [<] b[+]d. -intros. -apply leEq_less_trans with (a[+]d). -apply plus_resp_leEq_lft. auto. -apply plus_resp_less_rht. auto. +Proof. + intros. + apply leEq_less_trans with (a[+]d). + apply plus_resp_leEq_lft. auto. + apply plus_resp_less_rht. auto. Qed. Lemma plus_resp_leEq_less : forall a b c d : R, a [<=] b -> c [<] d -> a[+]c [<] b[+]d. -intros. -astepl (c[+]a). -astepr (d[+]b). -apply plus_resp_less_leEq; auto. +Proof. + intros. + astepl (c[+]a). + astepr (d[+]b). + apply plus_resp_less_leEq; auto. Qed. Lemma plus_resp_nonneg : forall x y : R, Zero [<=] x -> Zero [<=] y -> Zero [<=] x[+]y. -intros. -astepl (Zero[+]Zero:R). -apply plus_resp_leEq_both; auto. +Proof. + intros. + astepl (Zero[+]Zero:R). + apply plus_resp_leEq_both; auto. Qed. Lemma minus_resp_less_leEq : forall x y x' y' : R, x [<=] y -> y' [<] x' -> x[-]x' [<] y[-]y'. -intros. -astepl (x[+][--]x'). -astepr (y[+][--]y'). -apply plus_resp_leEq_less. -auto. -apply inv_resp_less. auto. +Proof. + intros. + astepl (x[+][--]x'). + astepr (y[+][--]y'). + apply plus_resp_leEq_less. + auto. + apply inv_resp_less. auto. Qed. Lemma minus_resp_leEq_both : forall x y x' y' : R, x [<=] y -> y' [<=] x' -> x[-]x' [<=] y[-]y'. -intros. -astepl (x[+][--]x'). -astepr (y[+][--]y'). -apply plus_resp_leEq_both. auto. -apply inv_resp_leEq. auto. +Proof. + intros. + astepl (x[+][--]x'). + astepr (y[+][--]y'). + apply plus_resp_leEq_both. auto. + apply inv_resp_leEq. auto. Qed. (** Cancellation properties *) Lemma plus_cancel_leEq_rht : forall x y z : R, x[+]z [<=] y[+]z -> x [<=] y. +Proof. intros. rstepl (x[+]z[+][--]z). rstepr (y[+]z[+][--]z). @@ -155,6 +167,7 @@ Lemma plus_cancel_leEq_rht : forall x y z : R, x[+]z [<=] y[+]z -> x [<=] y. Qed. Lemma inv_cancel_leEq : forall x y : R, [--]y [<=] [--]x -> x [<=] y. +Proof. intros. rstepl ([--][--]x). rstepr ([--][--]y). @@ -166,78 +179,89 @@ Qed. *) Lemma shift_plus_leEq : forall a b c : R, a [<=] c[-]b -> a[+]b [<=] c. -intros. -rstepr (c[-]b[+]b). -apply plus_resp_leEq. -assumption. +Proof. + intros. + rstepr (c[-]b[+]b). + apply plus_resp_leEq. + assumption. Qed. Lemma shift_leEq_plus : forall a b c : R, a[-]b [<=] c -> a [<=] c[+]b. -intros. -rstepl (a[-]b[+]b). -apply plus_resp_leEq. -assumption. +Proof. + intros. + rstepl (a[-]b[+]b). + apply plus_resp_leEq. + assumption. Qed. Lemma shift_plus_leEq' : forall a b c : R, b [<=] c[-]a -> a[+]b [<=] c. -intros. -rstepr (a[+] (c[-]a)). -apply plus_resp_leEq_lft. -assumption. +Proof. + intros. + rstepr (a[+] (c[-]a)). + apply plus_resp_leEq_lft. + assumption. Qed. Lemma shift_leEq_plus' : forall a b c : R, a[-]b [<=] c -> a [<=] b[+]c. -intros. -rstepl (b[+] (a[-]b)). -apply plus_resp_leEq_lft. auto. +Proof. + intros. + rstepl (b[+] (a[-]b)). + apply plus_resp_leEq_lft. auto. Qed. Lemma shift_leEq_rht : forall a b : R, Zero [<=] b[-]a -> a [<=] b. -intros. -astepl (Zero[+]a). -rstepr (b[-]a[+]a). -apply plus_resp_leEq. auto. +Proof. + intros. + astepl (Zero[+]a). + rstepr (b[-]a[+]a). + apply plus_resp_leEq. auto. Qed. Lemma shift_leEq_lft : forall a b : R, a [<=] b -> Zero [<=] b[-]a. -intros. -astepl (a[-]a). -apply minus_resp_leEq. auto. +Proof. + intros. + astepl (a[-]a). + apply minus_resp_leEq. auto. Qed. Lemma shift_minus_leEq : forall a b c : R, a [<=] c[+]b -> a[-]b [<=] c. -intros. -rstepr (c[+]b[-]b). -apply minus_resp_leEq. -assumption. +Proof. + intros. + rstepr (c[+]b[-]b). + apply minus_resp_leEq. + assumption. Qed. Lemma shift_leEq_minus : forall a b c : R, a[+]c [<=] b -> a [<=] b[-]c. -intros. -rstepl (a[+]c[-]c). -apply minus_resp_leEq. -assumption. +Proof. + intros. + rstepl (a[+]c[-]c). + apply minus_resp_leEq. + assumption. Qed. Lemma shift_leEq_minus' : forall a b c : R, c[+]a [<=] b -> a [<=] b[-]c. -intros. -rstepl (c[+]a[-]c). -apply minus_resp_leEq. -assumption. +Proof. + intros. + rstepl (c[+]a[-]c). + apply minus_resp_leEq. + assumption. Qed. Lemma shift_zero_leEq_minus : forall x y : R, x [<=] y -> Zero [<=] y[-]x. -intros. -rstepl (x[-]x). -apply minus_resp_leEq. -assumption. +Proof. + intros. + rstepl (x[-]x). + apply minus_resp_leEq. + assumption. Qed. Lemma shift_zero_leEq_minus' : forall x y : R, Zero [<=] y[-]x -> x [<=] y. -intros. -apply plus_cancel_leEq_rht with ([--]x). -rstepl (Zero:R). -assumption. +Proof. + intros. + apply plus_cancel_leEq_rht with ([--]x). + rstepl (Zero:R). + assumption. Qed. End addition. @@ -250,115 +274,117 @@ Multiplication and division respect [[<=]] *) Lemma mult_resp_leEq_rht : forall x y z : R, x [<=] y -> Zero [<=] z -> x[*]z [<=] y[*]z. -intros x y z . -repeat rewrite leEq_def. -intros H H0 H1. -generalize (shift_zero_less_minus _ _ _ H1); intro H2. -cut (Zero [<] (x[-]y) [*]z). -intro H3. -2: rstepr (x[*]z[-]y[*]z). -2: assumption. -cut - (forall a b : R, - Zero [<] a[*]b -> Zero [<] a and Zero [<] b or a [<] Zero and b [<] Zero). -intro H4. -generalize (H4 _ _ H3); intro H5. -elim H5; intro H6. -elim H6; intros. -elim H. -astepl (Zero[+]y). -apply shift_plus_less. -assumption. -elim H6; intros. -elim H0. -assumption. - -intros a b H4. -generalize (Greater_imp_ap _ _ _ H4); intro H5. -generalize (mult_cancel_ap_zero_lft _ _ _ H5); intro H6. -generalize (mult_cancel_ap_zero_rht _ _ _ H5); intro H7. -elim (ap_imp_less _ _ _ H6); intro H8. -right. -split. -assumption. -elim (ap_imp_less _ _ _ H7); intro H9. -assumption. -elimtype False. -elim (less_irreflexive_unfolded R Zero). -apply less_leEq_trans with (a[*]b). -assumption. -apply less_leEq. -apply inv_cancel_less. -astepl (Zero:R). -astepr ([--]a[*]b). -apply mult_resp_pos. -astepl ([--](Zero:R)). -apply inv_resp_less. -assumption. -assumption. -left. -split. -assumption. -elim (ap_imp_less _ _ _ H7); intro H9. -elimtype False. -elim (less_irreflexive_unfolded R Zero). -apply less_leEq_trans with (a[*]b). -assumption. -apply less_leEq. -apply inv_cancel_less. -astepl (Zero:R). -astepr (a[*][--]b). -apply mult_resp_pos. -assumption. -astepl ([--](Zero:R)). -apply inv_resp_less. -assumption. -assumption. +Proof. + intros x y z . + repeat rewrite leEq_def. + intros H H0 H1. + generalize (shift_zero_less_minus _ _ _ H1); intro H2. + cut (Zero [<] (x[-]y) [*]z). + intro H3. + 2: rstepr (x[*]z[-]y[*]z). + 2: assumption. + cut (forall a b : R, Zero [<] a[*]b -> Zero [<] a and Zero [<] b or a [<] Zero and b [<] Zero). + intro H4. + generalize (H4 _ _ H3); intro H5. + elim H5; intro H6. + elim H6; intros. + elim H. + astepl (Zero[+]y). + apply shift_plus_less. + assumption. + elim H6; intros. + elim H0. + assumption. + intros a b H4. + generalize (Greater_imp_ap _ _ _ H4); intro H5. + generalize (mult_cancel_ap_zero_lft _ _ _ H5); intro H6. + generalize (mult_cancel_ap_zero_rht _ _ _ H5); intro H7. + elim (ap_imp_less _ _ _ H6); intro H8. + right. + split. + assumption. + elim (ap_imp_less _ _ _ H7); intro H9. + assumption. + elimtype False. + elim (less_irreflexive_unfolded R Zero). + apply less_leEq_trans with (a[*]b). + assumption. + apply less_leEq. + apply inv_cancel_less. + astepl (Zero:R). + astepr ([--]a[*]b). + apply mult_resp_pos. + astepl ([--](Zero:R)). + apply inv_resp_less. + assumption. + assumption. + left. + split. + assumption. + elim (ap_imp_less _ _ _ H7); intro H9. + elimtype False. + elim (less_irreflexive_unfolded R Zero). + apply less_leEq_trans with (a[*]b). + assumption. + apply less_leEq. + apply inv_cancel_less. + astepl (Zero:R). + astepr (a[*][--]b). + apply mult_resp_pos. + assumption. + astepl ([--](Zero:R)). + apply inv_resp_less. + assumption. + assumption. Qed. Lemma mult_resp_leEq_lft : forall x y z : R, x [<=] y -> Zero [<=] z -> z[*]x [<=] z[*]y. -intros. -astepl (x[*]z). -astepr (y[*]z). -apply mult_resp_leEq_rht. -assumption. -assumption. +Proof. + intros. + astepl (x[*]z). + astepr (y[*]z). + apply mult_resp_leEq_rht. + assumption. + assumption. Qed. Lemma mult_resp_leEq_both : forall x x' y y' : R, Zero [<=] x -> Zero [<=] y -> x [<=] x' -> y [<=] y' -> x[*]y [<=] x'[*]y'. -intros. -apply leEq_transitive with (x[*]y'). -apply mult_resp_leEq_lft; assumption. -apply mult_resp_leEq_rht. -assumption. -apply leEq_transitive with y; assumption. +Proof. + intros. + apply leEq_transitive with (x[*]y'). + apply mult_resp_leEq_lft; assumption. + apply mult_resp_leEq_rht. + assumption. + apply leEq_transitive with y; assumption. Qed. Lemma recip_resp_leEq : forall (x y : R) x_ y_, Zero [<] y -> y [<=] x -> (One[/] x[//]x_) [<=] (One[/] y[//]y_). -intros x y x_ y_ H. -do 2 rewrite leEq_def. -intros H0 H1. apply H0. -cut ((One[/] x[//]x_) [#] Zero). intro x'_. -cut ((One[/] y[//]y_) [#] Zero). intro y'_. -rstepl (One[/] One[/] x[//]x_[//]x'_). -rstepr (One[/] One[/] y[//]y_[//]y'_). -apply recip_resp_less. -apply recip_resp_pos; auto. -auto. -apply div_resp_ap_zero_rev. apply ring_non_triv. -apply div_resp_ap_zero_rev. apply ring_non_triv. +Proof. + intros x y x_ y_ H. + do 2 rewrite leEq_def. + intros H0 H1. apply H0. + cut ((One[/] x[//]x_) [#] Zero). intro x'_. + cut ((One[/] y[//]y_) [#] Zero). intro y'_. + rstepl (One[/] One[/] x[//]x_[//]x'_). + rstepr (One[/] One[/] y[//]y_[//]y'_). + apply recip_resp_less. + apply recip_resp_pos; auto. + auto. + apply div_resp_ap_zero_rev. apply ring_non_triv. + apply div_resp_ap_zero_rev. apply ring_non_triv. Qed. Lemma div_resp_leEq : forall (x y z : R) z_, Zero [<] z -> x [<=] y -> (x[/] z[//]z_) [<=] (y[/] z[//]z_). -intros. -rstepl (x[*] (One[/] z[//]z_)). -rstepr (y[*] (One[/] z[//]z_)). -apply mult_resp_leEq_rht. -assumption. -apply less_leEq. -apply recip_resp_pos. -auto. +Proof. + intros. + rstepl (x[*] (One[/] z[//]z_)). + rstepr (y[*] (One[/] z[//]z_)). + apply mult_resp_leEq_rht. + assumption. + apply less_leEq. + apply recip_resp_pos. + auto. Qed. Hint Resolve recip_resp_leEq: algebra. @@ -367,123 +393,133 @@ Hint Resolve recip_resp_leEq: algebra. *) Lemma mult_cancel_leEq : forall x y z : R, Zero [<] z -> x[*]z [<=] y[*]z -> x [<=] y. -intros x y z H. -do 2 rewrite leEq_def. -intros H0 H1. -apply H0. -apply mult_resp_less. -assumption. -assumption. +Proof. + intros x y z H. + do 2 rewrite leEq_def. + intros H0 H1. + apply H0. + apply mult_resp_less. + assumption. + assumption. Qed. (** Laws for shifting *) Lemma shift_mult_leEq : forall (x y z : R) z_, Zero [<] z -> x [<=] (y[/] z[//]z_) -> x[*]z [<=] y. -intros. -rstepr ((y[/] z[//]z_) [*]z). -apply mult_resp_leEq_rht; [ assumption | apply less_leEq; assumption ]. +Proof. + intros. + rstepr ((y[/] z[//]z_) [*]z). + apply mult_resp_leEq_rht; [ assumption | apply less_leEq; assumption ]. Qed. Lemma shift_mult_leEq' : forall (x y z : R) z_, Zero [<] z -> x [<=] (y[/] z[//]z_) -> z[*]x [<=] y. -intros. -rstepr (z[*] (y[/] z[//]z_)). -apply mult_resp_leEq_lft; [ assumption | apply less_leEq; assumption ]. +Proof. + intros. + rstepr (z[*] (y[/] z[//]z_)). + apply mult_resp_leEq_lft; [ assumption | apply less_leEq; assumption ]. Qed. Lemma shift_leEq_mult' : forall (x y z : R) y_, Zero [<] y -> (x[/] y[//]y_) [<=] z -> x [<=] y[*]z. -intros x y z H H0. repeat rewrite leEq_def. intros H1 H2. apply H1. -apply shift_less_div. auto. -astepl (y[*]z). auto. +Proof. + intros x y z H H0. repeat rewrite leEq_def. intros H1 H2. apply H1. + apply shift_less_div. auto. + astepl (y[*]z). auto. Qed. Lemma shift_div_leEq : forall x y z : R, Zero [<] z -> forall z_ : z [#] Zero, x [<=] y[*]z -> (x[/] z[//]z_) [<=] y. -intros. -rstepr (y[*]z[/] z[//]z_). -apply div_resp_leEq. -assumption. -assumption. +Proof. + intros. + rstepr (y[*]z[/] z[//]z_). + apply div_resp_leEq. + assumption. + assumption. Qed. Lemma shift_div_leEq' : forall (x y z : R) z_, Zero [<] z -> x [<=] z[*]y -> (x[/] z[//]z_) [<=] y. -intros. -rstepr (z[*]y[/] z[//]z_). -apply div_resp_leEq. -assumption. -assumption. +Proof. + intros. + rstepr (z[*]y[/] z[//]z_). + apply div_resp_leEq. + assumption. + assumption. Qed. Lemma shift_leEq_div : forall (x y z : R) y_, Zero [<] y -> x[*]y [<=] z -> x [<=] (z[/] y[//]y_). -intros x y z H X. repeat rewrite leEq_def. intros H0 H1. apply H0. -astepr (y[*]x). -apply shift_less_mult' with H; auto. +Proof. + intros x y z H X. repeat rewrite leEq_def. intros H0 H1. apply H0. + astepr (y[*]x). + apply shift_less_mult' with H; auto. Qed. Hint Resolve shift_leEq_div: algebra. Lemma eps_div_leEq_eps : forall (eps d : R) d_, Zero [<=] eps -> One [<=] d -> (eps[/] d[//]d_) [<=] eps. -intros. -apply shift_div_leEq'. -apply less_leEq_trans with (One:R). -apply pos_one. - -assumption. - -astepl (One[*]eps). -apply mult_resp_leEq_rht. -assumption. - -assumption. +Proof. + intros. + apply shift_div_leEq'. + apply less_leEq_trans with (One:R). + apply pos_one. + assumption. + astepl (One[*]eps). + apply mult_resp_leEq_rht. + assumption. + assumption. Qed. Lemma nonneg_div_two : forall eps : R, Zero [<=] eps -> Zero [<=] eps [/]TwoNZ. -intros. -apply shift_leEq_div. -apply pos_two. - -astepl (Zero:R). -assumption. +Proof. + intros. + apply shift_leEq_div. + apply pos_two. + astepl (Zero:R). + assumption. Qed. Lemma nonneg_div_two' : forall eps : R, Zero [<=] eps -> eps [/]TwoNZ [<=] eps. -intros. -apply shift_div_leEq. -apply pos_two. -astepl (eps[+]Zero); rstepr (eps[+]eps). -apply plus_resp_leEq_lft; auto. +Proof. + intros. + apply shift_div_leEq. + apply pos_two. + astepl (eps[+]Zero); rstepr (eps[+]eps). + apply plus_resp_leEq_lft; auto. Qed. Lemma nonneg_div_three : forall eps : R, Zero [<=] eps -> Zero [<=] eps [/]ThreeNZ. -intros. -apply mult_cancel_leEq with (Three:R). -apply pos_three. -astepl (Zero:R); rstepr eps. -assumption. +Proof. + intros. + apply mult_cancel_leEq with (Three:R). + apply pos_three. + astepl (Zero:R); rstepr eps. + assumption. Qed. Lemma nonneg_div_three' : forall eps : R, Zero [<=] eps -> eps [/]ThreeNZ [<=] eps. -intros. -apply shift_div_leEq. -apply pos_three. -rstepl (eps[+]Zero[+]Zero); rstepr (eps[+]eps[+]eps). -repeat apply plus_resp_leEq_both; auto. -apply leEq_reflexive. +Proof. + intros. + apply shift_div_leEq. + apply pos_three. + rstepl (eps[+]Zero[+]Zero); rstepr (eps[+]eps[+]eps). + repeat apply plus_resp_leEq_both; auto. + apply leEq_reflexive. Qed. Lemma nonneg_div_four : forall eps : R, Zero [<=] eps -> Zero [<=] eps [/]FourNZ. -intros. -rstepr ((eps [/]TwoNZ) [/]TwoNZ). -apply nonneg_div_two; apply nonneg_div_two; assumption. +Proof. + intros. + rstepr ((eps [/]TwoNZ) [/]TwoNZ). + apply nonneg_div_two; apply nonneg_div_two; assumption. Qed. Lemma nonneg_div_four' : forall eps : R, Zero [<=] eps -> eps [/]FourNZ [<=] eps. -intros. -rstepl ((eps [/]TwoNZ) [/]TwoNZ). -apply leEq_transitive with (eps [/]TwoNZ). -2: apply nonneg_div_two'; assumption. -apply nonneg_div_two'. -apply nonneg_div_two. -assumption. +Proof. + intros. + rstepl ((eps [/]TwoNZ) [/]TwoNZ). + apply leEq_transitive with (eps [/]TwoNZ). + 2: apply nonneg_div_two'; assumption. + apply nonneg_div_two'. + apply nonneg_div_two. + assumption. Qed. End multiplication. @@ -494,301 +530,311 @@ Section misc. *) Lemma sqr_nonneg : forall x : R, Zero [<=] x[^]2. -intros. rewrite leEq_def in |- *. intro H. -cut (Zero [<] x[^]2). intro H0. -elim (less_antisymmetric_unfolded _ _ _ H H0). -cut (x [<] Zero or Zero [<] x). intro H0. elim H0; clear H0; intros H0. -rstepr ([--]x[*][--]x). -cut (Zero [<] [--]x). intro H1. -apply mult_resp_pos; auto. -astepl ([--](Zero:R)). apply inv_resp_less. auto. -rstepr (x[*]x). -apply mult_resp_pos; auto. -apply ap_imp_less. -apply cring_mult_ap_zero with x. -astepl (x[^]2). -apply less_imp_ap. auto. +Proof. + intros. rewrite leEq_def in |- *. intro H. + cut (Zero [<] x[^]2). intro H0. + elim (less_antisymmetric_unfolded _ _ _ H H0). + cut (x [<] Zero or Zero [<] x). intro H0. elim H0; clear H0; intros H0. + rstepr ([--]x[*][--]x). + cut (Zero [<] [--]x). intro H1. + apply mult_resp_pos; auto. + astepl ([--](Zero:R)). apply inv_resp_less. auto. + rstepr (x[*]x). + apply mult_resp_pos; auto. + apply ap_imp_less. + apply cring_mult_ap_zero with x. + astepl (x[^]2). + apply less_imp_ap. auto. Qed. Lemma nring_nonneg : forall n : nat, Zero [<=] nring (R:=R) n. -intro; induction n as [| n Hrecn]. -apply leEq_reflexive. -apply leEq_transitive with (nring (R:=R) n); - [ assumption | apply less_leEq; simpl in |- *; apply less_plusOne ]. +Proof. + intro; induction n as [| n Hrecn]. + apply leEq_reflexive. + apply leEq_transitive with (nring (R:=R) n); + [ assumption | apply less_leEq; simpl in |- *; apply less_plusOne ]. Qed. Lemma suc_leEq_dub : forall n, nring (R:=R) (S (S n)) [<=] Two[*]nring (S n). -intro n. -induction n as [| n Hrecn]. -apply eq_imp_leEq. -rational. - -astepl (nring (R:=R) (S (S n)) [+]nring 1). -apply leEq_transitive with (nring (R:=R) 2[*]nring (S n) [+]nring 1). -apply plus_resp_leEq. -astepr ((Two:R) [*]nring (S n)). -exact Hrecn. - -simpl in |- *. -astepr - (((Zero:R) [+]One[+]One) [*] (nring n[+]One) [+] ((Zero:R) [+]One[+]One) [*]One). -apply plus_resp_leEq_lft. -astepr ((Zero:R) [+]One[+]One). -astepr ((Zero:R) [+] (One[+]One)). -apply plus_resp_leEq_lft. -astepr (Two:R). -apply less_leEq. -apply one_less_two. - -simpl in |- *. -astepl (nring (R:=R) n[+]One[+] (One[+] (Zero[+]One))). -astepl (nring (R:=R) n[+] (One[+] (One[+] (Zero[+]One)))). -astepr (nring (R:=R) n[+]One[+] (One[+]One)). -astepr (nring (R:=R) n[+] (One[+] (One[+]One))). -rational. +Proof. + intro n. + induction n as [| n Hrecn]. + apply eq_imp_leEq. + rational. + astepl (nring (R:=R) (S (S n)) [+]nring 1). + apply leEq_transitive with (nring (R:=R) 2[*]nring (S n) [+]nring 1). + apply plus_resp_leEq. + astepr ((Two:R) [*]nring (S n)). + exact Hrecn. + simpl in |- *. + astepr (((Zero:R) [+]One[+]One) [*] (nring n[+]One) [+] ((Zero:R) [+]One[+]One) [*]One). + apply plus_resp_leEq_lft. + astepr ((Zero:R) [+]One[+]One). + astepr ((Zero:R) [+] (One[+]One)). + apply plus_resp_leEq_lft. + astepr (Two:R). + apply less_leEq. + apply one_less_two. + simpl in |- *. + astepl (nring (R:=R) n[+]One[+] (One[+] (Zero[+]One))). + astepl (nring (R:=R) n[+] (One[+] (One[+] (Zero[+]One)))). + astepr (nring (R:=R) n[+]One[+] (One[+]One)). + astepr (nring (R:=R) n[+] (One[+] (One[+]One))). + rational. Qed. Lemma leEq_nring : forall n m, nring (R:=R) n [<=] nring m -> n <= m. -intro n; induction n as [| n Hrecn]. -intros. -auto with arith. -intros. -induction m as [| m Hrecm]. -elimtype False. -cut (nring (R:=R) n [<] Zero). -change (Not (nring (R:=R) n[<](nring 0))). -rewrite <- leEq_def. -apply nring_leEq. -auto with arith. -change (nring n [<] nring (R:=R) 0) in |- *. -apply nring_less. -apply lt_le_trans with (S n). -auto with arith. -elimtype False. move: H; rewrite leEq_def; apply. -apply nring_less; auto with arith. -cut (n <= m). -auto with arith. -apply Hrecn. -rstepr (nring (R:=R) m[+]One[-]One). -apply shift_leEq_minus. -apply H. +Proof. + intro n; induction n as [| n Hrecn]. + intros. + auto with arith. + intros. + induction m as [| m Hrecm]. + elimtype False. + cut (nring (R:=R) n [<] Zero). + change (Not (nring (R:=R) n[<](nring 0))). + rewrite <- leEq_def. + apply nring_leEq. + auto with arith. + change (nring n [<] nring (R:=R) 0) in |- *. + apply nring_less. + apply lt_le_trans with (S n). + auto with arith. + elimtype False. move: H; rewrite leEq_def; apply. + apply nring_less; auto with arith. + cut (n <= m). + auto with arith. + apply Hrecn. + rstepr (nring (R:=R) m[+]One[-]One). + apply shift_leEq_minus. + apply H. Qed. Lemma cc_abs_aid : forall x y : R, Zero [<=] x[^]2[+]y[^]2. -intros. -astepl (Zero[+] (Zero:R)). -apply plus_resp_leEq_both; apply sqr_nonneg. +Proof. + intros. + astepl (Zero[+] (Zero:R)). + apply plus_resp_leEq_both; apply sqr_nonneg. Qed. Load "Transparent_algebra". Lemma nexp_resp_pos : forall (x : R) k, Zero [<] x -> Zero [<] x[^]k. -intros. -elim k. -simpl in |- *. -apply pos_one. -intros. -simpl in |- *. -apply mult_resp_pos. -assumption. -assumption. +Proof. + intros. + elim k. + simpl in |- *. + apply pos_one. + intros. + simpl in |- *. + apply mult_resp_pos. + assumption. + assumption. Qed. Load "Opaque_algebra". Lemma mult_resp_nonneg : forall x y : R, Zero [<=] x -> Zero [<=] y -> Zero [<=] x[*]y. -intros x y. repeat rewrite leEq_def. intros H H0 H1. apply H0. -cut (x[*]y [#] Zero). intro H2. -cut (x [#] Zero). intro H3. -cut (y [#] Zero). intro H4. -elim (ap_imp_less _ _ _ H4); intro H5. auto. -elim (ap_imp_less _ _ _ H3); intro H6. elim (H H6). -elim (less_antisymmetric_unfolded _ _ _ H1 (mult_resp_pos _ _ _ H6 H5)). -apply cring_mult_ap_zero_op with x. auto. -apply cring_mult_ap_zero with y. auto. -apply less_imp_ap. auto. +Proof. + intros x y. repeat rewrite leEq_def. intros H H0 H1. apply H0. + cut (x[*]y [#] Zero). intro H2. + cut (x [#] Zero). intro H3. + cut (y [#] Zero). intro H4. + elim (ap_imp_less _ _ _ H4); intro H5. auto. + elim (ap_imp_less _ _ _ H3); intro H6. elim (H H6). + elim (less_antisymmetric_unfolded _ _ _ H1 (mult_resp_pos _ _ _ H6 H5)). + apply cring_mult_ap_zero_op with x. auto. + apply cring_mult_ap_zero with y. auto. + apply less_imp_ap. auto. Qed. Load "Transparent_algebra". Lemma nexp_resp_nonneg : forall (x : R) (k : nat), Zero [<=] x -> Zero [<=] x[^]k. -intros. induction k as [| k Hreck]. intros. -astepr (One:R). apply less_leEq. apply pos_one. -astepr (x[^]k[*]x). -apply mult_resp_nonneg; auto. +Proof. + intros. induction k as [| k Hreck]. intros. + astepr (One:R). apply less_leEq. apply pos_one. + astepr (x[^]k[*]x). + apply mult_resp_nonneg; auto. Qed. Lemma power_resp_leEq : forall (x y : R) k, Zero [<=] x -> x [<=] y -> x[^]k [<=] y[^]k. -intros. induction k as [| k Hreck]; intros. -astepl (One:R). -astepr (One:R). -apply leEq_reflexive. -astepl (x[^]k[*]x). -astepr (y[^]k[*]y). -apply leEq_transitive with (x[^]k[*]y). -apply mult_resp_leEq_lft. auto. -apply nexp_resp_nonneg; auto. -apply mult_resp_leEq_rht. auto. -apply leEq_transitive with x; auto. +Proof. + intros. induction k as [| k Hreck]; intros. + astepl (One:R). + astepr (One:R). + apply leEq_reflexive. + astepl (x[^]k[*]x). + astepr (y[^]k[*]y). + apply leEq_transitive with (x[^]k[*]y). + apply mult_resp_leEq_lft. auto. + apply nexp_resp_nonneg; auto. + apply mult_resp_leEq_rht. auto. + apply leEq_transitive with x; auto. Qed. Lemma nexp_resp_less : forall (x y : R) n, 1 <= n -> Zero [<=] x -> x [<] y -> x[^]n [<] y[^]n. -intros. -induction n as [| n Hrecn]. -elimtype False. -inversion H. -elim n. -simpl in |- *. -astepl x. -astepr y. -assumption. -intros. -change (x[^]S n0[*]x [<] y[^]S n0[*]y) in |- *. -apply mult_resp_less_both. -apply nexp_resp_nonneg. -assumption. -assumption. -assumption. -assumption. +Proof. + intros. + induction n as [| n Hrecn]. + elimtype False. + inversion H. + elim n. + simpl in |- *. + astepl x. + astepr y. + assumption. + intros. + change (x[^]S n0[*]x [<] y[^]S n0[*]y) in |- *. + apply mult_resp_less_both. + apply nexp_resp_nonneg. + assumption. + assumption. + assumption. + assumption. Qed. Lemma power_cancel_leEq : forall (x y : R) k, 0 < k -> Zero [<=] y -> x[^]k [<=] y[^]k -> x [<=] y. -intros x y k H. repeat rewrite leEq_def. intros H0 H1 H2. apply H1. -apply nexp_resp_less; try rewrite leEq_def; auto. +Proof. + intros x y k H. repeat rewrite leEq_def. intros H0 H1 H2. apply H1. + apply nexp_resp_less; try rewrite leEq_def; auto. Qed. Lemma power_cancel_less : forall (x y : R) k, Zero [<=] y -> x[^]k [<] y[^]k -> x [<] y. -intros x y k H H0. -elim (zerop k); intro y0. -rewrite y0 in H0. -cut (One [<] (One:R)). intro H1. -elim (less_irreflexive_unfolded _ _ H1). -astepl (x[^]0). astepr (y[^]0). auto. -cut (x [<] y or y [<] x). intro H1. -elim H1; clear H1; intros H1. auto. -cut (x [<=] y). intro. destruct (leEq_def _ x y) as [H3 _]. elim ((H3 H2) H1). -apply power_cancel_leEq with k; auto. -apply less_leEq. auto. -apply ap_imp_less. apply un_op_strext_unfolded with (nexp_op (R:=R) k). -apply less_imp_ap. auto. +Proof. + intros x y k H H0. + elim (zerop k); intro y0. + rewrite y0 in H0. + cut (One [<] (One:R)). intro H1. + elim (less_irreflexive_unfolded _ _ H1). + astepl (x[^]0). astepr (y[^]0). auto. + cut (x [<] y or y [<] x). intro H1. + elim H1; clear H1; intros H1. auto. + cut (x [<=] y). intro. destruct (leEq_def _ x y) as [H3 _]. elim ((H3 H2) H1). + apply power_cancel_leEq with k; auto. + apply less_leEq. auto. + apply ap_imp_less. apply un_op_strext_unfolded with (nexp_op (R:=R) k). + apply less_imp_ap. auto. Qed. Lemma nat_less_bin_nexp : forall p : nat, Snring R p [<] Two[^]S p. -intro n. -unfold Snring in |- *. -induction n as [| n Hrecn]. -simpl in |- *. -astepl (One:R). -astepr ((Zero:R) [+]One[+]One). -astepr ((One:R) [+]One). -astepr (Two:R). -apply one_less_two. - -astepl (nring (R:=R) (S n) [+]One). -astepr ((Two:R)[^]S n[*]Two). -astepr ((Two:R)[^]S n[*]One[+]Two[^]S n[*]One). -apply plus_resp_less_both. -astepr ((Two:R)[^]S n). -exact Hrecn. - -astepr ((Two:R)[^]S n). -astepl ((One:R)[^]S n). -apply nexp_resp_less. -intuition. - -apply less_leEq. -apply pos_one. - -apply one_less_two. -rational. +Proof. + intro n. + unfold Snring in |- *. + induction n as [| n Hrecn]. + simpl in |- *. + astepl (One:R). + astepr ((Zero:R) [+]One[+]One). + astepr ((One:R) [+]One). + astepr (Two:R). + apply one_less_two. + astepl (nring (R:=R) (S n) [+]One). + astepr ((Two:R)[^]S n[*]Two). + astepr ((Two:R)[^]S n[*]One[+]Two[^]S n[*]One). + apply plus_resp_less_both. + astepr ((Two:R)[^]S n). + exact Hrecn. + astepr ((Two:R)[^]S n). + astepl ((One:R)[^]S n). + apply nexp_resp_less. + intuition. + apply less_leEq. + apply pos_one. + apply one_less_two. + rational. Qed. Lemma Sum_resp_leEq : forall (f g : nat -> R) a b, a <= S b -> (forall i, a <= i -> i <= b -> f i [<=] g i) -> Sum a b f [<=] Sum a b g. -intros. induction b as [| b Hrecb]; intros. -unfold Sum in |- *. unfold Sum1 in |- *. -generalize (toCle _ _ H); clear H; intro H. -inversion H as [|m X H2]. -astepl (Zero:R). -astepr (Zero:R). -apply leEq_reflexive. -inversion X. -simpl in |- *. -rstepl (f 0). -rstepr (g 0). -apply H0; auto. rewrite H1. auto. -elim (le_lt_eq_dec _ _ H); intro H1. -apply leEq_wdl with (Sum a b f[+]f (S b)). -apply leEq_wdr with (Sum a b g[+]g (S b)). -apply plus_resp_leEq_both. -apply Hrecb. auto with arith. auto. -apply H0. auto with arith. auto. -apply eq_symmetric_unfolded. apply Sum_last. -apply eq_symmetric_unfolded. apply Sum_last. -unfold Sum in |- *. unfold Sum1 in |- *. -rewrite H1. -simpl in |- *. -astepl (Zero:R). -astepr (Zero:R). -apply leEq_reflexive. +Proof. + intros. induction b as [| b Hrecb]; intros. + unfold Sum in |- *. unfold Sum1 in |- *. + generalize (toCle _ _ H); clear H; intro H. + inversion H as [|m X H2]. + astepl (Zero:R). + astepr (Zero:R). + apply leEq_reflexive. + inversion X. + simpl in |- *. + rstepl (f 0). + rstepr (g 0). + apply H0; auto. rewrite H1. auto. + elim (le_lt_eq_dec _ _ H); intro H1. + apply leEq_wdl with (Sum a b f[+]f (S b)). + apply leEq_wdr with (Sum a b g[+]g (S b)). + apply plus_resp_leEq_both. + apply Hrecb. auto with arith. auto. + apply H0. auto with arith. auto. + apply eq_symmetric_unfolded. apply Sum_last. + apply eq_symmetric_unfolded. apply Sum_last. + unfold Sum in |- *. unfold Sum1 in |- *. + rewrite H1. + simpl in |- *. + astepl (Zero:R). + astepr (Zero:R). + apply leEq_reflexive. Qed. Lemma Sumx_resp_leEq : forall n (f g : forall i, i < n -> R), (forall i H, f i H [<=] g i H) -> Sumx f [<=] Sumx g. -simple induction n. -intros; simpl in |- *; apply leEq_reflexive. -clear n; intros; simpl in |- *. -apply plus_resp_leEq_both. -apply H; intros; apply H0. -apply H0. +Proof. + simple induction n. + intros; simpl in |- *; apply leEq_reflexive. + clear n; intros; simpl in |- *. + apply plus_resp_leEq_both. + apply H; intros; apply H0. + apply H0. Qed. Lemma Sum2_resp_leEq : forall m n, m <= S n -> forall f g : forall i, m <= i -> i <= n -> R, (forall i Hm Hn, f i Hm Hn [<=] g i Hm Hn) -> Sum2 f [<=] Sum2 g. -intros. -unfold Sum2 in |- *. -apply Sum_resp_leEq. -assumption. -intros. -elim (le_lt_dec m i); intro; - [ simpl in |- * | elimtype False; apply (le_not_lt m i); auto with arith ]. -elim (le_lt_dec i n); intro; - [ simpl in |- * | elimtype False; apply (le_not_lt i n); auto with arith ]. -apply H0. +Proof. + intros. + unfold Sum2 in |- *. + apply Sum_resp_leEq. + assumption. + intros. + elim (le_lt_dec m i); intro; + [ simpl in |- * | elimtype False; apply (le_not_lt m i); auto with arith ]. + elim (le_lt_dec i n); intro; + [ simpl in |- * | elimtype False; apply (le_not_lt i n); auto with arith ]. + apply H0. Qed. Lemma approach_zero : forall x : R, (forall e, Zero [<] e -> x [<] e) -> x [<=] Zero. +Proof. intros. rewrite leEq_def; intro. cut (x [<] x [/]TwoNZ). - change (Not (x [<] x [/]TwoNZ)) in |- *. - apply less_antisymmetric_unfolded. - apply plus_cancel_less with (z := [--](x [/]TwoNZ)). - apply mult_cancel_less with (z := Two:R). - apply pos_two. - rstepl (Zero:R). - rstepr x. - assumption. + change (Not (x [<] x [/]TwoNZ)) in |- *. + apply less_antisymmetric_unfolded. + apply plus_cancel_less with (z := [--](x [/]TwoNZ)). + apply mult_cancel_less with (z := Two:R). + apply pos_two. + rstepl (Zero:R). + rstepr x. + assumption. apply X. apply pos_div_two. assumption. Qed. Lemma approach_zero_weak : forall x : R, (forall e, Zero [<] e -> x [<=] e) -> x [<=] Zero. +Proof. intros. rewrite leEq_def; intro. cut (x [<=] x [/]TwoNZ). - rewrite leEq_def. - change (~ Not (x [/]TwoNZ [<] x)) in |- *. - intro H1. - apply H1. - apply plus_cancel_less with (z := [--](x [/]TwoNZ)). - apply mult_cancel_less with (z := Two:R). - apply pos_two. - rstepl (Zero:R). - rstepr x. - assumption. + rewrite leEq_def. + change (~ Not (x [/]TwoNZ [<] x)) in |- *. + intro H1. + apply H1. + apply plus_cancel_less with (z := [--](x [/]TwoNZ)). + apply mult_cancel_less with (z := Two:R). + apply pos_two. + rstepl (Zero:R). + rstepr x. + assumption. apply H. apply pos_div_two. assumption. @@ -797,45 +843,43 @@ End misc. Lemma equal_less_leEq : forall a b x y : R, (a [<] b -> x [<=] y) -> (a [=] b -> x [<=] y) -> a [<=] b -> x [<=] y. -intros. -rewrite leEq_def. -red in |- *. -apply CNot_Not_or with (a [<] b) (a [=] b). - firstorder using leEq_def. - firstorder using leEq_def. -intro. -cut (a [=] b); intros. -2: apply leEq_imp_eq; auto. -auto. -rewrite leEq_def. -intro; auto. +Proof. + intros. + rewrite leEq_def. + red in |- *. + apply CNot_Not_or with (a [<] b) (a [=] b). + firstorder using leEq_def. + firstorder using leEq_def. + intro. + cut (a [=] b); intros. + 2: apply leEq_imp_eq; auto. + auto. + rewrite leEq_def. + intro; auto. Qed. Lemma power_plus_leEq : forall n (x y:R), (0 < n) -> (Zero[<=]x) -> (Zero[<=]y) -> (x[^]n [+] y[^]n)[<=](x[+]y)[^]n. Proof. -intros [|n] x y Hn Hx Hy. - elimtype False; auto with *. -induction n. - simpl. - rstepl (One[*](x[+]y)). - apply leEq_reflexive. -rename n into m. -set (n:=(S m)) in *. -apply leEq_transitive with ((x[^]n[+]y[^]n)[*](x[+]y)). - apply shift_zero_leEq_minus'. - change (x[^]S n) with (x[^]n[*]x). - change (y[^]S n) with (y[^]n[*]y). - rstepr (y[*]x[^]n[+]x[*]y[^]n). - apply plus_resp_nonneg; - apply mult_resp_nonneg; - try apply nexp_resp_nonneg; - try assumption. -change ((x[+]y)[^]S n) with ((x[+]y)[^]n[*](x[+]y)). -apply mult_resp_leEq_rht. - apply IHn. - unfold n; auto with *. -apply plus_resp_nonneg; assumption. + intros [|n] x y Hn Hx Hy. + elimtype False; auto with *. + induction n. + simpl. + rstepl (One[*](x[+]y)). + apply leEq_reflexive. + rename n into m. + set (n:=(S m)) in *. + apply leEq_transitive with ((x[^]n[+]y[^]n)[*](x[+]y)). + apply shift_zero_leEq_minus'. + change (x[^]S n) with (x[^]n[*]x). + change (y[^]S n) with (y[^]n[*]y). + rstepr (y[*]x[^]n[+]x[*]y[^]n). + apply plus_resp_nonneg; apply mult_resp_nonneg; try apply nexp_resp_nonneg; try assumption. + change ((x[+]y)[^]S n) with ((x[+]y)[^]n[*](x[+]y)). + apply mult_resp_leEq_rht. + apply IHn. + unfold n; auto with *. + apply plus_resp_nonneg; assumption. Qed. End Properties_of_leEq. @@ -859,169 +903,182 @@ Notation OneR := (One:R). (* end hide *) Lemma mult_pos_imp : forall a b : R, Zero [<] a[*]b -> Zero [<] a and Zero [<] b or a [<] Zero and b [<] Zero. -generalize I; intro. -generalize I; intro. -generalize I; intro. -generalize I; intro. -generalize I; intro. -intros a b H4. -generalize (Greater_imp_ap _ _ _ H4); intro H5. -generalize (mult_cancel_ap_zero_lft _ _ _ H5); intro H6. -generalize (mult_cancel_ap_zero_rht _ _ _ H5); intro H7. -elim (ap_imp_less _ _ _ H6); intro H8. -right. -split. -assumption. -elim (ap_imp_less _ _ _ H7); intro. -assumption. -elimtype False. -elim (less_irreflexive_unfolded R Zero). -apply less_leEq_trans with (a[*]b). -assumption. -apply less_leEq. -apply inv_cancel_less. -astepl ZeroR. -astepr ([--]a[*]b). -apply mult_resp_pos. -astepl ([--]ZeroR). -apply inv_resp_less. -assumption. -assumption. -left. -split. -assumption. -elim (ap_imp_less _ _ _ H7); intro. -elimtype False. -elim (less_irreflexive_unfolded R Zero). -apply less_leEq_trans with (a[*]b). -assumption. -apply less_leEq. -apply inv_cancel_less. -astepl ZeroR. -astepr (a[*][--]b). -apply mult_resp_pos. -assumption. -astepl ([--]ZeroR). -apply inv_resp_less. -assumption. -assumption. +Proof. + generalize I; intro. + generalize I; intro. + generalize I; intro. + generalize I; intro. + generalize I; intro. + intros a b H4. + generalize (Greater_imp_ap _ _ _ H4); intro H5. + generalize (mult_cancel_ap_zero_lft _ _ _ H5); intro H6. + generalize (mult_cancel_ap_zero_rht _ _ _ H5); intro H7. + elim (ap_imp_less _ _ _ H6); intro H8. + right. + split. + assumption. + elim (ap_imp_less _ _ _ H7); intro. + assumption. + elimtype False. + elim (less_irreflexive_unfolded R Zero). + apply less_leEq_trans with (a[*]b). + assumption. + apply less_leEq. + apply inv_cancel_less. + astepl ZeroR. + astepr ([--]a[*]b). + apply mult_resp_pos. + astepl ([--]ZeroR). + apply inv_resp_less. + assumption. + assumption. + left. + split. + assumption. + elim (ap_imp_less _ _ _ H7); intro. + elimtype False. + elim (less_irreflexive_unfolded R Zero). + apply less_leEq_trans with (a[*]b). + assumption. + apply less_leEq. + apply inv_cancel_less. + astepl ZeroR. + astepr (a[*][--]b). + apply mult_resp_pos. + assumption. + astepl ([--]ZeroR). + apply inv_resp_less. + assumption. + assumption. Qed. Lemma plus_resp_pos_nonneg : forall x y : R, Zero [<] x -> Zero [<=] y -> Zero [<] x[+]y. -intros. -apply less_leEq_trans with x. auto. -astepl (x[+]Zero). -apply plus_resp_leEq_lft. auto. +Proof. + intros. + apply less_leEq_trans with x. auto. + astepl (x[+]Zero). + apply plus_resp_leEq_lft. auto. Qed. Lemma plus_resp_nonneg_pos : forall x y : R, Zero [<=] x -> Zero [<] y -> Zero [<] x[+]y. -intros. -astepr (y[+]x). -apply plus_resp_pos_nonneg; auto. +Proof. + intros. + astepr (y[+]x). + apply plus_resp_pos_nonneg; auto. Qed. Lemma pos_square : forall x : R, x [#] Zero -> Zero [<] x[^]2. -intros x H. -elim (ap_imp_less _ _ _ H); intro H1. -rstepr ([--]x[*][--]x). -cut (Zero [<] [--]x). intro. -apply mult_resp_pos; auto. -astepl ([--]ZeroR). -apply inv_resp_less. auto. -rstepr (x[*]x). -apply mult_resp_pos; auto. +Proof. + intros x H. + elim (ap_imp_less _ _ _ H); intro H1. + rstepr ([--]x[*][--]x). + cut (Zero [<] [--]x). intro. + apply mult_resp_pos; auto. + astepl ([--]ZeroR). + apply inv_resp_less. auto. + rstepr (x[*]x). + apply mult_resp_pos; auto. Qed. Lemma mult_cancel_pos_rht : forall x y : R, Zero [<] x[*]y -> Zero [<=] x -> Zero [<] y. -intros x y H. -destruct (leEq_def _ Zero x) as [H0 _]. -intro H2. pose (H3:=(H0 H2)). -elim (mult_pos_imp _ _ H); intro H1. -elim H1; auto. -elim H1; intros. -contradiction. +Proof. + intros x y H. + destruct (leEq_def _ Zero x) as [H0 _]. + intro H2. pose (H3:=(H0 H2)). + elim (mult_pos_imp _ _ H); intro H1. + elim H1; auto. + elim H1; intros. + contradiction. Qed. Lemma mult_cancel_pos_lft : forall x y : R, Zero [<] x[*]y -> Zero [<=] y -> Zero [<] x. -intros. -apply mult_cancel_pos_rht with y. -astepr (x[*]y). -auto. auto. +Proof. + intros. + apply mult_cancel_pos_rht with y. + astepr (x[*]y). + auto. auto. Qed. Lemma pos_wd : forall x y : R, x [=] y -> Zero [<] y -> Zero [<] x. -intros. -astepr y. -auto. +Proof. + intros. + astepr y. + auto. Qed. Lemma even_power_pos : forall n, even n -> forall x : R, x [#] Zero -> Zero [<] x[^]n. -intros. -elim (even_2n n H). intros m y. -replace n with (2 * m). -astepr ((x[^]2)[^]m). -apply nexp_resp_pos. -apply pos_square. auto. -rewrite y. unfold double in |- *. omega. +Proof. + intros. + elim (even_2n n H). intros m y. + replace n with (2 * m). + astepr ((x[^]2)[^]m). + apply nexp_resp_pos. + apply pos_square. auto. + rewrite y. unfold double in |- *. omega. Qed. Lemma odd_power_cancel_pos : forall n, odd n -> forall x : R, Zero [<] x[^]n -> Zero [<] x. -intros n H x H0. -induction n as [| n Hrecn]. -generalize (to_Codd _ H); intro H1. -inversion H1. -apply mult_cancel_pos_rht with (x[^]n). -astepr (x[^]S n). auto. -apply less_leEq; apply even_power_pos. -inversion H. auto. -apply un_op_strext_unfolded with (nexp_op (R:=R) (S n)). -cut (0 < S n). intro. -astepr ZeroR. -apply Greater_imp_ap. auto. -auto with arith. +Proof. + intros n H x H0. + induction n as [| n Hrecn]. + generalize (to_Codd _ H); intro H1. + inversion H1. + apply mult_cancel_pos_rht with (x[^]n). + astepr (x[^]S n). auto. + apply less_leEq; apply even_power_pos. + inversion H. auto. + apply un_op_strext_unfolded with (nexp_op (R:=R) (S n)). + cut (0 < S n). intro. + astepr ZeroR. + apply Greater_imp_ap. auto. + auto with arith. Qed. Lemma plus_resp_pos : forall x y : R, Zero [<] x -> Zero [<] y -> Zero [<] x[+]y. -intros. -apply plus_resp_pos_nonneg. -auto. -apply less_leEq. auto. +Proof. + intros. + apply plus_resp_pos_nonneg. + auto. + apply less_leEq. auto. Qed. Lemma pos_nring_S : forall n, ZeroR [<] nring (S n). -simple induction n; simpl in |- *; intros. -(* base *) -astepr OneR; apply pos_one. -(* step *) -apply less_leEq_trans with (nring (R:=R) n0[+]One). -assumption. -apply less_leEq. -apply less_plusOne. +Proof. + simple induction n; simpl in |- *; intros. + (* base *) + astepr OneR; apply pos_one. + (* step *) + apply less_leEq_trans with (nring (R:=R) n0[+]One). + assumption. + apply less_leEq. + apply less_plusOne. Qed. Lemma square_eq_pos : forall x a : R, Zero [<] a -> Zero [<] x -> x[^]2 [=] a[^]2 -> x [=] a. -intros. -elim (square_eq _ x a); intros; auto. -elimtype False. -apply less_irreflexive_unfolded with (x := ZeroR). -apply less_leEq_trans with x. -auto. -apply less_leEq. -astepl ([--]a); apply inv_cancel_less. -astepl ZeroR; astepr a; auto. -apply Greater_imp_ap; auto. +Proof. + intros. + elim (square_eq _ x a); intros; auto. + elimtype False. + apply less_irreflexive_unfolded with (x := ZeroR). + apply less_leEq_trans with x. + auto. + apply less_leEq. + astepl ([--]a); apply inv_cancel_less. + astepl ZeroR; astepr a; auto. + apply Greater_imp_ap; auto. Qed. Lemma square_eq_neg : forall x a : R, Zero [<] a -> x [<] Zero -> x[^]2 [=] a[^]2 -> x [=] [--]a. -intros. -elim (square_eq _ x a); intros; auto. -elimtype False. -apply less_irreflexive_unfolded with (x := ZeroR). -apply leEq_less_trans with x. -astepr a; apply less_leEq; auto. -auto. -apply Greater_imp_ap; auto. +Proof. + intros. + elim (square_eq _ x a); intros; auto. + elimtype False. + apply less_irreflexive_unfolded with (x := ZeroR). + apply leEq_less_trans with x. + astepr a; apply less_leEq; auto. + auto. + apply Greater_imp_ap; auto. Qed. End PosP_properties. @@ -1043,29 +1100,32 @@ Section One_div_succ_properties. Variable R : COrdField. Lemma one_div_succ_resp_leEq : forall m n, m <= n -> one_div_succ (R:=R) n [<=] one_div_succ m. -unfold one_div_succ in |- *. unfold Snring in |- *. intros. -apply recip_resp_leEq. -apply pos_nring_S. -apply nring_leEq. -auto with arith. +Proof. + unfold one_div_succ in |- *. unfold Snring in |- *. intros. + apply recip_resp_leEq. + apply pos_nring_S. + apply nring_leEq. + auto with arith. Qed. Lemma one_div_succ_pos : forall i, (Zero:R) [<] one_div_succ i. -intro. -unfold one_div_succ in |- *. -unfold Snring in |- *. -apply recip_resp_pos. -apply nring_pos. -auto with arith. +Proof. + intro. + unfold one_div_succ in |- *. + unfold Snring in |- *. + apply recip_resp_pos. + apply nring_pos. + auto with arith. Qed. Lemma one_div_succ_resp_less : forall i j, i < j -> one_div_succ j [<] one_div_succ (R:=R) i. -intros. -unfold one_div_succ in |- *. unfold Snring in |- *. intros. -apply recip_resp_less. -apply pos_nring_S. -apply nring_less. -auto with arith. +Proof. + intros. + unfold one_div_succ in |- *. unfold Snring in |- *. intros. + apply recip_resp_less. + apply pos_nring_S. + apply nring_less. + auto with arith. Qed. End One_div_succ_properties. @@ -1089,43 +1149,49 @@ Let [R] be an ordered field. Variable R : COrdField. Lemma half_1 : (Half:R) [*]Two [=] One. -unfold Half in |- *. -apply div_1. +Proof. + unfold Half in |- *. + apply div_1. Qed. Hint Resolve half_1: algebra. Lemma pos_half : (Zero:R) [<] Half. -apply mult_cancel_pos_lft with (Two:R). -apply (pos_wd R (Half[*]Two) One). -exact half_1. -apply pos_one. -apply less_leEq; apply pos_two. +Proof. + apply mult_cancel_pos_lft with (Two:R). + apply (pos_wd R (Half[*]Two) One). + exact half_1. + apply pos_one. + apply less_leEq; apply pos_two. Qed. Lemma half_1' : forall x : R, x[*]Half[*]Two [=] x. -intros. -unfold Half in |- *. -rational. +Proof. + intros. + unfold Half in |- *. + rational. Qed. Lemma half_2 : (Half:R) [+]Half [=] One. -unfold Half in |- *. -rational. +Proof. + unfold Half in |- *. + rational. Qed. Lemma half_lt1 : (Half:R) [<] One. -astepr (Half[+] (Half:R)). -rstepl ((Half:R) [+]Zero). -apply plus_resp_less_lft. -exact pos_half. -exact half_2. +Proof. + astepr (Half[+] (Half:R)). + rstepl ((Half:R) [+]Zero). + apply plus_resp_less_lft. + exact pos_half. + exact half_2. Qed. Lemma half_3 : forall x : R, Zero [<] x -> Half[*]x [<] x. -intros. -astepr (One[*]x). -apply mult_resp_less; auto. -exact half_lt1. +Proof. + intros. + astepr (One[*]x). + apply mult_resp_less; auto. + exact half_lt1. Qed. End Half_properties. diff --git a/algebra/CPoly_ApZero.v b/algebra/CPoly_ApZero.v index 80114d11b..71d8d2787 100644 --- a/algebra/CPoly_ApZero.v +++ b/algebra/CPoly_ApZero.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CPoly_Degree. Require Export COrdFields2. @@ -69,126 +69,133 @@ Load "Transparent_algebra". Lemma poly_linear_shifted : forall (a : R) (f : RX), {f' : RX | {f'' : R | f [=] (_X_[-]_C_ a) [*]f'[+]_C_ f''}}. -intros. -induction f0 as [| s f0 Hrecf0]; intros. -exists (cpoly_zero R). -exists (Zero:R). -simpl in |- *. -algebra. -elim Hrecf0. intro g'. intros H. -elim H. intro g''. intros H0. -exists (_X_[*]g'[+]_C_ g''). -exists (a[*]g''[+]s). -astepl (_X_[*]f0[+]_C_ s). -astepl (_X_[*] ((_X_[-]_C_ a) [*]g'[+]_C_ g'') [+]_C_ s). -apply eq_symmetric_unfolded. -cut (_C_ (a[*]g''[+]s) [=] _C_ a[*]_C_ g''[+]_C_ s). intro. -astepl ((_X_[-]_C_ a) [*] (_X_[*]g'[+]_C_ g'') [+] (_C_ a[*]_C_ g''[+]_C_ s)). -rational. -Step_final (_C_ (a[*]g'') [+]_C_ s). +Proof. + intros. + induction f0 as [| s f0 Hrecf0]; intros. + exists (cpoly_zero R). + exists (Zero:R). + simpl in |- *. + algebra. + elim Hrecf0. intro g'. intros H. + elim H. intro g''. intros H0. + exists (_X_[*]g'[+]_C_ g''). + exists (a[*]g''[+]s). + astepl (_X_[*]f0[+]_C_ s). + astepl (_X_[*] ((_X_[-]_C_ a) [*]g'[+]_C_ g'') [+]_C_ s). + apply eq_symmetric_unfolded. + cut (_C_ (a[*]g''[+]s) [=] _C_ a[*]_C_ g''[+]_C_ s). intro. + astepl ((_X_[-]_C_ a) [*] (_X_[*]g'[+]_C_ g'') [+] (_C_ a[*]_C_ g''[+]_C_ s)). + rational. + Step_final (_C_ (a[*]g'') [+]_C_ s). Qed. Load "Opaque_algebra". Lemma poly_linear_factor : forall (f : RX) a, f ! a [=] Zero -> {f' : RX | f [=] (_X_[-]_C_ a) [*]f'}. -intros. -elim (poly_linear_shifted a f0). intro f'. intros H0. -elim H0. intro f''. intros H1. -exists f'. -cut (_C_ f'' [=] Zero). intro. -astepl ((_X_[-]_C_ a) [*]f'[+]_C_ f''). -Step_final ((_X_[-]_C_ a) [*]f'[+]Zero). -astepr (_C_ (Zero:R)). -apply cpoly_const_eq. -astepl (Zero[+]f''). -astepl (Zero[*]f' ! a[+]f''). -astepl ((a[-]a) [*]f' ! a[+]f''). -astepl ((_X_ ! a[-] (_C_ a) ! a) [*]f' ! a[+]f''). -astepl ((_X_[-]_C_ a) ! a[*]f' ! a[+]f''). -astepl (((_X_[-]_C_ a) [*]f') ! a[+]f''). -astepl (((_X_[-]_C_ a) [*]f') ! a[+] (_C_ f'') ! a). -astepl ((_X_[-]_C_ a) [*]f'[+]_C_ f'') ! a. -Step_final f0 ! a. +Proof. + intros. + elim (poly_linear_shifted a f0). intro f'. intros H0. + elim H0. intro f''. intros H1. + exists f'. + cut (_C_ f'' [=] Zero). intro. + astepl ((_X_[-]_C_ a) [*]f'[+]_C_ f''). + Step_final ((_X_[-]_C_ a) [*]f'[+]Zero). + astepr (_C_ (Zero:R)). + apply cpoly_const_eq. + astepl (Zero[+]f''). + astepl (Zero[*]f' ! a[+]f''). + astepl ((a[-]a) [*]f' ! a[+]f''). + astepl ((_X_ ! a[-] (_C_ a) ! a) [*]f' ! a[+]f''). + astepl ((_X_[-]_C_ a) ! a[*]f' ! a[+]f''). + astepl (((_X_[-]_C_ a) [*]f') ! a[+]f''). + astepl (((_X_[-]_C_ a) [*]f') ! a[+] (_C_ f'') ! a). + astepl ((_X_[-]_C_ a) [*]f'[+]_C_ f'') ! a. + Step_final f0 ! a. Qed. Lemma zero_poly : forall n (f : RX), degree_le n f -> (forall i, i <= n -> f ! (a_ i) [=] Zero) -> f [=] Zero. -intro. -induction n0 as [| n0 Hrecn0]; intros. -elim (degree_le_zero _ _ H). intros. -astepl (_C_ x). -astepr (_C_ (Zero:R)). -apply cpoly_const_eq. -apply eq_transitive_unfolded with f0 ! (a_ 0). -Step_final (_C_ x) ! (a_ 0). -apply H0. -auto. -cut (f0 ! (a_ (S n0)) [=] Zero). intro. -elim (poly_linear_factor f0 (a_ (S n0)) H1). intro f'. intros. -astepl ((_X_[-]_C_ (a_ (S n0))) [*]f'). -cut (f' [=] Zero). intro. -Step_final ((_X_[-]_C_ (a_ (S n0))) [*]Zero). -apply Hrecn0. -apply degree_le_mult_imp with (_X_[-]_C_ (a_ (S n0))) 1. -apply degree_minus_lft with 0. -apply degree_le_c_. -apply degree_x_. -auto. -apply degree_le_wd with f0. -auto. -auto. -intros. -apply mult_cancel_lft with (a_ i[-]a_ (S n0)). -apply minus_ap_zero. -apply distinct_a_. -intro; rewrite H3 in H2; exact (le_Sn_n _ H2). -astepr (Zero:R). -cut (a_ i[-]a_ (S n0) [=] (_X_[-]_C_ (a_ (S n0))) ! (a_ i)). intro. -astepl ((_X_[-]_C_ (a_ (S n0))) ! (a_ i) [*]f' ! (a_ i)). -astepl ((_X_[-]_C_ (a_ (S n0))) [*]f') ! (a_ i). -astepl f0 ! (a_ i). -apply H0. -auto with arith. -Step_final (_X_ ! (a_ i) [-] (_C_ (a_ (S n0))) ! (a_ i)). -apply H0. -auto. +Proof. + intro. + induction n0 as [| n0 Hrecn0]; intros. + elim (degree_le_zero _ _ H). intros. + astepl (_C_ x). + astepr (_C_ (Zero:R)). + apply cpoly_const_eq. + apply eq_transitive_unfolded with f0 ! (a_ 0). + Step_final (_C_ x) ! (a_ 0). + apply H0. + auto. + cut (f0 ! (a_ (S n0)) [=] Zero). intro. + elim (poly_linear_factor f0 (a_ (S n0)) H1). intro f'. intros. + astepl ((_X_[-]_C_ (a_ (S n0))) [*]f'). + cut (f' [=] Zero). intro. + Step_final ((_X_[-]_C_ (a_ (S n0))) [*]Zero). + apply Hrecn0. + apply degree_le_mult_imp with (_X_[-]_C_ (a_ (S n0))) 1. + apply degree_minus_lft with 0. + apply degree_le_c_. + apply degree_x_. + auto. + apply degree_le_wd with f0. + auto. + auto. + intros. + apply mult_cancel_lft with (a_ i[-]a_ (S n0)). + apply minus_ap_zero. + apply distinct_a_. + intro; rewrite H3 in H2; exact (le_Sn_n _ H2). + astepr (Zero:R). + cut (a_ i[-]a_ (S n0) [=] (_X_[-]_C_ (a_ (S n0))) ! (a_ i)). intro. + astepl ((_X_[-]_C_ (a_ (S n0))) ! (a_ i) [*]f' ! (a_ i)). + astepl ((_X_[-]_C_ (a_ (S n0))) [*]f') ! (a_ i). + astepl f0 ! (a_ i). + apply H0. + auto with arith. + Step_final (_X_ ! (a_ i) [-] (_C_ (a_ (S n0))) ! (a_ i)). + apply H0. + auto. Qed. Lemma identical_poly : forall f g : RX, degree_le n f -> degree_le n g -> (forall i, i <= n -> f ! (a_ i) [=] g ! (a_ i)) -> f [=] g. -intros. -apply cg_inv_unique_2. -apply zero_poly with n. -apply degree_le_minus; auto. -intros. -astepl (f0 ! (a_ i) [-]g ! (a_ i)). -Step_final (f0 ! (a_ i) [-]f0 ! (a_ i)). +Proof. + intros. + apply cg_inv_unique_2. + apply zero_poly with n. + apply degree_le_minus; auto. + intros. + astepl (f0 ! (a_ i) [-]g ! (a_ i)). + Step_final (f0 ! (a_ i) [-]f0 ! (a_ i)). Qed. Definition poly_01_factor' (n : nat) := _X_[-]_C_ (a_ n). Lemma poly_01_factor'_degree : forall n, degree_le 1 (poly_01_factor' n). -intros. -unfold poly_01_factor' in |- *. -apply degree_imp_degree_le. -apply degree_minus_lft with 0. -apply degree_le_c_. -apply degree_x_. -auto. +Proof. + intros. + unfold poly_01_factor' in |- *. + apply degree_imp_degree_le. + apply degree_minus_lft with 0. + apply degree_le_c_. + apply degree_x_. + auto. Qed. Lemma poly_01_factor'_zero : forall n, (poly_01_factor' n) ! (a_ n) [=] Zero. -intros. -unfold poly_01_factor' in |- *. -astepl (_X_ ! (a_ n0) [-] (_C_ (a_ n0)) ! (a_ n0)). -Step_final (a_ n0[-]a_ n0). +Proof. + intros. + unfold poly_01_factor' in |- *. + astepl (_X_ ! (a_ n0) [-] (_C_ (a_ n0)) ! (a_ n0)). + Step_final (a_ n0[-]a_ n0). Qed. Lemma poly_01_factor'_apzero : forall n i, i <> n -> (poly_01_factor' n) ! (a_ i) [#] Zero. -intros. -unfold poly_01_factor' in |- *. -astepl (_X_ ! (a_ i) [-] (_C_ (a_ n0)) ! (a_ i)). -astepl (a_ i[-]a_ n0). algebra. +Proof. + intros. + unfold poly_01_factor' in |- *. + astepl (_X_ ! (a_ i) [-] (_C_ (a_ n0)) ! (a_ i)). + astepl (a_ i[-]a_ n0). algebra. Qed. Hint Resolve poly_01_factor'_zero. @@ -198,42 +205,35 @@ Definition poly_01_factor n i (H : i <> n) := _C_ (One[/] (poly_01_factor' n) ! (a_ i) [//]poly_01_factor'_apzero n i H). Lemma poly_01_factor_degree : forall n i H, degree_le 1 (poly_01_factor n i H). -intros. -unfold poly_01_factor in |- *. -replace 1 with (1 + 0). -apply degree_le_mult. -apply poly_01_factor'_degree. -apply degree_le_c_. -auto. +Proof. + intros. + unfold poly_01_factor in |- *. + replace 1 with (1 + 0). + apply degree_le_mult. + apply poly_01_factor'_degree. + apply degree_le_c_. + auto. Qed. Lemma poly_01_factor_zero : forall n i H, (poly_01_factor n i H) ! (a_ n) [=] Zero. -intros. -unfold poly_01_factor in |- *. -astepl - ((poly_01_factor' n0) ! (a_ n0) [*] - (_C_ - (One[/] (poly_01_factor' n0) ! (a_ i) [//]poly_01_factor'_apzero n0 i H)) - ! (a_ n0)). -Step_final - (Zero[*] - (_C_ - (One[/] (poly_01_factor' n0) ! (a_ i) [//]poly_01_factor'_apzero n0 i H)) - ! (a_ n0)). +Proof. + intros. + unfold poly_01_factor in |- *. + astepl ((poly_01_factor' n0) ! (a_ n0) [*] (_C_ + (One[/] (poly_01_factor' n0) ! (a_ i) [//]poly_01_factor'_apzero n0 i H)) ! (a_ n0)). + Step_final (Zero[*] (_C_ (One[/] (poly_01_factor' n0) ! (a_ i) [//]poly_01_factor'_apzero n0 i H)) + ! (a_ n0)). Qed. Lemma poly_01_factor_one : forall n i H, (poly_01_factor n i H) ! (a_ i) [=] One. -intros. -unfold poly_01_factor in |- *. -astepl - ((poly_01_factor' n0) ! (a_ i) [*] - (_C_ - (One[/] (poly_01_factor' n0) ! (a_ i) [//]poly_01_factor'_apzero n0 i H)) - ! (a_ i)). -astepl - ((poly_01_factor' n0) ! (a_ i) [*] - (One[/] (poly_01_factor' n0) ! (a_ i) [//]poly_01_factor'_apzero n0 i H)). -apply div_1'. +Proof. + intros. + unfold poly_01_factor in |- *. + astepl ((poly_01_factor' n0) ! (a_ i) [*] (_C_ + (One[/] (poly_01_factor' n0) ! (a_ i) [//]poly_01_factor'_apzero n0 i H)) ! (a_ i)). + astepl ((poly_01_factor' n0) ! (a_ i) [*] + (One[/] (poly_01_factor' n0) ! (a_ i) [//]poly_01_factor'_apzero n0 i H)). + apply div_1'. Qed. Hint Resolve poly_01_factor_zero poly_01_factor_one: algebra. @@ -250,200 +250,202 @@ Fixpoint poly_01 (i n : nat) {struct n} : cpoly_cring R := end. Lemma poly_01_degree' : forall n i, degree_le (S n) (poly_01 i n). -intros. -induction n0 as [| n0 Hrecn0]. intros. -simpl in |- *. -elim (eq_nat_dec i 0); intro y. -apply degree_le_wd with (_C_ (One:R)). -Step_final (One:cpoly_cring R). -apply degree_le_mon with 0. -auto with arith. -apply degree_le_c_. -apply degree_le_wd with (poly_01_factor 0 i y). -algebra. -apply poly_01_factor_degree. -simpl in |- *. -elim (eq_nat_dec i (S n0)); intro. -apply degree_le_mon with (S n0). -auto. -apply degree_le_wd with (poly_01 i n0). -algebra. -auto. -replace (S (S n0)) with (1 + S n0). -apply degree_le_mult. -apply poly_01_factor_degree. -auto. -auto. +Proof. + intros. + induction n0 as [| n0 Hrecn0]. intros. + simpl in |- *. + elim (eq_nat_dec i 0); intro y. + apply degree_le_wd with (_C_ (One:R)). + Step_final (One:cpoly_cring R). + apply degree_le_mon with 0. + auto with arith. + apply degree_le_c_. + apply degree_le_wd with (poly_01_factor 0 i y). + algebra. + apply poly_01_factor_degree. + simpl in |- *. + elim (eq_nat_dec i (S n0)); intro. + apply degree_le_mon with (S n0). + auto. + apply degree_le_wd with (poly_01 i n0). + algebra. + auto. + replace (S (S n0)) with (1 + S n0). + apply degree_le_mult. + apply poly_01_factor_degree. + auto. + auto. Qed. Lemma poly_01_degree : forall n i, i <= n -> degree_le n (poly_01 i n). -intros. -induction n0 as [| n0 Hrecn0]; intros. -simpl in |- *. -elim (eq_nat_dec i 0); intro y. -apply degree_le_wd with (_C_ (One:R)). -Step_final (One:cpoly_cring R). -apply degree_le_c_. -cut (i = 0). intro. -elim (y H0). -auto with arith. -simpl in |- *. -elim (eq_nat_dec i (S n0)); intro. -apply degree_le_wd with (poly_01 i n0). -algebra. -apply poly_01_degree'. -pattern (S n0) at 1 in |- *. -replace (S n0) with (1 + n0). -apply degree_le_mult. -apply poly_01_factor_degree. -apply Hrecn0. -elim (le_lt_eq_dec _ _ H); auto with arith. -intro; elim (b b0). -auto. +Proof. + intros. + induction n0 as [| n0 Hrecn0]; intros. + simpl in |- *. + elim (eq_nat_dec i 0); intro y. + apply degree_le_wd with (_C_ (One:R)). + Step_final (One:cpoly_cring R). + apply degree_le_c_. + cut (i = 0). intro. + elim (y H0). + auto with arith. + simpl in |- *. + elim (eq_nat_dec i (S n0)); intro. + apply degree_le_wd with (poly_01 i n0). + algebra. + apply poly_01_degree'. + pattern (S n0) at 1 in |- *. + replace (S n0) with (1 + n0). + apply degree_le_mult. + apply poly_01_factor_degree. + apply Hrecn0. + elim (le_lt_eq_dec _ _ H); auto with arith. + intro; elim (b b0). + auto. Qed. Lemma poly_01_zero : forall n i j, j <= n -> j <> i -> (poly_01 i n) ! (a_ j) [=] Zero. -intros. -induction n0 as [| n0 Hrecn0]; intros. -rewrite <- (le_n_O_eq j H). -rewrite <- (le_n_O_eq j H) in H0. -simpl in |- *. -elim (eq_nat_dec i 0); intro y. -rewrite y in H0. -elim (H0 (refl_equal 0)). -astepl ((poly_01_factor 0 i y) ! (a_ 0) [*]One ! (a_ 0)). -astepl ((poly_01_factor 0 i y) ! (a_ 0) [*]One). -astepl (poly_01_factor 0 i y) ! (a_ 0). -apply poly_01_factor_zero. -elim (eq_nat_dec j (S n0)); intro y. -simpl in |- *. -rewrite <- y. -elim (eq_nat_dec i j); intro y0. -rewrite y0 in H0. -elim (H0 (refl_equal j)). -astepl ((poly_01_factor j i y0) ! (a_ j) [*] (poly_01 i n0) ! (a_ j)). -Step_final (Zero[*] (poly_01 i n0) ! (a_ j)). -cut (j <= n0). intro. -simpl in |- *. -elim (eq_nat_dec i (S n0)); intro y0. -astepl (One ! (a_ j) [*] (poly_01 i n0) ! (a_ j)). -Step_final (One ! (a_ j) [*]Zero). -astepl ((poly_01_factor (S n0) i y0) ! (a_ j) [*] (poly_01 i n0) ! (a_ j)). -Step_final ((poly_01_factor (S n0) i y0) ! (a_ j) [*]Zero). -elim (le_lt_eq_dec _ _ H); auto with arith. -intro; elim (y b). +Proof. + intros. + induction n0 as [| n0 Hrecn0]; intros. + rewrite <- (le_n_O_eq j H). + rewrite <- (le_n_O_eq j H) in H0. + simpl in |- *. + elim (eq_nat_dec i 0); intro y. + rewrite y in H0. + elim (H0 (refl_equal 0)). + astepl ((poly_01_factor 0 i y) ! (a_ 0) [*]One ! (a_ 0)). + astepl ((poly_01_factor 0 i y) ! (a_ 0) [*]One). + astepl (poly_01_factor 0 i y) ! (a_ 0). + apply poly_01_factor_zero. + elim (eq_nat_dec j (S n0)); intro y. + simpl in |- *. + rewrite <- y. + elim (eq_nat_dec i j); intro y0. + rewrite y0 in H0. + elim (H0 (refl_equal j)). + astepl ((poly_01_factor j i y0) ! (a_ j) [*] (poly_01 i n0) ! (a_ j)). + Step_final (Zero[*] (poly_01 i n0) ! (a_ j)). + cut (j <= n0). intro. + simpl in |- *. + elim (eq_nat_dec i (S n0)); intro y0. + astepl (One ! (a_ j) [*] (poly_01 i n0) ! (a_ j)). + Step_final (One ! (a_ j) [*]Zero). + astepl ((poly_01_factor (S n0) i y0) ! (a_ j) [*] (poly_01 i n0) ! (a_ j)). + Step_final ((poly_01_factor (S n0) i y0) ! (a_ j) [*]Zero). + elim (le_lt_eq_dec _ _ H); auto with arith. + intro; elim (y b). Qed. Lemma poly_01_one : forall n i, (poly_01 i n) ! (a_ i) [=] One. -intros. -induction n0 as [| n0 Hrecn0]; intros. -simpl in |- *. -elim (eq_nat_dec i 0); intro y. -astepl (One ! (a_ i) [*]One ! (a_ i)). -Step_final (One[*] (One:R)). -astepl ((poly_01_factor 0 i y) ! (a_ i) [*]One ! (a_ i)). -astepl ((poly_01_factor 0 i y) ! (a_ i) [*]One). -astepl (poly_01_factor 0 i y) ! (a_ i). -apply poly_01_factor_one. -simpl in |- *. -elim (eq_nat_dec i (S n0)); intro y. -astepl (One ! (a_ i) [*] (poly_01 i n0) ! (a_ i)). -astepl (One[*] (poly_01 i n0) ! (a_ i)). -Step_final (One[*] (One:R)). -astepl ((poly_01_factor (S n0) i y) ! (a_ i) [*] (poly_01 i n0) ! (a_ i)). -astepl ((poly_01_factor (S n0) i y) ! (a_ i) [*]One). -astepl (poly_01_factor (S n0) i y) ! (a_ i). -apply poly_01_factor_one. +Proof. + intros. + induction n0 as [| n0 Hrecn0]; intros. + simpl in |- *. + elim (eq_nat_dec i 0); intro y. + astepl (One ! (a_ i) [*]One ! (a_ i)). + Step_final (One[*] (One:R)). + astepl ((poly_01_factor 0 i y) ! (a_ i) [*]One ! (a_ i)). + astepl ((poly_01_factor 0 i y) ! (a_ i) [*]One). + astepl (poly_01_factor 0 i y) ! (a_ i). + apply poly_01_factor_one. + simpl in |- *. + elim (eq_nat_dec i (S n0)); intro y. + astepl (One ! (a_ i) [*] (poly_01 i n0) ! (a_ i)). + astepl (One[*] (poly_01 i n0) ! (a_ i)). + Step_final (One[*] (One:R)). + astepl ((poly_01_factor (S n0) i y) ! (a_ i) [*] (poly_01 i n0) ! (a_ i)). + astepl ((poly_01_factor (S n0) i y) ! (a_ i) [*]One). + astepl (poly_01_factor (S n0) i y) ! (a_ i). + apply poly_01_factor_one. Qed. Hint Resolve poly_01_zero poly_01_one: algebra. Lemma poly_representation'' : forall (a : nat -> R) i, i <= n -> (forall j, j <> i -> a j [=] Zero) -> Sum 0 n a [=] a i. -intro. intro. -elim i. -intros. -astepl (a 0[+]Sum 1 n a). -astepr (a 0[+]Zero). -apply bin_op_wd_unfolded. -algebra. -apply Sum_zero. -auto with arith. -intros. -apply H0. -intro; rewrite H3 in H1; inversion H1. -intro i'. -intros. -astepl (Sum 0 i' a[+]Sum (S i') n a). -astepr (Zero[+]a (S i')). -apply bin_op_wd_unfolded. -apply Sum_zero. -auto with arith. -intros. -apply H1. -intro; rewrite H4 in H3; exact (le_Sn_n _ H3). -astepl (a (S i') [+]Sum (S (S i')) n a). -astepr (a (S i') [+]Zero). -apply bin_op_wd_unfolded. -algebra. -apply Sum_zero. -auto with arith. -intros. -apply H1. -intro; rewrite H4 in H2; exact (le_Sn_n _ H2). +Proof. + intro. intro. + elim i. + intros. + astepl (a 0[+]Sum 1 n a). + astepr (a 0[+]Zero). + apply bin_op_wd_unfolded. + algebra. + apply Sum_zero. + auto with arith. + intros. + apply H0. + intro; rewrite H3 in H1; inversion H1. + intro i'. + intros. + astepl (Sum 0 i' a[+]Sum (S i') n a). + astepr (Zero[+]a (S i')). + apply bin_op_wd_unfolded. + apply Sum_zero. + auto with arith. + intros. + apply H1. + intro; rewrite H4 in H3; exact (le_Sn_n _ H3). + astepl (a (S i') [+]Sum (S (S i')) n a). + astepr (a (S i') [+]Zero). + apply bin_op_wd_unfolded. + algebra. + apply Sum_zero. + auto with arith. + intros. + apply H1. + intro; rewrite H4 in H2; exact (le_Sn_n _ H2). Qed. Lemma poly_representation' : forall (f_ : nat -> RX) k, k <= n -> (Sum 0 n (fun i => f_ i[*]poly_01 i n)) ! (a_ k) [=] (f_ k) ! (a_ k). -intros. -apply - eq_transitive_unfolded - with (Sum 0 n (fun i : nat => (f_ i[*]poly_01 i n) ! (a_ k))). -apply Sum_cpoly_ap with (f := fun i : nat => f_ i[*]poly_01 i n). -astepl (Sum 0 n (fun i : nat => (f_ i) ! (a_ k) [*] (poly_01 i n) ! (a_ k))). -astepr ((f_ k) ! (a_ k) [*]One). -astepr ((f_ k) ! (a_ k) [*] (poly_01 k n) ! (a_ k)). -apply - poly_representation'' - with (a := fun i : nat => (f_ i) ! (a_ k) [*] (poly_01 i n) ! (a_ k)). -auto. -intros. -Step_final ((f_ j) ! (a_ k) [*]Zero). +Proof. + intros. + apply eq_transitive_unfolded with (Sum 0 n (fun i : nat => (f_ i[*]poly_01 i n) ! (a_ k))). + apply Sum_cpoly_ap with (f := fun i : nat => f_ i[*]poly_01 i n). + astepl (Sum 0 n (fun i : nat => (f_ i) ! (a_ k) [*] (poly_01 i n) ! (a_ k))). + astepr ((f_ k) ! (a_ k) [*]One). + astepr ((f_ k) ! (a_ k) [*] (poly_01 k n) ! (a_ k)). + apply poly_representation'' with (a := fun i : nat => (f_ i) ! (a_ k) [*] (poly_01 i n) ! (a_ k)). + auto. + intros. + Step_final ((f_ j) ! (a_ k) [*]Zero). Qed. Lemma poly_representation : f [=] Sum 0 n (fun i => _C_ f ! (a_ i) [*]poly_01 i n). -apply identical_poly. -auto. -apply Sum_degree_le. auto with arith. intros. -replace n with (0 + n). -apply degree_le_mult. -apply degree_le_c_. -apply poly_01_degree. -auto. -auto with arith. -intros. -apply eq_symmetric_unfolded. -astepr (_C_ f ! (a_ i)) ! (a_ i). -apply poly_representation' with (f_ := fun i : nat => _C_ f ! (a_ i)). -auto. +Proof. + apply identical_poly. + auto. + apply Sum_degree_le. auto with arith. intros. + replace n with (0 + n). + apply degree_le_mult. + apply degree_le_c_. + apply poly_01_degree. + auto. + auto with arith. + intros. + apply eq_symmetric_unfolded. + astepr (_C_ f ! (a_ i)) ! (a_ i). + apply poly_representation' with (f_ := fun i : nat => _C_ f ! (a_ i)). + auto. Qed. Hint Resolve poly_representation: algebra. Lemma Cpoly_choose_apzero : f [#] Zero -> {i : nat | i <= n | f ! (a_ i) [#] Zero}. -intros H. -cut (Sum 0 n (fun i : nat => _C_ f ! (a_ i) [*]poly_01 i n) [#] Zero). intros H0. -elim - (Sum_apzero _ (fun i : nat => _C_ f ! (a_ i) [*]poly_01 i n) 0 n ( - le_O_n n) H0). -intro i. intro H1. -elim H1. intros H2 H3. intro H4. -exists i. -auto. -apply poly_c_apzero. -apply cring_mult_ap_zero with (poly_01 i n). -auto. -astepl f. auto. +Proof. + intros H. + cut (Sum 0 n (fun i : nat => _C_ f ! (a_ i) [*]poly_01 i n) [#] Zero). intros H0. + elim (Sum_apzero _ (fun i : nat => _C_ f ! (a_ i) [*]poly_01 i n) 0 n ( le_O_n n) H0). + intro i. intro H1. + elim H1. intros H2 H3. intro H4. + exists i. + auto. + apply poly_c_apzero. + apply cring_mult_ap_zero with (poly_01 i n). + auto. + astepl f. auto. Qed. End Poly_Representation. @@ -464,17 +466,18 @@ Notation RX := (cpoly_cring R). (* end hide *) Lemma poly_apzero : forall f : RX, f [#] Zero -> {c : R | f ! c [#] Zero}. -intros f H0. -elim (Cpoly_ex_degree _ f). intro n. intro H1. (* Set_ not necessary *) -cut (distinct1 (fun i : nat => nring i:R)). intro H2. -elim (Cpoly_choose_apzero _ (fun i : nat => nring i:R) H2 f n H1 H0). - (* Set_ not necessary *) -intro i. intros. -exists (nring i:R). -auto. -unfold distinct1 in |- *. -intros. -apply nring_different; auto. +Proof. + intros f H0. + elim (Cpoly_ex_degree _ f). intro n. intro H1. (* Set_ not necessary *) + cut (distinct1 (fun i : nat => nring i:R)). intro H2. + elim (Cpoly_choose_apzero _ (fun i : nat => nring i:R) H2 f n H1 H0). + (* Set_ not necessary *) + intro i. intros. + exists (nring i:R). + auto. + unfold distinct1 in |- *. + intros. + apply nring_different; auto. Qed. (** @@ -482,15 +485,16 @@ Also, in this situation polynomials are extensional functions. *) Lemma poly_extensional : forall p q : RX, (forall x, p ! x [=] q ! x) -> p [=] q. -intros p q H0. -apply cg_inv_unique_2. -apply not_ap_imp_eq. unfold Not in |- *. intros H1. -elim (poly_apzero (p[-]q)). intros x H2. -cut ((p[-]q) ! x [=] Zero). intro. -elim (eq_imp_not_ap _ _ _ H3 H2). -astepl (p ! x[-]q ! x). -Step_final (p ! x[-]p ! x). -auto. +Proof. + intros p q H0. + apply cg_inv_unique_2. + apply not_ap_imp_eq. unfold Not in |- *. intros H1. + elim (poly_apzero (p[-]q)). intros x H2. + cut ((p[-]q) ! x [=] Zero). intro. + elim (eq_imp_not_ap _ _ _ H3 H2). + astepl (p ! x[-]q ! x). + Step_final (p ! x[-]p ! x). + auto. Qed. End Characteristic_zero. @@ -508,61 +512,58 @@ Notation RX := (cpoly_cring R). Lemma Cpoly_apzero_interval : forall f : RX, f [#] Zero -> forall a b, a [<] b -> {c : R | a [<=] c /\ c [<=] b | f ! c [#] Zero}. -intros f H a b H0. -assert (H1 := poly_degree_lth _ f). -set (n := lth_of_poly f) in *. -cut (Zero [<] (nring n:R)). intros H2. -cut (nring n [#] (Zero:R)). intros H3. -cut - (distinct1 - (fun i : nat => nring i[*]a[+] (nring n[-]nring i) [*]b[/] nring n[//]H3)). -intro H4. -elim - (Cpoly_choose_apzero _ - (fun i : nat => nring i[*]a[+] (nring n[-]nring i) [*]b[/] nring n[//]H3) - H4 f n H1 H). -intro i. intros H6 H7. -exists (nring i[*]a[+] (nring n[-]nring i) [*]b[/] nring n[//]H3). -split. -apply shift_leEq_div. -auto. -rstepl (nring i[*]a[+] (nring n[-]nring i) [*]a). -apply plus_resp_leEq_lft. -apply mult_resp_leEq_lft. -apply less_leEq. auto. -apply shift_leEq_minus. astepl (nring (R:=R) i). -apply nring_leEq. -auto. -apply shift_div_leEq. -auto. -rstepr (nring i[*]b[+] (nring n[-]nring i) [*]b). -apply plus_resp_leEq. -apply mult_resp_leEq_lft. -apply less_leEq. auto. -astepl (nring 0:R). -apply nring_leEq. -auto with arith. -auto. -unfold distinct1 in |- *. -intros. -unfold cf_div in |- *. apply mult_rht_resp_ap. -apply zero_minus_apart. -rstepl ((nring i[-]nring j) [*] (a[-]b)). -apply mult_resp_ap_zero. -apply minus_ap_zero. -apply nring_apart. auto. -apply minus_ap_zero. -apply less_imp_ap. -auto. -apply f_rcpcl_resp_ap_zero. -apply pos_ap_zero. auto. -astepl (nring 0:R). -apply nring_less. -unfold n in |- *. -generalize H; clear H1 H; case f. -intro H; inversion H. -intros; simpl in |- *. -auto with arith. +Proof. + intros f H a b H0. + assert (H1 := poly_degree_lth _ f). + set (n := lth_of_poly f) in *. + cut (Zero [<] (nring n:R)). intros H2. + cut (nring n [#] (Zero:R)). intros H3. + cut (distinct1 (fun i : nat => nring i[*]a[+] (nring n[-]nring i) [*]b[/] nring n[//]H3)). + intro H4. + elim (Cpoly_choose_apzero _ (fun i : nat => nring i[*]a[+] (nring n[-]nring i) [*]b[/] nring n[//]H3) + H4 f n H1 H). + intro i. intros H6 H7. + exists (nring i[*]a[+] (nring n[-]nring i) [*]b[/] nring n[//]H3). + split. + apply shift_leEq_div. + auto. + rstepl (nring i[*]a[+] (nring n[-]nring i) [*]a). + apply plus_resp_leEq_lft. + apply mult_resp_leEq_lft. + apply less_leEq. auto. + apply shift_leEq_minus. astepl (nring (R:=R) i). + apply nring_leEq. + auto. + apply shift_div_leEq. + auto. + rstepr (nring i[*]b[+] (nring n[-]nring i) [*]b). + apply plus_resp_leEq. + apply mult_resp_leEq_lft. + apply less_leEq. auto. + astepl (nring 0:R). + apply nring_leEq. + auto with arith. + auto. + unfold distinct1 in |- *. + intros. + unfold cf_div in |- *. apply mult_rht_resp_ap. + apply zero_minus_apart. + rstepl ((nring i[-]nring j) [*] (a[-]b)). + apply mult_resp_ap_zero. + apply minus_ap_zero. + apply nring_apart. auto. + apply minus_ap_zero. + apply less_imp_ap. + auto. + apply f_rcpcl_resp_ap_zero. + apply pos_ap_zero. auto. + astepl (nring 0:R). + apply nring_less. + unfold n in |- *. + generalize H; clear H1 H; case f. + intro H; inversion H. + intros; simpl in |- *. + auto with arith. Qed. End Poly_ApZero_Interval. diff --git a/algebra/CPoly_Degree.v b/algebra/CPoly_Degree.v index 14f9da078..2321d362e 100644 --- a/algebra/CPoly_Degree.v +++ b/algebra/CPoly_Degree.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CPoly_NthCoeff. Require Export CFields. @@ -113,379 +113,400 @@ Notation RX := (cpoly_cring R). Lemma degree_le_wd : forall (p p' : RX) n, p [=] p' -> degree_le n p -> degree_le n p'. -unfold degree_le in |- *. intros. -Step_final (nth_coeff m p). +Proof. + unfold degree_le in |- *. intros. + Step_final (nth_coeff m p). Qed. Lemma degree_wd : forall (p p' : RX) n, p [=] p' -> degree n p -> degree n p'. -unfold degree in |- *. intros p p' n H H0. -elim H0. clear H0. intros. split. -astepl (nth_coeff n p). auto. -apply degree_le_wd with p; auto. +Proof. + unfold degree in |- *. intros p p' n H H0. + elim H0. clear H0. intros. split. + astepl (nth_coeff n p). auto. + apply degree_le_wd with p; auto. Qed. Lemma monic_wd : forall (p p' : RX) n, p [=] p' -> monic n p -> monic n p'. -unfold monic in |- *. intros. -elim H0. clear H0. intros. split. -Step_final (nth_coeff n p). -apply degree_le_wd with p; auto. +Proof. + unfold monic in |- *. intros. + elim H0. clear H0. intros. split. + Step_final (nth_coeff n p). + apply degree_le_wd with p; auto. Qed. Lemma degree_imp_degree_le : forall (p : RX) n, degree n p -> degree_le n p. -unfold degree in |- *. intros p n H. elim H. auto. +Proof. + unfold degree in |- *. intros p n H. elim H. auto. Qed. Lemma degree_le_c_ : forall c : R, degree_le 0 (_C_ c). -unfold degree_le in |- *. intros c m. elim m; intros. -elim (lt_irrefl _ H). -simpl in |- *. algebra. +Proof. + unfold degree_le in |- *. intros c m. elim m; intros. + elim (lt_irrefl _ H). + simpl in |- *. algebra. Qed. Lemma degree_c_ : forall c : R, c [#] Zero -> degree 0 (_C_ c). -unfold degree in |- *. intros. split. simpl in |- *. auto. apply degree_le_c_. +Proof. + unfold degree in |- *. intros. split. simpl in |- *. auto. apply degree_le_c_. Qed. Lemma monic_c_one : monic 0 (_C_ (One:R)). -unfold monic in |- *. intros. split. simpl in |- *. algebra. apply degree_le_c_. +Proof. + unfold monic in |- *. intros. split. simpl in |- *. algebra. apply degree_le_c_. Qed. Lemma degree_le_x_ : degree_le 1 (_X_:RX). -unfold degree_le in |- *. -intro. elim m. intros. elim (lt_n_O _ H). -intro. elim n. intros. elim (lt_irrefl _ H0). -intros. simpl in |- *. algebra. +Proof. + unfold degree_le in |- *. + intro. elim m. intros. elim (lt_n_O _ H). + intro. elim n. intros. elim (lt_irrefl _ H0). + intros. simpl in |- *. algebra. Qed. Lemma degree_x_ : degree 1 (_X_:RX). -unfold degree in |- *. split. simpl in |- *. algebra. exact degree_le_x_. +Proof. + unfold degree in |- *. split. simpl in |- *. algebra. exact degree_le_x_. Qed. Lemma monic_x_ : monic 1 (_X_:RX). -unfold monic in |- *. split. simpl in |- *. algebra. exact degree_le_x_. +Proof. + unfold monic in |- *. split. simpl in |- *. algebra. exact degree_le_x_. Qed. Lemma degree_le_mon : forall (p : RX) m n, m <= n -> degree_le m p -> degree_le n p. -unfold degree_le in |- *. intros. apply H0. -apply le_lt_trans with n; auto with arith. +Proof. + unfold degree_le in |- *. intros. apply H0. + apply le_lt_trans with n; auto with arith. Qed. Lemma degree_le_inv : forall (p : RX) n, degree_le n p -> degree_le n [--]p. -unfold degree_le in |- *. intros. -astepl ( [--] (nth_coeff m p)). -Step_final ( [--] (Zero:R)). +Proof. + unfold degree_le in |- *. intros. + astepl ( [--] (nth_coeff m p)). + Step_final ( [--] (Zero:R)). Qed. Lemma degree_le_plus : forall (p q : RX) n, degree_le n p -> degree_le n q -> degree_le n (p[+]q). -unfold degree_le in |- *. intros. -astepl (nth_coeff m p[+]nth_coeff m q). -Step_final (Zero[+] (Zero:R)). +Proof. + unfold degree_le in |- *. intros. + astepl (nth_coeff m p[+]nth_coeff m q). + Step_final (Zero[+] (Zero:R)). Qed. Lemma degree_le_minus : forall (p q : RX) n, degree_le n p -> degree_le n q -> degree_le n (p[-]q). -unfold degree_le in |- *. intros. -astepl (nth_coeff m p[-]nth_coeff m q). -Step_final (Zero[-] (Zero:R)). +Proof. + unfold degree_le in |- *. intros. + astepl (nth_coeff m p[-]nth_coeff m q). + Step_final (Zero[-] (Zero:R)). Qed. Lemma Sum_degree_le : forall (f : nat -> RX) (n k l : nat), k <= S l -> (forall i, k <= i -> i <= l -> degree_le n (f i)) -> degree_le n (Sum k l f). -unfold degree_le in |- *. intros. induction l as [| l Hrecl]; intros. -generalize (toCle _ _ H); clear H; intro H. -inversion H as [|m0 X]. -unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. -apply eq_transitive_unfolded with (nth_coeff m (Zero:RX)). -apply nth_coeff_wd. algebra. algebra. -inversion X. unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. -apply eq_transitive_unfolded with (nth_coeff m (f 0)). -apply nth_coeff_wd. cut (f 0[-]Zero [=] f 0). auto. algebra. -apply H0; try auto. rewrite H2. auto. -elim (le_lt_eq_dec _ _ H); intro y. -apply eq_transitive_unfolded with (nth_coeff m (Sum k l f[+]f (S l))). -apply nth_coeff_wd. algebra. -astepl (nth_coeff m (Sum k l f) [+]nth_coeff m (f (S l))). -astepr (Zero[+] (Zero:R)). apply bin_op_wd_unfolded. -apply Hrecl. auto with arith. intros. -apply H0. auto. auto. auto. -apply H0. auto with arith. auto. auto. -rewrite y. unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. -apply eq_transitive_unfolded with (nth_coeff m (Zero:RX)). -apply nth_coeff_wd. algebra. algebra. +Proof. + unfold degree_le in |- *. intros. induction l as [| l Hrecl]; intros. + generalize (toCle _ _ H); clear H; intro H. + inversion H as [|m0 X]. + unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. + apply eq_transitive_unfolded with (nth_coeff m (Zero:RX)). + apply nth_coeff_wd. algebra. algebra. + inversion X. unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. + apply eq_transitive_unfolded with (nth_coeff m (f 0)). + apply nth_coeff_wd. cut (f 0[-]Zero [=] f 0). auto. algebra. + apply H0; try auto. rewrite H2. auto. + elim (le_lt_eq_dec _ _ H); intro y. + apply eq_transitive_unfolded with (nth_coeff m (Sum k l f[+]f (S l))). + apply nth_coeff_wd. algebra. + astepl (nth_coeff m (Sum k l f) [+]nth_coeff m (f (S l))). + astepr (Zero[+] (Zero:R)). apply bin_op_wd_unfolded. + apply Hrecl. auto with arith. intros. + apply H0. auto. auto. auto. + apply H0. auto with arith. auto. auto. + rewrite y. unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. + apply eq_transitive_unfolded with (nth_coeff m (Zero:RX)). + apply nth_coeff_wd. algebra. algebra. Qed. Lemma degree_inv : forall (p : RX) (n : nat), degree n p -> degree n [--]p. -unfold degree in |- *. intros p n H. -elim H. clear H. intros. split. -astepl ( [--] (nth_coeff n p)). algebra. -apply degree_le_inv; auto. +Proof. + unfold degree in |- *. intros p n H. + elim H. clear H. intros. split. + astepl ( [--] (nth_coeff n p)). algebra. + apply degree_le_inv; auto. Qed. Lemma degree_plus_rht : forall (p q : RX) m n, degree_le m p -> degree n q -> m < n -> degree n (p[+]q). -unfold degree in |- *. unfold degree_le in |- *. intros. -elim X. clear X. intros. -split. -astepl (nth_coeff n p[+]nth_coeff n q). -astepl (Zero[+]nth_coeff n q). -astepl (nth_coeff n q). auto. -intros. -astepl (nth_coeff m0 p[+]nth_coeff m0 q). -cut (m < m0). intro. -Step_final (Zero[+] (Zero:R)). -apply lt_trans with n; auto. +Proof. + unfold degree in |- *. unfold degree_le in |- *. intros. + elim X. clear X. intros. + split. + astepl (nth_coeff n p[+]nth_coeff n q). + astepl (Zero[+]nth_coeff n q). + astepl (nth_coeff n q). auto. + intros. + astepl (nth_coeff m0 p[+]nth_coeff m0 q). + cut (m < m0). intro. + Step_final (Zero[+] (Zero:R)). + apply lt_trans with n; auto. Qed. Lemma degree_minus_lft : forall (p q : RX) m n, degree_le m p -> degree n q -> m < n -> degree n (q[-]p). -intros. -apply degree_wd with ( [--]p[+]q). -Step_final (q[+][--]p). -apply degree_plus_rht with m. -apply degree_le_inv. auto. auto. auto. +Proof. + intros. + apply degree_wd with ( [--]p[+]q). + Step_final (q[+][--]p). + apply degree_plus_rht with m. + apply degree_le_inv. auto. auto. auto. Qed. Lemma monic_plus : forall (p q : RX) m n, degree_le m p -> monic n q -> m < n -> monic n (p[+]q). -unfold monic in |- *. unfold degree_le in |- *. intros. -elim H0. clear H0. intros. -split. -astepl (nth_coeff n p[+]nth_coeff n q). -astepl (Zero[+]nth_coeff n q). -Step_final (nth_coeff n q). -intros. -astepl (nth_coeff m0 p[+]nth_coeff m0 q). -cut (m < m0). intro. -Step_final (Zero[+] (Zero:R)). -apply lt_trans with n; auto. +Proof. + unfold monic in |- *. unfold degree_le in |- *. intros. + elim H0. clear H0. intros. + split. + astepl (nth_coeff n p[+]nth_coeff n q). + astepl (Zero[+]nth_coeff n q). + Step_final (nth_coeff n q). + intros. + astepl (nth_coeff m0 p[+]nth_coeff m0 q). + cut (m < m0). intro. + Step_final (Zero[+] (Zero:R)). + apply lt_trans with n; auto. Qed. Lemma monic_minus : forall (p q : RX) m n, degree_le m p -> monic n q -> m < n -> monic n (q[-]p). -intros. -apply monic_wd with ( [--]p[+]q). -Step_final (q[+][--]p). -apply monic_plus with m. -apply degree_le_inv. auto. auto. auto. +Proof. + intros. + apply monic_wd with ( [--]p[+]q). + Step_final (q[+][--]p). + apply monic_plus with m. + apply degree_le_inv. auto. auto. auto. Qed. Lemma degree_le_mult : forall (p q : RX) m n, degree_le m p -> degree_le n q -> degree_le (m + n) (p[*]q). -unfold degree_le in |- *. intros. -astepl (Sum 0 m0 (fun i : nat => nth_coeff i p[*]nth_coeff (m0 - i) q)). -apply Sum_zero. auto with arith. -intros. -cut ({m < i} + {n < m0 - i}). intro. -elim H4; clear H4; intros. -Step_final (Zero[*]nth_coeff (m0 - i) q). -Step_final (nth_coeff i p[*]Zero). -elim (lt_eq_lt_dec m i); intro. -elim a; intro. -auto. -right. -omega. -right. -omega. +Proof. + unfold degree_le in |- *. intros. + astepl (Sum 0 m0 (fun i : nat => nth_coeff i p[*]nth_coeff (m0 - i) q)). + apply Sum_zero. auto with arith. + intros. + cut ({m < i} + {n < m0 - i}). intro. + elim H4; clear H4; intros. + Step_final (Zero[*]nth_coeff (m0 - i) q). + Step_final (nth_coeff i p[*]Zero). + elim (lt_eq_lt_dec m i); intro. + elim a; intro. + auto. + right. + omega. + right. + omega. Qed. Lemma degree_mult_aux : forall (p q : RX) m n, degree_le m p -> degree_le n q -> nth_coeff (m + n) (p[*]q) [=] nth_coeff m p[*]nth_coeff n q. -unfold degree_le in |- *. intros. -astepl - (Sum 0 (m + n) (fun i : nat => nth_coeff i p[*]nth_coeff (m + n - i) q)). -astepl - (Sum 0 m (fun i : nat => nth_coeff i p[*]nth_coeff (m + n - i) q) [+] - Sum (S m) (m + n) (fun i : nat => nth_coeff i p[*]nth_coeff (m + n - i) q)). -astepr (nth_coeff m p[*]nth_coeff n q[+]Zero). -apply bin_op_wd_unfolded. -elim (O_or_S m); intro y. -elim y. clear y. intros x y. rewrite <- y in H. rewrite <- y. -apply - eq_transitive_unfolded - with - (Sum 0 x (fun i : nat => nth_coeff i p[*]nth_coeff (S x + n - i) q) [+] - nth_coeff (S x) p[*]nth_coeff (S x + n - S x) q). -apply - Sum_last - with (f := fun i : nat => nth_coeff i p[*]nth_coeff (S x + n - i) q). -astepr (Zero[+]nth_coeff (S x) p[*]nth_coeff n q). -apply bin_op_wd_unfolded. -apply Sum_zero. auto with arith. intros. -cut (n < S x + n - i). intro. -Step_final (nth_coeff i p[*]Zero). -omega. -replace (S x + n - S x) with n. algebra. auto with arith. -rewrite <- y in H. rewrite <- y. -pattern n at 2 in |- *. replace n with (0 + n - 0). -apply - Sum_one with (f := fun i : nat => nth_coeff i p[*]nth_coeff (0 + n - i) q). -auto with arith. -apply Sum_zero. auto with arith. intros. -cut (m < i). intro. -Step_final (Zero[*]nth_coeff (m + n - i) q). -auto. +Proof. + unfold degree_le in |- *. intros. + astepl (Sum 0 (m + n) (fun i : nat => nth_coeff i p[*]nth_coeff (m + n - i) q)). + astepl (Sum 0 m (fun i : nat => nth_coeff i p[*]nth_coeff (m + n - i) q) [+] + Sum (S m) (m + n) (fun i : nat => nth_coeff i p[*]nth_coeff (m + n - i) q)). + astepr (nth_coeff m p[*]nth_coeff n q[+]Zero). + apply bin_op_wd_unfolded. + elim (O_or_S m); intro y. + elim y. clear y. intros x y. rewrite <- y in H. rewrite <- y. + apply eq_transitive_unfolded with + (Sum 0 x (fun i : nat => nth_coeff i p[*]nth_coeff (S x + n - i) q) [+] + nth_coeff (S x) p[*]nth_coeff (S x + n - S x) q). + apply Sum_last with (f := fun i : nat => nth_coeff i p[*]nth_coeff (S x + n - i) q). + astepr (Zero[+]nth_coeff (S x) p[*]nth_coeff n q). + apply bin_op_wd_unfolded. + apply Sum_zero. auto with arith. intros. + cut (n < S x + n - i). intro. + Step_final (nth_coeff i p[*]Zero). + omega. + replace (S x + n - S x) with n. algebra. auto with arith. + rewrite <- y in H. rewrite <- y. + pattern n at 2 in |- *. replace n with (0 + n - 0). + apply Sum_one with (f := fun i : nat => nth_coeff i p[*]nth_coeff (0 + n - i) q). + auto with arith. + apply Sum_zero. auto with arith. intros. + cut (m < i). intro. + Step_final (Zero[*]nth_coeff (m + n - i) q). + auto. Qed. Hint Resolve degree_mult_aux: algebra. Lemma monic_mult : forall (p q : RX) m n, monic m p -> monic n q -> monic (m + n) (p[*]q). -unfold monic in |- *. intros. -elim H. clear H. intros. elim H0. clear H0. intros. split. -astepl (nth_coeff m p[*]nth_coeff n q). -Step_final (One[*] (One:R)). -apply degree_le_mult; auto. +Proof. + unfold monic in |- *. intros. + elim H. clear H. intros. elim H0. clear H0. intros. split. + astepl (nth_coeff m p[*]nth_coeff n q). + Step_final (One[*] (One:R)). + apply degree_le_mult; auto. Qed. Lemma degree_le_nexp : forall (p : RX) m n, degree_le m p -> degree_le (m * n) (p[^]n). -intros. induction n as [| n Hrecn]; intros. -replace (m * 0) with 0. -apply degree_le_wd with (_C_ (One:R)). algebra. -apply degree_le_c_. -auto. -replace (m * S n) with (m * n + m). -apply degree_le_wd with (p[^]n[*]p). algebra. -apply degree_le_mult; auto. -auto. +Proof. + intros. induction n as [| n Hrecn]; intros. + replace (m * 0) with 0. + apply degree_le_wd with (_C_ (One:R)). algebra. + apply degree_le_c_. + auto. + replace (m * S n) with (m * n + m). + apply degree_le_wd with (p[^]n[*]p). algebra. + apply degree_le_mult; auto. + auto. Qed. Lemma monic_nexp : forall (p : RX) m n, monic m p -> monic (m * n) (p[^]n). -intros. induction n as [| n Hrecn]; intros. -replace (m * 0) with 0. -apply monic_wd with (_C_ (One:R)). algebra. -apply monic_c_one. -auto. -replace (m * S n) with (m * n + m). -apply monic_wd with (p[^]n[*]p). algebra. -apply monic_mult; auto. -auto. +Proof. + intros. induction n as [| n Hrecn]; intros. + replace (m * 0) with 0. + apply monic_wd with (_C_ (One:R)). algebra. + apply monic_c_one. + auto. + replace (m * S n) with (m * n + m). + apply monic_wd with (p[^]n[*]p). algebra. + apply monic_mult; auto. + auto. Qed. Lemma lt_i_lth_of_poly : forall i (p : RX), nth_coeff i p [#] Zero -> i < lth_of_poly p. -intros i. induction i as [| i Hreci]; intros; rename X into H. -induction p as [| s p Hrecp]; intros. -simpl in H. elim (ap_irreflexive_unfolded _ _ H). -simpl in |- *. auto with arith. -induction p as [| s p Hrecp]; intros. -simpl in H. elim (ap_irreflexive_unfolded _ _ H). -simpl in |- *. simpl in H. apply lt_n_S. auto. +Proof. + intros i. induction i as [| i Hreci]; intros; rename X into H. + induction p as [| s p Hrecp]; intros. + simpl in H. elim (ap_irreflexive_unfolded _ _ H). + simpl in |- *. auto with arith. + induction p as [| s p Hrecp]; intros. + simpl in H. elim (ap_irreflexive_unfolded _ _ H). + simpl in |- *. simpl in H. apply lt_n_S. auto. Qed. Lemma poly_degree_lth : forall p : RX, degree_le (lth_of_poly p) p. -unfold degree_le in |- *. intros. apply not_ap_imp_eq. intro. -elim (lt_not_le _ _ H). apply lt_le_weak. -apply lt_i_lth_of_poly. auto. +Proof. + unfold degree_le in |- *. intros. apply not_ap_imp_eq. intro. + elim (lt_not_le _ _ H). apply lt_le_weak. + apply lt_i_lth_of_poly. auto. Qed. Lemma Cpoly_ex_degree : forall p : RX, {n : nat | degree_le n p}. -intros. exists (lth_of_poly p). apply poly_degree_lth. +Proof. + intros. exists (lth_of_poly p). apply poly_degree_lth. Qed. Lemma poly_as_sum'' : forall (p : RX) n, degree_le n p -> p [=] Sum 0 n (fun i => _C_ (nth_coeff i p) [*]_X_[^]i). -unfold degree_le in |- *. intros. apply all_nth_coeff_eq_imp. intros. -apply eq_symmetric_unfolded. -apply - eq_transitive_unfolded - with - (Sum 0 n (fun i0 : nat => nth_coeff i (_C_ (nth_coeff i0 p) [*]_X_[^]i0))). -apply nth_coeff_sum with (p_ := fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i). -apply - eq_transitive_unfolded - with (Sum 0 n (fun i0 : nat => nth_coeff i0 p[*]nth_coeff i (_X_[^]i0))). -apply Sum_wd. intros. algebra. -elim (le_lt_dec i n); intros. -astepr (nth_coeff i p[*]One). -astepr (nth_coeff i p[*]nth_coeff i (_X_[^]i)). -apply - Sum_term - with - (i := i) - (f := fun i0 : nat => nth_coeff i0 p[*]nth_coeff i (_X_[^]i0)). -auto with arith. auto. -intros. -Step_final (nth_coeff j p[*]Zero). -astepr (Zero:R). -apply Sum_zero. auto with arith. intros. -cut (i <> i0). intro. -Step_final (nth_coeff i0 p[*]Zero). -intro; rewrite <- H2 in H1. -apply (le_not_lt i n); auto. +Proof. + unfold degree_le in |- *. intros. apply all_nth_coeff_eq_imp. intros. + apply eq_symmetric_unfolded. + apply eq_transitive_unfolded with + (Sum 0 n (fun i0 : nat => nth_coeff i (_C_ (nth_coeff i0 p) [*]_X_[^]i0))). + apply nth_coeff_sum with (p_ := fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i). + apply eq_transitive_unfolded + with (Sum 0 n (fun i0 : nat => nth_coeff i0 p[*]nth_coeff i (_X_[^]i0))). + apply Sum_wd. intros. algebra. + elim (le_lt_dec i n); intros. + astepr (nth_coeff i p[*]One). + astepr (nth_coeff i p[*]nth_coeff i (_X_[^]i)). + apply Sum_term with (i := i) (f := fun i0 : nat => nth_coeff i0 p[*]nth_coeff i (_X_[^]i0)). + auto with arith. auto. + intros. + Step_final (nth_coeff j p[*]Zero). + astepr (Zero:R). + apply Sum_zero. auto with arith. intros. + cut (i <> i0). intro. + Step_final (nth_coeff i0 p[*]Zero). + intro; rewrite <- H2 in H1. + apply (le_not_lt i n); auto. Qed. Hint Resolve poly_as_sum'': algebra. Lemma poly_as_sum' : forall p : RX, p [=] Sum 0 (lth_of_poly p) (fun i => _C_ (nth_coeff i p) [*]_X_[^]i). -intros. apply poly_as_sum''. apply poly_degree_lth. +Proof. + intros. apply poly_as_sum''. apply poly_degree_lth. Qed. Lemma poly_as_sum : forall (p : RX) n, degree_le n p -> forall x, p ! x [=] Sum 0 n (fun i => nth_coeff i p[*]x[^]i). -intros. -astepl (Sum 0 n (fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i)) ! x. -apply - eq_transitive_unfolded - with (Sum 0 n (fun i : nat => (_C_ (nth_coeff i p) [*]_X_[^]i) ! x)). -apply Sum_cpoly_ap with (f := fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i). -apply Sum_wd. intros. -astepl ((_C_ (nth_coeff i p)) ! x[*] (_X_[^]i) ! x). -Step_final (nth_coeff i p[*]_X_ ! x[^]i). +Proof. + intros. + astepl (Sum 0 n (fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i)) ! x. + apply eq_transitive_unfolded with (Sum 0 n (fun i : nat => (_C_ (nth_coeff i p) [*]_X_[^]i) ! x)). + apply Sum_cpoly_ap with (f := fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i). + apply Sum_wd. intros. + astepl ((_C_ (nth_coeff i p)) ! x[*] (_X_[^]i) ! x). + Step_final (nth_coeff i p[*]_X_ ! x[^]i). Qed. Lemma degree_le_zero : forall p : RX, degree_le 0 p -> {a : R | p [=] _C_ a}. -unfold degree_le in |- *. intros. -exists (nth_coeff 0 p). -apply all_nth_coeff_eq_imp. intros. -elim (O_or_S i); intro y. -elim y. clear y. intros x y. rewrite <- y. -cut (0 < S x). intro. Step_final (Zero:R). auto with arith. -rewrite <- y. algebra. +Proof. + unfold degree_le in |- *. intros. + exists (nth_coeff 0 p). + apply all_nth_coeff_eq_imp. intros. + elim (O_or_S i); intro y. + elim y. clear y. intros x y. rewrite <- y. + cut (0 < S x). intro. Step_final (Zero:R). auto with arith. + rewrite <- y. algebra. Qed. Lemma degree_le_1_imp : forall p : RX, degree_le 1 p -> {a : R | {b : R | p [=] _C_ a[*]_X_[+]_C_ b}}. -unfold degree_le in |- *. intros. -exists (nth_coeff 1 p). exists (nth_coeff 0 p). -apply all_nth_coeff_eq_imp. intros. -elim i; intros. -simpl in |- *. rational. -elim n; intros. -simpl in |- *. algebra. -simpl in |- *. apply H. auto with arith. +Proof. + unfold degree_le in |- *. intros. + exists (nth_coeff 1 p). exists (nth_coeff 0 p). + apply all_nth_coeff_eq_imp. intros. + elim i; intros. + simpl in |- *. rational. + elim n; intros. + simpl in |- *. algebra. + simpl in |- *. apply H. auto with arith. Qed. Lemma degree_le_cpoly_linear : forall (p : cpoly R) c n, degree_le (S n) (c[+X*]p) -> degree_le n p. -unfold degree_le in |- *. intros. -change (nth_coeff (S m) (cpoly_linear _ c p) [=] Zero) in |- *. -apply H. auto with arith. +Proof. + unfold degree_le in |- *. intros. + change (nth_coeff (S m) (cpoly_linear _ c p) [=] Zero) in |- *. + apply H. auto with arith. Qed. Lemma monic_cpoly_linear : forall (p : cpoly R) c n, monic (S n) (c[+X*]p) -> monic n p. -unfold monic in |- *. intros. elim H. clear H. intros. split. auto. -apply degree_le_cpoly_linear with c. auto. +Proof. + unfold monic in |- *. intros. elim H. clear H. intros. split. auto. + apply degree_le_cpoly_linear with c. auto. Qed. Lemma monic_one : forall (p : cpoly R) c, monic 1 (c[+X*]p) -> forall x, p ! x [=] One. -intros. cut (monic 0 p). unfold monic in |- *. intros. elim H0. clear H0. -intros H0 H1. -elim (degree_le_zero _ H1). intro d. intros. -astepl (_C_ d) ! x. -astepl d. -astepl (nth_coeff 0 (_C_ d)). -Step_final (nth_coeff 0 p). -apply monic_cpoly_linear with c. auto. +Proof. + intros. cut (monic 0 p). unfold monic in |- *. intros. elim H0. clear H0. + intros H0 H1. + elim (degree_le_zero _ H1). intro d. intros. + astepl (_C_ d) ! x. + astepl d. + astepl (nth_coeff 0 (_C_ d)). + Step_final (nth_coeff 0 p). + apply monic_cpoly_linear with c. auto. Qed. Lemma monic_apzero : forall (p : RX) n, monic n p -> p [#] Zero. -unfold monic in |- *. intros. -elim H. clear H. intros. -apply nth_coeff_ap_zero_imp with n. -astepl (One:R). apply one_ap_zero. +Proof. + unfold monic in |- *. intros. + elim H. clear H. intros. + apply nth_coeff_ap_zero_imp with n. + astepl (One:R). apply one_ap_zero. Qed. End Degree_props. @@ -510,75 +531,75 @@ Notation FX := (cpoly_cring F). Lemma degree_mult : forall (p q : FX) m n, degree m p -> degree n q -> degree (m + n) (p[*]q). -unfold degree in |- *. intros. rename X into H. rename X0 into H0. -elim H. clear H. intros H1 H2. elim H0. clear H0. intros H3 H4. -split. -astepl (nth_coeff m p[*]nth_coeff n q). algebra. -apply degree_le_mult; auto. +Proof. + unfold degree in |- *. intros. rename X into H. rename X0 into H0. + elim H. clear H. intros H1 H2. elim H0. clear H0. intros H3 H4. + split. + astepl (nth_coeff m p[*]nth_coeff n q). algebra. + apply degree_le_mult; auto. Qed. Lemma degree_nexp : forall (p : FX) m n, degree m p -> degree (m * n) (p[^]n). -intros. induction n as [| n Hrecn]; intros. -replace (m * 0) with 0. -apply degree_wd with (_C_ (One:F)). algebra. -apply degree_c_. algebra. -auto. -replace (m * S n) with (m * n + m). -apply degree_wd with (p[^]n[*]p). algebra. -apply degree_mult; auto. -auto. +Proof. + intros. induction n as [| n Hrecn]; intros. + replace (m * 0) with 0. + apply degree_wd with (_C_ (One:F)). algebra. + apply degree_c_. algebra. + auto. + replace (m * S n) with (m * n + m). + apply degree_wd with (p[^]n[*]p). algebra. + apply degree_mult; auto. + auto. Qed. Lemma degree_le_mult_imp : forall (p q : FX) m n, degree m p -> degree_le (m + n) (p[*]q) -> degree_le n q. -unfold degree in |- *. unfold degree_le in |- *. intros. rename H0 into H1. rename H into H0. rename X into H. elim H. clear H. intros H2 H3. -elim (Cpoly_ex_degree _ q). unfold degree_le in |- *. intro N. intro H4. - (* Set_ not necessary *) - -cut (forall k i : nat, n < i -> N - k < i -> nth_coeff i q [=] Zero). intro H5. -elim (le_lt_dec m0 N); intros H6. -replace m0 with (N - (N - m0)). apply H5 with (N - n). -omega. omega. omega. -apply H4; auto. -intro. induction k as [| k Hreck]; intros. -apply H4. rewrite <- minus_n_O in H5; auto. -elim (le_lt_eq_dec (N - k) i); try intro y. auto. rewrite y in Hreck. -apply mult_cancel_lft with (nth_coeff m p). auto. astepr (Zero:F). -apply - eq_transitive_unfolded - with - (Sum 0 (m + i) (fun j : nat => nth_coeff j p[*]nth_coeff (m + i - j) q)). -pattern i at 1 in |- *. replace i with (m + i - m). -apply eq_symmetric_unfolded. -apply - Sum_term with (f := fun j : nat => nth_coeff j p[*]nth_coeff (m + i - j) q). -auto with arith. auto with arith. -intros. elim (le_lt_dec j m); intros. -cut (i < m + i - j). intro. -cut (n < m + i - j). intro. -Step_final (nth_coeff j p[*]Zero). -omega. omega. -Step_final (Zero[*]nth_coeff (m + i - j) q). -auto with arith. -astepl (nth_coeff (m + i) (p[*]q)). -cut (m + n < m + i). intro. -auto. -auto with arith. -omega. +Proof. + unfold degree in |- *. unfold degree_le in |- *. intros. rename H0 into H1. rename H into H0. rename X into H. elim H. clear H. intros H2 H3. + elim (Cpoly_ex_degree _ q). unfold degree_le in |- *. intro N. intro H4. + (* Set_ not necessary *) + cut (forall k i : nat, n < i -> N - k < i -> nth_coeff i q [=] Zero). intro H5. + elim (le_lt_dec m0 N); intros H6. + replace m0 with (N - (N - m0)). apply H5 with (N - n). + omega. omega. omega. + apply H4; auto. + intro. induction k as [| k Hreck]; intros. + apply H4. rewrite <- minus_n_O in H5; auto. + elim (le_lt_eq_dec (N - k) i); try intro y. auto. rewrite y in Hreck. + apply mult_cancel_lft with (nth_coeff m p). auto. astepr (Zero:F). + apply eq_transitive_unfolded with + (Sum 0 (m + i) (fun j : nat => nth_coeff j p[*]nth_coeff (m + i - j) q)). + pattern i at 1 in |- *. replace i with (m + i - m). + apply eq_symmetric_unfolded. + apply Sum_term with (f := fun j : nat => nth_coeff j p[*]nth_coeff (m + i - j) q). + auto with arith. auto with arith. + intros. elim (le_lt_dec j m); intros. + cut (i < m + i - j). intro. + cut (n < m + i - j). intro. + Step_final (nth_coeff j p[*]Zero). + omega. omega. + Step_final (Zero[*]nth_coeff (m + i - j) q). + auto with arith. + astepl (nth_coeff (m + i) (p[*]q)). + cut (m + n < m + i). intro. + auto. + auto with arith. + omega. Qed. Lemma degree_mult_imp : forall (p q : FX) m n, degree m p -> degree (m + n) (p[*]q) -> degree n q. -unfold degree in |- *. intros. rename X into H. rename X0 into H0. -elim H. clear H. intros H H1. -elim H0. clear H0. intros H0 H2. -cut (degree_le n q). intro H3. split. -apply mult_cancel_ap_zero_rht with (nth_coeff m p). -astepl (nth_coeff (m + n) (p[*]q)). auto. -assumption. -apply degree_le_mult_imp with p m; auto. -unfold degree in |- *. split. auto. -assumption. +Proof. + unfold degree in |- *. intros. rename X into H. rename X0 into H0. + elim H. clear H. intros H H1. + elim H0. clear H0. intros H0 H2. + cut (degree_le n q). intro H3. split. + apply mult_cancel_ap_zero_rht with (nth_coeff m p). + astepl (nth_coeff (m + n) (p[*]q)). auto. + assumption. + apply degree_le_mult_imp with p m; auto. + unfold degree in |- *. split. auto. + assumption. Qed. End degree_props_Field. diff --git a/algebra/CPoly_Euclid.v b/algebra/CPoly_Euclid.v index c2995be13..ed9228115 100644 --- a/algebra/CPoly_Euclid.v +++ b/algebra/CPoly_Euclid.v @@ -31,15 +31,15 @@ Lemma degree_poly_div : forall (m n : nat) (f g : cpoly CR), let f1 := (_C_ (nth_coeff n g) [*] f [-] _C_ (nth_coeff (S m) f) [*] ((_X_ [^] ((S m) - n)) [*] g)) in S m >= n -> degree_le (S m) f -> degree_le n g -> degree_le m f1. Proof. -intros m n f g f1 ge_m_n df dg p Hp; unfold f1; clear f1. -rewrite nth_coeff_minus nth_coeff_c_mult_p nth_coeff_c_mult_p nth_coeff_mult. -rewrite (Sum_term _ _ _ (S m - n)); [ | omega | omega | intros ]. + intros m n f g f1 ge_m_n df dg p Hp; unfold f1; clear f1. + rewrite nth_coeff_minus nth_coeff_c_mult_p nth_coeff_c_mult_p nth_coeff_mult. + rewrite (Sum_term _ _ _ (S m - n)); [ | omega | omega | intros ]. rewrite nth_coeff_nexp_eq. destruct Hp. - replace (S m - (S m - n)) with n by omega; rational. + replace (S m - (S m - n)) with n by omega; rational. rewrite (dg (S m0 - (S m - n))); [ | omega]. rewrite df; [ rational | omega]. - rewrite nth_coeff_nexp_neq; [ rational | assumption]. + rewrite nth_coeff_nexp_neq; [ rational | assumption]. Qed. Theorem cpoly_div1 : forall (m n : nat) (f g : cpoly_cring CR), @@ -48,26 +48,26 @@ Theorem cpoly_div1 : forall (m n : nat) (f g : cpoly_cring CR), let (q,r):=qr in f [*] _C_ ((nth_coeff (S n) g) [^] (m - n)) [=] q [*] g [+] r & let (q,r):=qr in degree_le n r}. Proof. -intros m n; set (H := refl_equal (m - n)); revert H. -generalize (m - n) at 1 as p; intro p; revert m n; induction p; intros. + intros m n; set (H := refl_equal (m - n)); revert H. + generalize (m - n) at 1 as p; intro p; revert m n; induction p; intros. exists ((Zero : cpoly_cring CR),f). - rewrite <- H. - simpl (nth_coeff (S n) g[^]0); rewrite <- c_one; rational. + rewrite <- H. + simpl (nth_coeff (S n) g[^]0); rewrite <- c_one; rational. replace n with m by omega; assumption. -set (f1 := (_C_ (nth_coeff (S n) g) [*] f [-] _C_ (nth_coeff m f) [*] ((_X_ [^] (m - (S n))) [*] g))). -destruct (IHp (m - 1) n) with (f := f1) (g := g); [ omega | | assumption | omega | ]. + set (f1 := (_C_ (nth_coeff (S n) g) [*] f [-] _C_ (nth_coeff m f) [*] ((_X_ [^] (m - (S n))) [*] g))). + destruct (IHp (m - 1) n) with (f := f1) (g := g); [ omega | | assumption | omega | ]. unfold f1; clear f1. assert (HypTmp : m = S (m - 1)); [ omega | rewrite HypTmp; rewrite <- HypTmp at 1 ]. apply degree_poly_div; [ omega | rewrite <- HypTmp; assumption | assumption ]. -destruct x as [q1 r1]. -exists (q1 [+] _C_ ((nth_coeff (S n) g)[^](m - S n) [*] (nth_coeff m f)) [*] _X_ [^] (m - S n), r1); [ | assumption]. -unfold f1 in y. -rewrite ring_distl_unfolded. rewrite <- plus_assoc_unfolded. rewrite (cag_commutes _ _ r1). rewrite plus_assoc_unfolded. rewrite <- y. -replace (m - n) with (S (m - S n)) by omega. -replace (m - 1 - n) with (m - S n) by omega. -rewrite <- nexp_Sn. -generalize (nth_coeff (S n) g) (nth_coeff m f) (m - S n). -intros; rewrite c_mult c_mult; rational. + destruct x as [q1 r1]. + exists (q1 [+] _C_ ((nth_coeff (S n) g)[^](m - S n) [*] (nth_coeff m f)) [*] _X_ [^] (m - S n), r1); [ | assumption]. + unfold f1 in y. + rewrite ring_distl_unfolded. rewrite <- plus_assoc_unfolded. rewrite (cag_commutes _ _ r1). rewrite plus_assoc_unfolded. rewrite <- y. + replace (m - n) with (S (m - S n)) by omega. + replace (m - 1 - n) with (m - S n) by omega. + rewrite <- nexp_Sn. + generalize (nth_coeff (S n) g) (nth_coeff m f) (m - S n). + intros; rewrite c_mult c_mult; rational. Qed. Definition degree_lt_pair (p q : cpoly_cring CR) := (forall n : nat, degree_le (S n) q -> degree_le n p) and (degree_le O q -> p [=] Zero). @@ -75,85 +75,85 @@ Lemma cpoly_div2 : forall (n m : nat) (a b c : cpoly_cring CR), degree_le n a -> monic m b -> degree_lt_pair c b -> a [*] b [=] c -> a [=] Zero. Proof. -induction n. + induction n. intros; destruct (degree_le_zero _ _ H). move: H1. repeat rewrite s; destruct X; rewrite c_zero. intro. apply cpoly_const_eq. destruct m. - set (tmp := nth_coeff_wd _ 0 _ _ H1); destruct H0. - move: tmp. rewrite nth_coeff_c_mult_p H0 mult_one (nth_coeff_wd _ _ _ _ (s0 H2)). intro tmp; apply tmp. - set (tmp := nth_coeff_wd _ (S m) _ _ H1); destruct H0. + set (tmp := nth_coeff_wd _ 0 _ _ H1); destruct H0. + move: tmp. rewrite nth_coeff_c_mult_p H0 mult_one (nth_coeff_wd _ _ _ _ (s0 H2)). intro tmp; apply tmp. + set (tmp := nth_coeff_wd _ (S m) _ _ H1); destruct H0. move: tmp. rewrite nth_coeff_c_mult_p H0 mult_one (d m H2 (S m)). apply. apply le_n. -intros. -induction a as [ | a s ] using cpoly_induc; [ reflexivity | ]. -apply _linear_eq_zero. -move: H1. rewrite cpoly_lin ring_distl_unfolded. intro H1. -cut (a [=] Zero); [ intro aeqz; split; [ | apply aeqz ] | ]. + intros. + induction a as [ | a s ] using cpoly_induc; [ reflexivity | ]. + apply _linear_eq_zero. + move: H1. rewrite cpoly_lin ring_distl_unfolded. intro H1. + cut (a [=] Zero); [ intro aeqz; split; [ | apply aeqz ] | ]. assert (s [=] nth_coeff m (_C_ s[*]b[+]_X_[*]a[*]b)). - destruct H0; rewrite nth_coeff_plus nth_coeff_c_mult_p H0. - rewrite (nth_coeff_wd _ _ _ Zero); [ simpl; rational | ]. - rewrite aeqz; rational. + destruct H0; rewrite nth_coeff_plus nth_coeff_c_mult_p H0. + rewrite (nth_coeff_wd _ _ _ Zero); [ simpl; rational | ]. + rewrite aeqz; rational. rewrite H2. rewrite (nth_coeff_wd _ _ _ _ H1). destruct X. destruct H0. destruct m; [ rewrite (nth_coeff_wd _ _ _ _ (s0 H3)); reflexivity | apply (d m H3); apply le_n ]. -apply (IHn (S m) _ (Zero [+X*] b) (c [-] _C_ s [*] b)); [ | | | rewrite <- H1, cpoly_lin, <- c_zero; rational ]. - unfold degree_le; intros; rewrite <- (coeff_Sm_lin _ _ s). - apply H; apply lt_n_S; apply H2. + apply (IHn (S m) _ (Zero [+X*] b) (c [-] _C_ s [*] b)); [ | | | rewrite <- H1, cpoly_lin, <- c_zero; rational ]. + unfold degree_le; intros; rewrite <- (coeff_Sm_lin _ _ s). + apply H; apply lt_n_S; apply H2. split; [ rewrite coeff_Sm_lin; destruct H0; apply H0 | unfold degree_le; intros ]. destruct m0; [ inversion H2 | simpl; destruct H0 ]. apply H3; apply lt_S_n; apply H2. -unfold degree_lt_pair. -split; intros. + unfold degree_lt_pair. + split; intros. unfold degree_le; intros. rewrite nth_coeff_minus nth_coeff_c_mult_p (degree_le_cpoly_linear _ _ _ _ H2); [ | apply H3 ]. rewrite cring_mult_zero cg_inv_zero; destruct X. destruct m; [ destruct H0; apply (nth_coeff_wd _ _ _ _ (s0 H4)) | ]. apply (d n0); [ | apply H3 ]. apply (degree_le_mon _ _ n0); [ apply le_S; apply le_n | apply (degree_le_cpoly_linear _ _ _ _ H2) ]. -destruct (degree_le_zero _ _ H2) as [x s0]. move: s0. rewrite cpoly_C_. intro s0. -destruct (linear_eq_linear_ _ _ _ _ _ s0); rewrite <- H1, H4; rational. + destruct (degree_le_zero _ _ H2) as [x s0]. move: s0. rewrite cpoly_C_. intro s0. + destruct (linear_eq_linear_ _ _ _ _ _ s0); rewrite <- H1, H4; rational. Qed. Lemma cpoly_div : forall (f g : cpoly_cring CR) (n : nat), monic n g -> ex_unq (fun (qr : ProdCSetoid (cpoly_cring CR) (cpoly_cring CR)) => f[=](fst qr)[*]g[+](snd qr) and degree_lt_pair (snd qr) g). Proof. -intros; destruct n. + intros; destruct n. destruct H; destruct (degree_le_zero _ _ H0). rewrite -> (nth_coeff_wd _ _ _ _ s) in H. simpl in H; rewrite -> H in s. exists (f,Zero). - intros; destruct y; simpl (snd (s0, s1)) in *; simpl (fst (s0, s1)) in *. - destruct X; destruct d; split; [ | symmetry; apply (s3 H0) ]. - rewrite s2 (s3 H0) s -c_one; rational. + intros; destruct y; simpl (snd (s0, s1)) in *; simpl (fst (s0, s1)) in *. + destruct X; destruct d; split; [ | symmetry; apply (s3 H0) ]. + rewrite s2 (s3 H0) s -c_one; rational. simpl (fst (f, Zero : cpoly_cring CR)); simpl (snd (f, Zero : cpoly_cring CR)). replace (cpoly_zero CR) with (Zero : cpoly_cring CR) by (simpl;reflexivity). split; [ rewrite s -c_one; rational | ]. split; [ | reflexivity ]. unfold degree_le; intros; apply nth_coeff_zero. -destruct (@cpoly_div1 (max (lth_of_poly f) n) n f g); [ | destruct H; assumption | apply le_max_r | ]. + destruct (@cpoly_div1 (max (lth_of_poly f) n) n f g); [ | destruct H; assumption | apply le_max_r | ]. apply (@degree_le_mon _ _ (lth_of_poly f)); [ apply le_max_l | apply poly_degree_lth ]. -destruct H; destruct x as [q r]. -rewrite -> H, one_nexp, mult_one in y. -assert (f[=]q[*]g[+]r and degree_lt_pair r g). + destruct H; destruct x as [q r]. + rewrite -> H, one_nexp, mult_one in y. + assert (f[=]q[*]g[+]r and degree_lt_pair r g). split; [ assumption | ]. split. - intros; unfold degree_le; intros; apply y0; apply le_lt_trans with n0; [ | assumption ]. - unfold degree_le in H1; apply not_gt; intro; unfold gt in H3. - set (tmp := (H1 (S n) (lt_n_S _ _ H3))); rewrite -> H in tmp. - apply (eq_imp_not_ap _ _ _ tmp); apply ring_non_triv. + intros; unfold degree_le; intros; apply y0; apply le_lt_trans with n0; [ | assumption ]. + unfold degree_le in H1; apply not_gt; intro; unfold gt in H3. + set (tmp := (H1 (S n) (lt_n_S _ _ H3))); rewrite -> H in tmp. + apply (eq_imp_not_ap _ _ _ tmp); apply ring_non_triv. intro; unfold degree_le in H1; rewrite -> H1 in H; [ | apply lt_O_Sn ]. destruct (eq_imp_not_ap _ _ _ H); apply ap_symmetric; apply ring_non_triv. -exists (q,r); [ | assumption ]. -intros; destruct y1 as [q1 r1]; simpl (fst (q1, r1)); simpl (snd (q1, r1)) in X0. -destruct X; destruct X0; rewrite -> s in s0; assert (q [=] q1). + exists (q,r); [ | assumption ]. + intros; destruct y1 as [q1 r1]; simpl (fst (q1, r1)); simpl (snd (q1, r1)) in X0. + destruct X; destruct X0; rewrite -> s in s0; assert (q [=] q1). apply cg_inv_unique_2. apply (@cpoly_div2 (lth_of_poly (q [-] q1)) (S n) (q [-] q1) g (r1 [-] r)); [ apply poly_degree_lth | split; assumption | | ]. - destruct d; destruct d0; split. - intros; apply degree_le_minus; [ apply d0 | apply d ]; assumption. - intro; rewrite (s1 H1) (s2 H1); rational. + destruct d; destruct d0; split. + intros; apply degree_le_minus; [ apply d0 | apply d ]; assumption. + intro; rewrite (s1 H1) (s2 H1); rational. assert (r1[=]q1[*]g[+]r1[-]q1[*]g); [ rational | ]. rewrite H1 -s0; rational. -split; [ assumption | ]. -rewrite -> H1 in s0; apply (cg_cancel_lft _ _ _ _ s0). + split; [ assumption | ]. + rewrite -> H1 in s0; apply (cg_cancel_lft _ _ _ _ s0). Qed. End poly_eucl. diff --git a/algebra/CPoly_NthCoeff.v b/algebra/CPoly_NthCoeff.v index ecd5a408d..007c59ea0 100644 --- a/algebra/CPoly_NthCoeff.v +++ b/algebra/CPoly_NthCoeff.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CPolynomials. @@ -71,57 +71,59 @@ Fixpoint nth_coeff (n : nat) (p : RX) {struct p} : R := end. Lemma nth_coeff_strext : forall n p p', nth_coeff n p [#] nth_coeff n p' -> p [#] p'. -do 3 intro. -generalize n. -clear n. -pattern p, p' in |- *. -apply Ccpoly_double_sym_ind. -unfold Csymmetric in |- *. -intros. -apply ap_symmetric_unfolded. -apply X with n. -apply ap_symmetric_unfolded. -assumption. -intro p0. -pattern p0 in |- *. -apply Ccpoly_induc. -simpl in |- *. -intros. -elim (ap_irreflexive_unfolded _ _ X). -do 4 intro. -elim n. -simpl in |- *. -auto. -intros. -cut (c [#] Zero or p1 [#] Zero). -intro; apply _linear_ap_zero. -auto. -right. -apply X with n0. -astepr (Zero:R). auto. -intros. -induction n as [| n Hrecn]. -simpl in X0. -cut (c [#] d or p0 [#] q). -auto. -auto. -cut (c [#] d or p0 [#] q). -auto. -right. -apply X with n. -exact X0. +Proof. + do 3 intro. + generalize n. + clear n. + pattern p, p' in |- *. + apply Ccpoly_double_sym_ind. + unfold Csymmetric in |- *. + intros. + apply ap_symmetric_unfolded. + apply X with n. + apply ap_symmetric_unfolded. + assumption. + intro p0. + pattern p0 in |- *. + apply Ccpoly_induc. + simpl in |- *. + intros. + elim (ap_irreflexive_unfolded _ _ X). + do 4 intro. + elim n. + simpl in |- *. + auto. + intros. + cut (c [#] Zero or p1 [#] Zero). + intro; apply _linear_ap_zero. + auto. + right. + apply X with n0. + astepr (Zero:R). auto. + intros. + induction n as [| n Hrecn]. + simpl in X0. + cut (c [#] d or p0 [#] q). + auto. + auto. + cut (c [#] d or p0 [#] q). + auto. + right. + apply X with n. + exact X0. Qed. Lemma nth_coeff_wd : forall n p p', p [=] p' -> nth_coeff n p [=] nth_coeff n p'. -intros. -generalize (fun_strext_imp_wd _ _ (nth_coeff n)); intro. -unfold fun_wd in H0. -apply H0. -unfold fun_strext in |- *. -intros. -apply nth_coeff_strext with n. -assumption. -assumption. +Proof. + intros. + generalize (fun_strext_imp_wd _ _ (nth_coeff n)); intro. + unfold fun_wd in H0. + apply H0. + unfold fun_strext in |- *. + intros. + apply nth_coeff_strext with n. + assumption. + assumption. Qed. Definition nth_coeff_fun n := Build_CSetoid_fun _ _ _ (nth_coeff_strext n). @@ -168,7 +170,8 @@ The [cpoly_zero] case should be [c [=] Zero] in order to be extensional. Lemma nth_coeff_S : forall m p c, in_coeff (nth_coeff m p) p -> in_coeff (nth_coeff (S m) (c[+X*]p)) (c[+X*]p). -simpl in |- *; auto. +Proof. + simpl in |- *; auto. Qed. End NthCoeff_def. @@ -190,266 +193,270 @@ Notation RX := (cpoly_cring R). (* end hide *) Lemma nth_coeff_zero : forall n, nth_coeff n (Zero:RX) [=] Zero. -intros. -simpl in |- *. -algebra. +Proof. + intros. + simpl in |- *. + algebra. Qed. Lemma coeff_O_lin : forall p (c : R), nth_coeff 0 (c[+X*]p) [=] c. -intros. -simpl in |- *. -algebra. +Proof. + intros. + simpl in |- *. + algebra. Qed. Lemma coeff_Sm_lin : forall p (c : R) m, nth_coeff (S m) (c[+X*]p) [=] nth_coeff m p. -intros. -simpl in |- *. -algebra. +Proof. + intros. + simpl in |- *. + algebra. Qed. Lemma coeff_O_c_ : forall c : R, nth_coeff 0 (_C_ c) [=] c. -intros. -simpl in |- *. -algebra. +Proof. + intros. + simpl in |- *. + algebra. Qed. Lemma coeff_O_x_mult : forall p : RX, nth_coeff 0 (_X_[*]p) [=] Zero. -intros. -astepl (nth_coeff 0 (Zero[+]_X_[*]p)). -astepl (nth_coeff 0 (_C_ Zero[+]_X_[*]p)). -astepl (nth_coeff 0 (Zero[+X*]p)). -simpl in |- *. -algebra. +Proof. + intros. + astepl (nth_coeff 0 (Zero[+]_X_[*]p)). + astepl (nth_coeff 0 (_C_ Zero[+]_X_[*]p)). + astepl (nth_coeff 0 (Zero[+X*]p)). + simpl in |- *. + algebra. Qed. Lemma coeff_Sm_x_mult : forall (p : RX) m, nth_coeff (S m) (_X_[*]p) [=] nth_coeff m p. -intros. -astepl (nth_coeff (S m) (Zero[+]_X_[*]p)). -astepl (nth_coeff (S m) (_C_ Zero[+]_X_[*]p)). -astepl (nth_coeff (S m) (Zero[+X*]p)). -simpl in |- *. -algebra. +Proof. + intros. + astepl (nth_coeff (S m) (Zero[+]_X_[*]p)). + astepl (nth_coeff (S m) (_C_ Zero[+]_X_[*]p)). + astepl (nth_coeff (S m) (Zero[+X*]p)). + simpl in |- *. + algebra. Qed. Lemma coeff_Sm_mult_x_ : forall (p : RX) m, nth_coeff (S m) (p[*]_X_) [=] nth_coeff m p. -intros. -astepl (nth_coeff (S m) (_X_[*]p)). -apply coeff_Sm_x_mult. +Proof. + intros. + astepl (nth_coeff (S m) (_X_[*]p)). + apply coeff_Sm_x_mult. Qed. Hint Resolve nth_coeff_zero coeff_O_lin coeff_Sm_lin coeff_O_c_ coeff_O_x_mult coeff_Sm_x_mult coeff_Sm_mult_x_: algebra. Lemma nth_coeff_ap_zero_imp : forall (p : RX) n, nth_coeff n p [#] Zero -> p [#] Zero. -intros. -cut (nth_coeff n p [#] nth_coeff n Zero). -intro H0. -apply (nth_coeff_strext _ _ _ _ H0). -algebra. +Proof. + intros. + cut (nth_coeff n p [#] nth_coeff n Zero). + intro H0. + apply (nth_coeff_strext _ _ _ _ H0). + algebra. Qed. Lemma nth_coeff_plus : forall (p q : RX) n, nth_coeff n (p[+]q) [=] nth_coeff n p[+]nth_coeff n q. -do 2 intro. -pattern p, q in |- *. -apply poly_double_comp_ind. -intros. -astepl (nth_coeff n (p1[+]q1)). -astepr (nth_coeff n p1[+]nth_coeff n q1). -apply H1. -intros. -simpl in |- *. -algebra. -intros. -elim n. -simpl in |- *. -algebra. -intros. -astepl (nth_coeff n0 (p0[+]q0)). -generalize (H n0); intro. -astepl (nth_coeff n0 p0[+]nth_coeff n0 q0). -algebra. +Proof. + do 2 intro. + pattern p, q in |- *. + apply poly_double_comp_ind. + intros. + astepl (nth_coeff n (p1[+]q1)). + astepr (nth_coeff n p1[+]nth_coeff n q1). + apply H1. + intros. + simpl in |- *. + algebra. + intros. + elim n. + simpl in |- *. + algebra. + intros. + astepl (nth_coeff n0 (p0[+]q0)). + generalize (H n0); intro. + astepl (nth_coeff n0 p0[+]nth_coeff n0 q0). + algebra. Qed. Lemma nth_coeff_inv : forall (p : RX) n, nth_coeff n [--]p [=] [--] (nth_coeff n p). -intro. -pattern p in |- *. -apply cpoly_induc. -intros. -simpl in |- *. -algebra. -intros. -elim n. -simpl in |- *. -algebra. -intros. simpl in |- *. -apply H. +Proof. + intro. + pattern p in |- *. + apply cpoly_induc. + intros. + simpl in |- *. + algebra. + intros. + elim n. + simpl in |- *. + algebra. + intros. simpl in |- *. + apply H. Qed. Hint Resolve nth_coeff_inv: algebra. Lemma nth_coeff_c_mult_p : forall (p : RX) c n, nth_coeff n (_C_ c[*]p) [=] c[*]nth_coeff n p. -do 2 intro. -pattern p in |- *. -apply cpoly_induc. -intros. -astepl (nth_coeff n (Zero:RX)). -astepr (c[*]Zero). -astepl (Zero:R). -algebra. -intros. -elim n. -simpl in |- *. -algebra. -intros. -astepl (nth_coeff (S n0) (c[*]c0[+X*]_C_ c[*]p0)). -astepl (nth_coeff n0 (_C_ c[*]p0)). -astepl (c[*]nth_coeff n0 p0). -algebra. +Proof. + do 2 intro. + pattern p in |- *. + apply cpoly_induc. + intros. + astepl (nth_coeff n (Zero:RX)). + astepr (c[*]Zero). + astepl (Zero:R). + algebra. + intros. + elim n. + simpl in |- *. + algebra. + intros. + astepl (nth_coeff (S n0) (c[*]c0[+X*]_C_ c[*]p0)). + astepl (nth_coeff n0 (_C_ c[*]p0)). + astepl (c[*]nth_coeff n0 p0). + algebra. Qed. Lemma nth_coeff_p_mult_c_ : forall (p : RX) c n, nth_coeff n (p[*]_C_ c) [=] nth_coeff n p[*]c. -intros. -astepl (nth_coeff n (_C_ c[*]p)). -astepr (c[*]nth_coeff n p). -apply nth_coeff_c_mult_p. +Proof. + intros. + astepl (nth_coeff n (_C_ c[*]p)). + astepr (c[*]nth_coeff n p). + apply nth_coeff_c_mult_p. Qed. Hint Resolve nth_coeff_c_mult_p nth_coeff_p_mult_c_ nth_coeff_plus: algebra. Lemma nth_coeff_complicated : forall a b (p : RX) n, nth_coeff (S n) ((_C_ a[*]_X_[+]_C_ b) [*]p) [=] a[*]nth_coeff n p[+]b[*]nth_coeff (S n) p. -intros. -astepl (nth_coeff (S n) (_C_ a[*]_X_[*]p[+]_C_ b[*]p)). -astepl (nth_coeff (S n) (_C_ a[*]_X_[*]p) [+]nth_coeff (S n) (_C_ b[*]p)). -astepl (nth_coeff (S n) (_C_ a[*] (_X_[*]p)) [+]b[*]nth_coeff (S n) p). -astepl (a[*]nth_coeff (S n) (_X_[*]p) [+]b[*]nth_coeff (S n) p). -algebra. +Proof. + intros. + astepl (nth_coeff (S n) (_C_ a[*]_X_[*]p[+]_C_ b[*]p)). + astepl (nth_coeff (S n) (_C_ a[*]_X_[*]p) [+]nth_coeff (S n) (_C_ b[*]p)). + astepl (nth_coeff (S n) (_C_ a[*] (_X_[*]p)) [+]b[*]nth_coeff (S n) p). + astepl (a[*]nth_coeff (S n) (_X_[*]p) [+]b[*]nth_coeff (S n) p). + algebra. Qed. Lemma all_nth_coeff_eq_imp : forall p p' : RX, (forall i, nth_coeff i p [=] nth_coeff i p') -> p [=] p'. -intro. induction p as [| s p Hrecp]; intros; - [ induction p' as [| s p' Hrecp'] | induction p' as [| s0 p' Hrecp'] ]; - intros. -algebra. -simpl in |- *. simpl in H. simpl in Hrecp'. split. -apply eq_symmetric_unfolded. apply (H 0). apply Hrecp'. -intros. apply (H (S i)). -simpl in |- *. simpl in H. simpl in Hrecp. split. -apply (H 0). -change (Zero [=] (p:RX)) in |- *. apply eq_symmetric_unfolded. simpl in |- *. apply Hrecp. -intros. apply (H (S i)). -simpl in |- *. simpl in H. split. -apply (H 0). -change ((p:RX) [=] (p':RX)) in |- *. apply Hrecp. intros. apply (H (S i)). +Proof. + intro. induction p as [| s p Hrecp]; intros; + [ induction p' as [| s p' Hrecp'] | induction p' as [| s0 p' Hrecp'] ]; intros. + algebra. + simpl in |- *. simpl in H. simpl in Hrecp'. split. + apply eq_symmetric_unfolded. apply (H 0). apply Hrecp'. + intros. apply (H (S i)). + simpl in |- *. simpl in H. simpl in Hrecp. split. + apply (H 0). + change (Zero [=] (p:RX)) in |- *. apply eq_symmetric_unfolded. simpl in |- *. apply Hrecp. + intros. apply (H (S i)). + simpl in |- *. simpl in H. split. + apply (H 0). + change ((p:RX) [=] (p':RX)) in |- *. apply Hrecp. intros. apply (H (S i)). Qed. Lemma poly_at_zero : forall p : RX, p ! Zero [=] nth_coeff 0 p. -intros. induction p as [| s p Hrecp]; intros. -simpl in |- *. algebra. -simpl in |- *. Step_final (s[+]Zero). +Proof. + intros. induction p as [| s p Hrecp]; intros. + simpl in |- *. algebra. + simpl in |- *. Step_final (s[+]Zero). Qed. Lemma nth_coeff_inv' : forall (p : RX) i, nth_coeff i (cpoly_inv _ p) [=] [--] (nth_coeff i p). -intros. change (nth_coeff i [--] (p:RX) [=] [--] (nth_coeff i p)) in |- *. algebra. +Proof. + intros. change (nth_coeff i [--] (p:RX) [=] [--] (nth_coeff i p)) in |- *. algebra. Qed. Lemma nth_coeff_minus : forall (p q : RX) i, nth_coeff i (p[-]q) [=] nth_coeff i p[-]nth_coeff i q. -intros. -astepl (nth_coeff i (p[+][--]q)). -astepl (nth_coeff i p[+]nth_coeff i [--]q). -Step_final (nth_coeff i p[+][--] (nth_coeff i q)). +Proof. + intros. + astepl (nth_coeff i (p[+][--]q)). + astepl (nth_coeff i p[+]nth_coeff i [--]q). + Step_final (nth_coeff i p[+][--] (nth_coeff i q)). Qed. Hint Resolve nth_coeff_minus: algebra. Lemma nth_coeff_sum0 : forall (p_ : nat -> RX) k n, nth_coeff k (Sum0 n p_) [=] Sum0 n (fun i => nth_coeff k (p_ i)). -intros. induction n as [| n Hrecn]; intros. -simpl in |- *. algebra. -change - (nth_coeff k (Sum0 n p_[+]p_ n) [=] - Sum0 n (fun i : nat => nth_coeff k (p_ i)) [+]nth_coeff k (p_ n)) - in |- *. -Step_final (nth_coeff k (Sum0 n p_) [+]nth_coeff k (p_ n)). +Proof. + intros. induction n as [| n Hrecn]; intros. + simpl in |- *. algebra. + change (nth_coeff k (Sum0 n p_[+]p_ n) [=] + Sum0 n (fun i : nat => nth_coeff k (p_ i)) [+]nth_coeff k (p_ n)) in |- *. + Step_final (nth_coeff k (Sum0 n p_) [+]nth_coeff k (p_ n)). Qed. Lemma nth_coeff_sum : forall (p_ : nat -> RX) k m n, nth_coeff k (Sum m n p_) [=] Sum m n (fun i => nth_coeff k (p_ i)). -unfold Sum in |- *. unfold Sum1 in |- *. intros. -astepl (nth_coeff k (Sum0 (S n) p_) [-]nth_coeff k (Sum0 m p_)). -apply cg_minus_wd; apply nth_coeff_sum0. +Proof. + unfold Sum in |- *. unfold Sum1 in |- *. intros. + astepl (nth_coeff k (Sum0 (S n) p_) [-]nth_coeff k (Sum0 m p_)). + apply cg_minus_wd; apply nth_coeff_sum0. Qed. Lemma nth_coeff_nexp_eq : forall i, nth_coeff i (_X_[^]i) [=] (One:R). -intros. induction i as [| i Hreci]; intros. -simpl in |- *. algebra. -change (nth_coeff (S i) (_X_[^]i[*]_X_) [=] (One:R)) in |- *. -Step_final (nth_coeff i (_X_[^]i):R). +Proof. + intros. induction i as [| i Hreci]; intros. + simpl in |- *. algebra. + change (nth_coeff (S i) (_X_[^]i[*]_X_) [=] (One:R)) in |- *. + Step_final (nth_coeff i (_X_[^]i):R). Qed. Lemma nth_coeff_nexp_neq : forall i j, i <> j -> nth_coeff i (_X_[^]j) [=] (Zero:R). -intro; induction i as [| i Hreci]; intros; - [ induction j as [| j Hrecj] | induction j as [| j Hrecj] ]; - intros. -elim (H (refl_equal _)). -Step_final (nth_coeff 0 (_X_[*]_X_[^]j):R). -simpl in |- *. algebra. -change (nth_coeff (S i) (_X_[^]j[*]_X_) [=] (Zero:R)) in |- *. -astepl (nth_coeff i (_X_[^]j):R). -apply Hreci. auto. +Proof. + intro; induction i as [| i Hreci]; intros; + [ induction j as [| j Hrecj] | induction j as [| j Hrecj] ]; intros. + elim (H (refl_equal _)). + Step_final (nth_coeff 0 (_X_[*]_X_[^]j):R). + simpl in |- *. algebra. + change (nth_coeff (S i) (_X_[^]j[*]_X_) [=] (Zero:R)) in |- *. + astepl (nth_coeff i (_X_[^]j):R). + apply Hreci. auto. Qed. Lemma nth_coeff_mult : forall (p q : RX) n, nth_coeff n (p[*]q) [=] Sum 0 n (fun i => nth_coeff i p[*]nth_coeff (n - i) q). -intro; induction p as [| s p Hrecp]. intros. -stepl (nth_coeff n (Zero:RX)). -simpl in |- *. apply eq_symmetric_unfolded. -apply Sum_zero. auto with arith. intros. algebra. -apply nth_coeff_wd. -change (Zero[=]Zero[*]q). -algebra. -intros. -apply - eq_transitive_unfolded with (nth_coeff n (_C_ s[*]q[+]_X_[*] ((p:RX) [*]q))). -apply nth_coeff_wd. -change ((s[+X*]p) [*]q [=] _C_ s[*]q[+]_X_[*] ((p:RX) [*]q)) in |- *. -astepl ((_C_ s[+]_X_[*]p) [*]q). -Step_final (_C_ s[*]q[+]_X_[*]p[*]q). -astepl (nth_coeff n (_C_ s[*]q) [+]nth_coeff n (_X_[*] ((p:RX) [*]q))). -astepl (s[*]nth_coeff n q[+]nth_coeff n (_X_[*] ((p:RX) [*]q))). -induction n as [| n Hrecn]; intros. -astepl (s[*]nth_coeff 0 q[+]Zero). -astepl (s[*]nth_coeff 0 q). -astepl (nth_coeff 0 (cpoly_linear _ s p) [*]nth_coeff 0 q). -pattern 0 at 2 in |- *. replace 0 with (0 - 0). -apply eq_symmetric_unfolded. -apply - Sum_one - with - (f := fun i : nat => - nth_coeff i (cpoly_linear _ s p) [*]nth_coeff (0 - i) q). -auto. -astepl (s[*]nth_coeff (S n) q[+]nth_coeff n ((p:RX) [*]q)). -apply - eq_transitive_unfolded - with - (nth_coeff 0 (cpoly_linear _ s p) [*]nth_coeff (S n - 0) q[+] - Sum 1 (S n) - (fun i : nat => - nth_coeff i (cpoly_linear _ s p) [*]nth_coeff (S n - i) q)). -apply bin_op_wd_unfolded. algebra. -astepl (Sum 0 n (fun i : nat => nth_coeff i p[*]nth_coeff (n - i) q)). -apply Sum_shift. intros. simpl in |- *. algebra. -apply eq_symmetric_unfolded. -apply - Sum_first - with - (f := fun i : nat => - nth_coeff i (cpoly_linear _ s p) [*]nth_coeff (S n - i) q). +Proof. + intro; induction p as [| s p Hrecp]. intros. + stepl (nth_coeff n (Zero:RX)). + simpl in |- *. apply eq_symmetric_unfolded. + apply Sum_zero. auto with arith. intros. algebra. + apply nth_coeff_wd. + change (Zero[=]Zero[*]q). + algebra. + intros. + apply eq_transitive_unfolded with (nth_coeff n (_C_ s[*]q[+]_X_[*] ((p:RX) [*]q))). + apply nth_coeff_wd. + change ((s[+X*]p) [*]q [=] _C_ s[*]q[+]_X_[*] ((p:RX) [*]q)) in |- *. + astepl ((_C_ s[+]_X_[*]p) [*]q). + Step_final (_C_ s[*]q[+]_X_[*]p[*]q). + astepl (nth_coeff n (_C_ s[*]q) [+]nth_coeff n (_X_[*] ((p:RX) [*]q))). + astepl (s[*]nth_coeff n q[+]nth_coeff n (_X_[*] ((p:RX) [*]q))). + induction n as [| n Hrecn]; intros. + astepl (s[*]nth_coeff 0 q[+]Zero). + astepl (s[*]nth_coeff 0 q). + astepl (nth_coeff 0 (cpoly_linear _ s p) [*]nth_coeff 0 q). + pattern 0 at 2 in |- *. replace 0 with (0 - 0). + apply eq_symmetric_unfolded. + apply Sum_one with (f := fun i : nat => nth_coeff i (cpoly_linear _ s p) [*]nth_coeff (0 - i) q). + auto. + astepl (s[*]nth_coeff (S n) q[+]nth_coeff n ((p:RX) [*]q)). + apply eq_transitive_unfolded with (nth_coeff 0 (cpoly_linear _ s p) [*]nth_coeff (S n - 0) q[+] + Sum 1 (S n) (fun i : nat => nth_coeff i (cpoly_linear _ s p) [*]nth_coeff (S n - i) q)). + apply bin_op_wd_unfolded. algebra. + astepl (Sum 0 n (fun i : nat => nth_coeff i p[*]nth_coeff (n - i) q)). + apply Sum_shift. intros. simpl in |- *. algebra. + apply eq_symmetric_unfolded. + apply Sum_first with (f := fun i : nat => nth_coeff i (cpoly_linear _ s p) [*]nth_coeff (S n - i) q). Qed. End NthCoeff_props. diff --git a/algebra/CPolynomials.v b/algebra/CPolynomials.v index 236767a73..5b7b80786 100644 --- a/algebra/CPolynomials.v +++ b/algebra/CPolynomials.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing _X_ %\ensuremath{x}% *) (** printing _C_ %\ensuremath\diamond% *) @@ -85,43 +85,49 @@ Some useful induction lemmas for doubly quantified propositions. Lemma Ccpoly_double_ind0 : forall P : cpoly -> cpoly -> CProp, (forall p, P p cpoly_zero) -> (forall p, P cpoly_zero p) -> (forall p q c d, P p q -> P (cpoly_linear c p) (cpoly_linear d q)) -> forall p q, P p q. -simple induction p; auto. -simple induction q; auto. +Proof. + simple induction p; auto. + simple induction q; auto. Qed. Lemma Ccpoly_double_sym_ind0 : forall P : cpoly -> cpoly -> CProp, - Csymmetric P -> (forall p, P p cpoly_zero) -> + Csymmetric P -> (forall p, P p cpoly_zero) -> (forall p q c d, P p q -> P (cpoly_linear c p) (cpoly_linear d q)) -> forall p q, P p q. -intros. -apply Ccpoly_double_ind0; auto. +Proof. + intros. + apply Ccpoly_double_ind0; auto. Qed. Lemma Ccpoly_double_ind0' : forall P : cpoly -> cpoly -> CProp, (forall p, P cpoly_zero p) -> (forall p c, P (cpoly_linear c p) cpoly_zero) -> (forall p q c d, P p q -> P (cpoly_linear c p) (cpoly_linear d q)) -> forall p q, P p q. -simple induction p; auto. -simple induction q; auto. +Proof. + simple induction p; auto. + simple induction q; auto. Qed. Lemma cpoly_double_ind0 : forall P : cpoly -> cpoly -> Prop, (forall p, P p cpoly_zero) -> (forall p, P cpoly_zero p) -> (forall p q c d, P p q -> P (cpoly_linear c p) (cpoly_linear d q)) -> forall p q, P p q. -simple induction p; auto. -simple induction q; auto. +Proof. + simple induction p; auto. + simple induction q; auto. Qed. Lemma cpoly_double_sym_ind0 : forall P : cpoly -> cpoly -> Prop, Tsymmetric P -> (forall p, P p cpoly_zero) -> (forall p q c d, P p q -> P (cpoly_linear c p) (cpoly_linear d q)) -> forall p q, P p q. -intros. -apply cpoly_double_ind0; auto. +Proof. + intros. + apply cpoly_double_ind0; auto. Qed. Lemma cpoly_double_ind0' : forall P : cpoly -> cpoly -> Prop, (forall p, P cpoly_zero p) -> (forall p c, P (cpoly_linear c p) cpoly_zero) -> (forall p q c d, P p q -> P (cpoly_linear c p) (cpoly_linear d q)) -> forall p q, P p q. -simple induction p; auto. -simple induction q; auto. +Proof. + simple induction p; auto. + simple induction q; auto. Qed. (** @@ -144,7 +150,8 @@ Fixpoint cpoly_eq (p q : cpoly) {struct p} : Prop := end. Lemma cpoly_eq_p_zero : forall p, cpoly_eq p cpoly_zero = cpoly_eq_zero p. -simple induction p; auto. +Proof. + simple induction p; auto. Qed. Fixpoint cpoly_ap_zero (p : cpoly) : CProp := @@ -164,174 +171,179 @@ Fixpoint cpoly_ap (p q : cpoly) {struct p} : CProp := end. Lemma cpoly_ap_p_zero : forall p, cpoly_ap_zero p = cpoly_ap p cpoly_zero. -simple induction p; auto. +Proof. + simple induction p; auto. Qed. Lemma irreflexive_cpoly_ap : irreflexive cpoly_ap. -red in |- *. -intro p; induction p as [| s p Hrecp]. -intro H; elim H. -intro H. -elim H. - apply ap_irreflexive_unfolded. -assumption. +Proof. + red in |- *. + intro p; induction p as [| s p Hrecp]. + intro H; elim H. + intro H. + elim H. + apply ap_irreflexive_unfolded. + assumption. Qed. Lemma symmetric_cpoly_ap : Csymmetric cpoly_ap. -red in |- *. -intros x y. -pattern x, y in |- *. -apply Ccpoly_double_ind0'. - simpl in |- *; simple induction p; auto. - simpl in |- *; auto. -simpl in |- *. -intros p q c d H H0. -elim H0; intro H1. - left. - apply ap_symmetric_unfolded. - assumption. -auto. +Proof. + red in |- *. + intros x y. + pattern x, y in |- *. + apply Ccpoly_double_ind0'. + simpl in |- *; simple induction p; auto. + simpl in |- *; auto. + simpl in |- *. + intros p q c d H H0. + elim H0; intro H1. + left. + apply ap_symmetric_unfolded. + assumption. + auto. Qed. Lemma cotransitive_cpoly_ap : cotransitive cpoly_ap. -red in |- *. -intros x y. -pattern x, y in |- *. -apply Ccpoly_double_sym_ind0. - red in |- *; intros p q H H0 r. - generalize (symmetric_cpoly_ap _ _ H0); intro H1. - elim (H H1 r); intro H2; [ right | left ]; apply symmetric_cpoly_ap; - assumption. - simpl in |- *; intros p H z. - generalize H. - pattern p, z in |- *. - apply Ccpoly_double_ind0'. - simpl in |- *; intros q H0; elim H0. - simpl in |- *; auto. - simpl in |- *; intros r q c d H0 H1. - elim H1; intro H2. - generalize (ap_cotransitive_unfolded _ _ _ H2 d); intro H3. - elim H3; auto. - rewrite cpoly_ap_p_zero in H2. - elim (H0 H2); auto. - right; right; rewrite cpoly_ap_p_zero; assumption. -intros p q c d H H0 r. -simpl in H0. -elim H0; intro H1. - induction r as [| s r Hrecr]. +Proof. + red in |- *. + intros x y. + pattern x, y in |- *. + apply Ccpoly_double_sym_ind0. + red in |- *; intros p q H H0 r. + generalize (symmetric_cpoly_ap _ _ H0); intro H1. + elim (H H1 r); intro H2; [ right | left ]; apply symmetric_cpoly_ap; assumption. + simpl in |- *; intros p H z. + generalize H. + pattern p, z in |- *. + apply Ccpoly_double_ind0'. + simpl in |- *; intros q H0; elim H0. + simpl in |- *; auto. + simpl in |- *; intros r q c d H0 H1. + elim H1; intro H2. + generalize (ap_cotransitive_unfolded _ _ _ H2 d); intro H3. + elim H3; auto. + rewrite cpoly_ap_p_zero in H2. + elim (H0 H2); auto. + right; right; rewrite cpoly_ap_p_zero; assumption. + intros p q c d H H0 r. + simpl in H0. + elim H0; intro H1. + induction r as [| s r Hrecr]. + simpl in |- *. + generalize (ap_cotransitive_unfolded _ _ _ H1 Zero); intro H2. + elim H2; auto. + intro H3. + right; left; apply ap_symmetric_unfolded; assumption. simpl in |- *. - generalize (ap_cotransitive_unfolded _ _ _ H1 Zero); intro H2. + generalize (ap_cotransitive_unfolded _ _ _ H1 s); intro H2. elim H2; auto. - intro H3. - right; left; apply ap_symmetric_unfolded; assumption. - simpl in |- *. - generalize (ap_cotransitive_unfolded _ _ _ H1 s); intro H2. - elim H2; auto. -induction r as [| s r Hrecr]. - simpl in |- *. - cut (cpoly_ap_zero p or cpoly_ap_zero q). - intro H2; elim H2; auto. - generalize H1; pattern p, q in |- *; apply Ccpoly_double_ind0. - simpl in |- *. - intros r H2. - left; rewrite cpoly_ap_p_zero; assumption. - auto. - simpl in |- *. - intros p0 q0 c0 d0 H2 H3. - elim H3; intro H4. - elim (ap_cotransitive_unfolded _ _ _ H4 Zero); intro H5. + induction r as [| s r Hrecr]. + simpl in |- *. + cut (cpoly_ap_zero p or cpoly_ap_zero q). + intro H2; elim H2; auto. + generalize H1; pattern p, q in |- *; apply Ccpoly_double_ind0. + simpl in |- *. + intros r H2. + left; rewrite cpoly_ap_p_zero; assumption. auto. - right; left; apply ap_symmetric_unfolded; assumption. - elim (H2 H4); auto. -simpl in |- *. -elim (H H1 r); auto. + simpl in |- *. + intros p0 q0 c0 d0 H2 H3. + elim H3; intro H4. + elim (ap_cotransitive_unfolded _ _ _ H4 Zero); intro H5. + auto. + right; left; apply ap_symmetric_unfolded; assumption. + elim (H2 H4); auto. + simpl in |- *. + elim (H H1 r); auto. Qed. Lemma tight_apart_cpoly_ap : tight_apart cpoly_eq cpoly_ap. -red in |- *. -intros x y. -pattern x, y in |- *. -apply cpoly_double_ind0'. +Proof. + red in |- *. + intros x y. + pattern x, y in |- *. + apply cpoly_double_ind0'. + simple induction p. + simpl in |- *. + unfold iff in |- *. + unfold Not in |- *. + split. + auto. + intros H H0; inversion H0. + simpl in |- *. + intros s c H. + cut (Not (s [#] Zero) <-> s [=] Zero). + unfold Not in |- *. + intro H0. + elim H0; intros H1 H2. + split. + intro H3. + split; auto. + elim H; intros H4 H5. + apply H4. + intro H6. + auto. + intros H3 H4. + elim H3; intros H5 H6. + elim H4; intros H7. + auto. + elim H; intros H8 H9. + unfold Not in H8. + elim H9; assumption. + apply (ap_tight CR). simple induction p. simpl in |- *. - unfold iff in |- *. - unfold Not in |- *. - split. - auto. - intros H H0; inversion H0. - simpl in |- *. - intros s c H. - cut (Not (s [#] Zero) <-> s [=] Zero). - unfold Not in |- *. - intro H0. - elim H0; intros H1 H2. - split. - intro H3. - split; auto. - elim H; intros H4 H5. - apply H4. - intro H6. - auto. - intros H3 H4. - elim H3; intros H5 H6. - elim H4; intros H7. - auto. - elim H; intros H8 H9. - unfold Not in H8. - elim H9; assumption. - apply (ap_tight CR). - simple induction p. + intro c. + cut (Not (c [#] Zero) <-> c [=] Zero). + unfold Not in |- *. + intro H. + elim H; intros H0 H1. + split. + auto. + intros H2 H3. + elim H3; intro H4. + tauto. + elim H4. + apply (ap_tight CR). simpl in |- *. - intro c. - cut (Not (c [#] Zero) <-> c [=] Zero). - unfold Not in |- *. - intro H. - elim H; intros H0 H1. - split. - auto. - intros H2 H3. - elim H3; intro H4. - tauto. - elim H4. - apply (ap_tight CR). + intros s c H d. + generalize (H d). + generalize (ap_tight CR d Zero). + generalize (ap_tight CR s Zero). + unfold Not in |- *. + intros H0 H1 H2. + elim H0; clear H0; intros H3 H4. + elim H1; clear H1; intros H0 H5. + elim H2; clear H2; intros H1 H6. + tauto. simpl in |- *. - intros s c H d. - generalize (H d). - generalize (ap_tight CR d Zero). - generalize (ap_tight CR s Zero). unfold Not in |- *. - intros H0 H1 H2. - elim H0; clear H0; intros H3 H4. - elim H1; clear H1; intros H0 H5. - elim H2; clear H2; intros H1 H6. - tauto. -simpl in |- *. -unfold Not in |- *. -intros p q c d H. -elim H; intros H0 H1. -split. - intro H2. + intros p q c d H. + elim H; intros H0 H1. split. + intro H2. + split. + generalize (ap_tight CR c d). + unfold Not in |- *; tauto. + tauto. + intros H2 H3. + elim H3. + elim H2. + intros H4 H5 H6. generalize (ap_tight CR c d). - unfold Not in |- *; tauto. - tauto. -intros H2 H3. -elim H3. + unfold Not in |- *. + tauto. elim H2. - intros H4 H5 H6. - generalize (ap_tight CR c d). - unfold Not in |- *. - tauto. -elim H2. -auto. + auto. Qed. Lemma cpoly_is_CSetoid : is_CSetoid _ cpoly_eq cpoly_ap. -apply Build_is_CSetoid. -exact irreflexive_cpoly_ap. -exact symmetric_cpoly_ap. -exact cotransitive_cpoly_ap. -exact tight_apart_cpoly_ap. +Proof. + apply Build_is_CSetoid. + exact irreflexive_cpoly_ap. + exact symmetric_cpoly_ap. + exact cotransitive_cpoly_ap. + exact tight_apart_cpoly_ap. Qed. Definition cpoly_csetoid := Build_CSetoid _ _ _ cpoly_is_CSetoid. @@ -354,184 +366,207 @@ Let cpoly_linear_cs c (p : cpoly_csetoid) : cpoly_csetoid := cpoly_linear c p. Lemma Ccpoly_ind_cs : forall P : cpoly_csetoid -> CProp, P cpoly_zero_cs -> (forall p c, P p -> P (cpoly_linear_cs c p)) -> forall p, P p. -simple induction p; auto. -unfold cpoly_linear_cs in X0. -auto. +Proof. + simple induction p; auto. + unfold cpoly_linear_cs in X0. + auto. Qed. Lemma Ccpoly_double_ind0_cs : forall P : cpoly_csetoid -> cpoly_csetoid -> CProp, (forall p, P p cpoly_zero_cs) -> (forall p, P cpoly_zero_cs p) -> (forall p q c d, P p q -> P (cpoly_linear_cs c p) (cpoly_linear_cs d q)) -> forall p q, P p q. -simple induction p. -auto. -simple induction q. -auto. -simpl in X1. -unfold cpoly_linear_cs in X1. -auto. +Proof. + simple induction p. + auto. + simple induction q. + auto. + simpl in X1. + unfold cpoly_linear_cs in X1. + auto. Qed. Lemma Ccpoly_double_sym_ind0_cs : forall P : cpoly_csetoid -> cpoly_csetoid -> CProp, Csymmetric P -> (forall p, P p cpoly_zero_cs) -> (forall p q c d, P p q -> P (cpoly_linear_cs c p) (cpoly_linear_cs d q)) -> forall p q, P p q. -intros. -apply Ccpoly_double_ind0; auto. +Proof. + intros. + apply Ccpoly_double_ind0; auto. Qed. Lemma cpoly_ind_cs : forall P : cpoly_csetoid -> Prop, P cpoly_zero_cs -> (forall p c, P p -> P (cpoly_linear_cs c p)) -> forall p, P p. -simple induction p; auto. -unfold cpoly_linear_cs in H0. -auto. +Proof. + simple induction p; auto. + unfold cpoly_linear_cs in H0. + auto. Qed. Lemma cpoly_double_ind0_cs : forall P : cpoly_csetoid -> cpoly_csetoid -> Prop, (forall p, P p cpoly_zero_cs) -> (forall p, P cpoly_zero_cs p) -> (forall p q c d, P p q -> P (cpoly_linear_cs c p) (cpoly_linear_cs d q)) -> forall p q, P p q. -simple induction p. -auto. -simple induction q. -auto. -simpl in H1. -unfold cpoly_linear_cs in H1. -auto. +Proof. + simple induction p. + auto. + simple induction q. + auto. + simpl in H1. + unfold cpoly_linear_cs in H1. + auto. Qed. Lemma cpoly_double_sym_ind0_cs : forall P : cpoly_csetoid -> cpoly_csetoid -> Prop, Tsymmetric P -> (forall p, P p cpoly_zero_cs) -> (forall p q c d, P p q -> P (cpoly_linear_cs c p) (cpoly_linear_cs d q)) -> forall p q, P p q. -intros. -apply cpoly_double_ind0; auto. +Proof. + intros. + apply cpoly_double_ind0; auto. Qed. Lemma cpoly_lin_eq_zero_ : forall p c, cpoly_linear_cs c p [=] cpoly_zero_cs -> c [=] Zero /\ p [=] cpoly_zero_cs. -unfold cpoly_linear_cs in |- *. -unfold cpoly_zero_cs in |- *. -simpl in |- *. -intros p c H. -elim H; intros. -split; auto. -rewrite cpoly_eq_p_zero. -assumption. +Proof. + unfold cpoly_linear_cs in |- *. + unfold cpoly_zero_cs in |- *. + simpl in |- *. + intros p c H. + elim H; intros. + split; auto. + rewrite cpoly_eq_p_zero. + assumption. Qed. Lemma _cpoly_lin_eq_zero : forall p c, c [=] Zero /\ p [=] cpoly_zero_cs -> cpoly_linear_cs c p [=] cpoly_zero_cs. -unfold cpoly_linear_cs in |- *. -unfold cpoly_zero_cs in |- *. -simpl in |- *. -intros p c H. -elim H; intros. -split; auto. -rewrite <- cpoly_eq_p_zero. -assumption. +Proof. + unfold cpoly_linear_cs in |- *. + unfold cpoly_zero_cs in |- *. + simpl in |- *. + intros p c H. + elim H; intros. + split; auto. + rewrite <- cpoly_eq_p_zero. + assumption. Qed. Lemma cpoly_zero_eq_lin_ : forall p c, cpoly_zero_cs [=] cpoly_linear_cs c p -> c [=] Zero /\ cpoly_zero_cs [=] p. -auto. +Proof. + auto. Qed. Lemma _cpoly_zero_eq_lin : forall p c, c [=] Zero /\ cpoly_zero_cs [=] p -> cpoly_zero_cs [=] cpoly_linear_cs c p. -auto. +Proof. + auto. Qed. Lemma cpoly_lin_eq_lin_ : forall p q c d, cpoly_linear_cs c p [=] cpoly_linear_cs d q -> c [=] d /\ p [=] q. -auto. +Proof. + auto. Qed. Lemma _cpoly_lin_eq_lin : forall p q c d, c [=] d /\ p [=] q -> cpoly_linear_cs c p [=] cpoly_linear_cs d q. -auto. +Proof. + auto. Qed. Lemma cpoly_lin_ap_zero_ : forall p c, cpoly_linear_cs c p [#] cpoly_zero_cs -> c [#] Zero or p [#] cpoly_zero_cs. -unfold cpoly_zero_cs in |- *. -intros p c H. -cut (cpoly_ap (cpoly_linear c p) cpoly_zero); auto. -intro H0. -simpl in H0. -elim H0; auto. -right. -rewrite <- cpoly_ap_p_zero. -assumption. +Proof. + unfold cpoly_zero_cs in |- *. + intros p c H. + cut (cpoly_ap (cpoly_linear c p) cpoly_zero); auto. + intro H0. + simpl in H0. + elim H0; auto. + right. + rewrite <- cpoly_ap_p_zero. + assumption. Qed. Lemma _cpoly_lin_ap_zero : forall p c, c [#] Zero or p [#] cpoly_zero_cs -> cpoly_linear_cs c p [#] cpoly_zero_cs. -unfold cpoly_zero_cs in |- *. -intros. -simpl in |- *. -elim X; try auto. -intros. -right. -rewrite cpoly_ap_p_zero. -assumption. +Proof. + unfold cpoly_zero_cs in |- *. + intros. + simpl in |- *. + elim X; try auto. + intros. + right. + rewrite cpoly_ap_p_zero. + assumption. Qed. Lemma cpoly_lin_ap_zero : forall p c, (cpoly_linear_cs c p [#] cpoly_zero_cs) = (c [#] Zero or p [#] cpoly_zero_cs). -intros. -simpl in |- *. -unfold cpoly_zero_cs in |- *. -rewrite cpoly_ap_p_zero. -reflexivity. +Proof. + intros. + simpl in |- *. + unfold cpoly_zero_cs in |- *. + rewrite cpoly_ap_p_zero. + reflexivity. Qed. Lemma cpoly_zero_ap_lin_ : forall p c, cpoly_zero_cs [#] cpoly_linear_cs c p -> c [#] Zero or cpoly_zero_cs [#] p. -intros. -simpl in |- *. -assumption. +Proof. + intros. + simpl in |- *. + assumption. Qed. Lemma _cpoly_zero_ap_lin : forall p c, c [#] Zero or cpoly_zero_cs [#] p -> cpoly_zero_cs [#] cpoly_linear_cs c p. -intros. -simpl in |- *. -assumption. +Proof. + intros. + simpl in |- *. + assumption. Qed. Lemma cpoly_zero_ap_lin : forall p c, (cpoly_zero_cs [#] cpoly_linear_cs c p) = (c [#] Zero or cpoly_zero_cs [#] p). -intros. -simpl in |- *. -reflexivity. +Proof. + intros. + simpl in |- *. + reflexivity. Qed. Lemma cpoly_lin_ap_lin_ : forall p q c d, cpoly_linear_cs c p [#] cpoly_linear_cs d q -> c [#] d or p [#] q. -auto. +Proof. + auto. Qed. Lemma _cpoly_lin_ap_lin : forall p q c d, c [#] d or p [#] q -> cpoly_linear_cs c p [#] cpoly_linear_cs d q. -auto. +Proof. + auto. Qed. Lemma cpoly_lin_ap_lin : forall p q c d, (cpoly_linear_cs c p [#] cpoly_linear_cs d q) = (c [#] d or p [#] q). -intros. -simpl in |- *. -reflexivity. +Proof. + intros. + simpl in |- *. + reflexivity. Qed. Lemma cpoly_linear_strext : bin_fun_strext _ _ _ cpoly_linear_cs. -unfold bin_fun_strext in |- *. -intros. -apply cpoly_lin_ap_lin_. -assumption. +Proof. + unfold bin_fun_strext in |- *. + intros. + apply cpoly_lin_ap_lin_. + assumption. Qed. Lemma cpoly_linear_wd : bin_fun_wd _ _ _ cpoly_linear_cs. -apply bin_fun_strext_imp_wd. -exact cpoly_linear_strext. +Proof. + apply bin_fun_strext_imp_wd. + exact cpoly_linear_strext. Qed. Definition cpoly_linear_fun := Build_CSetoid_bin_fun _ _ _ _ cpoly_linear_strext. @@ -540,30 +575,30 @@ Lemma Ccpoly_double_comp_ind : forall P : cpoly_csetoid -> cpoly_csetoid -> CPro (forall p1 p2 q1 q2, p1 [=] p2 -> q1 [=] q2 -> P p1 q1 -> P p2 q2) -> P cpoly_zero_cs cpoly_zero_cs -> (forall p q c d, P p q -> P (cpoly_linear_cs c p) (cpoly_linear_cs d q)) -> forall p q, P p q. -intros. -apply Ccpoly_double_ind0_cs. -intro p0; pattern p0 in |- *; apply Ccpoly_ind_cs. -assumption. -intros p1 c. intros. -apply X with (cpoly_linear_cs c p1) (cpoly_linear_cs Zero cpoly_zero_cs). -algebra. -apply _cpoly_lin_eq_zero. -split; algebra. -apply X1. -assumption. - -intro p0; pattern p0 in |- *; apply Ccpoly_ind_cs. -assumption. -intros. -apply X with (cpoly_linear_cs Zero cpoly_zero_cs) (cpoly_linear_cs c p1). -apply _cpoly_lin_eq_zero. -split; algebra. -algebra. -apply X1. -assumption. -intros. -apply X1. -assumption. +Proof. + intros. + apply Ccpoly_double_ind0_cs. + intro p0; pattern p0 in |- *; apply Ccpoly_ind_cs. + assumption. + intros p1 c. intros. + apply X with (cpoly_linear_cs c p1) (cpoly_linear_cs Zero cpoly_zero_cs). + algebra. + apply _cpoly_lin_eq_zero. + split; algebra. + apply X1. + assumption. + intro p0; pattern p0 in |- *; apply Ccpoly_ind_cs. + assumption. + intros. + apply X with (cpoly_linear_cs Zero cpoly_zero_cs) (cpoly_linear_cs c p1). + apply _cpoly_lin_eq_zero. + split; algebra. + algebra. + apply X1. + assumption. + intros. + apply X1. + assumption. Qed. Lemma Ccpoly_triple_comp_ind : @@ -574,77 +609,67 @@ Lemma Ccpoly_triple_comp_ind : (forall p q r c d e, P p q r -> P (cpoly_linear_cs c p) (cpoly_linear_cs d q) (cpoly_linear_cs e r)) -> forall p q r, P p q r. -do 6 intro. -pattern p, q in |- *. -apply Ccpoly_double_comp_ind. -intros. -apply X with p1 q1 r. -assumption. -assumption. -algebra. -apply X2. - -intro r; pattern r in |- *; apply Ccpoly_ind_cs. -assumption. -intros. -apply - X - with - (cpoly_linear_cs Zero cpoly_zero_cs) - (cpoly_linear_cs Zero cpoly_zero_cs) +Proof. + do 6 intro. + pattern p, q in |- *. + apply Ccpoly_double_comp_ind. + intros. + apply X with p1 q1 r. + assumption. + assumption. + algebra. + apply X2. + intro r; pattern r in |- *; apply Ccpoly_ind_cs. + assumption. + intros. + apply X with (cpoly_linear_cs Zero cpoly_zero_cs) (cpoly_linear_cs Zero cpoly_zero_cs) (cpoly_linear_cs c p0). -apply _cpoly_lin_eq_zero; split; algebra. -apply _cpoly_lin_eq_zero; split; algebra. -algebra. -apply X1. -assumption. - -do 6 intro. -pattern r in |- *; apply Ccpoly_ind_cs. -apply - X - with - (cpoly_linear_cs c p0) - (cpoly_linear_cs d q0) - (cpoly_linear_cs Zero cpoly_zero_cs). -algebra. -algebra. -apply _cpoly_lin_eq_zero; split; algebra. -apply X1. -apply X2. -intros. -apply X1. -apply X2. + apply _cpoly_lin_eq_zero; split; algebra. + apply _cpoly_lin_eq_zero; split; algebra. + algebra. + apply X1. + assumption. + do 6 intro. + pattern r in |- *; apply Ccpoly_ind_cs. + apply X with (cpoly_linear_cs c p0) (cpoly_linear_cs d q0) (cpoly_linear_cs Zero cpoly_zero_cs). + algebra. + algebra. + apply _cpoly_lin_eq_zero; split; algebra. + apply X1. + apply X2. + intros. + apply X1. + apply X2. Qed. Lemma cpoly_double_comp_ind : forall P : cpoly_csetoid -> cpoly_csetoid -> Prop, (forall p1 p2 q1 q2, p1 [=] p2 -> q1 [=] q2 -> P p1 q1 -> P p2 q2) -> P cpoly_zero_cs cpoly_zero_cs -> (forall p q c d, P p q -> P (cpoly_linear_cs c p) (cpoly_linear_cs d q)) -> forall p q, P p q. -intros. -apply cpoly_double_ind0_cs. -intro p0; pattern p0 in |- *; apply cpoly_ind_cs. -assumption. -intros. -apply H with (cpoly_linear_cs c p1) (cpoly_linear_cs Zero cpoly_zero_cs). -algebra. -apply _cpoly_lin_eq_zero. -split; algebra. -apply H1. -assumption. - -intro p0; pattern p0 in |- *; apply cpoly_ind_cs. -assumption. -intros. -apply H with (cpoly_linear_cs Zero cpoly_zero_cs) (cpoly_linear_cs c p1). -apply _cpoly_lin_eq_zero. -split; algebra. -algebra. -apply H1. -assumption. -intros. -apply H1. -assumption. +Proof. + intros. + apply cpoly_double_ind0_cs. + intro p0; pattern p0 in |- *; apply cpoly_ind_cs. + assumption. + intros. + apply H with (cpoly_linear_cs c p1) (cpoly_linear_cs Zero cpoly_zero_cs). + algebra. + apply _cpoly_lin_eq_zero. + split; algebra. + apply H1. + assumption. + intro p0; pattern p0 in |- *; apply cpoly_ind_cs. + assumption. + intros. + apply H with (cpoly_linear_cs Zero cpoly_zero_cs) (cpoly_linear_cs c p1). + apply _cpoly_lin_eq_zero. + split; algebra. + algebra. + apply H1. + assumption. + intros. + apply H1. + assumption. Qed. Lemma cpoly_triple_comp_ind : @@ -655,47 +680,37 @@ Lemma cpoly_triple_comp_ind : (forall p q r c d e, P p q r -> P (cpoly_linear_cs c p) (cpoly_linear_cs d q) (cpoly_linear_cs e r)) -> forall p q r, P p q r. -do 6 intro. -pattern p, q in |- *. -apply cpoly_double_comp_ind. -intros. -apply H with p1 q1 r. -assumption. -assumption. -algebra. -apply H4. - -intro r; pattern r in |- *; apply cpoly_ind_cs. -assumption. -intros. -apply - H - with - (cpoly_linear_cs Zero cpoly_zero_cs) - (cpoly_linear_cs Zero cpoly_zero_cs) +Proof. + do 6 intro. + pattern p, q in |- *. + apply cpoly_double_comp_ind. + intros. + apply H with p1 q1 r. + assumption. + assumption. + algebra. + apply H4. + intro r; pattern r in |- *; apply cpoly_ind_cs. + assumption. + intros. + apply H with (cpoly_linear_cs Zero cpoly_zero_cs) (cpoly_linear_cs Zero cpoly_zero_cs) (cpoly_linear_cs c p0). -apply _cpoly_lin_eq_zero; split; algebra. -apply _cpoly_lin_eq_zero; split; algebra. -algebra. -apply H1. -assumption. - -do 6 intro. -pattern r in |- *; apply cpoly_ind_cs. -apply - H - with - (cpoly_linear_cs c p0) - (cpoly_linear_cs d q0) - (cpoly_linear_cs Zero cpoly_zero_cs). -algebra. -algebra. -apply _cpoly_lin_eq_zero; split; algebra. -apply H1. -apply H2. -intros. -apply H1. -apply H2. + apply _cpoly_lin_eq_zero; split; algebra. + apply _cpoly_lin_eq_zero; split; algebra. + algebra. + apply H1. + assumption. + do 6 intro. + pattern r in |- *; apply cpoly_ind_cs. + apply H with (cpoly_linear_cs c p0) (cpoly_linear_cs d q0) (cpoly_linear_cs Zero cpoly_zero_cs). + algebra. + algebra. + apply _cpoly_lin_eq_zero; split; algebra. + apply H1. + apply H2. + intros. + apply H1. + apply H2. Qed. (** @@ -715,307 +730,315 @@ Fixpoint cpoly_plus (p q : cpoly) {struct p} : cpoly := Definition cpoly_plus_cs (p q : cpoly_csetoid) : cpoly_csetoid := cpoly_plus p q. Lemma cpoly_zero_plus : forall p, cpoly_plus_cs cpoly_zero_cs p = p. -auto. +Proof. + auto. Qed. Lemma cpoly_plus_zero : forall p, cpoly_plus_cs p cpoly_zero_cs = p. -simple induction p. -auto. -auto. +Proof. + simple induction p. + auto. + auto. Qed. Lemma cpoly_lin_plus_lin : forall p q c d, cpoly_plus_cs (cpoly_linear_cs c p) (cpoly_linear_cs d q) = cpoly_linear_cs (c[+]d) (cpoly_plus_cs p q). -auto. +Proof. + auto. Qed. Lemma cpoly_plus_commutative : forall p q, cpoly_plus_cs p q [=] cpoly_plus_cs q p. -intros. -pattern p, q in |- *. -apply cpoly_double_sym_ind0_cs. -unfold Tsymmetric in |- *. -intros. -algebra. -intro p0. -rewrite cpoly_zero_plus. -rewrite cpoly_plus_zero. -algebra. -intros. -repeat rewrite cpoly_lin_plus_lin. -apply _cpoly_lin_eq_lin. -split. -algebra. -assumption. +Proof. + intros. + pattern p, q in |- *. + apply cpoly_double_sym_ind0_cs. + unfold Tsymmetric in |- *. + intros. + algebra. + intro p0. + rewrite cpoly_zero_plus. + rewrite cpoly_plus_zero. + algebra. + intros. + repeat rewrite cpoly_lin_plus_lin. + apply _cpoly_lin_eq_lin. + split. + algebra. + assumption. Qed. Lemma cpoly_plus_q_ap_q : forall p q, cpoly_plus_cs p q [#] q -> p [#] cpoly_zero_cs. -intro p; pattern p in |- *; apply Ccpoly_ind_cs. -intro. -rewrite cpoly_zero_plus. -intro H. -elimtype False. -apply (ap_irreflexive _ _ H). -do 4 intro. -pattern q in |- *; apply Ccpoly_ind_cs. -rewrite cpoly_plus_zero. -auto. -do 3 intro. -rewrite cpoly_lin_plus_lin. -intros. -cut (c[+]c0 [#] c0 or cpoly_plus_cs p0 p1 [#] p1). -intros. -2: apply cpoly_lin_ap_lin_. -2: assumption. -cut (c [#] Zero or p0 [#] cpoly_zero_cs). -intro. apply _cpoly_lin_ap_zero. assumption. -elim X1; intro. -left. -apply cg_ap_cancel_rht with c0. -astepr c0. auto. -right. -generalize (X _ b); intro. -assumption. +Proof. + intro p; pattern p in |- *; apply Ccpoly_ind_cs. + intro. + rewrite cpoly_zero_plus. + intro H. + elimtype False. + apply (ap_irreflexive _ _ H). + do 4 intro. + pattern q in |- *; apply Ccpoly_ind_cs. + rewrite cpoly_plus_zero. + auto. + do 3 intro. + rewrite cpoly_lin_plus_lin. + intros. + cut (c[+]c0 [#] c0 or cpoly_plus_cs p0 p1 [#] p1). + intros. + 2: apply cpoly_lin_ap_lin_. + 2: assumption. + cut (c [#] Zero or p0 [#] cpoly_zero_cs). + intro. apply _cpoly_lin_ap_zero. assumption. + elim X1; intro. + left. + apply cg_ap_cancel_rht with c0. + astepr c0. auto. + right. + generalize (X _ b); intro. + assumption. Qed. Lemma cpoly_p_plus_ap_p : forall p q, cpoly_plus_cs p q [#] p -> q [#] cpoly_zero. -intros. -apply cpoly_plus_q_ap_q with p. -apply ap_wdl_unfolded with (cpoly_plus_cs p q). -assumption. -apply cpoly_plus_commutative. +Proof. + intros. + apply cpoly_plus_q_ap_q with p. + apply ap_wdl_unfolded with (cpoly_plus_cs p q). + assumption. + apply cpoly_plus_commutative. Qed. Lemma cpoly_ap_zero_plus : forall p q, cpoly_plus_cs p q [#] cpoly_zero_cs -> p [#] cpoly_zero_cs or q [#] cpoly_zero_cs. -intros p q; pattern p, q in |- *; apply Ccpoly_double_sym_ind0_cs. -unfold Csymmetric in |- *. -intros x y H H0. -elim H. -auto. auto. -astepl (cpoly_plus_cs y x). auto. -apply cpoly_plus_commutative. -intros p0 H. -left. -rewrite cpoly_plus_zero in H. -assumption. -intros p0 q0 c d. -rewrite cpoly_lin_plus_lin. -intros. -cut (c[+]d [#] Zero or cpoly_plus_cs p0 q0 [#] cpoly_zero_cs). -2: apply cpoly_lin_ap_zero_. -2: assumption. -clear X0. -intros H0. -elim H0; intro H1. -cut (c[+]d [#] Zero[+]Zero). -intro H2. -elim (cs_bin_op_strext _ _ _ _ _ _ H2); intro H3. -left. -simpl in |- *. -left. -assumption. -right. -cut (d [#] Zero or q0 [#] cpoly_zero_cs). -intro H4. -apply _cpoly_lin_ap_zero. -auto. -left. -assumption. -astepr (Zero:CR). auto. -elim (X H1); intro. -left. -cut (c [#] Zero or p0 [#] cpoly_zero_cs). -intro; apply _cpoly_lin_ap_zero. -auto. -right. -assumption. -right. -cut (d [#] Zero or q0 [#] cpoly_zero_cs). -intro. -apply _cpoly_lin_ap_zero. -auto. -right. -assumption. +Proof. + intros p q; pattern p, q in |- *; apply Ccpoly_double_sym_ind0_cs. + unfold Csymmetric in |- *. + intros x y H H0. + elim H. + auto. auto. + astepl (cpoly_plus_cs y x). auto. + apply cpoly_plus_commutative. + intros p0 H. + left. + rewrite cpoly_plus_zero in H. + assumption. + intros p0 q0 c d. + rewrite cpoly_lin_plus_lin. + intros. + cut (c[+]d [#] Zero or cpoly_plus_cs p0 q0 [#] cpoly_zero_cs). + 2: apply cpoly_lin_ap_zero_. + 2: assumption. + clear X0. + intros H0. + elim H0; intro H1. + cut (c[+]d [#] Zero[+]Zero). + intro H2. + elim (cs_bin_op_strext _ _ _ _ _ _ H2); intro H3. + left. + simpl in |- *. + left. + assumption. + right. + cut (d [#] Zero or q0 [#] cpoly_zero_cs). + intro H4. + apply _cpoly_lin_ap_zero. + auto. + left. + assumption. + astepr (Zero:CR). auto. + elim (X H1); intro. + left. + cut (c [#] Zero or p0 [#] cpoly_zero_cs). + intro; apply _cpoly_lin_ap_zero. + auto. + right. + assumption. + right. + cut (d [#] Zero or q0 [#] cpoly_zero_cs). + intro. + apply _cpoly_lin_ap_zero. + auto. + right. + assumption. Qed. Lemma cpoly_plus_op_strext : bin_op_strext cpoly_csetoid cpoly_plus_cs. -unfold bin_op_strext in |- *. -unfold bin_fun_strext in |- *. -intros x1 x2. -pattern x1, x2 in |- *. -apply Ccpoly_double_sym_ind0_cs. -unfold Csymmetric in |- *. -intros. -generalize (ap_symmetric_unfolded _ _ _ X0); intro H1. -generalize (X _ _ H1); intro H2. -elim H2; intro H3; generalize (ap_symmetric_unfolded _ _ _ H3); auto. -intro p; pattern p in |- *; apply Ccpoly_ind_cs. -intro; intro H. -simpl in |- *; auto. -intros s c H y1 y2. -pattern y1, y2 in |- *. -apply Ccpoly_double_ind0_cs. -intros p0 H0. -apply cpoly_ap_zero_plus. -apply H0. -intro p0. -intro H0. -elim (ap_cotransitive _ _ _ H0 cpoly_zero_cs); auto. -do 4 intro. -intros. -cut (c[+]c0 [#] d or cpoly_plus_cs s p0 [#] q). -2: apply cpoly_lin_ap_lin_; assumption. -clear X0; intro H1. -elim H1; intro H2. -cut (c[+]c0 [#] Zero[+]d). -intro H3. -elim (cs_bin_op_strext _ _ _ _ _ _ H3). -intro H4. -left. -apply _cpoly_lin_ap_zero. -auto. -intro. -right. -apply _cpoly_lin_ap_lin. -auto. -astepr d. auto. -elim (H _ _ H2); auto. -intro. -left. -apply _cpoly_lin_ap_zero. -auto. -right. -apply _cpoly_lin_ap_lin. -auto. - -do 7 intro. -pattern y1, y2 in |- *. -apply Ccpoly_double_ind0_cs. -intro p0; pattern p0 in |- *; apply Ccpoly_ind_cs. -auto. -intros. -cut (c[+]c0 [#] d or cpoly_plus_cs p p1 [#] q). -intro H2. -2: apply cpoly_lin_ap_lin_. -2: auto. -elim H2; intro H3. -cut (c[+]c0 [#] d[+]Zero). -intro H4. -elim (cs_bin_op_strext _ _ _ _ _ _ H4). -intro. -left. -apply _cpoly_lin_ap_lin. -auto. -intro. -right. -apply _cpoly_lin_ap_zero. -auto. -astepr d. auto. -elim X with p1 cpoly_zero_cs. -intro. -left. -apply _cpoly_lin_ap_lin. -auto. -right. -apply _cpoly_lin_ap_zero. -auto. -rewrite cpoly_plus_zero. -assumption. -intro p0; pattern p0 in |- *; apply Ccpoly_ind_cs. -auto. -intros. -cut (c [#] d[+]c0 or p [#] cpoly_plus_cs q p1). -2: apply cpoly_lin_ap_lin_. -2: assumption. -clear X1; intro H1. -elim H1; intro H2. -cut (c[+]Zero [#] d[+]c0). -intro H3. -elim (cs_bin_op_strext _ _ _ _ _ _ H3). -intro. -left. -unfold cpoly_linear_cs in |- *; simpl in |- *; auto. -intro. -right. -left. -apply ap_symmetric_unfolded. -assumption. -astepl c. auto. -elim X with cpoly_zero_cs p1. -intro. -left. -unfold cpoly_linear_cs in |- *; simpl in |- *; auto. -intro. -right. -right; auto. -rewrite cpoly_plus_zero. -assumption. -intros. -elim X1; intro H2. -elim (cs_bin_op_strext _ _ _ _ _ _ H2); auto. -intro. -left. -left; auto. -intro. right. -left; auto. -simpl in H2. -elim (X _ _ H2). -intro. -left; right; auto. -right; right; auto. +Proof. + unfold bin_op_strext in |- *. + unfold bin_fun_strext in |- *. + intros x1 x2. + pattern x1, x2 in |- *. + apply Ccpoly_double_sym_ind0_cs. + unfold Csymmetric in |- *. + intros. + generalize (ap_symmetric_unfolded _ _ _ X0); intro H1. + generalize (X _ _ H1); intro H2. + elim H2; intro H3; generalize (ap_symmetric_unfolded _ _ _ H3); auto. + intro p; pattern p in |- *; apply Ccpoly_ind_cs. + intro; intro H. + simpl in |- *; auto. + intros s c H y1 y2. + pattern y1, y2 in |- *. + apply Ccpoly_double_ind0_cs. + intros p0 H0. + apply cpoly_ap_zero_plus. + apply H0. + intro p0. + intro H0. + elim (ap_cotransitive _ _ _ H0 cpoly_zero_cs); auto. + do 4 intro. + intros. + cut (c[+]c0 [#] d or cpoly_plus_cs s p0 [#] q). + 2: apply cpoly_lin_ap_lin_; assumption. + clear X0; intro H1. + elim H1; intro H2. + cut (c[+]c0 [#] Zero[+]d). + intro H3. + elim (cs_bin_op_strext _ _ _ _ _ _ H3). + intro H4. + left. + apply _cpoly_lin_ap_zero. + auto. + intro. + right. + apply _cpoly_lin_ap_lin. + auto. + astepr d. auto. + elim (H _ _ H2); auto. + intro. + left. + apply _cpoly_lin_ap_zero. + auto. + right. + apply _cpoly_lin_ap_lin. + auto. + do 7 intro. + pattern y1, y2 in |- *. + apply Ccpoly_double_ind0_cs. + intro p0; pattern p0 in |- *; apply Ccpoly_ind_cs. + auto. + intros. + cut (c[+]c0 [#] d or cpoly_plus_cs p p1 [#] q). + intro H2. + 2: apply cpoly_lin_ap_lin_. + 2: auto. + elim H2; intro H3. + cut (c[+]c0 [#] d[+]Zero). + intro H4. + elim (cs_bin_op_strext _ _ _ _ _ _ H4). + intro. + left. + apply _cpoly_lin_ap_lin. + auto. + intro. + right. + apply _cpoly_lin_ap_zero. + auto. + astepr d. auto. + elim X with p1 cpoly_zero_cs. + intro. + left. + apply _cpoly_lin_ap_lin. + auto. + right. + apply _cpoly_lin_ap_zero. + auto. + rewrite cpoly_plus_zero. + assumption. + intro p0; pattern p0 in |- *; apply Ccpoly_ind_cs. + auto. + intros. + cut (c [#] d[+]c0 or p [#] cpoly_plus_cs q p1). + 2: apply cpoly_lin_ap_lin_. + 2: assumption. + clear X1; intro H1. + elim H1; intro H2. + cut (c[+]Zero [#] d[+]c0). + intro H3. + elim (cs_bin_op_strext _ _ _ _ _ _ H3). + intro. + left. + unfold cpoly_linear_cs in |- *; simpl in |- *; auto. + intro. + right. + left. + apply ap_symmetric_unfolded. + assumption. + astepl c. auto. + elim X with cpoly_zero_cs p1. + intro. + left. + unfold cpoly_linear_cs in |- *; simpl in |- *; auto. + intro. + right. + right; auto. + rewrite cpoly_plus_zero. + assumption. + intros. + elim X1; intro H2. + elim (cs_bin_op_strext _ _ _ _ _ _ H2); auto. + intro. + left. + left; auto. + intro. right. + left; auto. + simpl in H2. + elim (X _ _ H2). + intro. + left; right; auto. + right; right; auto. Qed. Lemma cpoly_plus_op_wd : bin_op_wd cpoly_csetoid cpoly_plus_cs. -unfold bin_op_wd in |- *. -apply bin_fun_strext_imp_wd. -exact cpoly_plus_op_strext. +Proof. + unfold bin_op_wd in |- *. + apply bin_fun_strext_imp_wd. + exact cpoly_plus_op_strext. Qed. Definition cpoly_plus_op := Build_CSetoid_bin_op _ _ cpoly_plus_op_strext. Lemma cpoly_plus_associative : associative cpoly_plus_op. -unfold associative in |- *. -intros p q r. -change - (cpoly_plus_cs p (cpoly_plus_cs q r) [=] cpoly_plus_cs (cpoly_plus_cs p q) r) - in |- *. -pattern p, q, r in |- *; apply cpoly_triple_comp_ind. -intros. -apply eq_transitive_unfolded with (cpoly_plus_cs p1 (cpoly_plus_cs q1 r1)). -apply eq_symmetric_unfolded. -apply cpoly_plus_op_wd. -assumption. -apply cpoly_plus_op_wd. -assumption. -assumption. -astepl (cpoly_plus_cs (cpoly_plus_cs p1 q1) r1). -apply cpoly_plus_op_wd. -apply cpoly_plus_op_wd. -assumption. -assumption. -assumption. -simpl in |- *. -auto. -intros. -repeat rewrite cpoly_lin_plus_lin. -apply _cpoly_lin_eq_lin. -split. -algebra. -assumption. +Proof. + unfold associative in |- *. + intros p q r. + change (cpoly_plus_cs p (cpoly_plus_cs q r) [=] cpoly_plus_cs (cpoly_plus_cs p q) r) in |- *. + pattern p, q, r in |- *; apply cpoly_triple_comp_ind. + intros. + apply eq_transitive_unfolded with (cpoly_plus_cs p1 (cpoly_plus_cs q1 r1)). + apply eq_symmetric_unfolded. + apply cpoly_plus_op_wd. + assumption. + apply cpoly_plus_op_wd. + assumption. + assumption. + astepl (cpoly_plus_cs (cpoly_plus_cs p1 q1) r1). + apply cpoly_plus_op_wd. + apply cpoly_plus_op_wd. + assumption. + assumption. + assumption. + simpl in |- *. + auto. + intros. + repeat rewrite cpoly_lin_plus_lin. + apply _cpoly_lin_eq_lin. + split. + algebra. + assumption. Qed. Definition cpoly_csemi_grp := Build_CSemiGroup _ _ cpoly_plus_associative. Canonical Structure cpoly_csemi_grp. Lemma cpoly_cm_proof : is_CMonoid cpoly_csemi_grp cpoly_zero. -apply Build_is_CMonoid. -- intro; rewrite -> cpoly_plus_zero;algebra. -intro x. -eapply eq_transitive_unfolded. -apply cpoly_plus_commutative. -rewrite cpoly_plus_zero;algebra. +Proof. + apply Build_is_CMonoid. + - intro; rewrite -> cpoly_plus_zero;algebra. + intro x. + eapply eq_transitive_unfolded. + apply cpoly_plus_commutative. + rewrite cpoly_plus_zero;algebra. Qed. Definition cpoly_cmonoid := Build_CMonoid _ _ cpoly_cm_proof. @@ -1034,97 +1057,103 @@ Fixpoint cpoly_inv (p : cpoly) : cpoly := Definition cpoly_inv_cs (p : cpoly_csetoid) : cpoly_csetoid := cpoly_inv p. Lemma cpoly_inv_zero : cpoly_inv_cs cpoly_zero_cs = cpoly_zero_cs. -auto. +Proof. + auto. Qed. Lemma cpoly_inv_lin : forall p c, cpoly_inv_cs (cpoly_linear_cs c p) = cpoly_linear_cs [--]c (cpoly_inv_cs p). -simple induction p. -auto. -auto. +Proof. + simple induction p. + auto. + auto. Qed. Lemma cpoly_inv_op_strext : un_op_strext cpoly_csetoid cpoly_inv_cs. -unfold un_op_strext in |- *. -unfold fun_strext in |- *. -intros x y. -pattern x, y in |- *. -apply Ccpoly_double_sym_ind0_cs. -unfold Csymmetric in |- *. -intros. -apply ap_symmetric_unfolded. -apply X. -apply ap_symmetric_unfolded. -assumption. -intro p; pattern p in |- *; apply Ccpoly_ind_cs. -auto. -intros. -cut ( [--]c [#] Zero or cpoly_inv_cs p0 [#] cpoly_zero_cs). -2: apply cpoly_lin_ap_zero_. -2: auto. -clear X0; intro H0. -apply _cpoly_lin_ap_zero. -auto. -elim H0. -left. -astepl ( [--][--]c). algebra. -right. -apply X. -assumption. -intros. -cut ( [--]c [#] [--]d or cpoly_inv_cs p [#] cpoly_inv_cs q). -2: apply cpoly_lin_ap_lin_. -2: auto. -clear X0; intro H0. -auto. -elim H0; intro. -left. -astepl ( [--][--]c). -astepr ( [--][--]d). -apply inv_resp_ap. -assumption. -right. -apply X. -assumption. +Proof. + unfold un_op_strext in |- *. + unfold fun_strext in |- *. + intros x y. + pattern x, y in |- *. + apply Ccpoly_double_sym_ind0_cs. + unfold Csymmetric in |- *. + intros. + apply ap_symmetric_unfolded. + apply X. + apply ap_symmetric_unfolded. + assumption. + intro p; pattern p in |- *; apply Ccpoly_ind_cs. + auto. + intros. + cut ( [--]c [#] Zero or cpoly_inv_cs p0 [#] cpoly_zero_cs). + 2: apply cpoly_lin_ap_zero_. + 2: auto. + clear X0; intro H0. + apply _cpoly_lin_ap_zero. + auto. + elim H0. + left. + astepl ( [--][--]c). algebra. + right. + apply X. + assumption. + intros. + cut ( [--]c [#] [--]d or cpoly_inv_cs p [#] cpoly_inv_cs q). + 2: apply cpoly_lin_ap_lin_. + 2: auto. + clear X0; intro H0. + auto. + elim H0; intro. + left. + astepl ( [--][--]c). + astepr ( [--][--]d). + apply inv_resp_ap. + assumption. + right. + apply X. + assumption. Qed. Lemma cpoly_inv_op_wd : un_op_wd cpoly_csetoid cpoly_inv_cs. -unfold un_op_wd in |- *. -apply fun_strext_imp_wd. -exact cpoly_inv_op_strext. +Proof. + unfold un_op_wd in |- *. + apply fun_strext_imp_wd. + exact cpoly_inv_op_strext. Qed. Definition cpoly_inv_op := Build_CSetoid_un_op _ _ cpoly_inv_op_strext. Lemma cpoly_cg_proof : is_CGroup cpoly_cmonoid cpoly_inv_op. -unfold is_CGroup in |- *. -intro. -unfold is_inverse in |- *. -assert (x[+]cpoly_inv_cs x [=] Zero). -pattern x in |- *; apply cpoly_ind_cs. -rewrite cpoly_inv_zero. -rewrite -> cpoly_plus_zero. -simpl; auto. -intros. -rewrite cpoly_inv_lin. -rewrite -> cpoly_lin_plus_lin. -apply _cpoly_lin_eq_zero. -split. -algebra. -assumption. -split; auto. -eapply eq_transitive_unfolded. -apply cpoly_plus_commutative. -auto. +Proof. + unfold is_CGroup in |- *. + intro. + unfold is_inverse in |- *. + assert (x[+]cpoly_inv_cs x [=] Zero). + pattern x in |- *; apply cpoly_ind_cs. + rewrite cpoly_inv_zero. + rewrite -> cpoly_plus_zero. + simpl; auto. + intros. + rewrite cpoly_inv_lin. + rewrite -> cpoly_lin_plus_lin. + apply _cpoly_lin_eq_zero. + split. + algebra. + assumption. + split; auto. + eapply eq_transitive_unfolded. + apply cpoly_plus_commutative. + auto. Qed. Definition cpoly_cgroup := Build_CGroup _ _ cpoly_cg_proof. Canonical Structure cpoly_cgroup. Lemma cpoly_cag_proof : is_CAbGroup cpoly_cgroup. -unfold is_CAbGroup in |- *. -red in |- *; intros. -apply cpoly_plus_commutative. +Proof. + unfold is_CAbGroup in |- *. + red in |- *; intros. + apply cpoly_plus_commutative. Qed. Definition cpoly_cabgroup := Build_CAbGroup _ cpoly_cag_proof. @@ -1152,531 +1181,498 @@ Definition cpoly_mult_cr_cs (p : cpoly_csetoid) c : cpoly_csetoid := Lemma cpoly_zero_mult_cr : forall c, cpoly_mult_cr_cs cpoly_zero_cs c = cpoly_zero_cs. -auto. +Proof. + auto. Qed. Lemma cpoly_lin_mult_cr : forall c d q, cpoly_mult_cr_cs (cpoly_linear_cs d q) c = cpoly_linear_cs (c[*]d) (cpoly_mult_cr_cs q c). -auto. +Proof. + auto. Qed. Lemma cpoly_mult_cr_zero : forall p, cpoly_mult_cr_cs p Zero [=] cpoly_zero_cs. -intro; pattern p in |- *; apply cpoly_ind_cs. -rewrite cpoly_zero_mult_cr. -algebra. -intros. -rewrite cpoly_lin_mult_cr. -apply _cpoly_lin_eq_zero. -split. -algebra. -assumption. +Proof. + intro; pattern p in |- *; apply cpoly_ind_cs. + rewrite cpoly_zero_mult_cr. + algebra. + intros. + rewrite cpoly_lin_mult_cr. + apply _cpoly_lin_eq_zero. + split. + algebra. + assumption. Qed. Lemma cpoly_mult_cr_strext : bin_fun_strext _ _ _ cpoly_mult_cr_cs. -unfold bin_fun_strext in |- *. -do 4 intro. -pattern x1, x2 in |- *. -apply Ccpoly_double_ind0_cs. -intro. -rewrite cpoly_zero_mult_cr. -intro H. -left. -generalize H. -pattern p in |- *. -apply Ccpoly_ind_cs. -rewrite cpoly_zero_mult_cr. -auto. -do 2 intro. -rewrite cpoly_lin_mult_cr. -intros. -cut (y1[*]c [#] Zero or cpoly_mult_cr_cs p0 y1 [#] cpoly_zero_cs). -2: apply cpoly_lin_ap_zero_. -2: auto. -clear H0; intro H1. -cut (c [#] Zero or p0 [#] cpoly_zero_cs). -intro; apply _cpoly_lin_ap_zero. -auto. -elim H1; intro H2. -generalize (cring_mult_ap_zero_op _ _ _ H2); intro. -auto. -right. -auto. - -rewrite cpoly_zero_mult_cr. -intros. -left. -generalize X. -pattern p in |- *; apply Ccpoly_ind_cs. -rewrite cpoly_zero_mult_cr. -auto. -do 2 intro. -rewrite cpoly_lin_mult_cr. -intros. -cut (y2[*]c [#] Zero or cpoly_zero_cs [#] cpoly_mult_cr_cs p0 y2). -2: apply cpoly_zero_ap_lin_. -2: auto. -clear X1; intro H1. -cut (c [#] Zero or cpoly_zero_cs [#] p0). -intro. -apply _cpoly_zero_ap_lin. auto. -elim H1; intro H2. -generalize (cring_mult_ap_zero_op _ _ _ H2); auto. -right. -auto. - -do 4 intro. -repeat rewrite cpoly_lin_mult_cr. -intros. -cut (y1[*]c [#] y2[*]d or cpoly_mult_cr_cs p y1 [#] cpoly_mult_cr_cs q y2). -2: apply cpoly_lin_ap_lin_. -2: auto. -clear X0; intro H0. -cut ((c [#] d or p [#] q) or y1 [#] y2). -intro. -elim X0; try auto. -elim H0; intro H1. -generalize (cs_bin_op_strext _ _ _ _ _ _ H1); tauto. -elim X; auto. +Proof. + unfold bin_fun_strext in |- *. + do 4 intro. + pattern x1, x2 in |- *. + apply Ccpoly_double_ind0_cs. + intro. + rewrite cpoly_zero_mult_cr. + intro H. + left. + generalize H. + pattern p in |- *. + apply Ccpoly_ind_cs. + rewrite cpoly_zero_mult_cr. + auto. + do 2 intro. + rewrite cpoly_lin_mult_cr. + intros. + cut (y1[*]c [#] Zero or cpoly_mult_cr_cs p0 y1 [#] cpoly_zero_cs). + 2: apply cpoly_lin_ap_zero_. + 2: auto. + clear H0; intro H1. + cut (c [#] Zero or p0 [#] cpoly_zero_cs). + intro; apply _cpoly_lin_ap_zero. + auto. + elim H1; intro H2. + generalize (cring_mult_ap_zero_op _ _ _ H2); intro. + auto. + right. + auto. + rewrite cpoly_zero_mult_cr. + intros. + left. + generalize X. + pattern p in |- *; apply Ccpoly_ind_cs. + rewrite cpoly_zero_mult_cr. + auto. + do 2 intro. + rewrite cpoly_lin_mult_cr. + intros. + cut (y2[*]c [#] Zero or cpoly_zero_cs [#] cpoly_mult_cr_cs p0 y2). + 2: apply cpoly_zero_ap_lin_. + 2: auto. + clear X1; intro H1. + cut (c [#] Zero or cpoly_zero_cs [#] p0). + intro. + apply _cpoly_zero_ap_lin. auto. + elim H1; intro H2. + generalize (cring_mult_ap_zero_op _ _ _ H2); auto. + right. + auto. + do 4 intro. + repeat rewrite cpoly_lin_mult_cr. + intros. + cut (y1[*]c [#] y2[*]d or cpoly_mult_cr_cs p y1 [#] cpoly_mult_cr_cs q y2). + 2: apply cpoly_lin_ap_lin_. + 2: auto. + clear X0; intro H0. + cut ((c [#] d or p [#] q) or y1 [#] y2). + intro. + elim X0; try auto. + elim H0; intro H1. + generalize (cs_bin_op_strext _ _ _ _ _ _ H1); tauto. + elim X; auto. Qed. Lemma cpoly_mult_cr_wd : bin_fun_wd _ _ _ cpoly_mult_cr_cs. -apply bin_fun_strext_imp_wd. -exact cpoly_mult_cr_strext. +Proof. + apply bin_fun_strext_imp_wd. + exact cpoly_mult_cr_strext. Qed. Definition cpoly_mult_cs (p q : cpoly_csetoid) : cpoly_csetoid := cpoly_mult p q. Lemma cpoly_zero_mult : forall q, cpoly_mult_cs cpoly_zero_cs q = cpoly_zero_cs. -auto. +Proof. + auto. Qed. Lemma cpoly_lin_mult : forall c p q, cpoly_mult_cs (cpoly_linear_cs c p) q = cpoly_plus_cs (cpoly_mult_cr_cs q c) (cpoly_linear_cs Zero (cpoly_mult_cs p q)). -auto. +Proof. + auto. Qed. Lemma cpoly_mult_op_strext : bin_op_strext cpoly_csetoid cpoly_mult_cs. -do 4 intro. -pattern x1, x2 in |- *. -apply Ccpoly_double_ind0_cs. -rewrite cpoly_zero_mult. -intro; pattern p in |- *; apply Ccpoly_ind_cs. -rewrite cpoly_zero_mult. -auto. -do 2 intro. -rewrite cpoly_lin_mult. -intros. -cut ((c [#] Zero or p0 [#] cpoly_zero_cs) or y1 [#] y2). -intro H1. elim H1. intro; left; apply _cpoly_lin_ap_zero; assumption. -auto. -cut - (cpoly_plus_cs (cpoly_mult_cr_cs y1 c) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 y1)) [#] - cpoly_plus_cs (cpoly_mult_cr_cs y2 Zero) - (cpoly_linear_cs Zero (cpoly_mult_cs cpoly_zero_cs y2))). -intro H1. -elim (cpoly_plus_op_strext _ _ _ _ H1); intro H2. -elim (cpoly_mult_cr_strext _ _ _ _ H2); auto. -elim H2; intro H3. -elim (ap_irreflexive _ _ H3). -rewrite cpoly_zero_mult in H3. -elim X; auto. -rewrite cpoly_zero_mult. -apply ap_wdr_unfolded with cpoly_zero_cs. -assumption. -astepl (cpoly_plus_cs cpoly_zero_cs cpoly_zero_cs). -apply cpoly_plus_op_wd. -apply eq_symmetric_unfolded. -apply cpoly_mult_cr_zero. -apply _cpoly_zero_eq_lin. -split; algebra. - -intro; pattern p in |- *; apply Ccpoly_ind_cs. -auto. -intros. -cut ((c [#] Zero or cpoly_zero_cs [#] p0) or y1 [#] y2). -intro. -elim X1; try auto. -cut - (cpoly_plus_cs (cpoly_mult_cr_cs y1 Zero) - (cpoly_linear_cs Zero (cpoly_mult_cs cpoly_zero_cs y1)) [#] - cpoly_plus_cs (cpoly_mult_cr_cs y2 c) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 y2))). -intro H1. -elim (cpoly_plus_op_strext _ _ _ _ H1); intro H2. -elim (cpoly_mult_cr_strext _ _ _ _ H2); auto. -intro. -left. left. -apply ap_symmetric_unfolded. -assumption. -cut - ((Zero:CR) [#] Zero or cpoly_mult_cs cpoly_zero_cs y1 [#] cpoly_mult_cs p0 y2). -2: apply cpoly_lin_ap_lin_; auto. -clear H2; intro H2. -elim H2; intro H3. -elim (ap_irreflexive _ _ H3). -rewrite cpoly_zero_mult in H3. -elim X; auto. -rewrite cpoly_zero_mult. -apply ap_wdl_unfolded with cpoly_zero_cs. -assumption. -astepl (cpoly_plus_cs cpoly_zero_cs cpoly_zero_cs). -apply cpoly_plus_op_wd. -apply eq_symmetric_unfolded. -apply cpoly_mult_cr_zero. -apply _cpoly_zero_eq_lin. -split; algebra. - -intros. -cut ((c [#] d or p [#] q) or y1 [#] y2). -intro. -auto. -elim (cpoly_plus_op_strext _ _ _ _ X0); intro H1. -elim (cpoly_mult_cr_strext _ _ _ _ H1); auto. -elim H1; intro H2. -elim (ap_irreflexive _ _ H2). -elim X; auto. +Proof. + do 4 intro. + pattern x1, x2 in |- *. + apply Ccpoly_double_ind0_cs. + rewrite cpoly_zero_mult. + intro; pattern p in |- *; apply Ccpoly_ind_cs. + rewrite cpoly_zero_mult. + auto. + do 2 intro. + rewrite cpoly_lin_mult. + intros. + cut ((c [#] Zero or p0 [#] cpoly_zero_cs) or y1 [#] y2). + intro H1. elim H1. intro; left; apply _cpoly_lin_ap_zero; assumption. + auto. + cut (cpoly_plus_cs (cpoly_mult_cr_cs y1 c) (cpoly_linear_cs Zero (cpoly_mult_cs p0 y1)) [#] + cpoly_plus_cs (cpoly_mult_cr_cs y2 Zero) (cpoly_linear_cs Zero (cpoly_mult_cs cpoly_zero_cs y2))). + intro H1. + elim (cpoly_plus_op_strext _ _ _ _ H1); intro H2. + elim (cpoly_mult_cr_strext _ _ _ _ H2); auto. + elim H2; intro H3. + elim (ap_irreflexive _ _ H3). + rewrite cpoly_zero_mult in H3. + elim X; auto. + rewrite cpoly_zero_mult. + apply ap_wdr_unfolded with cpoly_zero_cs. + assumption. + astepl (cpoly_plus_cs cpoly_zero_cs cpoly_zero_cs). + apply cpoly_plus_op_wd. + apply eq_symmetric_unfolded. + apply cpoly_mult_cr_zero. + apply _cpoly_zero_eq_lin. + split; algebra. + intro; pattern p in |- *; apply Ccpoly_ind_cs. + auto. + intros. + cut ((c [#] Zero or cpoly_zero_cs [#] p0) or y1 [#] y2). + intro. + elim X1; try auto. + cut (cpoly_plus_cs (cpoly_mult_cr_cs y1 Zero) + (cpoly_linear_cs Zero (cpoly_mult_cs cpoly_zero_cs y1)) [#] cpoly_plus_cs (cpoly_mult_cr_cs y2 c) + (cpoly_linear_cs Zero (cpoly_mult_cs p0 y2))). + intro H1. + elim (cpoly_plus_op_strext _ _ _ _ H1); intro H2. + elim (cpoly_mult_cr_strext _ _ _ _ H2); auto. + intro. + left. left. + apply ap_symmetric_unfolded. + assumption. + cut ((Zero:CR) [#] Zero or cpoly_mult_cs cpoly_zero_cs y1 [#] cpoly_mult_cs p0 y2). + 2: apply cpoly_lin_ap_lin_; auto. + clear H2; intro H2. + elim H2; intro H3. + elim (ap_irreflexive _ _ H3). + rewrite cpoly_zero_mult in H3. + elim X; auto. + rewrite cpoly_zero_mult. + apply ap_wdl_unfolded with cpoly_zero_cs. + assumption. + astepl (cpoly_plus_cs cpoly_zero_cs cpoly_zero_cs). + apply cpoly_plus_op_wd. + apply eq_symmetric_unfolded. + apply cpoly_mult_cr_zero. + apply _cpoly_zero_eq_lin. + split; algebra. + intros. + cut ((c [#] d or p [#] q) or y1 [#] y2). + intro. + auto. + elim (cpoly_plus_op_strext _ _ _ _ X0); intro H1. + elim (cpoly_mult_cr_strext _ _ _ _ H1); auto. + elim H1; intro H2. + elim (ap_irreflexive _ _ H2). + elim X; auto. Qed. Lemma cpoly_mult_op_wd : bin_op_wd cpoly_csetoid cpoly_mult. -unfold bin_op_wd in |- *. -apply bin_fun_strext_imp_wd. -exact cpoly_mult_op_strext. +Proof. + unfold bin_op_wd in |- *. + apply bin_fun_strext_imp_wd. + exact cpoly_mult_op_strext. Qed. Definition cpoly_mult_op := Build_CSetoid_bin_op _ _ cpoly_mult_op_strext. Lemma cpoly_mult_cr_dist : forall p q c, - cpoly_mult_cr_cs (cpoly_plus_cs p q) c [=] + cpoly_mult_cr_cs (cpoly_plus_cs p q) c [=] cpoly_plus_cs (cpoly_mult_cr_cs p c) (cpoly_mult_cr_cs q c). -intros. -pattern p, q in |- *. -apply cpoly_double_comp_ind. -intros. -apply eq_transitive_unfolded with (cpoly_mult_cr_cs (cpoly_plus_cs p1 q1) c). -apply eq_symmetric_unfolded. -apply cpoly_mult_cr_wd. -apply cpoly_plus_op_wd. -assumption. -assumption. -algebra. -astepl (cpoly_plus_cs (cpoly_mult_cr_cs p1 c) (cpoly_mult_cr_cs q1 c)). -apply cpoly_plus_op_wd. -apply cpoly_mult_cr_wd; algebra. -apply cpoly_mult_cr_wd; algebra. -repeat rewrite cpoly_zero_plus. -algebra. -intros. -repeat rewrite cpoly_lin_mult_cr. -repeat rewrite cpoly_lin_plus_lin. -rewrite <- cpoly_lin_mult_cr. -apply: _cpoly_lin_eq_lin. -split; algebra. +Proof. + intros. + pattern p, q in |- *. + apply cpoly_double_comp_ind. + intros. + apply eq_transitive_unfolded with (cpoly_mult_cr_cs (cpoly_plus_cs p1 q1) c). + apply eq_symmetric_unfolded. + apply cpoly_mult_cr_wd. + apply cpoly_plus_op_wd. + assumption. + assumption. + algebra. + astepl (cpoly_plus_cs (cpoly_mult_cr_cs p1 c) (cpoly_mult_cr_cs q1 c)). + apply cpoly_plus_op_wd. + apply cpoly_mult_cr_wd; algebra. + apply cpoly_mult_cr_wd; algebra. + repeat rewrite cpoly_zero_plus. + algebra. + intros. + repeat rewrite cpoly_lin_mult_cr. + repeat rewrite cpoly_lin_plus_lin. + rewrite <- cpoly_lin_mult_cr. + apply: _cpoly_lin_eq_lin. + split; algebra. Qed. Lemma cpoly_cr_dist : distributive cpoly_mult_op cpoly_plus_op. -unfold distributive in |- *. -intros p q r. -change - (cpoly_mult_cs p (cpoly_plus_cs q r) [=] - cpoly_plus_cs (cpoly_mult_cs p q) (cpoly_mult_cs p r)) - in |- *. -pattern p in |- *. apply cpoly_ind_cs. -repeat rewrite cpoly_zero_mult. -rewrite cpoly_zero_plus. -algebra. -intros. -repeat rewrite cpoly_lin_mult. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs - (cpoly_plus_cs (cpoly_mult_cr_cs q c) (cpoly_mult_cr_cs r c)) - (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 r)))). -apply cpoly_plus_op_wd. -apply cpoly_mult_cr_dist. -rewrite cpoly_lin_plus_lin. -apply _cpoly_lin_eq_lin. -split. -algebra. -assumption. -clear H. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs (cpoly_mult_cr_cs q c) - (cpoly_plus_cs (cpoly_mult_cr_cs r c) - (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))))). -apply eq_symmetric_unfolded. -apply cpoly_plus_associative. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs (cpoly_mult_cr_cs q c) - (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) - (cpoly_plus_cs (cpoly_mult_cr_cs r c) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))))). -apply cpoly_plus_op_wd. -algebra. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs - (cpoly_plus_cs (cpoly_mult_cr_cs r c) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))). -apply cpoly_plus_associative. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs - (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) - (cpoly_mult_cr_cs r c)) (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))). -apply cpoly_plus_op_wd. -apply cpoly_plus_commutative. -algebra. -apply eq_symmetric_unfolded. -apply cpoly_plus_associative. -apply cpoly_plus_associative. +Proof. + unfold distributive in |- *. + intros p q r. + change (cpoly_mult_cs p (cpoly_plus_cs q r) [=] + cpoly_plus_cs (cpoly_mult_cs p q) (cpoly_mult_cs p r)) in |- *. + pattern p in |- *. apply cpoly_ind_cs. + repeat rewrite cpoly_zero_mult. + rewrite cpoly_zero_plus. + algebra. + intros. + repeat rewrite cpoly_lin_mult. + apply eq_transitive_unfolded with (cpoly_plus_cs + (cpoly_plus_cs (cpoly_mult_cr_cs q c) (cpoly_mult_cr_cs r c)) + (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) + (cpoly_linear_cs Zero (cpoly_mult_cs p0 r)))). + apply cpoly_plus_op_wd. + apply cpoly_mult_cr_dist. + rewrite cpoly_lin_plus_lin. + apply _cpoly_lin_eq_lin. + split. + algebra. + assumption. + clear H. + apply eq_transitive_unfolded with (cpoly_plus_cs (cpoly_mult_cr_cs q c) + (cpoly_plus_cs (cpoly_mult_cr_cs r c) (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) + (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))))). + apply eq_symmetric_unfolded. + apply cpoly_plus_associative. + apply eq_transitive_unfolded with (cpoly_plus_cs (cpoly_mult_cr_cs q c) + (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) (cpoly_plus_cs (cpoly_mult_cr_cs r c) + (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))))). + apply cpoly_plus_op_wd. + algebra. + apply eq_transitive_unfolded with (cpoly_plus_cs (cpoly_plus_cs (cpoly_mult_cr_cs r c) + (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))) (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))). + apply cpoly_plus_associative. + apply eq_transitive_unfolded with (cpoly_plus_cs + (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) + (cpoly_mult_cr_cs r c)) (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))). + apply cpoly_plus_op_wd. + apply cpoly_plus_commutative. + algebra. + apply eq_symmetric_unfolded. + apply cpoly_plus_associative. + apply cpoly_plus_associative. Qed. Lemma cpoly_mult_cr_assoc_mult_cr : forall p c d, cpoly_mult_cr_cs (cpoly_mult_cr_cs p c) d [=] cpoly_mult_cr_cs p (d[*]c). -intros. -pattern p in |- *; apply cpoly_ind_cs. -repeat rewrite cpoly_zero_mult_cr. -algebra. -intros. -repeat rewrite cpoly_lin_mult_cr. -apply _cpoly_lin_eq_lin. -split. -algebra. -assumption. +Proof. + intros. + pattern p in |- *; apply cpoly_ind_cs. + repeat rewrite cpoly_zero_mult_cr. + algebra. + intros. + repeat rewrite cpoly_lin_mult_cr. + apply _cpoly_lin_eq_lin. + split. + algebra. + assumption. Qed. Lemma cpoly_mult_cr_assoc_mult : forall p q c, cpoly_mult_cr_cs (cpoly_mult_cs p q) c [=] cpoly_mult_cs (cpoly_mult_cr_cs p c) q. -intros. -pattern p in |- *; apply cpoly_ind_cs. -rewrite cpoly_zero_mult. -rewrite -> cpoly_zero_mult_cr; reflexivity. -intros. -rewrite cpoly_lin_mult. -repeat rewrite cpoly_lin_mult_cr. -rewrite cpoly_lin_mult. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs (cpoly_mult_cr_cs (cpoly_mult_cr_cs q c0) c) - (cpoly_mult_cr_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) c)). -apply cpoly_mult_cr_dist. -apply cpoly_plus_op_wd. -apply cpoly_mult_cr_assoc_mult_cr. -rewrite cpoly_lin_mult_cr. -apply _cpoly_lin_eq_lin. -split;algebra. +Proof. + intros. + pattern p in |- *; apply cpoly_ind_cs. + rewrite cpoly_zero_mult. + rewrite -> cpoly_zero_mult_cr; reflexivity. + intros. + rewrite cpoly_lin_mult. + repeat rewrite cpoly_lin_mult_cr. + rewrite cpoly_lin_mult. + apply eq_transitive_unfolded with (cpoly_plus_cs (cpoly_mult_cr_cs (cpoly_mult_cr_cs q c0) c) + (cpoly_mult_cr_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) c)). + apply cpoly_mult_cr_dist. + apply cpoly_plus_op_wd. + apply cpoly_mult_cr_assoc_mult_cr. + rewrite cpoly_lin_mult_cr. + apply _cpoly_lin_eq_lin. + split;algebra. Qed. Lemma cpoly_mult_zero : forall p, cpoly_mult_cs p cpoly_zero_cs [=] cpoly_zero_cs. -intros. -pattern p in |- *; apply cpoly_ind_cs. -algebra. -intros. -rewrite cpoly_lin_mult. -rewrite cpoly_zero_mult_cr. -rewrite cpoly_zero_plus. -apply _cpoly_lin_eq_zero. -split;algebra. +Proof. + intros. + pattern p in |- *; apply cpoly_ind_cs. + algebra. + intros. + rewrite cpoly_lin_mult. + rewrite cpoly_zero_mult_cr. + rewrite cpoly_zero_plus. + apply _cpoly_lin_eq_zero. + split;algebra. Qed. Lemma cpoly_mult_lin : forall c p q, - cpoly_mult_cs p (cpoly_linear_cs c q) [=] + cpoly_mult_cs p (cpoly_linear_cs c q) [=] cpoly_plus_cs (cpoly_mult_cr_cs p c) (cpoly_linear_cs Zero (cpoly_mult_cs p q)). -intros. -pattern p in |- *; apply cpoly_ind_cs. -repeat rewrite cpoly_zero_mult. -rewrite cpoly_zero_mult_cr. -rewrite cpoly_zero_plus. -apply _cpoly_zero_eq_lin. -algebra. -intros. -repeat rewrite cpoly_lin_mult. -repeat rewrite cpoly_lin_mult_cr. -repeat rewrite cpoly_lin_plus_lin. -apply _cpoly_lin_eq_lin. split. -algebra. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs - (cpoly_plus_cs (cpoly_mult_cr_cs p0 c) (cpoly_mult_cr_cs q c0)) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))). -2: apply eq_symmetric_unfolded. -2: apply cpoly_plus_associative. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs - (cpoly_plus_cs (cpoly_mult_cr_cs q c0) (cpoly_mult_cr_cs p0 c)) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))). -2: apply cpoly_plus_op_wd. -3: algebra. -2: apply cpoly_plus_commutative. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs (cpoly_mult_cr_cs q c0) - (cpoly_plus_cs (cpoly_mult_cr_cs p0 c) - (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)))). -2: apply cpoly_plus_associative. -apply cpoly_plus_op_wd. -algebra. -assumption. +Proof. + intros. + pattern p in |- *; apply cpoly_ind_cs. + repeat rewrite cpoly_zero_mult. + rewrite cpoly_zero_mult_cr. + rewrite cpoly_zero_plus. + apply _cpoly_zero_eq_lin. + algebra. + intros. + repeat rewrite cpoly_lin_mult. + repeat rewrite cpoly_lin_mult_cr. + repeat rewrite cpoly_lin_plus_lin. + apply _cpoly_lin_eq_lin. split. + algebra. + apply eq_transitive_unfolded with (cpoly_plus_cs + (cpoly_plus_cs (cpoly_mult_cr_cs p0 c) (cpoly_mult_cr_cs q c0)) + (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))). + 2: apply eq_symmetric_unfolded. + 2: apply cpoly_plus_associative. + apply eq_transitive_unfolded with (cpoly_plus_cs + (cpoly_plus_cs (cpoly_mult_cr_cs q c0) (cpoly_mult_cr_cs p0 c)) + (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))). + 2: apply cpoly_plus_op_wd. + 3: algebra. + 2: apply cpoly_plus_commutative. + apply eq_transitive_unfolded with (cpoly_plus_cs (cpoly_mult_cr_cs q c0) + (cpoly_plus_cs (cpoly_mult_cr_cs p0 c) (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)))). + 2: apply cpoly_plus_associative. + apply cpoly_plus_op_wd. + algebra. + assumption. Qed. Lemma cpoly_mult_commutative : forall p q : cpoly_csetoid, cpoly_mult_cs p q [=] cpoly_mult_cs q p. -intros. -pattern p in |- *. -apply cpoly_ind_cs. -rewrite cpoly_zero_mult. -apply eq_symmetric_unfolded. -apply cpoly_mult_zero. -intros. -rewrite cpoly_lin_mult. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs (cpoly_mult_cr_cs q c) - (cpoly_linear_cs Zero (cpoly_mult_cs q p0))). -2: apply eq_symmetric_unfolded; apply cpoly_mult_lin. -apply cpoly_plus_op_wd. -algebra. -apply cpoly_linear_wd. -algebra. -assumption. +Proof. + intros. + pattern p in |- *. + apply cpoly_ind_cs. + rewrite cpoly_zero_mult. + apply eq_symmetric_unfolded. + apply cpoly_mult_zero. + intros. + rewrite cpoly_lin_mult. + apply eq_transitive_unfolded with (cpoly_plus_cs (cpoly_mult_cr_cs q c) + (cpoly_linear_cs Zero (cpoly_mult_cs q p0))). + 2: apply eq_symmetric_unfolded; apply cpoly_mult_lin. + apply cpoly_plus_op_wd. + algebra. + apply cpoly_linear_wd. + algebra. + assumption. Qed. Lemma cpoly_mult_dist_rht : forall p q r, cpoly_mult_cs (cpoly_plus_cs p q) r [=] cpoly_plus_cs (cpoly_mult_cs p r) (cpoly_mult_cs q r). -intros. -apply eq_transitive_unfolded with (cpoly_mult_cs r (cpoly_plus_cs p q)). -apply cpoly_mult_commutative. -apply - eq_transitive_unfolded - with (cpoly_plus_cs (cpoly_mult_cs r p) (cpoly_mult_cs r q)). -generalize cpoly_cr_dist; intro. -unfold distributive in H. -simpl in H. -simpl in |- *. -apply H. -apply cpoly_plus_op_wd. -apply cpoly_mult_commutative. -apply cpoly_mult_commutative. +Proof. + intros. + apply eq_transitive_unfolded with (cpoly_mult_cs r (cpoly_plus_cs p q)). + apply cpoly_mult_commutative. + apply eq_transitive_unfolded with (cpoly_plus_cs (cpoly_mult_cs r p) (cpoly_mult_cs r q)). + generalize cpoly_cr_dist; intro. + unfold distributive in H. + simpl in H. + simpl in |- *. + apply H. + apply cpoly_plus_op_wd. + apply cpoly_mult_commutative. + apply cpoly_mult_commutative. Qed. Lemma cpoly_mult_assoc : associative cpoly_mult_op. -unfold associative in |- *. -intros p q r. -change - (cpoly_mult_cs p (cpoly_mult_cs q r) [=] cpoly_mult_cs (cpoly_mult_cs p q) r) - in |- *. -pattern p in |- *; apply cpoly_ind_cs. -repeat rewrite cpoly_zero_mult. -algebra. -intros. -repeat rewrite cpoly_lin_mult. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs (cpoly_mult_cs (cpoly_mult_cr_cs q c) r) - (cpoly_mult_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) r)). -apply cpoly_plus_op_wd. -apply cpoly_mult_cr_assoc_mult. -rewrite cpoly_lin_mult. -apply - eq_transitive_unfolded - with - (cpoly_plus_cs cpoly_zero_cs - (cpoly_linear_cs Zero (cpoly_mult_cs (cpoly_mult_cs p0 q) r))). -rewrite cpoly_zero_plus. -apply _cpoly_lin_eq_lin. -split. -algebra. -assumption. -apply cpoly_plus_op_wd. -apply eq_symmetric_unfolded. -apply cpoly_mult_cr_zero. -apply _cpoly_lin_eq_lin. -split. -algebra. -algebra. -apply eq_symmetric_unfolded. -apply cpoly_mult_dist_rht. +Proof. + unfold associative in |- *. + intros p q r. + change (cpoly_mult_cs p (cpoly_mult_cs q r) [=] cpoly_mult_cs (cpoly_mult_cs p q) r) in |- *. + pattern p in |- *; apply cpoly_ind_cs. + repeat rewrite cpoly_zero_mult. + algebra. + intros. + repeat rewrite cpoly_lin_mult. + apply eq_transitive_unfolded with (cpoly_plus_cs (cpoly_mult_cs (cpoly_mult_cr_cs q c) r) + (cpoly_mult_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) r)). + apply cpoly_plus_op_wd. + apply cpoly_mult_cr_assoc_mult. + rewrite cpoly_lin_mult. + apply eq_transitive_unfolded with (cpoly_plus_cs cpoly_zero_cs + (cpoly_linear_cs Zero (cpoly_mult_cs (cpoly_mult_cs p0 q) r))). + rewrite cpoly_zero_plus. + apply _cpoly_lin_eq_lin. + split. + algebra. + assumption. + apply cpoly_plus_op_wd. + apply eq_symmetric_unfolded. + apply cpoly_mult_cr_zero. + apply _cpoly_lin_eq_lin. + split. + algebra. + algebra. + apply eq_symmetric_unfolded. + apply cpoly_mult_dist_rht. Qed. Lemma cpoly_mult_cr_one : forall p, cpoly_mult_cr_cs p One [=] p. -intro. -pattern p in |- *; apply cpoly_ind_cs. -algebra. -intros. -rewrite cpoly_lin_mult_cr. -apply _cpoly_lin_eq_lin. -algebra. +Proof. + intro. + pattern p in |- *; apply cpoly_ind_cs. + algebra. + intros. + rewrite cpoly_lin_mult_cr. + apply _cpoly_lin_eq_lin. + algebra. Qed. Lemma cpoly_one_mult : forall p, cpoly_mult_cs cpoly_one p [=] p. -intro. -unfold cpoly_one in |- *. -unfold cpoly_constant in |- *. -replace (cpoly_linear One cpoly_zero) with (cpoly_linear_cs One cpoly_zero). -2: reflexivity. -rewrite cpoly_lin_mult. -rewrite cpoly_zero_mult. -apply eq_transitive_unfolded with (cpoly_plus_cs p cpoly_zero_cs). -apply cpoly_plus_op_wd. -apply cpoly_mult_cr_one. -apply _cpoly_lin_eq_zero; algebra. -rewrite cpoly_plus_zero; algebra. +Proof. + intro. + unfold cpoly_one in |- *. + unfold cpoly_constant in |- *. + replace (cpoly_linear One cpoly_zero) with (cpoly_linear_cs One cpoly_zero). + 2: reflexivity. + rewrite cpoly_lin_mult. + rewrite cpoly_zero_mult. + apply eq_transitive_unfolded with (cpoly_plus_cs p cpoly_zero_cs). + apply cpoly_plus_op_wd. + apply cpoly_mult_cr_one. + apply _cpoly_lin_eq_zero; algebra. + rewrite cpoly_plus_zero; algebra. Qed. Lemma cpoly_mult_one : forall p, cpoly_mult_cs p cpoly_one [=] p. -intro. -apply eq_transitive_unfolded with (cpoly_mult_cs cpoly_one p). -apply cpoly_mult_commutative. -apply cpoly_one_mult. +Proof. + intro. + apply eq_transitive_unfolded with (cpoly_mult_cs cpoly_one p). + apply cpoly_mult_commutative. + apply cpoly_one_mult. Qed. -Lemma cpoly_mult_monoid : +Lemma cpoly_mult_monoid : is_CMonoid (Build_CSemiGroup _ _ cpoly_mult_assoc) cpoly_one. -apply Build_is_CMonoid. -exact cpoly_mult_one. -exact cpoly_one_mult. +Proof. + apply Build_is_CMonoid. + exact cpoly_mult_one. + exact cpoly_one_mult. Qed. Lemma cpoly_cr_non_triv : cpoly_ap cpoly_one cpoly_zero. -change (cpoly_linear_cs One cpoly_zero_cs [#] cpoly_zero_cs) in |- *. -cut ((One:CR) [#] Zero or cpoly_zero_cs [#] cpoly_zero_cs). -auto. -left. -algebra. +Proof. + change (cpoly_linear_cs One cpoly_zero_cs [#] cpoly_zero_cs) in |- *. + cut ((One:CR) [#] Zero or cpoly_zero_cs [#] cpoly_zero_cs). + auto. + left. + algebra. Qed. (** -cring_old uses the original definition of polynomial multiplication +cring_old uses the original definition of polynomial multiplication *) Lemma cpoly_is_CRing_old : is_CRing cpoly_cabgroup cpoly_one cpoly_mult_op. -apply Build_is_CRing with cpoly_mult_assoc. -exact cpoly_mult_monoid. -exact cpoly_mult_commutative. -exact cpoly_cr_dist. -exact cpoly_cr_non_triv. +Proof. + apply Build_is_CRing with cpoly_mult_assoc. + exact cpoly_mult_monoid. + exact cpoly_mult_commutative. + exact cpoly_cr_dist. + exact cpoly_cr_non_triv. Qed. Definition cpoly_cring_old : CRing := Build_CRing _ _ _ cpoly_is_CRing_old. @@ -1684,14 +1680,14 @@ Definition cpoly_cring_old : CRing := Build_CRing _ _ _ cpoly_is_CRing_old. (** [cpoly_mult_fast] produces smaller lengthed polynomials when multiplying by zero. For example [Eval simpl in cpoly_mult_cs _ _X_ (Zero:cpoly_cring Q_as_CRing)] -returns +returns [cpoly_linear Q_as_CRing QZERO (cpoly_linear Q_as_CRing QZERO (cpoly_zero Q_as_CRing))] -while +while [Eval simpl in cpoly_mult_fast_cs _ _X_ (Zero:cpoly_cring Q_as_CRing)] returns [cpoly_zero Q_as_CRing]. -Smaller lengthed polynomials means faster operations, and better estimates of the +Smaller lengthed polynomials means faster operations, and better estimates of the degree of a polynomial. *) @@ -1706,95 +1702,95 @@ Definition cpoly_mult_fast_cs (p q : cpoly_csetoid) : cpoly_csetoid := cpoly_mul (** cpoly_mult_fast is proven correct with respect the the original multiplication in cpoly_cring_old *) -Lemma cpoly_mult_fast_ap_equiv : forall p1 p2 q1 q2, +Lemma cpoly_mult_fast_ap_equiv : forall p1 p2 q1 q2, (cpoly_mult_fast_cs p1 q1)[#](cpoly_mult_cs p2 q2) -> p1[#]p2 or q1[#]q2. -destruct q1 as [|c q1]; -destruct q2 as [|c0 q2]; -intros X; -simpl in X. -rewrite cpoly_ap_p_zero in X. -elim (ap_irreflexive cpoly_csetoid cpoly_zero). -stepl (cpoly_mult_cs p2 cpoly_zero). -assumption. -apply cpoly_mult_zero. -rewrite cpoly_ap_p_zero in X. -right. -apply ap_symmetric. -eapply cring_mult_ap_zero_op with (R:=cpoly_cring_old). -apply X. -right. -eapply cring_mult_ap_zero_op with (R:=cpoly_cring_old). -change (cpoly_mult p1 (cpoly_linear c q1)) with (cpoly_mult_cs p1 (cpoly_linear c q1)) in X. -stepr (cpoly_mult_cs p2 cpoly_zero). -apply X. -apply cpoly_mult_zero. -apply cpoly_mult_op_strext. -apply X. -Qed. - -Lemma cpoly_mult_fast_equiv : forall p q, + destruct q1 as [|c q1]; destruct q2 as [|c0 q2]; intros X; simpl in X. +Proof. + rewrite cpoly_ap_p_zero in X. + elim (ap_irreflexive cpoly_csetoid cpoly_zero). + stepl (cpoly_mult_cs p2 cpoly_zero). + assumption. + apply cpoly_mult_zero. + rewrite cpoly_ap_p_zero in X. + right. + apply ap_symmetric. + eapply cring_mult_ap_zero_op with (R:=cpoly_cring_old). + apply X. + right. + eapply cring_mult_ap_zero_op with (R:=cpoly_cring_old). + change (cpoly_mult p1 (cpoly_linear c q1)) with (cpoly_mult_cs p1 (cpoly_linear c q1)) in X. + stepr (cpoly_mult_cs p2 cpoly_zero). + apply X. + apply cpoly_mult_zero. + apply cpoly_mult_op_strext. + apply X. +Qed. + +Lemma cpoly_mult_fast_equiv : forall p q, (cpoly_mult_fast_cs p q)[=](cpoly_mult_cs p q). -intros p q. -apply not_ap_imp_eq. -intro H. -assert (p[#]p or q[#]q). -apply cpoly_mult_fast_ap_equiv. -assumption. -destruct X as [X|X]; apply (ap_irreflexive _ _ X). +Proof. + intros p q. + apply not_ap_imp_eq. + intro H. + assert (p[#]p or q[#]q). + apply cpoly_mult_fast_ap_equiv. + assumption. + destruct X as [X|X]; apply (ap_irreflexive _ _ X). Qed. Lemma cpoly_mult_fast_op_strext : bin_op_strext cpoly_csetoid cpoly_mult_fast_cs. -intros x1 x2 y1 y2 H. -apply cpoly_mult_op_strext. -stepl (cpoly_mult_fast_cs x1 y1). -stepr (cpoly_mult_fast_cs x2 y2). -assumption. -apply cpoly_mult_fast_equiv. -apply cpoly_mult_fast_equiv. +Proof. + intros x1 x2 y1 y2 H. + apply cpoly_mult_op_strext. + stepl (cpoly_mult_fast_cs x1 y1). + stepr (cpoly_mult_fast_cs x2 y2). + assumption. + apply cpoly_mult_fast_equiv. + apply cpoly_mult_fast_equiv. Qed. Definition cpoly_mult_fast_op := Build_CSetoid_bin_op _ _ cpoly_mult_fast_op_strext. Lemma cpoly_is_CRing : is_CRing cpoly_cabgroup cpoly_one cpoly_mult_fast_op. -assert (mult_assoc:(associative cpoly_mult_fast_op)). -intros p q r. -stepl (cpoly_mult_op p (cpoly_mult_op q r)). -stepr (cpoly_mult_op (cpoly_mult_op p q) r). -apply cpoly_mult_assoc. -stepl (cpoly_mult_op (cpoly_mult_fast_op p q) r). -apply eq_symmetric; apply cpoly_mult_fast_equiv. -apply bin_op_wd_unfolded. -apply cpoly_mult_fast_equiv. -apply eq_reflexive. -stepl (cpoly_mult_op p (cpoly_mult_fast_op q r)). -apply eq_symmetric; apply cpoly_mult_fast_equiv. -apply bin_op_wd_unfolded. -apply eq_reflexive. -apply cpoly_mult_fast_equiv. -eapply Build_is_CRing with mult_assoc. -split. -intro p. -stepl (cpoly_mult_op p cpoly_one). -apply cpoly_mult_one. -apply eq_symmetric; apply cpoly_mult_fast_equiv. -intro p. -stepl (cpoly_mult_op cpoly_one p). -apply cpoly_one_mult. -apply eq_symmetric; apply cpoly_mult_fast_equiv. -intros p q. -stepl (cpoly_mult_op p q). -stepr (cpoly_mult_op q p). -apply cpoly_mult_commutative. -apply eq_symmetric; apply cpoly_mult_fast_equiv. -apply eq_symmetric; apply cpoly_mult_fast_equiv. -intros p q r. -stepl (cpoly_mult_op p (q[+]r)). -stepr (cpoly_plus_op (cpoly_mult_op p q) (cpoly_mult_op p r)). -apply cpoly_cr_dist. -apply bin_op_wd_unfolded; -apply eq_symmetric; apply cpoly_mult_fast_equiv. -apply eq_symmetric; apply cpoly_mult_fast_equiv. -exact cpoly_cr_non_triv. +Proof. + assert (mult_assoc:(associative cpoly_mult_fast_op)). + intros p q r. + stepl (cpoly_mult_op p (cpoly_mult_op q r)). + stepr (cpoly_mult_op (cpoly_mult_op p q) r). + apply cpoly_mult_assoc. + stepl (cpoly_mult_op (cpoly_mult_fast_op p q) r). + apply eq_symmetric; apply cpoly_mult_fast_equiv. + apply bin_op_wd_unfolded. + apply cpoly_mult_fast_equiv. + apply eq_reflexive. + stepl (cpoly_mult_op p (cpoly_mult_fast_op q r)). + apply eq_symmetric; apply cpoly_mult_fast_equiv. + apply bin_op_wd_unfolded. + apply eq_reflexive. + apply cpoly_mult_fast_equiv. + eapply Build_is_CRing with mult_assoc. + split. + intro p. + stepl (cpoly_mult_op p cpoly_one). + apply cpoly_mult_one. + apply eq_symmetric; apply cpoly_mult_fast_equiv. + intro p. + stepl (cpoly_mult_op cpoly_one p). + apply cpoly_one_mult. + apply eq_symmetric; apply cpoly_mult_fast_equiv. + intros p q. + stepl (cpoly_mult_op p q). + stepr (cpoly_mult_op q p). + apply cpoly_mult_commutative. + apply eq_symmetric; apply cpoly_mult_fast_equiv. + apply eq_symmetric; apply cpoly_mult_fast_equiv. + intros p q r. + stepl (cpoly_mult_op p (q[+]r)). + stepr (cpoly_plus_op (cpoly_mult_op p q) (cpoly_mult_op p r)). + apply cpoly_cr_dist. + apply bin_op_wd_unfolded; apply eq_symmetric; apply cpoly_mult_fast_equiv. + apply eq_symmetric; apply cpoly_mult_fast_equiv. + exact cpoly_cr_non_triv. Qed. Definition cpoly_cring : CRing := Build_CRing _ _ _ cpoly_is_CRing. @@ -1802,19 +1798,21 @@ Canonical Structure cpoly_cring. Lemma cpoly_constant_strext : fun_strext (S1:=CR) (S2:=cpoly_cring) cpoly_constant. -unfold fun_strext in |- *. -unfold cpoly_constant in |- *. -simpl in |- *. -intros x y H. -elim H. -auto. -intro. -elim b. +Proof. + unfold fun_strext in |- *. + unfold cpoly_constant in |- *. + simpl in |- *. + intros x y H. + elim H. + auto. + intro. + elim b. Qed. Lemma cpoly_constant_wd : fun_wd (S1:=CR) (S2:=cpoly_cring) cpoly_constant. -apply fun_strext_imp_wd. -exact cpoly_constant_strext. +Proof. + apply fun_strext_imp_wd. + exact cpoly_constant_strext. Qed. Definition cpoly_constant_fun := Build_CSetoid_fun _ _ _ cpoly_constant_strext. @@ -1827,20 +1825,22 @@ Definition cpoly_x_minus_c c : cpoly_cring := Lemma cpoly_x_minus_c_strext : fun_strext (S1:=CR) (S2:=cpoly_cring) cpoly_x_minus_c. -unfold fun_strext in |- *. -unfold cpoly_x_minus_c in |- *. -simpl in |- *. -intros x y H. -elim H; intro H0. -apply (cs_un_op_strext _ _ _ _ H0). -elim H0; intro H1. -elim (ap_irreflexive_unfolded _ _ H1). -elim H1. +Proof. + unfold fun_strext in |- *. + unfold cpoly_x_minus_c in |- *. + simpl in |- *. + intros x y H. + elim H; intro H0. + apply (cs_un_op_strext _ _ _ _ H0). + elim H0; intro H1. + elim (ap_irreflexive_unfolded _ _ H1). + elim H1. Qed. Lemma cpoly_x_minus_c_wd : fun_wd (S1:=CR) (S2:=cpoly_cring) cpoly_x_minus_c. -apply fun_strext_imp_wd. -exact cpoly_x_minus_c_strext. +Proof. + apply fun_strext_imp_wd. + exact cpoly_x_minus_c_strext. Qed. End CPoly_CRing. @@ -1925,19 +1925,22 @@ End helpful_section. Lemma Ccpoly_induc : forall P : RX -> CProp, P Zero -> (forall p c, P p -> P (c[+X*]p)) -> forall p, P p. -exact (Ccpoly_ind_cs CR). +Proof. + exact (Ccpoly_ind_cs CR). Qed. Lemma Ccpoly_double_sym_ind : forall P : RX -> RX -> CProp, Csymmetric P -> (forall p, P p Zero) -> (forall p q c d, P p q -> P (c[+X*]p) (d[+X*]q)) -> forall p q, P p q. -exact (Ccpoly_double_sym_ind0_cs CR). +Proof. + exact (Ccpoly_double_sym_ind0_cs CR). Qed. Lemma Cpoly_double_comp_ind : forall P : RX -> RX -> CProp, (forall p1 p2 q1 q2, p1 [=] p2 -> q1 [=] q2 -> P p1 q1 -> P p2 q2) -> P Zero Zero -> (forall p q c d, P p q -> P (c[+X*]p) (d[+X*]q)) -> forall p q, P p q. -exact (Ccpoly_double_comp_ind CR). +Proof. + exact (Ccpoly_double_comp_ind CR). Qed. Lemma Cpoly_triple_comp_ind : forall P : RX -> RX -> RX -> CProp, @@ -1945,24 +1948,28 @@ Lemma Cpoly_triple_comp_ind : forall P : RX -> RX -> RX -> CProp, p1 [=] p2 -> q1 [=] q2 -> r1 [=] r2 -> P p1 q1 r1 -> P p2 q2 r2) -> P Zero Zero Zero -> (forall p q r c d e, P p q r -> P (c[+X*]p) (d[+X*]q) (e[+X*]r)) -> forall p q r, P p q r. -exact (Ccpoly_triple_comp_ind CR). +Proof. + exact (Ccpoly_triple_comp_ind CR). Qed. Lemma cpoly_induc : forall P : RX -> Prop, P Zero -> (forall p c, P p -> P (c[+X*]p)) -> forall p, P p. -exact (cpoly_ind_cs CR). +Proof. + exact (cpoly_ind_cs CR). Qed. Lemma cpoly_double_sym_ind : forall P : RX -> RX -> Prop, Tsymmetric P -> (forall p, P p Zero) -> (forall p q c d, P p q -> P (c[+X*]p) (d[+X*]q)) -> forall p q, P p q. -exact (cpoly_double_sym_ind0_cs CR). +Proof. + exact (cpoly_double_sym_ind0_cs CR). Qed. Lemma poly_double_comp_ind : forall P : RX -> RX -> Prop, (forall p1 p2 q1 q2, p1 [=] p2 -> q1 [=] q2 -> P p1 q1 -> P p2 q2) -> P Zero Zero -> (forall p q c d, P p q -> P (c[+X*]p) (d[+X*]q)) -> forall p q, P p q. -exact (cpoly_double_comp_ind CR). +Proof. + exact (cpoly_double_comp_ind CR). Qed. Lemma poly_triple_comp_ind : forall P : RX -> RX -> RX -> Prop, @@ -1970,7 +1977,8 @@ Lemma poly_triple_comp_ind : forall P : RX -> RX -> RX -> Prop, p1 [=] p2 -> q1 [=] q2 -> r1 [=] r2 -> P p1 q1 r1 -> P p2 q2 r2) -> P Zero Zero Zero -> (forall p q r c d e, P p q r -> P (c[+X*]p) (d[+X*]q) (e[+X*]r)) -> forall p q r, P p q r. -exact (cpoly_triple_comp_ind CR). +Proof. + exact (cpoly_triple_comp_ind CR). Qed. Transparent cpoly_cring. @@ -1984,63 +1992,65 @@ Fixpoint cpoly_apply (p : RX) (x : CR) {struct p} : CR := end. Lemma cpoly_apply_strext : bin_fun_strext _ _ _ cpoly_apply. -unfold bin_fun_strext in |- *. -do 2 intro. -pattern x1, x2 in |- *. -apply Ccpoly_double_sym_ind. -unfold Csymmetric in |- *. -intros. -generalize (ap_symmetric _ _ _ X0); intro. -elim (X _ _ X1); intro. -left. -apply ap_symmetric_unfolded. -assumption. -right. -apply ap_symmetric_unfolded. -assumption. -do 3 intro. -pattern p in |- *. -apply Ccpoly_induc. -simpl in |- *. -intro H. -elim (ap_irreflexive _ _ H). -intros. -simpl in X0. -simpl in X. -cut (c[+]y1[*]cpoly_apply p0 y1 [#] Zero[+]y1[*]Zero). -intro. -elim (cs_bin_op_strext _ _ _ _ _ _ X1); intro H2. -left. -cut (c [#] Zero or p0 [#] Zero). -intro. -apply _linear_ap_zero. -auto. -left. -assumption. -elim (cs_bin_op_strext _ _ _ _ _ _ H2); intro H3. -elim (ap_irreflexive _ _ H3). -elim (X H3); intro H4. -left. -cut (c [#] Zero or p0 [#] Zero). -intro; apply _linear_ap_zero. -auto. -right. -exact H4. -auto. -astepr (Zero[+](Zero:CR)). -astepr (Zero:CR). auto. -simpl in |- *. -intros. -elim (cs_bin_op_strext _ _ _ _ _ _ X0); intro H1. -auto. -elim (cs_bin_op_strext _ _ _ _ _ _ H1); intro H2. -auto. -elim (X _ _ H2); auto. +Proof. + unfold bin_fun_strext in |- *. + do 2 intro. + pattern x1, x2 in |- *. + apply Ccpoly_double_sym_ind. + unfold Csymmetric in |- *. + intros. + generalize (ap_symmetric _ _ _ X0); intro. + elim (X _ _ X1); intro. + left. + apply ap_symmetric_unfolded. + assumption. + right. + apply ap_symmetric_unfolded. + assumption. + do 3 intro. + pattern p in |- *. + apply Ccpoly_induc. + simpl in |- *. + intro H. + elim (ap_irreflexive _ _ H). + intros. + simpl in X0. + simpl in X. + cut (c[+]y1[*]cpoly_apply p0 y1 [#] Zero[+]y1[*]Zero). + intro. + elim (cs_bin_op_strext _ _ _ _ _ _ X1); intro H2. + left. + cut (c [#] Zero or p0 [#] Zero). + intro. + apply _linear_ap_zero. + auto. + left. + assumption. + elim (cs_bin_op_strext _ _ _ _ _ _ H2); intro H3. + elim (ap_irreflexive _ _ H3). + elim (X H3); intro H4. + left. + cut (c [#] Zero or p0 [#] Zero). + intro; apply _linear_ap_zero. + auto. + right. + exact H4. + auto. + astepr (Zero[+](Zero:CR)). + astepr (Zero:CR). auto. + simpl in |- *. + intros. + elim (cs_bin_op_strext _ _ _ _ _ _ X0); intro H1. + auto. + elim (cs_bin_op_strext _ _ _ _ _ _ H1); intro H2. + auto. + elim (X _ _ H2); auto. Qed. Lemma cpoly_apply_wd : bin_fun_wd _ _ _ cpoly_apply. -apply bin_fun_strext_imp_wd. -exact cpoly_apply_strext. +Proof. + apply bin_fun_strext_imp_wd. + exact cpoly_apply_strext. Qed. Definition cpoly_apply_fun := Build_CSetoid_bin_fun _ _ _ _ cpoly_apply_strext. @@ -2072,35 +2082,42 @@ Variable R : CRing. Notation RX := (cpoly_cring R). Lemma cpoly_const_one : One [=] cpoly_constant_fun _ (One:R). -simpl in |- *; split; algebra. +Proof. + simpl in |- *; split; algebra. Qed. Lemma cpoly_const_plus : forall a b : R, cpoly_constant_fun _ (a[+]b) [=] cpoly_constant_fun _ a[+]cpoly_constant_fun _ b. -simpl in |- *; split; algebra. +Proof. + simpl in |- *; split; algebra. Qed. Lemma cpoly_const_mult : forall a b : R, cpoly_constant_fun _ (a[*]b) [=] cpoly_constant_fun _ a[*] cpoly_constant_fun _ b. -simpl in |- *; split; algebra. +Proof. + simpl in |- *; split; algebra. Qed. Definition polyconst : RingHom R RX := Build_RingHom _ _ _ cpoly_const_plus cpoly_const_mult cpoly_const_one. Notation "'_C_'" := polyconst. Lemma c_one : One [=] _C_ (One:R). -simpl in |- *; split; algebra. +Proof. + simpl in |- *; split; algebra. Qed. Lemma c_plus : forall a b : R, _C_ (a[+]b) [=] _C_ a[+] _C_ b. -simpl in |- *; split; algebra. +Proof. + simpl in |- *; split; algebra. Qed. Lemma c_mult : forall a b : R, _C_ (a[*]b) [=] _C_ a[*] _C_ b. -simpl in |- *; split; algebra. +Proof. + simpl in |- *; split; algebra. Qed. Lemma c_zero : Zero [=] _C_ (Zero:R). -simpl in |- *. -split; algebra. +Proof. + simpl in |- *. + split; algebra. Qed. (** @@ -2108,102 +2125,100 @@ Qed. *) Lemma cpoly_X_ : _X_ [=] (Zero:RX) [+X*]One. -algebra. +Proof. + algebra. Qed. Lemma cpoly_C_ : forall c : R, _C_ c [=] c[+X*]Zero. -algebra. +Proof. + algebra. Qed. Hint Resolve cpoly_X_ cpoly_C_: algebra. Lemma cpoly_const_eq : forall c d : R, c [=] d -> _C_ c [=] _C_ d. -intros. -algebra. +Proof. + intros. + algebra. Qed. Lemma cpoly_lin : forall (p : RX) (c : R), c[+X*]p [=] _C_ c[+]_X_[*]p. -intros. -astepr - (c[+X*]Zero[+] - ((cpoly_mult_cr_cs _ p Zero:RX) [+] - (cpoly_linear _ (Zero:R) - (cpoly_mult_cs _ (cpoly_one R) (p:cpoly_csetoid R)) - :cpoly_csetoid R))). -cut (cpoly_mult_cr_cs R p Zero [=] (Zero:RX)). -intro. -astepr - (c[+X*]Zero[+] - ((Zero:RX) [+] - (cpoly_linear _ (Zero:R) - (cpoly_mult_cs _ (cpoly_one R) (p:cpoly_csetoid R)) - :cpoly_csetoid R))). -2: apply (cpoly_mult_cr_zero R p). -cut ((cpoly_mult_cs _ (cpoly_one R) (p:cpoly_csetoid R):cpoly_csetoid R) [=] p). -intro. -apply - eq_transitive_unfolded - with - (c[+X*]Zero[+]((Zero:RX) [+]cpoly_linear _ (Zero:R) (p:cpoly_csetoid R))). -2: apply bin_op_wd_unfolded. -2: algebra. -2: apply bin_op_wd_unfolded. -2: algebra. -2: apply (cpoly_linear_wd R). -2: algebra. -2: apply eq_symmetric_unfolded. -2: apply cpoly_one_mult. -astepr (c[+X*]Zero[+]cpoly_linear _ (Zero:R) (p:cpoly_csetoid R)). -astepr (c[+]Zero[+X*](Zero[+]p)). -astepr (c[+X*]p). -algebra. -apply cpoly_one_mult. -destruct p. -simpl. -algebra. -simpl. -split. -auto with *. -apply eq_reflexive with (S:=cpoly_cring R). +Proof. + intros. + astepr (c[+X*]Zero[+] ((cpoly_mult_cr_cs _ p Zero:RX) [+] (cpoly_linear _ (Zero:R) + (cpoly_mult_cs _ (cpoly_one R) (p:cpoly_csetoid R)) :cpoly_csetoid R))). + cut (cpoly_mult_cr_cs R p Zero [=] (Zero:RX)). + intro. + astepr (c[+X*]Zero[+] ((Zero:RX) [+] (cpoly_linear _ (Zero:R) + (cpoly_mult_cs _ (cpoly_one R) (p:cpoly_csetoid R)) :cpoly_csetoid R))). + 2: apply (cpoly_mult_cr_zero R p). + cut ((cpoly_mult_cs _ (cpoly_one R) (p:cpoly_csetoid R):cpoly_csetoid R) [=] p). + intro. + apply eq_transitive_unfolded with + (c[+X*]Zero[+]((Zero:RX) [+]cpoly_linear _ (Zero:R) (p:cpoly_csetoid R))). + 2: apply bin_op_wd_unfolded. + 2: algebra. + 2: apply bin_op_wd_unfolded. + 2: algebra. + 2: apply (cpoly_linear_wd R). + 2: algebra. + 2: apply eq_symmetric_unfolded. + 2: apply cpoly_one_mult. + astepr (c[+X*]Zero[+]cpoly_linear _ (Zero:R) (p:cpoly_csetoid R)). + astepr (c[+]Zero[+X*](Zero[+]p)). + astepr (c[+X*]p). + algebra. + apply cpoly_one_mult. + destruct p. + simpl. + algebra. + simpl. + split. + auto with *. + apply eq_reflexive with (S:=cpoly_cring R). Qed. Hint Resolve cpoly_lin: algebra. (* SUPERFLUOUS *) Lemma poly_linear : forall c f, (cpoly_linear _ c f:RX) [=] _X_[*]f[+]_C_ c. -intros. -astepr (_C_ c[+]_X_[*]f). -exact (cpoly_lin f c). +Proof. + intros. + astepr (_C_ c[+]_X_[*]f). + exact (cpoly_lin f c). Qed. Lemma poly_c_apzero : forall a : R, _C_ a [#] Zero -> a [#] Zero. -intros. -cut (_C_ a [#] _C_ Zero). -intro H0. -generalize (csf_strext _ _ _ _ _ H0); auto. -Hint Resolve c_zero: algebra. -astepr (Zero:RX). auto. +Proof. + intros. + cut (_C_ a [#] _C_ Zero). + intro H0. + generalize (csf_strext _ _ _ _ _ H0); auto. + Hint Resolve c_zero: algebra. + astepr (Zero:RX). auto. Qed. Lemma c_mult_lin : forall (p : RX) c d, _C_ c[*] (d[+X*]p) [=] c[*]d[+X*]_C_ c[*]p. -intros. -pattern p in |- *. -apply cpoly_induc. -simpl in |- *. -repeat split; algebra. -intros. simpl in |- *. -repeat split; algebra. -change ((cpoly_mult_cr R p0 c:RX) [=] (cpoly_mult_cr R p0 c:RX)[+]Zero) in |- *. -algebra. +Proof. + intros. + pattern p in |- *. + apply cpoly_induc. + simpl in |- *. + repeat split; algebra. + intros. simpl in |- *. + repeat split; algebra. + change ((cpoly_mult_cr R p0 c:RX) [=] (cpoly_mult_cr R p0 c:RX)[+]Zero) in |- *. + algebra. Qed. (* SUPERFLUOUS ? *) Lemma lin_mult : forall (p q : RX) c, (c[+X*]p) [*]q [=] _C_ c[*]q[+]_X_[*] (p[*]q). -intros. -astepl ((_C_ c[+]_X_[*]p)[*]q). -astepl (_C_ c[*]q[+]_X_[*]p[*]q). -algebra. +Proof. + intros. + astepl ((_C_ c[+]_X_[*]p)[*]q). + astepl (_C_ c[*]q[+]_X_[*]p[*]q). + algebra. Qed. Hint Resolve lin_mult: algebra. @@ -2213,27 +2228,31 @@ Hint Resolve lin_mult: algebra. *) Lemma poly_eq_zero : forall p : RX, p [=] cpoly_zero R -> forall x, p ! x [=] Zero. -intros. -astepl (cpoly_zero R) ! x. -change (Zero ! x [=] Zero) in |- *. -algebra. +Proof. + intros. + astepl (cpoly_zero R) ! x. + change (Zero ! x [=] Zero) in |- *. + algebra. Qed. Lemma apply_wd : forall (p p' : RX) x x', p [=] p' -> x [=] x' -> p ! x [=] p' ! x'. -intros. -algebra. +Proof. + intros. + algebra. Qed. Lemma cpolyap_pres_eq : forall (f : RX) x y, x [=] y -> f ! x [=] f ! y. -intros. -algebra. +Proof. + intros. + algebra. Qed. Lemma cpolyap_strext : forall (f : RX) x y, f ! x [#] f ! y -> x [#] y. -intros f x y H. -elim (csbf_strext _ _ _ _ _ _ _ _ H); intro H0. -elim (ap_irreflexive_unfolded _ _ H0). -assumption. +Proof. + intros f x y H. + elim (csbf_strext _ _ _ _ _ _ _ _ H); intro H0. + elim (ap_irreflexive_unfolded _ _ H0). + assumption. Qed. Definition cpoly_csetoid_op (f : RX) : CSetoid_un_op R := @@ -2242,171 +2261,183 @@ Definition cpoly_csetoid_op (f : RX) : CSetoid_un_op R := Definition FPoly p := total_eq_part _ (cpoly_csetoid_op p). Lemma c_apply : forall c x : R, (_C_ c) ! x [=] c. -intros. -simpl in |- *. -astepl (c[+]Zero). -algebra. +Proof. + intros. + simpl in |- *. + astepl (c[+]Zero). + algebra. Qed. Lemma x_apply : forall x : R, _X_ ! x [=] x. -intros. -simpl in |- *. -astepl (x[*](One[+]x[*]Zero)). -astepl (x[*](One[+]Zero)). -astepl (x[*]One). -algebra. +Proof. + intros. + simpl in |- *. + astepl (x[*](One[+]x[*]Zero)). + astepl (x[*](One[+]Zero)). + astepl (x[*]One). + algebra. Qed. Lemma plus_apply : forall (p q : RX) x, (p[+]q) ! x [=] p ! x[+]q ! x. -intros. -pattern p, q in |- *; apply poly_double_comp_ind. -intros. -astepl (p1[+]q1) ! x. -astepr (p1 ! x[+]q1 ! x). -algebra. -simpl in |- *. -algebra. -intros. -astepl (c[+]d[+]x[*](p0[+]q0) ! x). -astepr (c[+]x[*]p0 ! x[+](d[+]x[*]q0 ! x)). -astepl (c[+]d[+]x[*](p0 ! x[+]q0 ! x)). -astepl (c[+]d[+](x[*]p0 ! x[+]x[*]q0 ! x)). -astepl (c[+](d[+](x[*]p0 ! x[+]x[*]q0 ! x))). -astepr (c[+](x[*]p0 ! x[+](d[+]x[*]q0 ! x))). -astepl (c[+](d[+]x[*]p0 ! x[+]x[*]q0 ! x)). -astepr (c[+](x[*]p0 ! x[+]d[+]x[*]q0 ! x)). -algebra. +Proof. + intros. + pattern p, q in |- *; apply poly_double_comp_ind. + intros. + astepl (p1[+]q1) ! x. + astepr (p1 ! x[+]q1 ! x). + algebra. + simpl in |- *. + algebra. + intros. + astepl (c[+]d[+]x[*](p0[+]q0) ! x). + astepr (c[+]x[*]p0 ! x[+](d[+]x[*]q0 ! x)). + astepl (c[+]d[+]x[*](p0 ! x[+]q0 ! x)). + astepl (c[+]d[+](x[*]p0 ! x[+]x[*]q0 ! x)). + astepl (c[+](d[+](x[*]p0 ! x[+]x[*]q0 ! x))). + astepr (c[+](x[*]p0 ! x[+](d[+]x[*]q0 ! x))). + astepl (c[+](d[+]x[*]p0 ! x[+]x[*]q0 ! x)). + astepr (c[+](x[*]p0 ! x[+]d[+]x[*]q0 ! x)). + algebra. Qed. Lemma inv_apply : forall (p : RX) x, ( [--]p) ! x [=] [--]p ! x. -intros. -pattern p in |- *. -apply cpoly_induc. -simpl in |- *. -algebra. -intros. -astepl ( [--]c[+]x[*]( [--]p0) ! x). -astepr ( [--](c[+]x[*]p0 ! x)). -astepr ( [--]c[+][--](x[*]p0 ! x)). -astepr ( [--]c[+]x[*][--]p0 ! x). -algebra. +Proof. + intros. + pattern p in |- *. + apply cpoly_induc. + simpl in |- *. + algebra. + intros. + astepl ( [--]c[+]x[*]( [--]p0) ! x). + astepr ( [--](c[+]x[*]p0 ! x)). + astepr ( [--]c[+][--](x[*]p0 ! x)). + astepr ( [--]c[+]x[*][--]p0 ! x). + algebra. Qed. Hint Resolve plus_apply inv_apply: algebra. Lemma minus_apply : forall (p q : RX) x, (p[-]q) ! x [=] p ! x[-]q ! x. -intros. -astepl (p[+][--]q) ! x. -astepr (p ! x[+][--]q ! x). -astepl (p ! x[+]( [--]q) ! x). -algebra. +Proof. + intros. + astepl (p[+][--]q) ! x. + astepr (p ! x[+][--]q ! x). + astepl (p ! x[+]( [--]q) ! x). + algebra. Qed. Lemma c_mult_apply : forall (q : RX) c x, (_C_ c[*]q) ! x [=] c[*]q ! x. -intros. -astepl ((cpoly_mult_cr R q c:RX)[+](Zero[+X*]Zero)) ! x. -astepl ((cpoly_mult_cr R q c) ! x[+](Zero[+X*]Zero) ! x). -astepl ((cpoly_mult_cr R q c) ! x[+](Zero[+]x[*]Zero)). -astepl ((cpoly_mult_cr R q c) ! x[+](Zero[+]Zero)). -astepl ((cpoly_mult_cr R q c) ! x[+]Zero). -astepl (cpoly_mult_cr R q c) ! x. -pattern q in |- *. -apply cpoly_induc. -simpl in |- *. -algebra. -intros. -astepl (c[*]c0[+X*]cpoly_mult_cr R p c) ! x. -astepl (c[*]c0[+]x[*](cpoly_mult_cr R p c) ! x). -astepl (c[*]c0[+]x[*](c[*]p ! x)). -astepr (c[*](c0[+]x[*]p ! x)). -astepr (c[*]c0[+]c[*](x[*]p ! x)). -apply bin_op_wd_unfolded. -algebra. -astepl (x[*]c[*]p ! x). -astepr (c[*]x[*]p ! x). -algebra. -stepr ((cpoly_mult _ (_C_ c) q)!x). -apply eq_reflexive. -apply apply_wd. -apply eq_symmetric. -apply (cpoly_mult_fast_equiv _ (_C_ c) q). -apply eq_reflexive. +Proof. + intros. + astepl ((cpoly_mult_cr R q c:RX)[+](Zero[+X*]Zero)) ! x. + astepl ((cpoly_mult_cr R q c) ! x[+](Zero[+X*]Zero) ! x). + astepl ((cpoly_mult_cr R q c) ! x[+](Zero[+]x[*]Zero)). + astepl ((cpoly_mult_cr R q c) ! x[+](Zero[+]Zero)). + astepl ((cpoly_mult_cr R q c) ! x[+]Zero). + astepl (cpoly_mult_cr R q c) ! x. + pattern q in |- *. + apply cpoly_induc. + simpl in |- *. + algebra. + intros. + astepl (c[*]c0[+X*]cpoly_mult_cr R p c) ! x. + astepl (c[*]c0[+]x[*](cpoly_mult_cr R p c) ! x). + astepl (c[*]c0[+]x[*](c[*]p ! x)). + astepr (c[*](c0[+]x[*]p ! x)). + astepr (c[*]c0[+]c[*](x[*]p ! x)). + apply bin_op_wd_unfolded. + algebra. + astepl (x[*]c[*]p ! x). + astepr (c[*]x[*]p ! x). + algebra. + stepr ((cpoly_mult _ (_C_ c) q)!x). + apply eq_reflexive. + apply apply_wd. + apply eq_symmetric. + apply (cpoly_mult_fast_equiv _ (_C_ c) q). + apply eq_reflexive. Qed. Hint Resolve c_mult_apply: algebra. Lemma mult_apply : forall (p q : RX) x, (p[*]q) ! x [=] p ! x[*]q ! x. -intros. -pattern p in |- *. -apply cpoly_induc. -astepl (Zero ! x). -simpl in |- *. -algebra. -intros. -astepl (_C_ c[*]q[+]_X_[*](p0[*]q)) ! x. -astepl ((_C_ c[*]q) ! x[+](_X_[*](p0[*]q)) ! x). -astepl ((_C_ c[*]q) ! x[+](Zero[+]_X_[*](p0[*]q)) ! x). -astepl ((_C_ c[*]q) ! x[+](_C_ Zero[+]_X_[*](p0[*]q)) ! x). -astepl ((_C_ c[*]q) ! x[+](Zero[+X*]p0[*]q) ! x). -astepl ((_C_ c[*]q) ! x[+](Zero[+]x[*](p0[*]q) ! x)). -astepl (c[*]q ! x[+]x[*](p0[*]q) ! x). -astepl (c[*]q ! x[+]x[*](p0 ! x[*]q ! x)). -astepr ((c[+]x[*]p0 ! x)[*]q ! x). -astepr (c[*]q ! x[+]x[*]p0 ! x[*]q ! x). -algebra. +Proof. + intros. + pattern p in |- *. + apply cpoly_induc. + astepl (Zero ! x). + simpl in |- *. + algebra. + intros. + astepl (_C_ c[*]q[+]_X_[*](p0[*]q)) ! x. + astepl ((_C_ c[*]q) ! x[+](_X_[*](p0[*]q)) ! x). + astepl ((_C_ c[*]q) ! x[+](Zero[+]_X_[*](p0[*]q)) ! x). + astepl ((_C_ c[*]q) ! x[+](_C_ Zero[+]_X_[*](p0[*]q)) ! x). + astepl ((_C_ c[*]q) ! x[+](Zero[+X*]p0[*]q) ! x). + astepl ((_C_ c[*]q) ! x[+](Zero[+]x[*](p0[*]q) ! x)). + astepl (c[*]q ! x[+]x[*](p0[*]q) ! x). + astepl (c[*]q ! x[+]x[*](p0 ! x[*]q ! x)). + astepr ((c[+]x[*]p0 ! x)[*]q ! x). + astepr (c[*]q ! x[+]x[*]p0 ! x[*]q ! x). + algebra. Qed. Hint Resolve mult_apply: algebra. Lemma one_apply : forall x : R, One ! x [=] One. -intro. -astepl (_C_ One) ! x. -apply c_apply. +Proof. + intro. + astepl (_C_ One) ! x. + apply c_apply. Qed. Hint Resolve one_apply: algebra. Lemma nexp_apply : forall (p : RX) n x, (p[^]n) ! x [=] p ! x[^]n. -intros. -induction n as [| n Hrecn]. -astepl (One:RX) ! x. -astepl (One:R). -algebra. -astepl (p[*]p[^]n) ! x. -astepl (p ! x[*](p[^]n) ! x). -astepl (p ! x[*]p ! x[^]n). -algebra. +Proof. + intros. + induction n as [| n Hrecn]. + astepl (One:RX) ! x. + astepl (One:R). + algebra. + astepl (p[*]p[^]n) ! x. + astepl (p ! x[*](p[^]n) ! x). + astepl (p ! x[*]p ! x[^]n). + algebra. Qed. (* SUPERFLUOUS *) Lemma poly_inv_apply : forall (p : RX) x, (cpoly_inv _ p) ! x [=] [--]p ! x. -exact inv_apply. +Proof. + exact inv_apply. Qed. Lemma Sum0_cpoly_ap : forall (f : nat -> RX) a k, (Sum0 k f) ! a [=] Sum0 k (fun i => (f i) ! a). -intros. -induction k as [| k Hreck]. -simpl in |- *. -algebra. -astepl (Sum0 k f[+]f k) ! a. -astepl ((Sum0 k f) ! a[+](f k) ! a). -astepl (Sum0 k (fun i : nat => (f i) ! a)[+](f k) ! a). -simpl in |- *. -algebra. +Proof. + intros. + induction k as [| k Hreck]. + simpl in |- *. + algebra. + astepl (Sum0 k f[+]f k) ! a. + astepl ((Sum0 k f) ! a[+](f k) ! a). + astepl (Sum0 k (fun i : nat => (f i) ! a)[+](f k) ! a). + simpl in |- *. + algebra. Qed. Lemma Sum_cpoly_ap : forall (f : nat -> RX) a k l, (Sum k l f) ! a [=] Sum k l (fun i => (f i) ! a). -unfold Sum in |- *. -unfold Sum1 in |- *. -intros. -unfold cg_minus in |- *. -astepl ((Sum0 (S l) f) ! a[+]( [--](Sum0 k f)) ! a). -astepl ((Sum0 (S l) f) ! a[+][--](Sum0 k f) ! a). -apply bin_op_wd_unfolded. -apply Sum0_cpoly_ap. -apply un_op_wd_unfolded. -apply Sum0_cpoly_ap. +Proof. + unfold Sum in |- *. + unfold Sum1 in |- *. + intros. + unfold cg_minus in |- *. + astepl ((Sum0 (S l) f) ! a[+]( [--](Sum0 k f)) ! a). + astepl ((Sum0 (S l) f) ! a[+][--](Sum0 k f) ! a). + apply bin_op_wd_unfolded. + apply Sum0_cpoly_ap. + apply un_op_wd_unfolded. + apply Sum0_cpoly_ap. Qed. End Poly_properties. @@ -2432,7 +2463,8 @@ Notation Cpoly_cring := (cpoly_cring CR). Lemma cpoly_double_ind : forall P : Cpoly_cring -> Cpoly_cring -> Prop, (forall p, P p Zero) -> (forall p, P Zero p) -> (forall p q c d, P p q -> P (c[+X*]p) (d[+X*]q)) -> forall p q, P p q. -exact (cpoly_double_ind0_cs CR). +Proof. + exact (cpoly_double_ind0_cs CR). Qed. End Poly_Prop_Induction. @@ -2460,36 +2492,31 @@ end. Lemma cpoly_diff_strext : un_op_strext _ cpoly_diff. Proof. -intros x. -induction x. - induction y. - auto with *. - intros Hxy. - right. - abstract ( - destruct (cpoly_ap_zero_plus _ _ _ (ap_symmetric _ _ _ Hxy)) as [c|[c|c]]; - [apply (ap_symmetric _ _ _ c) - |elim (ap_irreflexive _ _ c) - |apply IHy;apply c]). -intros [|a y] Hxy. - simpl in Hxy. + intros x. + induction x. + induction y. + auto with *. + intros Hxy. + right. + abstract ( destruct (cpoly_ap_zero_plus _ _ _ (ap_symmetric _ _ _ Hxy)) as [c|[c|c]]; + [apply (ap_symmetric _ _ _ c) |elim (ap_irreflexive _ _ c) |apply IHy;apply c]). + intros [|a y] Hxy. + simpl in Hxy. + right. + abstract ( destruct (cpoly_ap_zero_plus _ _ _ Hxy) as [c|[c|c]]; [apply (ap_symmetric _ _ _ c) + |elim (ap_irreflexive _ _ c) + |change (Zero[#]x); apply ap_symmetric; apply IHx; apply ap_symmetric; apply c]). right. - abstract ( - destruct (cpoly_ap_zero_plus _ _ _ Hxy) as [c|[c|c]]; - [apply (ap_symmetric _ _ _ c) - |elim (ap_irreflexive _ _ c) - |change (Zero[#]x); apply ap_symmetric; apply IHx; apply ap_symmetric; apply c]). -right. -destruct (cpoly_plus_op_strext _ _ _ _ _ Hxy) as [c|[c|c]]. - assumption. - elim (ap_irreflexive _ _ c). -apply IHx; apply c. + destruct (cpoly_plus_op_strext _ _ _ _ _ Hxy) as [c|[c|c]]. + assumption. + elim (ap_irreflexive _ _ c). + apply IHx; apply c. Defined. Lemma cpoly_diff_wd : un_op_wd _ cpoly_diff. Proof. -apply fun_strext_imp_wd. -apply cpoly_diff_strext. + apply fun_strext_imp_wd. + apply cpoly_diff_strext. Qed. Definition cpolyder := Build_CSetoid_un_op _ _ cpoly_diff_strext. @@ -2497,96 +2524,94 @@ Notation "'_D_'" := cpolyder. Lemma diff_zero : _D_ Zero[=]Zero. Proof. -reflexivity. + reflexivity. Qed. Lemma diff_one : _D_ One[=]Zero. Proof. -simpl; split; auto with *; reflexivity. + simpl; split; auto with *; reflexivity. Qed. Lemma diff_const : forall c, _D_ (_C_ c)[=]Zero. Proof. -simpl; split; auto with *. + simpl; split; auto with *. Qed. Lemma diff_x : _D_ _X_[=]One. Proof. -simpl; split; auto with *. + simpl; split; auto with *. Qed. Lemma diff_linear : forall a (p:RX), _D_ (a[+X*]p)[=]p[+]_X_[*]_D_ p. Proof. -intros a p. -change (p[+](Zero[+X*]_D_ p)[=]p[+]_X_[*]_D_ p). -rewrite cpoly_lin. -rewrite <- c_zero. -rational. + intros a p. + change (p[+](Zero[+X*]_D_ p)[=]p[+]_X_[*]_D_ p). + rewrite cpoly_lin. + rewrite <- c_zero. + rational. Qed. Lemma diff_plus : forall (p q:RX), _D_ (p[+]q)[=]_D_ p[+]_D_ q. Proof. -induction p. - reflexivity. -intros [|a q]. - rewrite cm_rht_unit_unfolded. - change (cpoly_zero R) with (Zero:cpoly_cring R). - rewrite diff_zero; algebra. -change ((p[+]q)[+]cpoly_linear _ Zero (_D_ (p[+]q))[=] - (p[+]cpoly_linear _ Zero (_D_ p))[+](q[+]cpoly_linear _ Zero (_D_ q))). -do 3 rewrite poly_linear. -change (st_car RX) in p, q. -change (p[+]q[+](_X_[*]_D_ (p[+]q)[+]_C_ Zero)[=] -p[+](_X_[*]_D_ p[+]_C_ Zero)[+](q[+](_X_[*]_D_ q[+]_C_ Zero))). -rewrite (IHp q). -rewrite <- c_zero. -rational. + induction p. + reflexivity. + intros [|a q]. + rewrite cm_rht_unit_unfolded. + change (cpoly_zero R) with (Zero:cpoly_cring R). + rewrite diff_zero; algebra. + change ((p[+]q)[+]cpoly_linear _ Zero (_D_ (p[+]q))[=] + (p[+]cpoly_linear _ Zero (_D_ p))[+](q[+]cpoly_linear _ Zero (_D_ q))). + do 3 rewrite poly_linear. + change (st_car RX) in p, q. + change (p[+]q[+](_X_[*]_D_ (p[+]q)[+]_C_ Zero)[=] + p[+](_X_[*]_D_ p[+]_C_ Zero)[+](q[+](_X_[*]_D_ q[+]_C_ Zero))). + rewrite (IHp q). + rewrite <- c_zero. + rational. Qed. Lemma diff_c_mult : forall c (p:RX), _D_ (_C_ c[*]p)[=]_C_ c[*]_D_ p. Proof. -intros c p. -induction p. - auto with *. -change (_D_ (cpoly_linear R s p)) with (p[+](Zero[+X*](_D_ p))). -change (cpoly_linear R s p) with (s[+X*]p). -rewrite c_mult_lin. -change (_D_ (c[*]s[+X*]_C_ c[*]p)) - with (_C_ c[*]p [+] (Zero[+X*](_D_ (_C_ c[*]p)))). -rewrite IHp. -do 2 rewrite cpoly_lin. -rewrite <- c_zero. -rational. + intros c p. + induction p. + auto with *. + change (_D_ (cpoly_linear R s p)) with (p[+](Zero[+X*](_D_ p))). + change (cpoly_linear R s p) with (s[+X*]p). + rewrite c_mult_lin. + change (_D_ (c[*]s[+X*]_C_ c[*]p)) with (_C_ c[*]p [+] (Zero[+X*](_D_ (_C_ c[*]p)))). + rewrite IHp. + do 2 rewrite cpoly_lin. + rewrite <- c_zero. + rational. Qed. Lemma diff_mult : forall (p q:RX), _D_ (p[*]q)[=]_D_ p[*]q [+] p[*]_D_ q. Proof. -induction p. + induction p. + intros q. + change (_D_(Zero[*]q)[=]Zero[*]q[+]Zero[*]_D_ q). + rstepl (_D_(Zero:RX)). + rewrite diff_zero. + rational. intros q. - change (_D_(Zero[*]q)[=]Zero[*]q[+]Zero[*]_D_ q). - rstepl (_D_(Zero:RX)). - rewrite diff_zero. + change (st_car RX) in p. + change (_D_((s[+X*]p)[*]q)[=]_D_(s[+X*]p)[*]q[+](s[+X*]p)[*]_D_ q). + do 2 rewrite lin_mult. + rewrite diff_linear. + fold RX. + rewrite diff_plus. + setoid_replace (_D_ ((_C_ s:RX)[*]q)) with (_C_ s[*]_D_ q) by apply diff_c_mult. + setoid_replace (((_X_:RX)[*](p[*]q)):RX) + with ((((_X_:RX)[*](p[*]q)))[+]Zero) by (symmetry;apply cm_rht_unit_unfolded). + setoid_replace (Zero:RX) with (_C_ Zero:RX) by apply c_zero. + unfold RX. + rewrite <- poly_linear. + fold RX. + change (_D_ (cpoly_linear R Zero (p[*]q))) with (p[*]q [+] (Zero[+X*]_D_ (p[*]q))). + rewrite cpoly_lin. + rewrite <- c_zero. + rewrite IHp. rational. -intros q. -change (st_car RX) in p. -change (_D_((s[+X*]p)[*]q)[=]_D_(s[+X*]p)[*]q[+](s[+X*]p)[*]_D_ q). -do 2 rewrite lin_mult. -rewrite diff_linear. -fold RX. -rewrite diff_plus. -setoid_replace (_D_ ((_C_ s:RX)[*]q)) with (_C_ s[*]_D_ q) by apply diff_c_mult. -setoid_replace (((_X_:RX)[*](p[*]q)):RX) - with ((((_X_:RX)[*](p[*]q)))[+]Zero) by (symmetry;apply cm_rht_unit_unfolded). -setoid_replace (Zero:RX) with (_C_ Zero:RX) by apply c_zero. -unfold RX. -rewrite <- poly_linear. -fold RX. -change (_D_ (cpoly_linear R Zero (p[*]q))) - with (p[*]q [+] (Zero[+X*]_D_ (p[*]q))). -rewrite cpoly_lin. -rewrite <- c_zero. -rewrite IHp. -rational. Qed. End Derivative. @@ -2608,158 +2633,155 @@ end. Lemma cpoly_map_strext : fun_strext cpoly_map_fun. Proof. -intros x. -induction x; intros y H. - induction y. - elim H. - destruct H as [H|H]. - left. - eapply rh_apzero; apply H. - right. - apply IHy. - apply H. -destruct y as [|c y]. + intros x. + induction x; intros y H. + induction y. + elim H. + destruct H as [H|H]. + left. + eapply rh_apzero; apply H. + right. + apply IHy. + apply H. + destruct y as [|c y]. + destruct H as [H|H]. + left. + eapply rh_apzero; apply H. + right. + change (Zero[#]x). + apply ap_symmetric. + apply IHx. + apply ap_symmetric. + apply H. destruct H as [H|H]. left. - eapply rh_apzero; apply H. + eapply rh_strext; apply H. right. - change (Zero[#]x). - apply ap_symmetric. apply IHx. - apply ap_symmetric. apply H. -destruct H as [H|H]. - left. - eapply rh_strext; apply H. -right. -apply IHx. -apply H. Defined. Definition cpoly_map_csf : CSetoid_fun RX SX := Build_CSetoid_fun _ _ _ cpoly_map_strext. Lemma cpoly_map_pres_plus : fun_pres_plus _ _ cpoly_map_csf. Proof. -unfold fun_pres_plus. -apply (cpoly_double_ind0 R). + unfold fun_pres_plus. + apply (cpoly_double_ind0 R). + intros p. + change (cpoly_map_csf(p[+]Zero)[=]cpoly_map_csf p[+]Zero). + rstepr (cpoly_map_csf p). + apply csf_wd. + rational. intros p. - change (cpoly_map_csf(p[+]Zero)[=]cpoly_map_csf p[+]Zero). - rstepr (cpoly_map_csf p). - apply csf_wd. - rational. - intros p. - apply eq_reflexive. -intros p q c d H. -split. - apply rh_pres_plus. -apply H. + apply eq_reflexive. + intros p q c d H. + split. + apply rh_pres_plus. + apply H. Qed. Lemma cpoly_map_pres_mult : fun_pres_mult _ _ cpoly_map_csf. Proof. -unfold fun_pres_mult. -assert (X:forall x y, cpoly_map_csf (cpoly_mult_cr _ x y)[=]cpoly_mult_cr _ (cpoly_map_csf x) (f y)). - induction x; intros y. - apply eq_reflexive. - split. - apply rh_pres_mult. - apply IHx. -apply (cpoly_double_ind0 R). + unfold fun_pres_mult. + assert (X:forall x y, cpoly_map_csf (cpoly_mult_cr _ x y)[=]cpoly_mult_cr _ (cpoly_map_csf x) (f y)). + induction x; intros y. + apply eq_reflexive. + split. + apply rh_pres_mult. + apply IHx. + apply (cpoly_double_ind0 R). + intros p. + apply eq_reflexive. intros p. - apply eq_reflexive. - intros p. - change (st_car RX) in p. - change (cpoly_zero R) with (Zero:RX). - stepl (cpoly_map_csf (Zero:RX)) by (apply csf_wd; rational). - change (cpoly_map_csf Zero) with (Zero:SX). + change (st_car RX) in p. + change (cpoly_zero R) with (Zero:RX). + stepl (cpoly_map_csf (Zero:RX)) by (apply csf_wd; rational). + change (cpoly_map_csf Zero) with (Zero:SX). + rational. + intros p q c d H. + split. + autorewrite with ringHomPush. + reflexivity. + change (st_car RX) in p,q. + change (cpoly_map_csf ((cpoly_mult_cr _ q c)[+](p[*](cpoly_linear _ d q))) + [=](cpoly_mult_cr _ (cpoly_map_csf q) (f c))[+](cpoly_map_csf p)[*](cpoly_map_csf (cpoly_linear _ d q))). + stepl ((cpoly_map_csf (cpoly_mult_cr R q c))[+](cpoly_map_csf (p[*]cpoly_linear R d q))) by + apply eq_symmetric; apply cpoly_map_pres_plus. + apply csbf_wd. + apply X. + stepl (cpoly_map_csf ((cpoly_linear R d q:RX)[*]p)) by apply csf_wd;rational. + stepr (cpoly_map_csf (cpoly_linear R d q)[*]cpoly_map_csf p). + 2:apply (mult_commut_unfolded SX). + change ((cpoly_linear R d q:RX)[*]p) with (cpoly_mult_fast_cs _ (cpoly_linear R d q) p). + rewrite cpoly_mult_fast_equiv. + rewrite cpoly_lin_mult. + change (cpoly_map_csf (cpoly_linear R d q:RX)[*]cpoly_map_csf p) + with (cpoly_mult_fast_cs _ (cpoly_linear S (f d) (cpoly_map_csf q)) (cpoly_map_csf p)). + rewrite cpoly_mult_fast_equiv. + rewrite cpoly_lin_mult. + stepl (cpoly_map_csf (cpoly_mult_cr_cs R p d)[+]cpoly_map_csf (cpoly_linear R Zero (cpoly_mult_cs R q p))) by + apply eq_symmetric; apply cpoly_map_pres_plus. + change (cpoly_map_fun (cpoly_mult_cr_cs R p d)[+] cpoly_map_fun (Zero[+X*] (cpoly_mult_cs R q p))[=] + (cpoly_mult_cr_cs S (cpoly_map_fun p) (f d))[+] + (Zero[+X*](cpoly_mult_cs S (cpoly_map_fun q) (cpoly_map_fun p)))). + apply csbf_wd. + apply X. + split. + auto with *. + change ((cpoly_map_csf (cpoly_mult_cs R q p))[=](cpoly_mult_cs S (cpoly_map_csf q) (cpoly_map_csf p))). + repeat setoid_rewrite <- cpoly_mult_fast_equiv. + change (cpoly_map_csf (q[*]p)[=]cpoly_map_csf q[*]cpoly_map_csf p). + rstepr (cpoly_map_csf p[*]cpoly_map_csf q). + rewrite <- H. + apply csf_wd. rational. -intros p q c d H. -split. - autorewrite with ringHomPush. - reflexivity. -change (st_car RX) in p,q. -change (cpoly_map_csf ((cpoly_mult_cr _ q c)[+](p[*](cpoly_linear _ d q))) - [=](cpoly_mult_cr _ (cpoly_map_csf q) (f c))[+](cpoly_map_csf p)[*](cpoly_map_csf (cpoly_linear _ d q))). -stepl ((cpoly_map_csf (cpoly_mult_cr R q c))[+](cpoly_map_csf (p[*]cpoly_linear R d q))) by - apply eq_symmetric; apply cpoly_map_pres_plus. -apply csbf_wd. - apply X. -stepl (cpoly_map_csf ((cpoly_linear R d q:RX)[*]p)) by - apply csf_wd;rational. -stepr (cpoly_map_csf (cpoly_linear R d q)[*]cpoly_map_csf p). - 2:apply (mult_commut_unfolded SX). -change ((cpoly_linear R d q:RX)[*]p) - with (cpoly_mult_fast_cs _ (cpoly_linear R d q) p). -rewrite cpoly_mult_fast_equiv. -rewrite cpoly_lin_mult. -change (cpoly_map_csf (cpoly_linear R d q:RX)[*]cpoly_map_csf p) - with (cpoly_mult_fast_cs _ (cpoly_linear S (f d) (cpoly_map_csf q)) (cpoly_map_csf p)). -rewrite cpoly_mult_fast_equiv. -rewrite cpoly_lin_mult. -stepl (cpoly_map_csf (cpoly_mult_cr_cs R p d)[+]cpoly_map_csf (cpoly_linear R Zero (cpoly_mult_cs R q p))) by - apply eq_symmetric; apply cpoly_map_pres_plus. -change (cpoly_map_fun (cpoly_mult_cr_cs R p d)[+] -cpoly_map_fun (Zero[+X*] (cpoly_mult_cs R q p))[=] -(cpoly_mult_cr_cs S (cpoly_map_fun p) (f d))[+] - (Zero[+X*](cpoly_mult_cs S (cpoly_map_fun q) (cpoly_map_fun p)))). -apply csbf_wd. - apply X. -split. - auto with *. -change ((cpoly_map_csf (cpoly_mult_cs R q p))[=](cpoly_mult_cs S (cpoly_map_csf q) (cpoly_map_csf p))). -repeat setoid_rewrite <- cpoly_mult_fast_equiv. -change (cpoly_map_csf (q[*]p)[=]cpoly_map_csf q[*]cpoly_map_csf p). -rstepr (cpoly_map_csf p[*]cpoly_map_csf q). -rewrite <- H. -apply csf_wd. -rational. Qed. Lemma cpoly_map_pres_unit : fun_pres_unit _ _ cpoly_map_csf. Proof. -split. - apply rh_pres_unit. -constructor. + split. + apply rh_pres_unit. + constructor. Qed. Definition cpoly_map := Build_RingHom _ _ _ cpoly_map_pres_plus cpoly_map_pres_mult cpoly_map_pres_unit. Lemma cpoly_map_X : cpoly_map _X_[=]_X_. Proof. -repeat split. - apply rh_pres_zero. -apply rh_pres_unit. + repeat split. + apply rh_pres_zero. + apply rh_pres_unit. Qed. Lemma cpoly_map_C : forall c, cpoly_map (_C_ c)[=]_C_ (f c). Proof. -reflexivity. + reflexivity. Qed. Lemma cpoly_map_diff : forall p, cpoly_map (_D_ p) [=] _D_ (cpoly_map p). Proof. -induction p. + induction p. + apply eq_reflexive. + change (cpoly_map (_D_ (s[+X*]p))[=]_D_ (f s[+X*](cpoly_map p))). + do 2 rewrite diff_linear. + unfold RX. + autorewrite with ringHomPush. + rewrite IHp. + rewrite cpoly_map_X. apply eq_reflexive. -change (cpoly_map (_D_ (s[+X*]p))[=]_D_ (f s[+X*](cpoly_map p))). -do 2 rewrite diff_linear. -unfold RX. -autorewrite with ringHomPush. -rewrite IHp. -rewrite cpoly_map_X. -apply eq_reflexive. Qed. Lemma cpoly_map_apply : forall p x, f (p ! x)[=] (cpoly_map p) ! (f x). Proof. -induction p. + induction p. + intros x. + apply rh_pres_zero. intros x. - apply rh_pres_zero. -intros x. -simpl in *. -rewrite rh_pres_plus. -rewrite rh_pres_mult. -rewrite IHp. -reflexivity. + simpl in *. + rewrite rh_pres_plus. + rewrite rh_pres_mult. + rewrite IHp. + reflexivity. Qed. End Map. @@ -2768,11 +2790,11 @@ Implicit Arguments cpoly_map [R S]. Lemma cpoly_map_compose : forall R S T (g:RingHom S T) (f:RingHom R S) p, (cpoly_map (RHcompose _ _ _ g f) p)[=]cpoly_map g (cpoly_map f p). Proof. -induction p. - constructor. -split. - reflexivity. -apply IHp. + induction p. + constructor. + split. + reflexivity. + apply IHp. Qed. (* TODO: proof that the polynomials form a module over the ring*) diff --git a/algebra/CQuotient_Modules.v b/algebra/CQuotient_Modules.v index e51aab17b..f5f70322e 100644 --- a/algebra/CQuotient_Modules.v +++ b/algebra/CQuotient_Modules.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* CQuotient_Modules.v, v1.0, 28april2004, Bart Kirkels *) (** printing [+] %\ensuremath+% #+# *) @@ -64,43 +64,46 @@ Variable cm: comod A. Definition ap_quotmod (x y:A) := cm(x[-]y). Lemma ap_quotmod_irreflexive : irreflexive ap_quotmod. -red in |-*. -intro x. -unfold ap_quotmod in |-*. -assert (x[-]x[=]Zero); algebra. -assert (Not ((cmpred A cm) Zero)); algebra. -intro. apply H0. -apply (comod_wd A cm (x[-]x) Zero); auto. +Proof. + red in |-*. + intro x. + unfold ap_quotmod in |-*. + assert (x[-]x[=]Zero); algebra. + assert (Not ((cmpred A cm) Zero)); algebra. + intro. apply H0. + apply (comod_wd A cm (x[-]x) Zero); auto. Qed. Lemma ap_quotmod_symmetric : Csymmetric ap_quotmod. -red in |-*. -intros x y. -unfold ap_quotmod. -intro X. -apply (comod_mult A cm (y[-]x) ([--]One)). -apply (comod_wd A cm (x[-]y) (rm_mu A [--]One (y[-]x))); algebra. -astepr [--](y[-]x); try apply eq_symmetric; try apply muminus1. -astepl [--](y[+][--]x). -astepl ([--][--]x[+][--]y). -astepl (x[+][--]y). -algebra. +Proof. + red in |-*. + intros x y. + unfold ap_quotmod. + intro X. + apply (comod_mult A cm (y[-]x) ([--]One)). + apply (comod_wd A cm (x[-]y) (rm_mu A [--]One (y[-]x))); algebra. + astepr [--](y[-]x); try apply eq_symmetric; try apply muminus1. + astepl [--](y[+][--]x). + astepl ([--][--]x[+][--]y). + astepl (x[+][--]y). + algebra. Qed. Lemma ap_quotmod_cotransitive : cotransitive ap_quotmod. -red in |-*. -intros x y; unfold ap_quotmod. -intros X z. -apply (comod_plus A cm (x[-]z) (z[-]y)). -apply (comod_wd A cm (x[-]y) ((x[-]z)[+](z[-]y))); auto. -astepr ((x[-]z)[+]z[-]y). -astepr ((x[-]z)[+]z[+][--]y). -astepr ((x[+][--]z)[+]z[+][--]y). -astepr (x[+]([--]z[+]z)[+][--]y). -astepr (x[+]Zero[+][--]y). -astepr (x[+][--]y). -astepr (x[-]y). -apply eq_reflexive. +Proof. + red in |-*. + intros x y; unfold ap_quotmod. + intros X z. + apply (comod_plus A cm (x[-]z) (z[-]y)). + apply (comod_wd A cm (x[-]y) ((x[-]z)[+](z[-]y))); auto. + astepr ((x[-]z)[+]z[-]y). + astepr ((x[-]z)[+]z[+][--]y). + astepr ((x[+][--]z)[+]z[+][--]y). + astepr (x[+]([--]z[+]z)[+][--]y). + astepr (x[+]Zero[+][--]y). + astepr (x[+][--]y). + astepr (x[-]y). + apply eq_reflexive. Qed. (** @@ -110,27 +113,29 @@ We take `not apart' as the new equality. Definition eq_quotmod (x y:A) := Not (cm(x[-]y)). Lemma eq_quotmod_wd : forall (x y:A), x[=]y -> (eq_quotmod x y). -intros x y X; auto. -red in |-*; intro X0. -assert ((cmpred A cm)(Zero)); algebra. -apply (comod_wd A cm (x[-]y) Zero); algebra. -apply x_minus_x; auto. -apply (comod_nonzero A cm); assumption. +Proof. + intros x y X; auto. + red in |-*; intro X0. + assert ((cmpred A cm)(Zero)); algebra. + apply (comod_wd A cm (x[-]y) Zero); algebra. + apply x_minus_x; auto. + apply (comod_nonzero A cm); assumption. Qed. Lemma ap_quotmod_tight : tight_apart eq_quotmod ap_quotmod. -red in |-*. -intros x y; intuition. +Proof. + red in |-*. + intros x y; intuition. Qed. Definition ap_quotmod_is_apartness := -Build_is_CSetoid A eq_quotmod ap_quotmod +Build_is_CSetoid A eq_quotmod ap_quotmod ap_quotmod_irreflexive ap_quotmod_symmetric ap_quotmod_cotransitive ap_quotmod_tight. -Definition quotmod_as_CSetoid := Build_CSetoid _ _ _ +Definition quotmod_as_CSetoid := Build_CSetoid _ _ _ ap_quotmod_is_apartness. (** @@ -139,36 +144,38 @@ ap_quotmod_is_apartness. We use [[+]] as the operation for this. *) -Lemma dmplus_is_ext : bin_fun_strext quotmod_as_CSetoid +Lemma dmplus_is_ext : bin_fun_strext quotmod_as_CSetoid quotmod_as_CSetoid quotmod_as_CSetoid (csg_op (c:=A)). -red in |-*. -intros x1 x2 y1 y2. -simpl in |-*. -unfold ap_quotmod in |-*. -intro X. -apply (comod_plus A cm (x1[-]x2) (y1[-]y2)); auto. -apply (comod_wd A cm ((x1[+]y1)[-](x2[+]y2)) ((x1[-]x2)[+](y1[-]y2))); auto. -astepr ((x1[+][--]x2)[+](y1[+][--]y2)). -astepr ((x1[+][--]x2)[+]y1[+][--]y2). -astepr (((x1[+][--]x2)[+]y1)[+][--]y2). -astepr ([--]y2[+]((x1[+][--]x2)[+]y1)). -astepr ([--]y2[+](x1[+][--]x2)[+]y1). -astepr ([--]y2[+]([--]x2[+]x1)[+]y1). -astepr (([--]y2[+][--]x2)[+]x1[+]y1). -astepr (([--]y2[+][--]x2)[+](x1[+]y1)). -astepr ((x1[+]y1)[+]([--]y2[+][--]x2)). -astepr ((x1[+]y1)[+][--](x2[+]y2)). -algebra. +Proof. + red in |-*. + intros x1 x2 y1 y2. + simpl in |-*. + unfold ap_quotmod in |-*. + intro X. + apply (comod_plus A cm (x1[-]x2) (y1[-]y2)); auto. + apply (comod_wd A cm ((x1[+]y1)[-](x2[+]y2)) ((x1[-]x2)[+](y1[-]y2))); auto. + astepr ((x1[+][--]x2)[+](y1[+][--]y2)). + astepr ((x1[+][--]x2)[+]y1[+][--]y2). + astepr (((x1[+][--]x2)[+]y1)[+][--]y2). + astepr ([--]y2[+]((x1[+][--]x2)[+]y1)). + astepr ([--]y2[+](x1[+][--]x2)[+]y1). + astepr ([--]y2[+]([--]x2[+]x1)[+]y1). + astepr (([--]y2[+][--]x2)[+]x1[+]y1). + astepr (([--]y2[+][--]x2)[+](x1[+]y1)). + astepr ((x1[+]y1)[+]([--]y2[+][--]x2)). + astepr ((x1[+]y1)[+][--](x2[+]y2)). + algebra. Qed. -Definition dmplus_is_bin_fun := +Definition dmplus_is_bin_fun := Build_CSetoid_bin_fun quotmod_as_CSetoid quotmod_as_CSetoid quotmod_as_CSetoid (csg_op (c:=A)) dmplus_is_ext. Lemma dmplus_is_assoc : associative dmplus_is_bin_fun. -red in |-*; auto. -intros x y z; simpl in |-*. -apply eq_quotmod_wd; algebra. +Proof. + red in |-*; auto. + intros x y z; simpl in |-*. + apply eq_quotmod_wd; algebra. Qed. Definition quotmod_as_CSemiGroup := Build_CSemiGroup quotmod_as_CSetoid @@ -177,17 +184,19 @@ dmplus_is_bin_fun dmplus_is_assoc. (** ** QuotMod ia a monoid [Zero:A] will work as unit. -*) +*) Lemma zero_as_rht_unit : is_rht_unit dmplus_is_bin_fun Zero. -red in |-*; intro x. -simpl in |-*. -apply eq_quotmod_wd; algebra. +Proof. + red in |-*; intro x. + simpl in |-*. + apply eq_quotmod_wd; algebra. Qed. Lemma zero_as_lft_unit : is_lft_unit dmplus_is_bin_fun Zero. -red in |-*; intro x; simpl in |-*. -apply eq_quotmod_wd; algebra. +Proof. + red in |-*; intro x; simpl in |-*. + apply eq_quotmod_wd; algebra. Qed. Definition quotmod_is_CMonoid := Build_is_CMonoid quotmod_as_CSemiGroup @@ -196,36 +205,38 @@ Zero zero_as_rht_unit zero_as_lft_unit. Definition quotmod_as_CMonoid := Build_CMonoid quotmod_as_CSemiGroup Zero quotmod_is_CMonoid. -(** +(** ** QuotMod is a group The same function still works as inverse (i.e. minus). *) Lemma dminv_is_ext : un_op_strext quotmod_as_CSetoid (cg_inv (c:=A)). -red in |-*. -red in |-*. -intros x y. -simpl in |-*. -unfold ap_quotmod in |-*. -intro X. -apply (comod_mult A cm (x[-]y) [--]One); algebra. -apply (comod_wd A cm ([--]x[-][--]y) ([--]One['](x[-]y))); algebra. -astepr ([--](x[-]y)). -astepr ([--](x[+][--]y)). -astepr ([--]x[+][--][--]y). -algebra. +Proof. + red in |-*. + red in |-*. + intros x y. + simpl in |-*. + unfold ap_quotmod in |-*. + intro X. + apply (comod_mult A cm (x[-]y) [--]One); algebra. + apply (comod_wd A cm ([--]x[-][--]y) ([--]One['](x[-]y))); algebra. + astepr ([--](x[-]y)). + astepr ([--](x[+][--]y)). + astepr ([--]x[+][--][--]y). + algebra. Qed. -Definition dminv_is_un_op := +Definition dminv_is_un_op := Build_CSetoid_un_op quotmod_as_CSetoid (cg_inv (c:=A)) dminv_is_ext. Lemma dminv_is_inv : is_CGroup quotmod_as_CMonoid dminv_is_un_op. -red in |-*. -intro x. -simpl in |-*. -unfold is_inverse in |-*. -simpl in |-*. -split; apply eq_quotmod_wd; algebra. +Proof. + red in |-*. + intro x. + simpl in |-*. + unfold is_inverse in |-*. + simpl in |-*. + split; apply eq_quotmod_wd; algebra. Qed. Definition quotmod_as_CGroup := Build_CGroup quotmod_as_CMonoid @@ -237,10 +248,11 @@ dminv_is_un_op dminv_is_inv. *) Lemma dmplus_is_commutative : commutes dmplus_is_bin_fun. -red in |-*. -intros x y. -simpl in |-*. -apply eq_quotmod_wd; algebra. +Proof. + red in |-*. + intros x y. + simpl in |-*. + apply eq_quotmod_wd; algebra. Qed. Definition quotmod_as_CAbGroup := Build_CAbGroup quotmod_as_CGroup @@ -251,55 +263,57 @@ dmplus_is_commutative. [rm_mu A] does the job. *) -Lemma dmmu_is_ext : bin_fun_strext R +Lemma dmmu_is_ext : bin_fun_strext R quotmod_as_CAbGroup quotmod_as_CAbGroup (rm_mu A). -red in |-*. -intros a1 a2 x1 x2. -simpl in |-*;simpl in |-*. -unfold ap_quotmod in |-*. -intro X. -cut (cm ( a1['](x1[-]x2) [+] (a1[-]a2)[']x2) ). -intro. -assert ( cm (a1['](x1[-]x2)) or cm ((a1[-]a2)[']x2) ). -algebra. -elim X1;intros. -right. -apply (comod_mult A cm (x1[-]x2) a1); assumption. -left. -cut ( (a1[-]a2)[']x2 [#] Zero). -intro X2; cut ((a1[-]a2)[#]Zero); algebra. -apply (mu_axap0_aap0 R A (a1[-]a2) x2); assumption. -apply (comod_apzero A cm); assumption. -apply (comod_wd A cm (a1[']x1 [-] a2[']x2) ); try assumption. -astepr ( a1['](x1[+][--]x2) [+] (a1[-]a2)[']x2). -astepr ((a1['](x1[+][--]x2))[+]((a1[+][--]a2)[']x2)). -astepr ((a1['](x1[+][--]x2))[+](a1[']x2 [+] [--]a2[']x2)). -astepr ((a1[']x2 [+] [--]a2[']x2) [+] (a1['](x1[+][--]x2))). -astepr (a1[']x2 [+] [--]a2[']x2 [+] (a1['](x1[+][--]x2))). -astepr ((a1[']x2) [+] ([--]a2[']x2) [+] (a1['](x1[+][--]x2))). -simpl in |-*. -astepr (a1[']x2 [+] [--]a2[']x2 [+] a1[']x1 [+] a1['][--]x2); simpl in |-*. -astepr ((a1[']x2 [+] [--]a2[']x2 [+] a1[']x1) [+] a1['][--]x2); simpl in |-*. -astepr ((a1[']x2 [+] [--]a2[']x2 [+] a1[']x1) [+] [--](a1[']x2)). -astepr ([--](a1[']x2) [+] (a1[']x2 [+] [--]a2[']x2 [+] a1[']x1)). -astepr ([--](a1[']x2) [+] (a1[']x2 [+] ([--]a2[']x2 [+] a1[']x1))). -astepr (([--](a1[']x2) [+] a1[']x2) [+] ([--]a2[']x2 [+] a1[']x1)). -astepr (Zero [+] ([--]a2[']x2 [+] a1[']x1)). -astepr ([--]a2[']x2 [+] a1[']x1). -astepr (a1[']x1 [+] [--]a2[']x2). -astepr (a1[']x1 [+] [--](a2[']x2)). -Step_final (a1[']x1 [-] a2[']x2). -astepl ((a1[']x2 [+] [--]a2[']x2) [+] (a1[']x1 [+] a1['][--]x2)). -apply plus_resp_eq; algebra. +Proof. + red in |-*. + intros a1 a2 x1 x2. + simpl in |-*;simpl in |-*. + unfold ap_quotmod in |-*. + intro X. + cut (cm ( a1['](x1[-]x2) [+] (a1[-]a2)[']x2) ). + intro. + assert ( cm (a1['](x1[-]x2)) or cm ((a1[-]a2)[']x2) ). + algebra. + elim X1;intros. + right. + apply (comod_mult A cm (x1[-]x2) a1); assumption. + left. + cut ( (a1[-]a2)[']x2 [#] Zero). + intro X2; cut ((a1[-]a2)[#]Zero); algebra. + apply (mu_axap0_aap0 R A (a1[-]a2) x2); assumption. + apply (comod_apzero A cm); assumption. + apply (comod_wd A cm (a1[']x1 [-] a2[']x2) ); try assumption. + astepr ( a1['](x1[+][--]x2) [+] (a1[-]a2)[']x2). + astepr ((a1['](x1[+][--]x2))[+]((a1[+][--]a2)[']x2)). + astepr ((a1['](x1[+][--]x2))[+](a1[']x2 [+] [--]a2[']x2)). + astepr ((a1[']x2 [+] [--]a2[']x2) [+] (a1['](x1[+][--]x2))). + astepr (a1[']x2 [+] [--]a2[']x2 [+] (a1['](x1[+][--]x2))). + astepr ((a1[']x2) [+] ([--]a2[']x2) [+] (a1['](x1[+][--]x2))). + simpl in |-*. + astepr (a1[']x2 [+] [--]a2[']x2 [+] a1[']x1 [+] a1['][--]x2); simpl in |-*. + astepr ((a1[']x2 [+] [--]a2[']x2 [+] a1[']x1) [+] a1['][--]x2); simpl in |-*. + astepr ((a1[']x2 [+] [--]a2[']x2 [+] a1[']x1) [+] [--](a1[']x2)). + astepr ([--](a1[']x2) [+] (a1[']x2 [+] [--]a2[']x2 [+] a1[']x1)). + astepr ([--](a1[']x2) [+] (a1[']x2 [+] ([--]a2[']x2 [+] a1[']x1))). + astepr (([--](a1[']x2) [+] a1[']x2) [+] ([--]a2[']x2 [+] a1[']x1)). + astepr (Zero [+] ([--]a2[']x2 [+] a1[']x1)). + astepr ([--]a2[']x2 [+] a1[']x1). + astepr (a1[']x1 [+] [--]a2[']x2). + astepr (a1[']x1 [+] [--](a2[']x2)). + Step_final (a1[']x1 [-] a2[']x2). + astepl ((a1[']x2 [+] [--]a2[']x2) [+] (a1[']x1 [+] a1['][--]x2)). + apply plus_resp_eq; algebra. Qed. -Definition dmmu_is_bin_fun := +Definition dmmu_is_bin_fun := Build_CSetoid_bin_fun R quotmod_as_CAbGroup quotmod_as_CAbGroup (rm_mu A) dmmu_is_ext. -Lemma quotmod_is_RModule : is_RModule quotmod_as_CAbGroup +Lemma quotmod_is_RModule : is_RModule quotmod_as_CAbGroup dmmu_is_bin_fun. -apply Build_is_RModule; intuition; simpl in |-*; apply eq_quotmod_wd; algebra. +Proof. + apply Build_is_RModule; intuition; simpl in |-*; apply eq_quotmod_wd; algebra. Qed. Definition quotmod_as_RModule := Build_RModule R quotmod_as_CAbGroup diff --git a/algebra/CQuotient_Rings.v b/algebra/CQuotient_Rings.v index 14ba36ebf..e5c474544 100644 --- a/algebra/CQuotient_Rings.v +++ b/algebra/CQuotient_Rings.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* CQuotient_Rings.v, v1.0, 28april2004, Bart Kirkels *) (** printing [+] %\ensuremath+% #+# *) @@ -63,43 +63,46 @@ Variable C : coideal R. Definition ap_quotring (x y:R) := C(x[-]y). Lemma ap_quotring_irreflexive : irreflexive ap_quotring. -red in |-*. -intro x. -unfold ap_quotring in |-*. -assert (x[-]x[=]Zero); algebra. -assert (Not ((cipred R C) Zero)); algebra. -intro. apply H0. -apply (coideal_wd R C (x[-]x) Zero); auto. +Proof. + red in |-*. + intro x. + unfold ap_quotring in |-*. + assert (x[-]x[=]Zero); algebra. + assert (Not ((cipred R C) Zero)); algebra. + intro. apply H0. + apply (coideal_wd R C (x[-]x) Zero); auto. Qed. Lemma ap_quotring_symmetric : Csymmetric ap_quotring. -red in |-*. -intros x y. -unfold ap_quotring. -intro X. -cut (C [--]One and C (y[-]x)). intuition. -apply (coideal_mult R C [--]One (y[-]x)). -apply (coideal_wd R C (x[-]y) ([--]One[*](y[-]x))); algebra. -astepr [--](y[-]x). -astepr [--](y[+][--]x). -astepr ([--][--]x[+][--]y). -Step_final (x[+][--]y). +Proof. + red in |-*. + intros x y. + unfold ap_quotring. + intro X. + cut (C [--]One and C (y[-]x)). intuition. + apply (coideal_mult R C [--]One (y[-]x)). + apply (coideal_wd R C (x[-]y) ([--]One[*](y[-]x))); algebra. + astepr [--](y[-]x). + astepr [--](y[+][--]x). + astepr ([--][--]x[+][--]y). + Step_final (x[+][--]y). Qed. Lemma ap_quotring_cotransitive : cotransitive ap_quotring. -red in |-*. -intros x y; unfold ap_quotring. -intros X z. -apply (coideal_plus R C (x[-]z) (z[-]y)). -apply (coideal_wd R C (x[-]y) ((x[-]z)[+](z[-]y))); auto. -astepr ((x[-]z)[+]z[-]y). -astepr ((x[-]z)[+]z[+][--]y). -astepr ((x[+][--]z)[+]z[+][--]y). -astepr (x[+]([--]z[+]z)[+][--]y). -astepr (x[+]Zero[+][--]y). -astepr (x[+][--]y). -astepr (x[-]y). -apply eq_reflexive. +Proof. + red in |-*. + intros x y; unfold ap_quotring. + intros X z. + apply (coideal_plus R C (x[-]z) (z[-]y)). + apply (coideal_wd R C (x[-]y) ((x[-]z)[+](z[-]y))); auto. + astepr ((x[-]z)[+]z[-]y). + astepr ((x[-]z)[+]z[+][--]y). + astepr ((x[+][--]z)[+]z[+][--]y). + astepr (x[+]([--]z[+]z)[+][--]y). + astepr (x[+]Zero[+][--]y). + astepr (x[+][--]y). + astepr (x[-]y). + apply eq_reflexive. Qed. (** @@ -109,27 +112,29 @@ We take `not apart' as the new equality. Definition eq_quotring (x y:R) := Not (C(x[-]y)). Lemma eq_quotring_wd : forall (x y:R), x[=]y -> (eq_quotring x y). -intros x y X; auto. -red in |-*; intro X0. -assert ((cipred R C)(Zero)); algebra. -apply (coideal_wd R C (x[-]y) Zero); algebra. -apply x_minus_x; auto. -apply (coideal_nonzero R C); assumption. +Proof. + intros x y X; auto. + red in |-*; intro X0. + assert ((cipred R C)(Zero)); algebra. + apply (coideal_wd R C (x[-]y) Zero); algebra. + apply x_minus_x; auto. + apply (coideal_nonzero R C); assumption. Qed. Lemma ap_quotring_tight : tight_apart eq_quotring ap_quotring. -red in |-*. -intros x y; intuition. +Proof. + red in |-*. + intros x y; intuition. Qed. Definition ap_quotring_is_apartness := -Build_is_CSetoid R eq_quotring ap_quotring +Build_is_CSetoid R eq_quotring ap_quotring ap_quotring_irreflexive ap_quotring_symmetric ap_quotring_cotransitive ap_quotring_tight. -Definition quotring_as_CSetoid := Build_CSetoid _ _ _ +Definition quotring_as_CSetoid := Build_CSetoid _ _ _ ap_quotring_is_apartness. (** @@ -138,36 +143,38 @@ ap_quotring_is_apartness. We use [[+]] as the operation for this. *) -Lemma drplus_is_ext : bin_fun_strext quotring_as_CSetoid +Lemma drplus_is_ext : bin_fun_strext quotring_as_CSetoid quotring_as_CSetoid quotring_as_CSetoid (csg_op (c:=R)). -red in |-*. -intros x1 x2 y1 y2. -simpl in |-*. -unfold ap_quotring in |-*. -intro X. -apply (coideal_plus R C (x1[-]x2) (y1[-]y2)); auto. -apply (coideal_wd R C ((x1[+]y1)[-](x2[+]y2)) ((x1[-]x2)[+](y1[-]y2))); auto. -astepr ((x1[+][--]x2)[+](y1[+][--]y2)). -astepr ((x1[+][--]x2)[+]y1[+][--]y2). -astepr (((x1[+][--]x2)[+]y1)[+][--]y2). -astepr ([--]y2[+]((x1[+][--]x2)[+]y1)). -astepr ([--]y2[+](x1[+][--]x2)[+]y1). -astepr ([--]y2[+]([--]x2[+]x1)[+]y1). -astepr (([--]y2[+][--]x2)[+]x1[+]y1). -astepr (([--]y2[+][--]x2)[+](x1[+]y1)). -astepr ((x1[+]y1)[+]([--]y2[+][--]x2)). -astepr ((x1[+]y1)[+][--](x2[+]y2)). -algebra. +Proof. + red in |-*. + intros x1 x2 y1 y2. + simpl in |-*. + unfold ap_quotring in |-*. + intro X. + apply (coideal_plus R C (x1[-]x2) (y1[-]y2)); auto. + apply (coideal_wd R C ((x1[+]y1)[-](x2[+]y2)) ((x1[-]x2)[+](y1[-]y2))); auto. + astepr ((x1[+][--]x2)[+](y1[+][--]y2)). + astepr ((x1[+][--]x2)[+]y1[+][--]y2). + astepr (((x1[+][--]x2)[+]y1)[+][--]y2). + astepr ([--]y2[+]((x1[+][--]x2)[+]y1)). + astepr ([--]y2[+](x1[+][--]x2)[+]y1). + astepr ([--]y2[+]([--]x2[+]x1)[+]y1). + astepr (([--]y2[+][--]x2)[+]x1[+]y1). + astepr (([--]y2[+][--]x2)[+](x1[+]y1)). + astepr ((x1[+]y1)[+]([--]y2[+][--]x2)). + astepr ((x1[+]y1)[+][--](x2[+]y2)). + algebra. Qed. -Definition drplus_is_bin_fun := +Definition drplus_is_bin_fun := Build_CSetoid_bin_fun quotring_as_CSetoid quotring_as_CSetoid quotring_as_CSetoid (csg_op (c:=R)) drplus_is_ext. Lemma drplus_is_assoc : associative drplus_is_bin_fun. -red in |-*; auto. -intros x y z; simpl in |-*. -apply eq_quotring_wd; algebra. +Proof. + red in |-*; auto. + intros x y z; simpl in |-*. + apply eq_quotring_wd; algebra. Qed. Definition quotring_as_CSemiGroup := Build_CSemiGroup quotring_as_CSetoid @@ -179,14 +186,16 @@ drplus_is_bin_fun drplus_is_assoc. *) Lemma zero_as_rht_unit : is_rht_unit drplus_is_bin_fun Zero. -red in |-*; intro x. -simpl in |-*. -apply eq_quotring_wd; algebra. +Proof. + red in |-*; intro x. + simpl in |-*. + apply eq_quotring_wd; algebra. Qed. Lemma zero_as_lft_unit : is_lft_unit drplus_is_bin_fun Zero. -red in |-*; intro x; simpl in |-*. -apply eq_quotring_wd; algebra. +Proof. + red in |-*; intro x; simpl in |-*. + apply eq_quotring_wd; algebra. Qed. Definition quotring_is_CMonoid := Build_is_CMonoid quotring_as_CSemiGroup @@ -201,31 +210,33 @@ The same function still works as inverse (i.e. minus). *) Lemma drinv_is_ext : un_op_strext quotring_as_CSetoid (cg_inv (c:=R)). -red in |-*. -red in |-*. -intros x y. -simpl in |-*. -unfold ap_quotring in |-*. -intro X. -cut (C (x[-]y) and C [--]One). intuition. -apply (coideal_mult R C (x[-]y) [--]One); algebra. -apply (coideal_wd R C ([--]One[*](x[-]y)) ((x[-]y)[*][--]One)); algebra. -apply (coideal_wd R C ([--]x[-][--]y) ([--]One[*](x[-]y))); algebra. -astepr ([--](x[-]y)). -astepr ([--](x[+][--]y)). -Step_final ([--]x[+][--][--]y). +Proof. + red in |-*. + red in |-*. + intros x y. + simpl in |-*. + unfold ap_quotring in |-*. + intro X. + cut (C (x[-]y) and C [--]One). intuition. + apply (coideal_mult R C (x[-]y) [--]One); algebra. + apply (coideal_wd R C ([--]One[*](x[-]y)) ((x[-]y)[*][--]One)); algebra. + apply (coideal_wd R C ([--]x[-][--]y) ([--]One[*](x[-]y))); algebra. + astepr ([--](x[-]y)). + astepr ([--](x[+][--]y)). + Step_final ([--]x[+][--][--]y). Qed. -Definition drinv_is_un_op := +Definition drinv_is_un_op := Build_CSetoid_un_op quotring_as_CSetoid (cg_inv (c:=R)) drinv_is_ext. Lemma drinv_is_inv : is_CGroup quotring_as_CMonoid drinv_is_un_op. -red in |-*. -intro x. -simpl in |-*. -unfold is_inverse in |-*. -simpl in |-*. -split; apply eq_quotring_wd; algebra. +Proof. + red in |-*. + intro x. + simpl in |-*. + unfold is_inverse in |-*. + simpl in |-*. + split; apply eq_quotring_wd; algebra. Qed. Definition quotring_as_CGroup := Build_CGroup quotring_as_CMonoid @@ -237,10 +248,11 @@ drinv_is_un_op drinv_is_inv. *) Lemma drplus_is_commutative : commutes drplus_is_bin_fun. -red in |-*. -intros x y. -simpl in |-*. -apply eq_quotring_wd; algebra. +Proof. + red in |-*. + intros x y. + simpl in |-*. + apply eq_quotring_wd; algebra. Qed. Definition quotring_as_CAbGroup := Build_CAbGroup quotring_as_CGroup @@ -252,70 +264,74 @@ Multiplication from [R] still works as a multiplicative function, making quotring a ring. *) -Lemma drmult_is_ext : bin_fun_strext quotring_as_CAbGroup +Lemma drmult_is_ext : bin_fun_strext quotring_as_CAbGroup quotring_as_CAbGroup quotring_as_CAbGroup (cr_mult (c:=R)). -red in |-*. -intros x1 x2 y1 y2. -simpl in |-*. -unfold ap_quotring. -intro X. -cut (C ((x1[*](y1[-]y2)) [+] ((x1[-]x2)[*]y2))). -intro. -assert (C (x1[*](y1[-]y2)) or C ((x1[-]x2)[*]y2)); algebra. -elim X1; intros. -right. cut (C x1 and C (y1[-]y2)). intuition. -apply coideal_mult; assumption. -left. cut (C (x1[-]x2) and C y2). intuition. -apply coideal_mult; assumption. -apply (coideal_wd R C (x1[*]y1 [-] x2[*]y2)); try assumption. -astepr (x1[*]y1 [-] x1[*]y2 [+] (x1[-]x2)[*]y2). -astepr (x1[*]y1 [-] x1[*]y2 [+] x1[*]y2 [-] x2[*]y2). -astepr (x1[*]y1 [+] [--](x1[*]y2) [+] x1[*]y2 [+] [--](x2[*]y2)). -astepr ((x1[*]y1 [+] ([--](x1[*]y2) [+] x1[*]y2)) [+] [--](x2[*]y2)). -astepr ((x1[*]y1 [+] Zero) [+] [--](x2[*]y2)). -Step_final (x1[*]y1 [+] [--](x2[*]y2)). -astepl ((x1[*]y1 [-] x1[*]y2)[+](x1[*]y2)[+][--](x2[*]y2)). -astepl ((x1[*]y1 [-] x1[*]y2)[+](x1[*]y2[+][--](x2[*]y2))). -apply plus_resp_eq. -apply eq_symmetric; apply (ring_distr2 R x1 x2 y2). -astepl ((x1[-]x2)[*]y2 [+] (x1[*]y1 [-] x1[*]y2)). -astepr ((x1[-]x2)[*]y2 [+] x1[*](y1[-]y2)). -apply plus_resp_eq. -apply eq_symmetric; apply (ring_distr1 R x1 y1 y2). +Proof. + red in |-*. + intros x1 x2 y1 y2. + simpl in |-*. + unfold ap_quotring. + intro X. + cut (C ((x1[*](y1[-]y2)) [+] ((x1[-]x2)[*]y2))). + intro. + assert (C (x1[*](y1[-]y2)) or C ((x1[-]x2)[*]y2)); algebra. + elim X1; intros. + right. cut (C x1 and C (y1[-]y2)). intuition. + apply coideal_mult; assumption. + left. cut (C (x1[-]x2) and C y2). intuition. + apply coideal_mult; assumption. + apply (coideal_wd R C (x1[*]y1 [-] x2[*]y2)); try assumption. + astepr (x1[*]y1 [-] x1[*]y2 [+] (x1[-]x2)[*]y2). + astepr (x1[*]y1 [-] x1[*]y2 [+] x1[*]y2 [-] x2[*]y2). + astepr (x1[*]y1 [+] [--](x1[*]y2) [+] x1[*]y2 [+] [--](x2[*]y2)). + astepr ((x1[*]y1 [+] ([--](x1[*]y2) [+] x1[*]y2)) [+] [--](x2[*]y2)). + astepr ((x1[*]y1 [+] Zero) [+] [--](x2[*]y2)). + Step_final (x1[*]y1 [+] [--](x2[*]y2)). + astepl ((x1[*]y1 [-] x1[*]y2)[+](x1[*]y2)[+][--](x2[*]y2)). + astepl ((x1[*]y1 [-] x1[*]y2)[+](x1[*]y2[+][--](x2[*]y2))). + apply plus_resp_eq. + apply eq_symmetric; apply (ring_distr2 R x1 x2 y2). + astepl ((x1[-]x2)[*]y2 [+] (x1[*]y1 [-] x1[*]y2)). + astepr ((x1[-]x2)[*]y2 [+] x1[*](y1[-]y2)). + apply plus_resp_eq. + apply eq_symmetric; apply (ring_distr1 R x1 y1 y2). Qed. -Definition drmult_is_bin_op := +Definition drmult_is_bin_op := Build_CSetoid_bin_op quotring_as_CAbGroup (cr_mult (c:=R)) drmult_is_ext. Lemma drmult_associative : associative drmult_is_bin_op. -red in |-*; simpl in |-*. -intros x y z; apply eq_quotring_wd. -algebra. +Proof. + red in |-*; simpl in |-*. + intros x y z; apply eq_quotring_wd. + algebra. Qed. Lemma drmult_monoid : is_CMonoid (Build_CSemiGroup quotring_as_CAbGroup drmult_is_bin_op drmult_associative) One. -apply Build_is_CMonoid; red in |-*; intro x; simpl in |-*; -apply eq_quotring_wd; algebra. + apply Build_is_CMonoid; red in |-*; intro x; simpl in |-*; apply eq_quotring_wd; algebra. Qed. Lemma drmult_commutes : commutes drmult_is_bin_op. -red in |-*; simpl in |-*; intros x y; apply eq_quotring_wd; algebra. +Proof. + red in |-*; simpl in |-*; intros x y; apply eq_quotring_wd; algebra. Qed. Lemma quotring_distr : distributive drmult_is_bin_op drplus_is_bin_fun. -red in |-*; simpl in |-*; intros x y z. -apply eq_quotring_wd; algebra. +Proof. + red in |-*; simpl in |-*; intros x y z. + apply eq_quotring_wd; algebra. Qed. Lemma quotring_nontriv : (One:quotring_as_CAbGroup) [#] (Zero:quotring_as_CAbGroup). -simpl in |-*. -unfold ap_quotring. -apply (coideal_wd R C One (One[-]Zero)); algebra. +Proof. + simpl in |-*. + unfold ap_quotring. + apply (coideal_wd R C One (One[-]Zero)); algebra. Qed. Definition quotring_is_CRing := Build_is_CRing quotring_as_CAbGroup One -drmult_is_bin_op drmult_associative drmult_monoid +drmult_is_bin_op drmult_associative drmult_monoid drmult_commutes quotring_distr quotring_nontriv. Definition quotring_as_CRing := Build_CRing quotring_as_CAbGroup diff --git a/algebra/CRingClass.v b/algebra/CRingClass.v index 7b2b191a0..52e64f7e0 100644 --- a/algebra/CRingClass.v +++ b/algebra/CRingClass.v @@ -24,7 +24,7 @@ Require Import CornTac. (* For rapply*) Section cring_is_ring. Global Instance CRing_is_Ring (CR : CRing) : Ring (@cm_unit CR) (@cr_one CR) (@csg_op CR) (@cr_mult CR) (fun x y => x [-] y) (@cg_inv CR). Proof with auto. -intro CR. split;split;algebra. + intro CR. split;split;algebra. Qed. End cring_is_ring. @@ -43,21 +43,21 @@ Let submult : CSetoid_bin_op subcrr := Build_SubCSetoid_bin_op _ _ _ mul_pres_P. Lemma isring_scrr : is_CRing subcrr (Build_subcsetoid_crr _ _ _ Pone) submult. Proof. -assert (associative submult). -intros x y z; destruct x as [x xpf]; destruct y as [y ypf]; destruct z as [z zpf]; simpl; apply mult_assoc. -apply (Build_is_CRing _ _ _ H). -split; intro x; destruct x as [x xpf]; simpl; algebra. -intros x y; destruct x as [x xpf]; destruct y as [y ypf]; simpl; apply mult_commutes. -intros x y z; destruct x as [x xpf]; destruct y as [y ypf]; destruct z as [z zpf]; simpl; apply dist. -simpl; apply ring_non_triv. + assert (associative submult). + intros x y z; destruct x as [x xpf]; destruct y as [y ypf]; destruct z as [z zpf]; simpl; apply mult_assoc. + apply (Build_is_CRing _ _ _ H). + split; intro x; destruct x as [x xpf]; simpl; algebra. + intros x y; destruct x as [x xpf]; destruct y as [y ypf]; simpl; apply mult_commutes. + intros x y z; destruct x as [x xpf]; destruct y as [y ypf]; destruct z as [z zpf]; simpl; apply dist. + simpl; apply ring_non_triv. Qed. Definition Build_SubCRing : CRing := Build_CRing _ _ _ isring_scrr. Global Instance SubCRing_is_SubRing : SubRing P. Proof. -constructor; auto. -intros x y Px Py; apply op_pres_P; [ | apply inv_pres_P ]; assumption. + constructor; auto. + intros x y Px Py; apply op_pres_P; [ | apply inv_pres_P ]; assumption. Qed. End SubCRings. diff --git a/algebra/CRing_Homomorphisms.v b/algebra/CRing_Homomorphisms.v index 8500db42d..10a0eb94f 100644 --- a/algebra/CRing_Homomorphisms.v +++ b/algebra/CRing_Homomorphisms.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* CRing_Homomorphisms.v, v1.0, 28april2004, Bart Kirkels *) (** printing [+] %\ensuremath+% #+# *) @@ -74,7 +74,7 @@ Record RingHom : Type := rh1 : fun_pres_plus rhmap; rh2 : fun_pres_mult rhmap; rh3 : fun_pres_unit rhmap}. - + End RingHom_Definition. (** @@ -92,20 +92,24 @@ Section RingHom_Axioms. Variable f : RingHom R S. Lemma rh_strext : forall x y:R, (f x) [#] (f y) -> x [#] y. -elim f; intuition. -assert (fun_strext rhmap0); elim rhmap0; intuition. +Proof. + elim f; intuition. + assert (fun_strext rhmap0); elim rhmap0; intuition. Qed. Lemma rh_pres_plus : forall x y:R, f (x[+]y) [=] (f x) [+] (f y). -elim f; auto. +Proof. + elim f; auto. Qed. Lemma rh_pres_mult : forall x y:R, f (x[*]y) [=] (f x) [*] (f y). -elim f; auto. +Proof. + elim f; auto. Qed. Lemma rh_pres_unit : (f (One:R)) [=] (One:S). -elim f; auto. +Proof. + elim f; auto. Qed. End RingHom_Axioms. @@ -122,44 +126,48 @@ Section RingHom_Basics. Variable f : RingHom R S. Lemma rh_pres_zero : (f (Zero:R)) [=] (Zero:S). -astepr ((f Zero)[-](f Zero)). -astepr ((f (Zero[+]Zero))[-](f Zero)). -Step_final ((f Zero[+]f Zero)[-]f Zero). +Proof. + astepr ((f Zero)[-](f Zero)). + astepr ((f (Zero[+]Zero))[-](f Zero)). + Step_final ((f Zero[+]f Zero)[-]f Zero). Qed. Lemma rh_pres_inv : forall x:R, (f [--]x) [=] [--] (f x). -intro x; apply (cg_cancel_lft S (f x)). -astepr (Zero:S). -astepl (f (x[+][--]x)). -Step_final (f (Zero:R)); try apply rh_pres_zero. +Proof. + intro x; apply (cg_cancel_lft S (f x)). + astepr (Zero:S). + astepl (f (x[+][--]x)). + Step_final (f (Zero:R)); try apply rh_pres_zero. Qed. Lemma rh_pres_minus : forall x y:R, f (x[-]y) [=] (f x) [-] (f y). -unfold cg_minus. -intros x y. -rewrite rh_pres_plus. -rewrite rh_pres_inv. -reflexivity. +Proof. + unfold cg_minus. + intros x y. + rewrite rh_pres_plus. + rewrite rh_pres_inv. + reflexivity. Qed. Lemma rh_apzero : forall x:R, (f x) [#] Zero -> x [#] Zero. -intros x X; apply (cg_ap_cancel_rht R x (Zero:R) x). -astepr x. -apply (rh_strext f (x[+]x) x). -astepl ((f x)[+](f x)). -astepr ((Zero:S) [+] (f x)). -apply (op_rht_resp_ap S (f x) (Zero:S) (f x)). -assumption. +Proof. + intros x X; apply (cg_ap_cancel_rht R x (Zero:R) x). + astepr x. + apply (rh_strext f (x[+]x) x). + astepl ((f x)[+](f x)). + astepr ((Zero:S) [+] (f x)). + apply (op_rht_resp_ap S (f x) (Zero:S) (f x)). + assumption. Qed. Lemma rh_pres_nring : forall n, (f (nring n:R)) [=] (nring n:S). Proof. -induction n. - apply rh_pres_zero. -simpl. -rewrite rh_pres_plus. -auto with *. + induction n. + apply rh_pres_zero. + simpl. + rewrite rh_pres_plus. + auto with *. Qed. End RingHom_Basics. @@ -171,11 +179,12 @@ Hint Resolve rh_pres_zero rh_pres_minus rh_pres_inv rh_apzero : algebra. Hint Rewrite rh_pres_zero rh_pres_plus rh_pres_minus rh_pres_inv rh_pres_mult rh_pres_unit : ringHomPush. Definition RHid R : RingHom R R. -intros R. -exists (id_un_op R). +Proof. + intros R. + exists (id_un_op R). + intros x y; apply eq_reflexive. intros x y; apply eq_reflexive. - intros x y; apply eq_reflexive. -apply eq_reflexive. + apply eq_reflexive. Defined. Section Compose. @@ -186,26 +195,26 @@ Variable psi : RingHom R S. Lemma RHcompose1 : fun_pres_plus _ _ (compose_CSetoid_fun _ _ _ psi phi). Proof. -intros x y. -simpl. -repeat rewrite rh_pres_plus. -reflexivity. + intros x y. + simpl. + repeat rewrite rh_pres_plus. + reflexivity. Qed. Lemma RHcompose2 : fun_pres_mult _ _ (compose_CSetoid_fun _ _ _ psi phi). Proof. -intros x y. -simpl. -repeat rewrite rh_pres_mult. -reflexivity. + intros x y. + simpl. + repeat rewrite rh_pres_mult. + reflexivity. Qed. Lemma RHcompose3 : fun_pres_unit _ _ (compose_CSetoid_fun _ _ _ psi phi). Proof. -unfold fun_pres_unit. -simpl. -repeat rewrite rh_pres_unit. -reflexivity. + unfold fun_pres_unit. + simpl. + repeat rewrite rh_pres_unit. + reflexivity. Qed. Definition RHcompose : RingHom R T := Build_RingHom _ _ _ RHcompose1 RHcompose2 RHcompose3. diff --git a/algebra/CRing_as_Ring.v b/algebra/CRing_as_Ring.v index 9be90fe9a..d259a904f 100644 --- a/algebra/CRing_as_Ring.v +++ b/algebra/CRing_as_Ring.v @@ -3,6 +3,7 @@ Require Export RingClass. (* should not be needed *) Require Export CRings Ring. Definition CRing_Ring(R:CRing):(ring_theory (@cm_unit R) (@cr_one R) (@csg_op R) (@cr_mult R) (fun x y => x [-] y) (@cg_inv R) (@cs_eq R)). -intro R. -split;algebra. +Proof. + intro R. + split;algebra. Qed. diff --git a/algebra/CRings.v b/algebra/CRings.v index a1b6d0e67..ae4696f56 100644 --- a/algebra/CRings.v +++ b/algebra/CRings.v @@ -19,21 +19,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing [*] %\ensuremath\times% #×# *) (** printing [^] %\ensuremath{\hat{\ }}% #^# *) @@ -73,14 +73,14 @@ Definition distributive S (mult plus : CSetoid_bin_op S) := Implicit Arguments distributive [S]. -Record is_CRing (G : CAbGroup) (One : G) (mult : CSetoid_bin_op G) : CProp := +Record is_CRing (G : CAbGroup) (One : G) (mult : CSetoid_bin_op G) : CProp := {ax_mult_assoc : associative mult; ax_mult_mon : is_CMonoid (Build_CSemiGroup G mult ax_mult_assoc) One; ax_mult_com : commutes mult; ax_dist : distributive mult csg_op; ax_non_triv : One [#] Zero}. -Record CRing : Type := +Record CRing : Type := {cr_crr :> CAbGroup; cr_one : cr_crr; cr_mult : CSetoid_bin_op cr_crr; @@ -115,44 +115,53 @@ Section CRing_axioms. Variable R : CRing. Lemma CRing_is_CRing : is_CRing R One cr_mult. -elim R; auto. +Proof. + elim R; auto. Qed. Lemma mult_assoc : associative (cr_mult (c:=R)). -elim CRing_is_CRing; auto. +Proof. + elim CRing_is_CRing; auto. Qed. Lemma mult_commutes : commutes (cr_mult (c:=R)). -elim CRing_is_CRing; auto. +Proof. + elim CRing_is_CRing; auto. Qed. Lemma mult_mon : is_CMonoid (Build_CSemiGroup R cr_mult mult_assoc) One. -elim (cr_proof R). -intros H1 H2 H3 H4 H5. -apply is_CMonoid_proof_irr with H1. -assumption. +Proof. + elim (cr_proof R). + intros H1 H2 H3 H4 H5. + apply is_CMonoid_proof_irr with H1. + assumption. Qed. (* End_SpecReals *) Lemma dist : distributive (S:=R) cr_mult (cr_plus R). -elim (cr_proof R); auto. +Proof. + elim (cr_proof R); auto. Qed. Lemma ring_non_triv : (One:R) [#] Zero. -elim (cr_proof R); auto. +Proof. + elim (cr_proof R); auto. Qed. Lemma mult_wd : forall x1 x2 y1 y2 : R, x1 [=] x2 -> y1 [=] y2 -> x1[*]y1 [=] x2[*]y2. -intros; algebra. +Proof. + intros; algebra. Qed. Lemma mult_wdl : forall x1 x2 y : R, x1 [=] x2 -> x1[*]y [=] x2[*]y. -intros; algebra. +Proof. + intros; algebra. Qed. Lemma mult_wdr : forall x y1 y2 : R, y1 [=] y2 -> x[*]y1 [=] x[*]y2. -intros; algebra. +Proof. + intros; algebra. Qed. (* Begin_SpecReals *) @@ -206,11 +215,12 @@ Proof dist R. Hint Resolve ring_dist_unfolded: algebra. Lemma ring_distl_unfolded : forall x y z : R, (y[+]z) [*]x [=] y[*]x[+]z[*]x. -intros x y z. -astepl (x[*] (y[+]z)). -astepl (x[*]y[+]x[*]z). -astepl (y[*]x[+]x[*]z). -Step_final (y[*]x[+]z[*]x). +Proof. + intros x y z. + astepl (x[*] (y[+]z)). + astepl (x[*]y[+]x[*]z). + astepl (y[*]x[+]x[*]z). + Step_final (y[*]x[+]z[*]x). Qed. End Ring_unfolded. @@ -238,97 +248,110 @@ Implicit Arguments is_zero_rht [S]. Implicit Arguments is_zero_lft [S]. Lemma cring_mult_zero : forall x : R, x[*]Zero [=] Zero. -intro x. -apply cg_cancel_lft with (x[*]Zero). -astepr (x[*]Zero). -Step_final (x[*] (Zero[+]Zero)). +Proof. + intro x. + apply cg_cancel_lft with (x[*]Zero). + astepr (x[*]Zero). + Step_final (x[*] (Zero[+]Zero)). Qed. Hint Resolve cring_mult_zero: algebra. Lemma x_mult_zero : forall x y : R, y [=] Zero -> x[*]y [=] Zero. -intros x y H; Step_final (x[*]Zero). +Proof. + intros x y H; Step_final (x[*]Zero). Qed. Lemma cring_mult_zero_op : forall x : R, Zero[*]x [=] Zero. -intro x; Step_final (x[*]Zero). +Proof. + intro x; Step_final (x[*]Zero). Qed. Hint Resolve cring_mult_zero_op: algebra. Lemma cring_inv_mult_lft : forall x y : R, x[*] [--]y [=] [--] (x[*]y). -intros x y. -apply cg_inv_unique. -astepl (x[*] (y[+] [--]y)). -Step_final (x[*]Zero). +Proof. + intros x y. + apply cg_inv_unique. + astepl (x[*] (y[+] [--]y)). + Step_final (x[*]Zero). Qed. Hint Resolve cring_inv_mult_lft: algebra. Lemma cring_inv_mult_rht : forall x y : R, [--]x[*]y [=] [--] (x[*]y). -intros x y. -astepl (y[*] [--]x). -Step_final ( [--] (y[*]x)). +Proof. + intros x y. + astepl (y[*] [--]x). + Step_final ( [--] (y[*]x)). Qed. Hint Resolve cring_inv_mult_rht: algebra. Lemma cring_mult_ap_zero :(forall x y : R, x[*]y [#] Zero -> x [#] Zero):CProp. -intros x y H. -elim (cs_bin_op_strext _ cr_mult x Zero y y). - auto. - intro contra; elim (ap_irreflexive _ _ contra). -astepr (Zero:R). auto. +Proof. + intros x y H. + elim (cs_bin_op_strext _ cr_mult x Zero y y). + auto. + intro contra; elim (ap_irreflexive _ _ contra). + astepr (Zero:R). auto. Qed. Lemma cring_mult_ap_zero_op : (forall x y : R, x[*]y [#] Zero -> y [#] Zero) :CProp. -intros x y H. -apply cring_mult_ap_zero with x. -astepl (x[*]y). auto. +Proof. + intros x y H. + apply cring_mult_ap_zero with x. + astepl (x[*]y). auto. Qed. Lemma inv_mult_invol : forall x y : R, [--]x[*] [--]y [=] x[*]y. -intros x y. -astepl ( [--] (x[*] [--]y)). -Step_final ( [--][--] (x[*]y)). +Proof. + intros x y. + astepl ( [--] (x[*] [--]y)). + Step_final ( [--][--] (x[*]y)). Qed. Lemma ring_dist_minus : forall x y z : R, x[*] (y[-]z) [=] x[*]y[-]x[*]z. -intros x y z. -unfold cg_minus in |- *. -Step_final (x[*]y[+]x[*] [--]z). +Proof. + intros x y z. + unfold cg_minus in |- *. + Step_final (x[*]y[+]x[*] [--]z). Qed. Hint Resolve ring_dist_minus: algebra. Lemma ring_distl_minus : forall x y z : R, (y[-]z) [*]x [=] y[*]x[-]z[*]x. -intros x y z. -unfold cg_minus in |- *. -Step_final (y[*]x[+] [--]z[*]x). +Proof. + intros x y z. + unfold cg_minus in |- *. + Step_final (y[*]x[+] [--]z[*]x). Qed. Hint Resolve ring_distl_minus: algebra. Lemma mult_minus1 : forall x:R, [--]One [*] x [=] [--]x. -intro x. -apply (cg_cancel_lft R x). -astepr (Zero:R). -astepl ((One[*]x)[+]([--]One[*]x)). -astepl ((One[+][--]One)[*]x). -Step_final (Zero[*]x). +Proof. + intro x. + apply (cg_cancel_lft R x). + astepr (Zero:R). + astepl ((One[*]x)[+]([--]One[*]x)). + astepl ((One[+][--]One)[*]x). + Step_final (Zero[*]x). Qed. Lemma ring_distr1 : forall a b1 b2:R, a [*] (b1[-]b2) [=] a[*]b1 [-] a[*]b2. -intros a b1 b2. -astepl (a[*](b1[+][--]b2)). -astepl (a[*]b1 [+] a[*][--]b2). -Step_final (a[*]b1 [+] [--](a[*]b2)). +Proof. + intros a b1 b2. + astepl (a[*](b1[+][--]b2)). + astepl (a[*]b1 [+] a[*][--]b2). + Step_final (a[*]b1 [+] [--](a[*]b2)). Qed. Lemma ring_distr2 : forall a1 a2 b:R, (a1[-]a2) [*] b [=] a1[*]b [-] a2[*]b. -intros a1 a2 b. -astepl ((a1[+][--]a2)[*]b). -astepl (a1[*]b [+] [--]a2[*]b). -Step_final (a1[*]b [+] [--](a2[*]b)). +Proof. + intros a1 a2 b. + astepl ((a1[+][--]a2)[*]b). + astepl (a1[*]b [+] [--]a2[*]b). + Step_final (a1[*]b [+] [--](a2[*]b)). Qed. @@ -365,15 +388,14 @@ Fixpoint nexp (m : nat) : R -> R := end. Lemma nexp_well_def : forall n, fun_wd (nexp n). -intro n; induction n as [| n Hrecn]; red in |- *; intros; simpl in |- *; - algebra. + intro n; induction n as [| n Hrecn]; red in |- *; intros; simpl in |- *; algebra. Qed. Lemma nexp_strong_ext : forall n, fun_strext (nexp n). -intro n; red in |- *; induction n as [| n Hrecn]; simpl in |- *; - intros x y H. - elim (ap_irreflexive _ _ H). -elim (cs_bin_op_strext _ cr_mult _ _ _ _ H); auto. + intro n; red in |- *; induction n as [| n Hrecn]; simpl in |- *; intros x y H. +Proof. + elim (ap_irreflexive _ _ H). + elim (cs_bin_op_strext _ cr_mult _ _ _ _ H); auto. Qed. Definition nexp_op n := Build_CSetoid_un_op R (nexp n) (nexp_strong_ext n). @@ -413,20 +435,22 @@ Definition Char0 := forall n : nat, 0 < n -> nring n [#] Zero. (* End_SpecReals *) Lemma nring_comm_plus : forall n m, nring (n + m) [=] nring n[+]nring m. -intros n m; induction n as [| n Hrecn]; simpl in |- *. - algebra. -astepr (nring n[+] (One[+]nring m)). -astepr (nring n[+] (nring m[+]One)). -Step_final (nring n[+]nring m[+]One). +Proof. + intros n m; induction n as [| n Hrecn]; simpl in |- *. + algebra. + astepr (nring n[+] (One[+]nring m)). + astepr (nring n[+] (nring m[+]One)). + Step_final (nring n[+]nring m[+]One). Qed. Lemma nring_comm_mult : forall n m, nring (n * m) [=] nring n[*]nring m. -intros n m; induction n as [| n Hrecn]; simpl in |- *. - algebra. -apply eq_transitive_unfolded with (nring m[+]nring (n * m)). apply (nring_comm_plus m (n * m)). -astepr (nring n[*]nring m[+]One[*]nring m). -astepr (nring n[*]nring m[+]nring m). -Step_final (nring m[+]nring n[*]nring m). +Proof. + intros n m; induction n as [| n Hrecn]; simpl in |- *. + algebra. + apply eq_transitive_unfolded with (nring m[+]nring (n * m)). apply (nring_comm_plus m (n * m)). + astepr (nring n[*]nring m[+]One[*]nring m). + astepr (nring n[*]nring m[+]nring m). + Step_final (nring m[+]nring n[*]nring m). Qed. End nat_injection. @@ -450,14 +474,16 @@ Notation TwentyFour := (nring 24). Notation FortyEight := (nring 48). Lemma one_plus_one : forall R : CRing, One[+]One [=] (Two:R). -simpl in |- *; algebra. +Proof. + simpl in |- *; algebra. Qed. Lemma x_plus_x : forall (R : CRing) (x : R), x[+]x [=] Two[*]x. -intros R x. -astepl (One[*]x[+]One[*]x). -astepl ((One[+]One) [*]x). -simpl in |- *; algebra. +Proof. + intros R x. + astepl (One[*]x[+]One[*]x). + astepl ((One[+]One) [*]x). + simpl in |- *; algebra. Qed. Hint Resolve one_plus_one x_plus_x: algebra. @@ -467,24 +493,25 @@ In a ring of characteristic zero, [nring] is really an injection. *) Lemma nring_different : forall R, Char0 R -> forall i j, i <> j -> nring i [#] (nring j:R). -intros R H i j H0. -elim (Cnat_total_order i j); intros. -replace j with (i + (j - i)). -astepr (nring i[+]nring (j - i):R). -astepl (nring i[+]Zero:R). -apply op_lft_resp_ap. -apply ap_symmetric_unfolded. -apply H. -omega. -auto with arith. -replace i with (j + (i - j)). -astepl (nring j[+]nring (i - j):R). -astepr (nring j[+] (Zero:R)). -apply op_lft_resp_ap. -apply H. -omega. -auto with arith. -auto. +Proof. + intros R H i j H0. + elim (Cnat_total_order i j); intros. + replace j with (i + (j - i)). + astepr (nring i[+]nring (j - i):R). + astepl (nring i[+]Zero:R). + apply op_lft_resp_ap. + apply ap_symmetric_unfolded. + apply H. + omega. + auto with arith. + replace i with (j + (i - j)). + astepl (nring j[+]nring (i - j):R). + astepr (nring j[+] (Zero:R)). + apply op_lft_resp_ap. + apply H. + omega. + auto with arith. + auto. Qed. Section int_injection. @@ -509,188 +536,170 @@ one. It is kept to avoid having to redo all the proofs. Definition zring_old k : R := caseZ_diff k (fun m n => nring m[-]nring n). Lemma zring_old_zero : zring_old 0 [=] Zero. -simpl in |- *; algebra. +Proof. + simpl in |- *; algebra. Qed. Hint Resolve zring_old_zero: algebra. Lemma zring_old_diff : forall m n : nat, zring_old (m - n) [=] nring m[-]nring n. -unfold zring_old in |- *. -intros m n. -apply - proper_caseZ_diff_CS - with (f := fun m0 n0 : nat => nring (R:=R) m0[-]nring n0). -clear m n. -intros m n p q H. -apply cg_cancel_lft with (nring n:R). -unfold cg_minus in |- *. -astepl (nring (R:=R) n[+] ( [--] (nring n) [+]nring m)). -astepl (nring (R:=R) n[+] [--] (nring n) [+]nring m). -astepl (Zero[+]nring (R:=R) m). -astepl (nring (R:=R) m). -apply cg_cancel_rht with (nring q:R). -astepr (nring (R:=R) n[+] (nring p[+] [--] (nring q) [+]nring q)). -astepr (nring (R:=R) n[+] (nring p[+] ( [--] (nring q) [+]nring q))). -astepr (nring (R:=R) n[+] (nring p[+]Zero)). -astepr (nring (R:=R) n[+]nring p). -astepr (nring (R:=R) (n + p)). -astepl (nring (R:=R) (m + q)). -rewrite H. -algebra. +Proof. + unfold zring_old in |- *. + intros m n. + apply proper_caseZ_diff_CS with (f := fun m0 n0 : nat => nring (R:=R) m0[-]nring n0). + clear m n. + intros m n p q H. + apply cg_cancel_lft with (nring n:R). + unfold cg_minus in |- *. + astepl (nring (R:=R) n[+] ( [--] (nring n) [+]nring m)). + astepl (nring (R:=R) n[+] [--] (nring n) [+]nring m). + astepl (Zero[+]nring (R:=R) m). + astepl (nring (R:=R) m). + apply cg_cancel_rht with (nring q:R). + astepr (nring (R:=R) n[+] (nring p[+] [--] (nring q) [+]nring q)). + astepr (nring (R:=R) n[+] (nring p[+] ( [--] (nring q) [+]nring q))). + astepr (nring (R:=R) n[+] (nring p[+]Zero)). + astepr (nring (R:=R) n[+]nring p). + astepr (nring (R:=R) (n + p)). + astepl (nring (R:=R) (m + q)). + rewrite H. + algebra. Qed. Hint Resolve zring_old_diff. Lemma zring_old_plus_nat : forall n : nat, zring_old n [=] nring n. -intro n. -replace (n:Z) with (n - 0%nat)%Z. - astepl (nring (R:=R) n[-]nring 0). - simpl in |- *; algebra. -simpl in |- *; auto with zarith. +Proof. + intro n. + replace (n:Z) with (n - 0%nat)%Z. + astepl (nring (R:=R) n[-]nring 0). + simpl in |- *; algebra. + simpl in |- *; auto with zarith. Qed. Hint Resolve zring_old_plus_nat: algebra. Lemma zring_old_inv_nat : forall n : nat, zring_old (- n) [=] [--] (nring n). -intro n. -replace (- n)%Z with (0%nat - n)%Z. - astepl (nring 0[-]nring (R:=R) n). - simpl in |- *; algebra. -simpl in |- *; auto. +Proof. + intro n. + replace (- n)%Z with (0%nat - n)%Z. + astepl (nring 0[-]nring (R:=R) n). + simpl in |- *; algebra. + simpl in |- *; auto. Qed. Hint Resolve zring_old_inv_nat: algebra. Lemma zring_old_plus : forall i j, zring_old (i + j) [=] zring_old i[+]zring_old j. -intros i j. -pattern i in |- *. -apply diff_Z_ind. -intros m n. -pattern j in |- *. -apply diff_Z_ind. -intros m0 n0. -Hint Resolve zring_old_diff: algebra. -replace (m - n + (m0 - n0))%Z with ((m + m0)%nat - (n + n0)%nat)%Z. -astepl (nring (m + m0) [-]nring (n + n0):R). -astepl (nring m[+]nring m0[-] (nring n[+]nring n0):R). -astepr (nring m[-]nring n[+] (nring m0[-]nring n0):R). -unfold cg_minus in |- *. -astepl (nring m[+] (nring m0[+] [--] (nring n[+]nring n0)):R). -astepr (nring m[+] ( [--] (nring n) [+] (nring m0[+] [--] (nring n0))):R). -apply bin_op_wd_unfolded. - algebra. -astepl (nring m0[+] ( [--] (nring n) [+] [--] (nring n0)):R). -astepl (nring m0[+] [--] (nring n) [+] [--] (nring n0):R). -Step_final ( [--] (nring n) [+]nring m0[+] [--] (nring n0):R). - -repeat rewrite Znat.inj_plus. -auto with zarith. +Proof. + intros i j. + pattern i in |- *. + apply diff_Z_ind. + intros m n. + pattern j in |- *. + apply diff_Z_ind. + intros m0 n0. + Hint Resolve zring_old_diff: algebra. + replace (m - n + (m0 - n0))%Z with ((m + m0)%nat - (n + n0)%nat)%Z. + astepl (nring (m + m0) [-]nring (n + n0):R). + astepl (nring m[+]nring m0[-] (nring n[+]nring n0):R). + astepr (nring m[-]nring n[+] (nring m0[-]nring n0):R). + unfold cg_minus in |- *. + astepl (nring m[+] (nring m0[+] [--] (nring n[+]nring n0)):R). + astepr (nring m[+] ( [--] (nring n) [+] (nring m0[+] [--] (nring n0))):R). + apply bin_op_wd_unfolded. + algebra. + astepl (nring m0[+] ( [--] (nring n) [+] [--] (nring n0)):R). + astepl (nring m0[+] [--] (nring n) [+] [--] (nring n0):R). + Step_final ( [--] (nring n) [+]nring m0[+] [--] (nring n0):R). + repeat rewrite Znat.inj_plus. + auto with zarith. Qed. Hint Resolve zring_old_plus: algebra. Lemma zring_old_inv : forall i, zring_old (- i) [=] [--] (zring_old i). -intro i. -pattern i in |- *. -apply diff_Z_ind. -intros m n. -replace (- (m - n))%Z with (n - m)%Z. -astepl (nring (R:=R) n[-]nring m). -astepr ( [--] (nring (R:=R) m[-]nring n)). -unfold cg_minus in |- *. -astepr ( [--] (nring m) [+] [--][--] (nring (R:=R) n)). -Step_final ( [--] (nring (R:=R) m) [+]nring n). - -auto with zarith. +Proof. + intro i. + pattern i in |- *. + apply diff_Z_ind. + intros m n. + replace (- (m - n))%Z with (n - m)%Z. + astepl (nring (R:=R) n[-]nring m). + astepr ( [--] (nring (R:=R) m[-]nring n)). + unfold cg_minus in |- *. + astepr ( [--] (nring m) [+] [--][--] (nring (R:=R) n)). + Step_final ( [--] (nring (R:=R) m) [+]nring n). + auto with zarith. Qed. Hint Resolve zring_old_inv: algebra. Lemma zring_old_minus : forall i j, zring_old (i - j) [=] zring_old i[-]zring_old j. -intros i j. -unfold cg_minus in |- *. -replace (i - j)%Z with (i + - j)%Z. -Step_final (zring_old i[+]zring_old (- j)). - -auto. +Proof. + intros i j. + unfold cg_minus in |- *. + replace (i - j)%Z with (i + - j)%Z. + Step_final (zring_old i[+]zring_old (- j)). + auto. Qed. Hint Resolve zring_old_minus: algebra. Lemma zring_old_mult : forall i j, zring_old (i * j) [=] zring_old i[*]zring_old j. -intros i j. -pattern i in |- *. -apply diff_Z_ind. -intros m n. -pattern j in |- *. -apply diff_Z_ind. -intros m0 n0. -astepr ((nring (R:=R) m[-]nring n) [*] (nring m0[-]nring n0)). -replace ((m - n) * (m0 - n0))%Z with - ((m * m0 + n * n0)%nat - (n * m0 + m * n0)%nat)%Z. - 2: repeat rewrite Znat.inj_plus. - 2: repeat rewrite Znat.inj_mult. - 2: repeat rewrite BinInt.Zmult_minus_distr_r. - 2: repeat rewrite Basics.Zmult_minus_distr_r. - 2: auto with zarith. -astepl (nring (R:=R) (m * m0 + n * n0) [-]nring (n * m0 + m * n0)). -astepl - (nring (R:=R) (m * m0) [+]nring (n * n0) [-] (nring (n * m0) [+]nring (m * n0))). -astepl - (nring (R:=R) m[*]nring m0[+]nring n[*]nring n0[-] - (nring n[*]nring m0[+]nring m[*]nring n0)). -astepr - (nring (R:=R) m[*] (nring m0[-]nring n0) [-]nring n[*] (nring m0[-]nring n0)). -astepr - (nring (R:=R) m[*]nring m0[-]nring m[*]nring n0[-] - (nring n[*]nring m0[-]nring n[*]nring n0)). -unfold cg_minus in |- *. -astepr - (nring (R:=R) m[*]nring m0[+] - ( [--] (nring m[*]nring n0) [+] +Proof. + intros i j. + pattern i in |- *. + apply diff_Z_ind. + intros m n. + pattern j in |- *. + apply diff_Z_ind. + intros m0 n0. + astepr ((nring (R:=R) m[-]nring n) [*] (nring m0[-]nring n0)). + replace ((m - n) * (m0 - n0))%Z with ((m * m0 + n * n0)%nat - (n * m0 + m * n0)%nat)%Z. + 2: repeat rewrite Znat.inj_plus. + 2: repeat rewrite Znat.inj_mult. + 2: repeat rewrite BinInt.Zmult_minus_distr_r. + 2: repeat rewrite Basics.Zmult_minus_distr_r. + 2: auto with zarith. + astepl (nring (R:=R) (m * m0 + n * n0) [-]nring (n * m0 + m * n0)). + astepl (nring (R:=R) (m * m0) [+]nring (n * n0) [-] (nring (n * m0) [+]nring (m * n0))). + astepl (nring (R:=R) m[*]nring m0[+]nring n[*]nring n0[-] (nring n[*]nring m0[+]nring m[*]nring n0)). + astepr (nring (R:=R) m[*] (nring m0[-]nring n0) [-]nring n[*] (nring m0[-]nring n0)). + astepr (nring (R:=R) m[*]nring m0[-]nring m[*]nring n0[-] (nring n[*]nring m0[-]nring n[*]nring n0)). + unfold cg_minus in |- *. + astepr (nring (R:=R) m[*]nring m0[+] ( [--] (nring m[*]nring n0) [+] [--] (nring n[*]nring m0[+] [--] (nring n[*]nring n0)))). -astepl - (nring (R:=R) m[*]nring m0[+] - (nring n[*]nring n0[+] [--] (nring n[*]nring m0[+]nring m[*]nring n0))). -apply bin_op_wd_unfolded. - algebra. -astepl - (nring (R:=R) n[*]nring n0[+] - ( [--] (nring n[*]nring m0) [+] [--] (nring m[*]nring n0))). -astepr - ( [--] (nring (R:=R) m[*]nring n0) [+] - ( [--] (nring n[*]nring m0) [+] [--][--] (nring n[*]nring n0))). -astepr - ( [--] (nring (R:=R) m[*]nring n0) [+] - ( [--] (nring n[*]nring m0) [+]nring n[*]nring n0)). -astepr - ( [--] (nring (R:=R) m[*]nring n0) [+] - (nring n[*]nring n0[+] [--] (nring n[*]nring m0))). -astepr - ( [--] (nring (R:=R) m[*]nring n0) [+]nring n[*]nring n0[+] - [--] (nring n[*]nring m0)). -astepr - (nring (R:=R) n[*]nring n0[+] [--] (nring m[*]nring n0) [+] - [--] (nring n[*]nring m0)). -Step_final - (nring (R:=R) n[*]nring n0[+] - ( [--] (nring m[*]nring n0) [+] [--] (nring n[*]nring m0))). + astepl (nring (R:=R) m[*]nring m0[+] + (nring n[*]nring n0[+] [--] (nring n[*]nring m0[+]nring m[*]nring n0))). + apply bin_op_wd_unfolded. + algebra. + astepl (nring (R:=R) n[*]nring n0[+] ( [--] (nring n[*]nring m0) [+] [--] (nring m[*]nring n0))). + astepr ( [--] (nring (R:=R) m[*]nring n0) [+] + ( [--] (nring n[*]nring m0) [+] [--][--] (nring n[*]nring n0))). + astepr ( [--] (nring (R:=R) m[*]nring n0) [+] ( [--] (nring n[*]nring m0) [+]nring n[*]nring n0)). + astepr ( [--] (nring (R:=R) m[*]nring n0) [+] (nring n[*]nring n0[+] [--] (nring n[*]nring m0))). + astepr ( [--] (nring (R:=R) m[*]nring n0) [+]nring n[*]nring n0[+] [--] (nring n[*]nring m0)). + astepr (nring (R:=R) n[*]nring n0[+] [--] (nring m[*]nring n0) [+] [--] (nring n[*]nring m0)). + Step_final (nring (R:=R) n[*]nring n0[+] ( [--] (nring m[*]nring n0) [+] [--] (nring n[*]nring m0))). Qed. Hint Resolve zring_old_mult: algebra. Lemma zring_old_one : zring_old 1 [=] One. -simpl in |- *. -Step_final (One[-]Zero:R). +Proof. + simpl in |- *. + Step_final (One[-]Zero:R). Qed. Hint Resolve zring_old_one: algebra. Lemma zring_old_inv_one : forall x, zring_old (-1) [*]x [=] [--]x. -intro x. -simpl in |- *. -astepl ( [--] (Zero[+]One) [*]x). -astepl ( [--]One[*]x). -Step_final ( [--] (One[*]x)). +Proof. + intro x. + simpl in |- *. + astepl ( [--] (Zero[+]One) [*]x). + astepl ( [--]One[*]x). + Step_final ( [--] (One[*]x)). Qed. (*---------------- new def of zring. --------------------*) @@ -715,98 +724,110 @@ Definition zring (z : Z) : R := end. Lemma pring_aux_lemma : forall p r r', r [=] r' -> pring_aux p r [=] pring_aux p r'. -simple induction p; simpl in |- *; algebra. +Proof. + simple induction p; simpl in |- *; algebra. Qed. Lemma double_nring : forall n, Two[*]nring (R:=R) n [=] nring (R:=R) (n + n). -intros. -Step_final (nring (R:=R) n[+]nring n). +Proof. + intros. + Step_final (nring (R:=R) n[+]nring n). Qed. Hint Resolve pring_aux_lemma double_nring: algebra. Lemma pring_aux_nring : forall p n, pring_aux p (nring n) [=] nring (Pmult_nat p n). -simple induction p; simpl in |- *; intros. - -astepl (nring n[+]pring_aux p0 (nring (n + n))). -Step_final (nring (R:=R) n[+]nring (R:=R) (Pmult_nat p0 (n + n))). - -Step_final (pring_aux p0 (nring (n + n))). - -algebra. +Proof. + simple induction p; simpl in |- *; intros. + astepl (nring n[+]pring_aux p0 (nring (n + n))). + Step_final (nring (R:=R) n[+]nring (R:=R) (Pmult_nat p0 (n + n))). + Step_final (pring_aux p0 (nring (n + n))). + algebra. Qed. Hint Resolve pring_aux_nring: algebra. Lemma pring_convert : forall p, pring p [=] nring (nat_of_P p). -intros; unfold pring, nat_of_P in |- *; simpl in |- *. -astepr (pring_aux p (nring 1)). -simpl in |- *; algebra. +Proof. + intros; unfold pring, nat_of_P in |- *; simpl in |- *. + astepr (pring_aux p (nring 1)). + simpl in |- *; algebra. Qed. Hint Resolve pring_convert: algebra. Lemma zring_zring_old : forall z : Z, zring z [=] zring_old z. -simple induction z; simpl in |- *; intros. -algebra. -astepr (nring (R:=R) (nat_of_P p)). -algebra. -astepr ( [--] (nring (R:=R) (nat_of_P p))). -algebra. +Proof. + simple induction z; simpl in |- *; intros. + algebra. + astepr (nring (R:=R) (nat_of_P p)). + algebra. + astepr ( [--] (nring (R:=R) (nat_of_P p))). + algebra. Qed. Hint Resolve zring_zring_old: algebra. Lemma zring_zero : zring 0 [=] Zero. -simpl in |- *; algebra. +Proof. + simpl in |- *; algebra. Qed. Lemma zring_diff : forall m n : nat, zring (m - n) [=] nring m[-]nring n. -intros; Step_final (zring_old (m - n)). +Proof. + intros; Step_final (zring_old (m - n)). Qed. Lemma zring_plus_nat : forall n : nat, zring n [=] nring n. -intro n; Step_final (zring_old n). +Proof. + intro n; Step_final (zring_old n). Qed. Lemma zring_inv_nat : forall n : nat, zring (- n) [=] [--] (nring n). -intro n; Step_final (zring_old (- n)). +Proof. + intro n; Step_final (zring_old (- n)). Qed. Lemma zring_plus : forall i j, zring (i + j) [=] zring i[+]zring j. -intros. -astepl (zring_old (i + j)). -Step_final (zring_old i[+]zring_old j). +Proof. + intros. + astepl (zring_old (i + j)). + Step_final (zring_old i[+]zring_old j). Qed. Lemma zring_inv : forall i, zring (- i) [=] [--] (zring i). -intro i. -astepl (zring_old (- i)). -Step_final ( [--] (zring_old i)). +Proof. + intro i. + astepl (zring_old (- i)). + Step_final ( [--] (zring_old i)). Qed. Lemma zring_minus : forall i j, zring (i - j) [=] zring i[-]zring j. -intros i j. -astepl (zring_old (i - j)). -Step_final (zring_old i[-]zring_old j). +Proof. + intros i j. + astepl (zring_old (i - j)). + Step_final (zring_old i[-]zring_old j). Qed. Lemma zring_mult : forall i j, zring (i * j) [=] zring i[*]zring j. -intros i j. -astepl (zring_old (i * j)). -Step_final (zring_old i[*]zring_old j). +Proof. + intros i j. + astepl (zring_old (i * j)). + Step_final (zring_old i[*]zring_old j). Qed. Lemma zring_one : zring 1 [=] One. -simpl in |- *. -unfold pring in |- *. -algebra. +Proof. + simpl in |- *. + unfold pring in |- *. + algebra. Qed. Lemma zring_inv_one : forall x, zring (-1) [*]x [=] [--]x. -intro x. -simpl in |- *. -unfold pring in |- *. -simpl in |- *. -Step_final ( [--] (One[*]x)). +Proof. + intro x. + simpl in |- *. + unfold pring in |- *. + simpl in |- *. + Step_final ( [--] (One[*]x)). Qed. End int_injection. @@ -839,7 +860,8 @@ Fixpoint Sum_upto (f : nat -> R) (n : nat) {struct n} : R := end. Lemma sum_upto_O : forall f : nat -> R, Sum_upto f 0 [=] Zero. -algebra. +Proof. + algebra. Qed. Definition Sum_from_upto f m n : R := Sum_upto f n[-]Sum_upto f m. @@ -874,7 +896,8 @@ Fixpoint List_Sum_upto (l : list R) (n : nat) {struct n} : R := end. Lemma list_sum_upto_O : forall l : list R, List_Sum_upto l 0 [=] Zero. -algebra. +Proof. + algebra. Qed. Definition List_Sum_from_upto l m n := List_Sum_upto l n[-]List_Sum_upto l m. @@ -892,59 +915,66 @@ Section Dist_properties. Variable R : CRing. Lemma dist_1b : forall x y z : R, (x[+]y) [*]z [=] x[*]z[+]y[*]z. -intros x y z. -astepl (z[*] (x[+]y)). -Step_final (z[*]x[+]z[*]y). +Proof. + intros x y z. + astepl (z[*] (x[+]y)). + Step_final (z[*]x[+]z[*]y). Qed. Hint Resolve dist_1b: algebra. Lemma dist_2a : forall x y z : R, z[*] (x[-]y) [=] z[*]x[-]z[*]y. -intros x y z. -astepl (z[*] (x[+] [--]y)). -astepl (z[*]x[+]z[*] [--]y). -Step_final (z[*]x[+] [--] (z[*]y)). +Proof. + intros x y z. + astepl (z[*] (x[+] [--]y)). + astepl (z[*]x[+]z[*] [--]y). + Step_final (z[*]x[+] [--] (z[*]y)). Qed. Hint Resolve dist_2a: algebra. Lemma dist_2b : forall x y z : R, (x[-]y) [*]z [=] x[*]z[-]y[*]z. -intros x y z. -astepl (z[*] (x[-]y)). -Step_final (z[*]x[-]z[*]y). +Proof. + intros x y z. + astepl (z[*] (x[-]y)). + Step_final (z[*]x[-]z[*]y). Qed. Hint Resolve dist_2b: algebra. Lemma mult_distr_sum0_lft : forall (f : nat -> R) x n, Sum0 n (fun i => x[*]f i) [=] x[*]Sum0 n f. -intros f x n. -induction n as [| n Hrecn]. - simpl in |- *; algebra. -simpl in |- *. -Step_final (x[*]Sum0 n f[+]x[*]f n). +Proof. + intros f x n. + induction n as [| n Hrecn]. + simpl in |- *; algebra. + simpl in |- *. + Step_final (x[*]Sum0 n f[+]x[*]f n). Qed. Hint Resolve mult_distr_sum0_lft. Lemma mult_distr_sum_lft : forall (f : nat -> R) x m n, Sum m n (fun i => x[*]f i) [=] x[*]Sum m n f. -intros f x m n. -unfold Sum in |- *. -unfold Sum1 in |- *. -Step_final (x[*]Sum0 (S n) f[-]x[*]Sum0 m f). +Proof. + intros f x m n. + unfold Sum in |- *. + unfold Sum1 in |- *. + Step_final (x[*]Sum0 (S n) f[-]x[*]Sum0 m f). Qed. Hint Resolve mult_distr_sum_lft: algebra. Lemma mult_distr_sum_rht : forall (f : nat -> R) x m n, Sum m n (fun i => f i[*]x) [=] Sum m n f[*]x. -intros f x m n. -astepl (Sum m n (fun i : nat => x[*]f i)). -Step_final (x[*]Sum m n f). +Proof. + intros f x m n. + astepl (Sum m n (fun i : nat => x[*]f i)). + Step_final (x[*]Sum m n f). Qed. Lemma sumx_const : forall n (x : R), Sumx (fun i (_ : i < n) => x) [=] nring n[*]x. -intros n x; induction n as [| n Hrecn]. - simpl in |- *; algebra. -simpl in |- *. -astepr (nring n[*]x[+]One[*]x). -Step_final (nring n[*]x[+]x). +Proof. + intros n x; induction n as [| n Hrecn]. + simpl in |- *; algebra. + simpl in |- *. + astepr (nring n[*]x[+]One[*]x). + Step_final (nring n[*]x[+]x). Qed. End Dist_properties. @@ -963,179 +993,199 @@ Section NExp_properties. Variable R : CRing. Lemma nexp_wd : forall (x y : R) n, x [=] y -> x[^]n [=] y[^]n. -algebra. +Proof. + algebra. Qed. Lemma nexp_strext : forall (x y : R) n, x[^]n [#] y[^]n -> x [#] y. -intros x y n H. -exact (un_op_strext_unfolded _ _ _ _ H). +Proof. + intros x y n H. + exact (un_op_strext_unfolded _ _ _ _ H). Qed. Lemma nexp_Sn : forall (x : R) n, x[*]x[^]n [=] x[^]S n. -intros x n. -Step_final (x[^]n[*]x). +Proof. + intros x n. + Step_final (x[^]n[*]x). Qed. Hint Resolve nexp_wd nexp_Sn: algebra. Lemma nexp_plus : forall (x : R) m n, x[^]m[*]x[^]n [=] x[^] (m + n). -intros x m n. -induction m as [| m Hrecm]. - rewrite plus_O_n. - Step_final (One[*]x[^]n). -rewrite plus_Sn_m. -astepl (x[^]m[*]x[*]x[^]n). -astepl (x[*]x[^]m[*]x[^]n). -astepl (x[*] (x[^]m[*]x[^]n)). -Step_final (x[*]x[^] (m + n)). +Proof. + intros x m n. + induction m as [| m Hrecm]. + rewrite plus_O_n. + Step_final (One[*]x[^]n). + rewrite plus_Sn_m. + astepl (x[^]m[*]x[*]x[^]n). + astepl (x[*]x[^]m[*]x[^]n). + astepl (x[*] (x[^]m[*]x[^]n)). + Step_final (x[*]x[^] (m + n)). Qed. Hint Resolve nexp_plus: algebra. Lemma one_nexp : forall n : nat, (One:R) [^]n [=] One. -intro n. -induction n as [| n Hrecn]. - algebra. -astepl ((One:R) [*]One[^]n). -Step_final ((One:R) [*]One). +Proof. + intro n. + induction n as [| n Hrecn]. + algebra. + astepl ((One:R) [*]One[^]n). + Step_final ((One:R) [*]One). Qed. Hint Resolve one_nexp: algebra. Lemma mult_nexp : forall (x y : R) n, (x[*]y) [^]n [=] x[^]n[*]y[^]n. -intros x y n. -induction n as [| n Hrecn]. - astepl (One:R). - Step_final ((One:R) [*]One). -astepl (x[*]y[*] (x[*]y) [^]n). -astepl (x[*]y[*] (x[^]n[*]y[^]n)). -astepl (x[*] (y[*] (x[^]n[*]y[^]n))). -astepl (x[*] (y[*]x[^]n[*]y[^]n)). -astepl (x[*] (x[^]n[*]y[*]y[^]n)). -astepl (x[*] (x[^]n[*] (y[*]y[^]n))). -Step_final (x[*]x[^]n[*] (y[*]y[^]n)). +Proof. + intros x y n. + induction n as [| n Hrecn]. + astepl (One:R). + Step_final ((One:R) [*]One). + astepl (x[*]y[*] (x[*]y) [^]n). + astepl (x[*]y[*] (x[^]n[*]y[^]n)). + astepl (x[*] (y[*] (x[^]n[*]y[^]n))). + astepl (x[*] (y[*]x[^]n[*]y[^]n)). + astepl (x[*] (x[^]n[*]y[*]y[^]n)). + astepl (x[*] (x[^]n[*] (y[*]y[^]n))). + Step_final (x[*]x[^]n[*] (y[*]y[^]n)). Qed. Hint Resolve mult_nexp: algebra. Lemma nexp_mult : forall (x : R) m n, (x[^]m) [^]n [=] x[^] (m * n). -intros x m n. -induction m as [| m Hrecm]. - simpl in |- *. - Step_final ((One:R) [^]n). -astepl ((x[*]x[^]m) [^]n). -astepl (x[^]n[*] (x[^]m) [^]n). -astepl (x[^]n[*]x[^] (m * n)). -astepl (x[^] (n + m * n)). -replace (n + m * n) with (S m * n); algebra. +Proof. + intros x m n. + induction m as [| m Hrecm]. + simpl in |- *. + Step_final ((One:R) [^]n). + astepl ((x[*]x[^]m) [^]n). + astepl (x[^]n[*] (x[^]m) [^]n). + astepl (x[^]n[*]x[^] (m * n)). + astepl (x[^] (n + m * n)). + replace (n + m * n) with (S m * n); algebra. Qed. Hint Resolve nexp_mult: algebra. Lemma zero_nexp : forall n, 0 < n -> (Zero:R) [^]n [=] Zero. -intros n H. -induction n as [| n Hrecn]. - inversion H. -Step_final ((Zero:R) [*]Zero[^]n). +Proof. + intros n H. + induction n as [| n Hrecn]. + inversion H. + Step_final ((Zero:R) [*]Zero[^]n). Qed. Hint Resolve zero_nexp: algebra. Lemma inv_nexp_even : forall (x : R) n, even n -> [--]x[^]n [=] x[^]n. -intros x n H. -elim (even_2n n); try assumption. -intros m H0. -rewrite H0. unfold double in |- *. -astepl ( [--]x[^]m[*] [--]x[^]m). -astepl (( [--]x[*] [--]x) [^]m). -astepl ((x[*]x) [^]m). -Step_final (x[^]m[*]x[^]m). +Proof. + intros x n H. + elim (even_2n n); try assumption. + intros m H0. + rewrite H0. unfold double in |- *. + astepl ( [--]x[^]m[*] [--]x[^]m). + astepl (( [--]x[*] [--]x) [^]m). + astepl ((x[*]x) [^]m). + Step_final (x[^]m[*]x[^]m). Qed. Hint Resolve inv_nexp_even: algebra. Lemma inv_nexp_two : forall x : R, [--]x[^]2 [=] x[^]2. -intro x. -apply inv_nexp_even. -auto with arith. +Proof. + intro x. + apply inv_nexp_even. + auto with arith. Qed. Hint Resolve inv_nexp_two: algebra. Lemma inv_nexp_odd : forall (x : R) n, odd n -> [--]x[^]n [=] [--] (x[^]n). -intros x n H. -inversion H; clear H1 H n. -astepl ( [--]x[*] [--]x[^]n0). -astepl ( [--]x[*]x[^]n0). -Step_final ( [--] (x[*]x[^]n0)). +Proof. + intros x n H. + inversion H; clear H1 H n. + astepl ( [--]x[*] [--]x[^]n0). + astepl ( [--]x[*]x[^]n0). + Step_final ( [--] (x[*]x[^]n0)). Qed. Hint Resolve inv_nexp_odd: algebra. Lemma nexp_one : forall x : R, x[^]1 [=] x. -intro x. -Step_final (One[*]x). +Proof. + intro x. + Step_final (One[*]x). Qed. Hint Resolve nexp_one: algebra. Lemma nexp_two : forall x : R, x[^]2 [=] x[*]x. -intro x. -replace 2 with (1 + 1). - Step_final (x[^]1[*]x[^]1). -auto with arith. +Proof. + intro x. + replace 2 with (1 + 1). + Step_final (x[^]1[*]x[^]1). + auto with arith. Qed. Hint Resolve nexp_two: algebra. Lemma inv_one_even_nexp : forall n : nat, even n -> [--]One[^]n [=] (One:R). -intros n H. -Step_final ((One:R) [^]n). +Proof. + intros n H. + Step_final ((One:R) [^]n). Qed. Hint Resolve inv_one_even_nexp: algebra. Lemma inv_one_odd_nexp : forall n : nat, odd n -> [--]One[^]n [=] [--] (One:R). -intros n H. -Step_final ( [--] ((One:R) [^]n)). +Proof. + intros n H. + Step_final ( [--] ((One:R) [^]n)). Qed. Hint Resolve inv_one_odd_nexp: algebra. Lemma square_plus : forall x y : R, (x[+]y) [^]2 [=] x[^]2[+]y[^]2[+]Two[*]x[*]y. -intros x y. -astepl ((x[+]y) [*] (x[+]y)). -astepl (x[*] (x[+]y) [+]y[*] (x[+]y)). -astepl (x[*]x[+]x[*]y[+] (y[*]x[+]y[*]y)). -astepl (x[^]2[+]x[*]y[+] (x[*]y[+]y[^]2)). -astepl (x[^]2[+]x[*]y[+]x[*]y[+]y[^]2). -astepl (x[^]2[+] (x[*]y[+]x[*]y) [+]y[^]2). -astepl (x[^]2[+]Two[*] (x[*]y) [+]y[^]2). -astepl (x[^]2[+]Two[*]x[*]y[+]y[^]2). -astepl (x[^]2[+] (Two[*]x[*]y[+]y[^]2)). -Step_final (x[^]2[+] (y[^]2[+]Two[*]x[*]y)). +Proof. + intros x y. + astepl ((x[+]y) [*] (x[+]y)). + astepl (x[*] (x[+]y) [+]y[*] (x[+]y)). + astepl (x[*]x[+]x[*]y[+] (y[*]x[+]y[*]y)). + astepl (x[^]2[+]x[*]y[+] (x[*]y[+]y[^]2)). + astepl (x[^]2[+]x[*]y[+]x[*]y[+]y[^]2). + astepl (x[^]2[+] (x[*]y[+]x[*]y) [+]y[^]2). + astepl (x[^]2[+]Two[*] (x[*]y) [+]y[^]2). + astepl (x[^]2[+]Two[*]x[*]y[+]y[^]2). + astepl (x[^]2[+] (Two[*]x[*]y[+]y[^]2)). + Step_final (x[^]2[+] (y[^]2[+]Two[*]x[*]y)). Qed. Lemma square_minus : forall x y : R, (x[-]y) [^]2 [=] x[^]2[+]y[^]2[-]Two[*]x[*]y. -intros x y. -unfold cg_minus in |- *. -eapply eq_transitive_unfolded. - apply square_plus. -algebra. +Proof. + intros x y. + unfold cg_minus in |- *. + eapply eq_transitive_unfolded. + apply square_plus. + algebra. Qed. Lemma nexp_funny : forall x y : R, (x[+]y) [*] (x[-]y) [=] x[^]2[-]y[^]2. -intros x y. -astepl (x[*] (x[-]y) [+]y[*] (x[-]y)). -astepl (x[*]x[-]x[*]y[+] (y[*]x[-]y[*]y)). -astepl (x[*]x[+] [--] (x[*]y) [+] (y[*]x[+] [--] (y[*]y))). -astepl (x[*]x[+] [--] (x[*]y) [+]y[*]x[+] [--] (y[*]y)). -astepl (x[*]x[+] ( [--] (x[*]y) [+]y[*]x) [+] [--] (y[*]y)). -astepl (x[*]x[+] ( [--] (x[*]y) [+]x[*]y) [+] [--] (y[*]y)). -astepl (x[*]x[+]Zero[+] [--] (y[*]y)). -astepl (x[*]x[+] [--] (y[*]y)). -Step_final (x[*]x[-]y[*]y). +Proof. + intros x y. + astepl (x[*] (x[-]y) [+]y[*] (x[-]y)). + astepl (x[*]x[-]x[*]y[+] (y[*]x[-]y[*]y)). + astepl (x[*]x[+] [--] (x[*]y) [+] (y[*]x[+] [--] (y[*]y))). + astepl (x[*]x[+] [--] (x[*]y) [+]y[*]x[+] [--] (y[*]y)). + astepl (x[*]x[+] ( [--] (x[*]y) [+]y[*]x) [+] [--] (y[*]y)). + astepl (x[*]x[+] ( [--] (x[*]y) [+]x[*]y) [+] [--] (y[*]y)). + astepl (x[*]x[+]Zero[+] [--] (y[*]y)). + astepl (x[*]x[+] [--] (y[*]y)). + Step_final (x[*]x[-]y[*]y). Qed. Hint Resolve nexp_funny: algebra. Lemma nexp_funny' : forall x y : R, (x[-]y) [*] (x[+]y) [=] x[^]2[-]y[^]2. -intros x y. -Step_final ((x[+]y) [*] (x[-]y)). +Proof. + intros x y. + Step_final ((x[+]y) [*] (x[-]y)). Qed. Hint Resolve nexp_funny': algebra. End NExp_properties. Add Parametric Morphism c n : (nexp c n) with signature (@cs_eq (cr_crr c)) ==> (@cs_eq c) as nexp_morph_wd. -intros. apply: nexp_wd. assumption. Qed. +Proof. + intros. apply: nexp_wd. assumption. Qed. Hint Resolve nexp_wd nexp_Sn nexp_plus one_nexp mult_nexp nexp_mult zero_nexp inv_nexp_even inv_nexp_two inv_nexp_odd nexp_one nexp_two nexp_funny @@ -1168,9 +1218,9 @@ Section Part_Function_Mult. Lemma part_function_mult_strext : forall x y (Hx : Conj P Q x) (Hy : Conj P Q y), F x (Prj1 Hx) [*]G x (Prj2 Hx) [#] F y (Prj1 Hy) [*]G y (Prj2 Hy) -> x [#] y. -intros x y Hx Hy H. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intro H1; - exact (pfstrx _ _ _ _ _ _ H1). +Proof. + intros x y Hx Hy H. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intro H1; exact (pfstrx _ _ _ _ _ _ H1). Qed. Definition Fmult := Build_PartFunct R _ (conj_wd (dom_wd _ F) (dom_wd _ G)) @@ -1183,9 +1233,10 @@ Section Part_Function_Nth_Power. Variable n : nat. Lemma part_function_nth_strext : forall x y Hx Hy, F x Hx[^]n [#] F y Hy[^]n -> x [#] y. -intros x y Hx Hy H. -apply pfstrx with F Hx Hy. -apply nexp_strext with n; assumption. +Proof. + intros x y Hx Hy H. + apply pfstrx with F Hx Hy. + apply nexp_strext with n; assumption. Qed. Definition Fnth := Build_PartFunct R _ (dom_wd R F) @@ -1201,25 +1252,30 @@ End Part_Function_Nth_Power. Variable R':R -> CProp. Lemma included_FMult : included R' P -> included R' Q -> included R' (Dom Fmult). -intros; simpl in |- *; apply included_conj; assumption. +Proof. + intros; simpl in |- *; apply included_conj; assumption. Qed. Lemma included_FMult' : included R' (Dom Fmult) -> included R' P. -intro H; simpl in H; eapply included_conj_lft; apply H. +Proof. + intro H; simpl in H; eapply included_conj_lft; apply H. Qed. Lemma included_FMult'' : included R' (Dom Fmult) -> included R' Q. -intro H; simpl in H; eapply included_conj_rht; apply H. +Proof. + intro H; simpl in H; eapply included_conj_rht; apply H. Qed. Variable n:nat. Lemma included_FNth : included R' P -> forall n, included R' (Dom (Fnth n)). -auto. +Proof. + auto. Qed. Lemma included_FNth' : forall n, included R' (Dom (Fnth n)) -> included R' (Dom F). -auto. +Proof. + auto. Qed. End CRing_Ops. @@ -1248,13 +1304,15 @@ Let P := Dom F. Variable R':R -> CProp. Lemma included_FScalMult : included R' P -> forall c, included R' (Dom (c{**}F)). -intros; simpl in |- *; apply included_conj. -red in |- *; intros; auto. -assumption. +Proof. + intros; simpl in |- *; apply included_conj. + red in |- *; intros; auto. + assumption. Qed. Lemma included_FScalMult' : forall c, included R' (Dom (c{**}F)) -> included R' P. -intros c H; simpl in H; eapply included_conj_rht; apply H. +Proof. + intros c H; simpl in H; eapply included_conj_rht; apply H. Qed. End ScalarMultiplication. diff --git a/algebra/CSemiGroups.v b/algebra/CSemiGroups.v index 4b00053fb..438f58912 100644 --- a/algebra/CSemiGroups.v +++ b/algebra/CSemiGroups.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing [+] %\ensuremath+% #+# *) (** printing {+} %\ensuremath+% #+# *) @@ -48,7 +48,7 @@ Require Export CSetoidInc. Definition is_CSemiGroup A (op : CSetoid_bin_op A) := associative op. -Record CSemiGroup : Type := +Record CSemiGroup : Type := {csg_crr :> CSetoid; csg_op : CSetoid_bin_op csg_crr; csg_proof : is_CSemiGroup csg_crr csg_op}. @@ -74,11 +74,13 @@ Section CSemiGroup_axioms. Variable G : CSemiGroup. Lemma CSemiGroup_is_CSemiGroup : is_CSemiGroup G csg_op. -elim G; auto. +Proof. + elim G; auto. Qed. Lemma plus_assoc : associative (csg_op (c:=G)). -exact CSemiGroup_is_CSemiGroup. +Proof. + exact CSemiGroup_is_CSemiGroup. Qed. End CSemiGroup_axioms. @@ -98,7 +100,8 @@ Variable G : CSemiGroup. (* End_SpecReals *) Lemma plus_assoc_unfolded : forall (G : CSemiGroup) (x y z : G), x[+] (y[+]z) [=] x[+]y[+]z. -exact plus_assoc. +Proof. + exact plus_assoc. Qed. End CSemiGroup_basics. @@ -142,23 +145,24 @@ Implicit Arguments is_rht_unit [S]. Definition is_unit (S:CSemiGroup): S -> Prop := fun e => forall (a:S), e[+]a [=] a /\ a[+]e [=]a. -Lemma cs_unique_unit : forall (S:CSemiGroup) (e f:S), +Lemma cs_unique_unit : forall (S:CSemiGroup) (e f:S), (is_unit S e) /\ (is_unit S f) -> e[=]f. -intros S e f. -unfold is_unit. -intros H. -elim H. -clear H. -intros H0 H1. -elim (H0 f). -clear H0. -intros H2 H3. -elim (H1 e). -clear H1. -intros H4 H5. -astepr (e[+]f). -astepl (e[+]f). -apply eq_reflexive. +Proof. + intros S e f. + unfold is_unit. + intros H. + elim H. + clear H. + intros H0 H1. + elim (H0 f). + clear H0. + intros H2 H3. + elim (H1 e). + clear H1. + intros H4 H5. + astepr (e[+]f). + astepl (e[+]f). + apply eq_reflexive. Qed. @@ -191,9 +195,9 @@ Let Q := Dom F'. Lemma part_function_plus_strext : forall x y (Hx : Conj P Q x) (Hy : Conj P Q y), F x (Prj1 Hx) [+]F' x (Prj2 Hx) [#] F y (Prj1 Hy) [+]F' y (Prj2 Hy) -> x [#] y. -intros x y Hx Hy H. -elim: (cs_bin_op_strext _ _ _ _ _ _ H); intro H1; - exact (pfstrx _ _ _ _ _ _ H1). +Proof. + intros x y Hx Hy H. + elim: (cs_bin_op_strext _ _ _ _ _ _ H); intro H1; exact (pfstrx _ _ _ _ _ _ H1). Qed. Definition Fplus := Build_PartFunct G _ (conj_wd (dom_wd _ F) (dom_wd _ F')) @@ -207,15 +211,18 @@ Definition Fplus := Build_PartFunct G _ (conj_wd (dom_wd _ F) (dom_wd _ F')) Variable R : G -> CProp. Lemma included_FPlus : included R P -> included R Q -> included R (Dom Fplus). -intros; simpl in |- *; apply included_conj; assumption. +Proof. + intros; simpl in |- *; apply included_conj; assumption. Qed. Lemma included_FPlus' : included R (Dom Fplus) -> included R P. -intro H; simpl in H; eapply included_conj_lft; apply H. +Proof. + intro H; simpl in H; eapply included_conj_lft; apply H. Qed. Lemma included_FPlus'' : included R (Dom Fplus) -> included R Q. -intro H; simpl in H; eapply included_conj_rht; apply H. +Proof. + intro H; simpl in H; eapply included_conj_rht; apply H. Qed. End Part_Function_Plus. @@ -264,44 +271,41 @@ let (y1, y2):= y in Lemma dprod_strext:(bin_fun_strext (ProdCSetoid M1 M2)(ProdCSetoid M1 M2) (ProdCSetoid M1 M2)dprod). -unfold bin_fun_strext. -intros x1 x2 y1 y2. -unfold dprod. -case x1. -intros a1 a2. -case x2. -intros b1 b2. -case y1. -intros c1 c2. -case y2. -intros d1 d2. -simpl. -intro H. -elim H. -clear H. -intro H. -cut (a1[#]b1 or c1[#]d1). -intuition. - -set (H0:= (@csg_op M1)). -unfold CSetoid_bin_op in H0. -set (H1:= (@csbf_strext M1 M1 M1 H0)). -unfold bin_fun_strext in H1. -apply H1. -exact H. - - -clear H. -intro H. -cut (a2[#]b2 or c2[#]d2). -intuition. - -set (H0:= (@csg_op M2)). -unfold CSetoid_bin_op in H0. -set (H1:= (@csbf_strext M2 M2 M2 H0)). -unfold bin_fun_strext in H1. -apply H1. -exact H. +Proof. + unfold bin_fun_strext. + intros x1 x2 y1 y2. + unfold dprod. + case x1. + intros a1 a2. + case x2. + intros b1 b2. + case y1. + intros c1 c2. + case y2. + intros d1 d2. + simpl. + intro H. + elim H. + clear H. + intro H. + cut (a1[#]b1 or c1[#]d1). + intuition. + set (H0:= (@csg_op M1)). + unfold CSetoid_bin_op in H0. + set (H1:= (@csbf_strext M1 M1 M1 H0)). + unfold bin_fun_strext in H1. + apply H1. + exact H. + clear H. + intro H. + cut (a2[#]b2 or c2[#]d2). + intuition. + set (H0:= (@csg_op M2)). + unfold CSetoid_bin_op in H0. + set (H1:= (@csbf_strext M2 M2 M2 H0)). + unfold bin_fun_strext in H1. + apply H1. + exact H. Qed. Definition dprod_as_csb_fun: @@ -309,25 +313,26 @@ Definition dprod_as_csb_fun: (Build_CSetoid_bin_fun (ProdCSetoid M1 M2)(ProdCSetoid M1 M2) (ProdCSetoid M1 M2) dprod dprod_strext). -Lemma direct_product_is_CSemiGroup: +Lemma direct_product_is_CSemiGroup: (is_CSemiGroup (ProdCSetoid M1 M2) dprod_as_csb_fun). -unfold is_CSemiGroup. -unfold associative. -intros x y z. -case x. -intros x1 x2. -case y. -intros y1 y2. -case z. -intros z1 z2. -simpl. -split. -apply CSemiGroup_is_CSemiGroup. -apply CSemiGroup_is_CSemiGroup. +Proof. + unfold is_CSemiGroup. + unfold associative. + intros x y z. + case x. + intros x1 x2. + case y. + intros y1 y2. + case z. + intros z1 z2. + simpl. + split. + apply CSemiGroup_is_CSemiGroup. + apply CSemiGroup_is_CSemiGroup. Qed. Definition direct_product_as_CSemiGroup:= - (Build_CSemiGroup (ProdCSetoid M1 M2) dprod_as_csb_fun + (Build_CSemiGroup (ProdCSetoid M1 M2) dprod_as_csb_fun direct_product_is_CSemiGroup). End D9S. @@ -337,10 +342,11 @@ End D9S. ** The SemiGroup of Setoid functions *) -Lemma FS_is_CSemiGroup: +Lemma FS_is_CSemiGroup: forall (X:CSetoid),(is_CSemiGroup (FS_as_CSetoid X X) (comp_as_bin_op X )). -unfold is_CSemiGroup. -exact assoc_comp. +Proof. + unfold is_CSemiGroup. + exact assoc_comp. Qed. Definition FS_as_CSemiGroup (A : CSetoid) := @@ -356,24 +362,24 @@ Section p66E2b4. Variable A:CSetoid. -Lemma Astar_is_CSemiGroup: +Lemma Astar_is_CSemiGroup: (is_CSemiGroup (free_csetoid_as_csetoid A) (app_as_csb_fun A)). -unfold is_CSemiGroup. -unfold associative. -intros x. -unfold app_as_csb_fun. -simpl. -induction x. -simpl. -intros x y. -apply eq_fm_reflexive. - -simpl. -intuition. +Proof. + unfold is_CSemiGroup. + unfold associative. + intros x. + unfold app_as_csb_fun. + simpl. + induction x. + simpl. + intros x y. + apply eq_fm_reflexive. + simpl. + intuition. Qed. -Definition Astar_as_CSemiGroup:= - (Build_CSemiGroup (free_csetoid_as_csetoid A) (app_as_csb_fun A) +Definition Astar_as_CSemiGroup:= + (Build_CSemiGroup (free_csetoid_as_csetoid A) (app_as_csb_fun A) Astar_is_CSemiGroup). End p66E2b4. diff --git a/algebra/CSetoidFun.v b/algebra/CSetoidFun.v index f77f0ff90..c712f7ddb 100644 --- a/algebra/CSetoidFun.v +++ b/algebra/CSetoidFun.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CSetoids. Require Import ssreflect. @@ -49,75 +49,77 @@ Definition eq_fun (A B : CSetoid) (f g : CSetoid_fun A B) := Lemma irrefl_apfun : forall A B : CSetoid, irreflexive (ap_fun A B). -intros A B. -unfold irreflexive in |- *. -intros f. -unfold ap_fun in |- *. -red in |- *. -intro H. -elim H. -intros a H0. -set (H1 := ap_irreflexive B (f a)) in *. -intuition. +Proof. + intros A B. + unfold irreflexive in |- *. + intros f. + unfold ap_fun in |- *. + red in |- *. + intro H. + elim H. + intros a H0. + set (H1 := ap_irreflexive B (f a)) in *. + intuition. Qed. Lemma cotrans_apfun : forall A B : CSetoid, cotransitive (ap_fun A B). -intros A B. -unfold cotransitive in |- *. -unfold ap_fun in |- *. -intros f g H h. -elim H. -clear H. -intros a H. -set (H1 := ap_cotransitive B (f a) (g a) H (h a)) in *. -elim H1. -clear H1. -intros H1. -left. -exists a. -exact H1. - -clear H1. -intro H1. -right. -exists a. -exact H1. +Proof. + intros A B. + unfold cotransitive in |- *. + unfold ap_fun in |- *. + intros f g H h. + elim H. + clear H. + intros a H. + set (H1 := ap_cotransitive B (f a) (g a) H (h a)) in *. + elim H1. + clear H1. + intros H1. + left. + exists a. + exact H1. + clear H1. + intro H1. + right. + exists a. + exact H1. Qed. Lemma ta_apfun : forall A B : CSetoid, tight_apart (eq_fun A B) (ap_fun A B). -unfold tight_apart in |- *. -unfold ap_fun in |- *. -unfold eq_fun in |- *. -intros A B f g. -split. -intros H a. -red in H. -apply not_ap_imp_eq. -red in |- *. -intros H0. -apply H. -exists a. -exact H0. -intros H. -red in |- *. - -intro H1. -elim H1. -intros a X. -set (H2 := eq_imp_not_ap B (f a) (g a) (H a) X) in *. -exact H2. +Proof. + unfold tight_apart in |- *. + unfold ap_fun in |- *. + unfold eq_fun in |- *. + intros A B f g. + split. + intros H a. + red in H. + apply not_ap_imp_eq. + red in |- *. + intros H0. + apply H. + exists a. + exact H0. + intros H. + red in |- *. + intro H1. + elim H1. + intros a X. + set (H2 := eq_imp_not_ap B (f a) (g a) (H a) X) in *. + exact H2. Qed. Lemma sym_apfun : forall A B : CSetoid, Csymmetric (ap_fun A B). -unfold Csymmetric in |- *. -unfold ap_fun in |- *. -intros A B f g H. -elim H. -clear H. -intros a H. -exists a. -apply ap_symmetric. -exact H. +Proof. + unfold Csymmetric in |- *. + unfold ap_fun in |- *. + intros A B f g H. + elim H. + clear H. + intros a H. + exists a. + apply ap_symmetric. + exact H. Qed. Definition FS_is_CSetoid (A B : CSetoid) := @@ -154,10 +156,11 @@ Variable f : CSetoid_fun S1 S2. Variable g : CSetoid_fun S2 S3. Definition compose_CSetoid_fun : CSetoid_fun S1 S3. -apply (Build_CSetoid_fun _ _ (fun x : S1 => g (f x))). -(* str_ext *) -unfold fun_strext in |- *; intros x y H. -apply (csf_strext _ _ f). apply (csf_strext _ _ g). assumption. +Proof. + apply (Build_CSetoid_fun _ _ (fun x : S1 => g (f x))). + (* str_ext *) + unfold fun_strext in |- *; intros x y H. + apply (csf_strext _ _ f). apply (csf_strext _ _ g). assumption. Defined. End unary_function_composition. @@ -167,106 +170,111 @@ End unary_function_composition. *) Definition comp (A B C : CSetoid) : FS_as_CSetoid A B -> FS_as_CSetoid B C -> FS_as_CSetoid A C. -intros A B C f g. -set (H := compose_CSetoid_fun A B C f g) in *. -exact H. +Proof. + intros A B C f g. + set (H := compose_CSetoid_fun A B C f g) in *. + exact H. Defined. Definition comp_as_bin_op (A:CSetoid) : CSetoid_bin_op (FS_as_CSetoid A A). -intro A. -unfold CSetoid_bin_op in |- *. -eapply Build_CSetoid_bin_fun with (comp A A A). -unfold bin_fun_strext in |- *. -unfold comp in |- *. -intros f1 f2 g1 g2. -simpl in |- *. -unfold ap_fun in |- *. -unfold compose_CSetoid_fun in |- *. -simpl in |- *. -elim f1. -unfold fun_strext in |- *. -clear f1. -intros f1 Hf1. -elim f2. -unfold fun_strext in |- *. -clear f2. -intros f2 Hf2. -elim g1. -unfold fun_strext in |- *. -clear g1. -intros g1 Hg1. -elim g2. -unfold fun_strext in |- *. -clear g2. -intros g2 Hg2. -simpl in |- *. -intro H. -elim H. -clear H. -intros a H. -set (H0 := ap_cotransitive A (g1 (f1 a)) (g2 (f2 a)) H (g2 (f1 a))) in *. -elim H0. -clear H0. -intro H0. -right. -exists (f1 a). -exact H0. - -clear H0. -intro H0. -left. -exists a. -apply Hg2. -exact H0. +Proof. + intro A. + unfold CSetoid_bin_op in |- *. + eapply Build_CSetoid_bin_fun with (comp A A A). + unfold bin_fun_strext in |- *. + unfold comp in |- *. + intros f1 f2 g1 g2. + simpl in |- *. + unfold ap_fun in |- *. + unfold compose_CSetoid_fun in |- *. + simpl in |- *. + elim f1. + unfold fun_strext in |- *. + clear f1. + intros f1 Hf1. + elim f2. + unfold fun_strext in |- *. + clear f2. + intros f2 Hf2. + elim g1. + unfold fun_strext in |- *. + clear g1. + intros g1 Hg1. + elim g2. + unfold fun_strext in |- *. + clear g2. + intros g2 Hg2. + simpl in |- *. + intro H. + elim H. + clear H. + intros a H. + set (H0 := ap_cotransitive A (g1 (f1 a)) (g2 (f2 a)) H (g2 (f1 a))) in *. + elim H0. + clear H0. + intro H0. + right. + exists (f1 a). + exact H0. + clear H0. + intro H0. + left. + exists a. + apply Hg2. + exact H0. Defined. Lemma assoc_comp : forall A : CSetoid, associative (comp_as_bin_op A). -unfold associative in |- *. -unfold comp_as_bin_op in |- *. -intros A f g h. -simpl in |- *. -unfold eq_fun in |- *. -simpl in |- *. -intuition. +Proof. + unfold associative in |- *. + unfold comp_as_bin_op in |- *. + intros A f g h. + simpl in |- *. + unfold eq_fun in |- *. + simpl in |- *. + intuition. Qed. Section unary_and_binary_function_composition. Definition compose_CSetoid_bin_un_fun (A B C : CSetoid) (f : CSetoid_bin_fun B B C) (g : CSetoid_fun A B) : CSetoid_bin_fun A A C. -intros A B C f g. -apply (Build_CSetoid_bin_fun A A C (fun a0 a1 : A => f (g a0) (g a1))). -intros x1 x2 y1 y2 H0. -assert (H10:= csbf_strext B B C f). -red in H10. -assert (H40 := csf_strext A B g). -red in H40. -elim (H10 (g x1) (g x2) (g y1) (g y2) H0); [left | right]; auto. +Proof. + intros A B C f g. + apply (Build_CSetoid_bin_fun A A C (fun a0 a1 : A => f (g a0) (g a1))). + intros x1 x2 y1 y2 H0. + assert (H10:= csbf_strext B B C f). + red in H10. + assert (H40 := csf_strext A B g). + red in H40. + elim (H10 (g x1) (g x2) (g y1) (g y2) H0); [left | right]; auto. Defined. Definition compose_CSetoid_bin_fun A B C (f g : CSetoid_fun A B) (h : CSetoid_bin_fun B B C) : CSetoid_fun A C. -intros A B C f g h. -apply (Build_CSetoid_fun A C (fun a : A => h (f a) (g a))). -intros x y H. -elim (csbf_strext _ _ _ _ _ _ _ _ H); apply csf_strext. +Proof. + intros A B C f g h. + apply (Build_CSetoid_fun A C (fun a : A => h (f a) (g a))). + intros x y H. + elim (csbf_strext _ _ _ _ _ _ _ _ H); apply csf_strext. Defined. Definition compose_CSetoid_un_bin_fun A B C (f : CSetoid_bin_fun B B C) (g : CSetoid_fun C A) : CSetoid_bin_fun B B A. -intros A0 B0 C f g. -apply Build_CSetoid_bin_fun with (fun x y : B0 => g (f x y)). -intros x1 x2 y1 y2. -case f. -simpl in |- *. -unfold bin_fun_strext in |- *. -case g. -simpl in |- *. -unfold fun_strext in |- *. -intros gu gstrext fu fstrext H. -apply fstrext. -apply gstrext. -exact H. +Proof. + intros A0 B0 C f g. + apply Build_CSetoid_bin_fun with (fun x y : B0 => g (f x y)). + intros x1 x2 y1 y2. + case f. + simpl in |- *. + unfold bin_fun_strext in |- *. + case g. + simpl in |- *. + unfold fun_strext in |- *. + intros gu gstrext fu fstrext H. + apply fstrext. + apply gstrext. + exact H. Defined. End unary_and_binary_function_composition. @@ -278,15 +286,16 @@ End unary_and_binary_function_composition. Section function_projection. Lemma proj_bin_fun : forall A B C (f : CSetoid_bin_fun A B C) a, fun_strext (f a). -intros A B C f a. -red in |- *. -elim f. -intro fo. -simpl. -intros csbf_strext0 x y H. -elim (csbf_strext0 _ _ _ _ H); intro H0. - elim (ap_irreflexive _ _ H0). -exact H0. +Proof. + intros A B C f a. + red in |- *. + elim f. + intro fo. + simpl. + intros csbf_strext0 x y H. + elim (csbf_strext0 _ _ _ _ H); intro H0. + elim (ap_irreflexive _ _ H0). + exact H0. Qed. Definition projected_bin_fun A B C (f : CSetoid_bin_fun A B C) (a : A) := @@ -301,12 +310,14 @@ Variable S : CSetoid. Definition binproj1 (x y:S) := x. Lemma binproj1_strext : bin_fun_strext _ _ _ binproj1. -red in |- *; auto. +Proof. + red in |- *; auto. Qed. Definition cs_binproj1 : CSetoid_bin_op S. -red in |- *; apply Build_CSetoid_bin_op with binproj1. -apply binproj1_strext. +Proof. + red in |- *; apply Build_CSetoid_bin_op with binproj1. + apply binproj1_strext. Defined. End BinProj. @@ -330,11 +341,12 @@ Variable f : CSetoid_fun S1 S2. Variable op : CSetoid_un_op S2. Definition opOnFun : CSetoid_fun S1 S2. -apply (Build_CSetoid_fun S1 S2 (fun x : S1 => op (f x))). -(* str_ext *) -unfold fun_strext in |- *; intros x y H. -apply (csf_strext _ _ f x y). -apply (csf_strext _ _ op _ _ H). +Proof. + apply (Build_CSetoid_fun S1 S2 (fun x : S1 => op (f x))). + (* str_ext *) + unfold fun_strext in |- *; intros x y H. + apply (csf_strext _ _ f x y). + apply (csf_strext _ _ op _ _ H). Defined. End CombiningUnaryOperations. @@ -366,7 +378,7 @@ match m with |nil => False |cons a l => b[=]a /\ (eq_fm n l) end -end. +end. Fixpoint ap_fm (m:Astar)(k:Astar){struct m}: CProp := match m with @@ -375,222 +387,203 @@ match m with |cons a l => CTrue end |cons b n => match k with - |nil => CTrue + |nil => CTrue |cons a l => b[#]a or (ap_fm n l) end -end. +end. Lemma ap_fm_irreflexive: (irreflexive ap_fm). -unfold irreflexive. -intro x. -induction x. -simpl. -red. -intuition. - -simpl. -red. -intro H. -apply IHx. -elim H. -clear H. -generalize (ap_irreflexive A a). -unfold Not. -intuition. - -intuition. +Proof. + unfold irreflexive. + intro x. + induction x. + simpl. + red. + intuition. + simpl. + red. + intro H. + apply IHx. + elim H. + clear H. + generalize (ap_irreflexive A a). + unfold Not. + intuition. + intuition. Qed. Lemma ap_fm_symmetric: Csymmetric ap_fm. -unfold Csymmetric. -intros x. -induction x. -intro y. -case y. -simpl. -intuition. - -simpl. -intuition. -simpl. -intro y. -case y. -simpl. -intuition. - -simpl. -intros c l H0. -elim H0. -generalize (ap_symmetric A a c). -intuition. -clear H0. -intro H0. -right. -apply IHx. -exact H0. +Proof. + unfold Csymmetric. + intros x. + induction x. + intro y. + case y. + simpl. + intuition. + simpl. + intuition. + simpl. + intro y. + case y. + simpl. + intuition. + simpl. + intros c l H0. + elim H0. + generalize (ap_symmetric A a c). + intuition. + clear H0. + intro H0. + right. + apply IHx. + exact H0. Qed. Lemma ap_fm_cotransitive : (cotransitive ap_fm). -unfold cotransitive. -intro x. -induction x. -simpl. -intro y. -case y. -intuition. - -intros c l H z. -case z. -simpl. -intuition. - -intuition. - -simpl. -intro y. -case y. -intros H z. -case z. -intuition. - -simpl. -intuition. - -intros c l H z. -case z. -intuition. - -simpl. -intros c0 l0. -elim H. -clear H. -intro H. -generalize (ap_cotransitive A a c H c0). -intuition. - -clear H. -intro H. -generalize (IHx l H l0). -intuition. +Proof. + unfold cotransitive. + intro x. + induction x. + simpl. + intro y. + case y. + intuition. + intros c l H z. + case z. + simpl. + intuition. + intuition. + simpl. + intro y. + case y. + intros H z. + case z. + intuition. + simpl. + intuition. + intros c l H z. + case z. + intuition. + simpl. + intros c0 l0. + elim H. + clear H. + intro H. + generalize (ap_cotransitive A a c H c0). + intuition. + clear H. + intro H. + generalize (IHx l H l0). + intuition. Qed. Lemma ap_fm_tight : (tight_apart eq_fm ap_fm). -unfold tight_apart. -intros x. -induction x. -simpl. -intro y. -case y. -red. -unfold Not. -intuition. - -intuition. - -intro y. -simpl. -case y. -intuition. - -intros c l. -generalize (IHx l). -red. -intro H0. -elim H0. -intros H1 H2. -split. -intro H3. -split. -red in H3. -generalize (ap_tight A a c). -intuition. - -apply H1. -intro H4. -apply H3. -right. -exact H4. - -intro H3. -elim H3. -clear H3. -intros H3 H4. -intro H5. -elim H5. -generalize (ap_tight A a c). -intuition. - -apply H2. -exact H4. +Proof. + unfold tight_apart. + intros x. + induction x. + simpl. + intro y. + case y. + red. + unfold Not. + intuition. + intuition. + intro y. + simpl. + case y. + intuition. + intros c l. + generalize (IHx l). + red. + intro H0. + elim H0. + intros H1 H2. + split. + intro H3. + split. + red in H3. + generalize (ap_tight A a c). + intuition. + apply H1. + intro H4. + apply H3. + right. + exact H4. + intro H3. + elim H3. + clear H3. + intros H3 H4. + intro H5. + elim H5. + generalize (ap_tight A a c). + intuition. + apply H2. + exact H4. Qed. Definition free_csetoid_is_CSetoid:(is_CSetoid Astar eq_fm ap_fm):= - (Build_is_CSetoid Astar eq_fm ap_fm ap_fm_irreflexive ap_fm_symmetric + (Build_is_CSetoid Astar eq_fm ap_fm ap_fm_irreflexive ap_fm_symmetric ap_fm_cotransitive ap_fm_tight). Definition free_csetoid_as_csetoid:CSetoid:= (Build_CSetoid Astar eq_fm ap_fm free_csetoid_is_CSetoid). Lemma app_strext: - (bin_fun_strext free_csetoid_as_csetoid free_csetoid_as_csetoid + (bin_fun_strext free_csetoid_as_csetoid free_csetoid_as_csetoid free_csetoid_as_csetoid appA). -unfold bin_fun_strext. -intros x1. -induction x1. -simpl. -intro x2. -case x2. -simpl. -intuition. - -intuition. - -intros x2 y1 y2. -simpl. -case x2. -case y2. -simpl. -intuition. - -simpl. -intuition. - -case y2. -simpl. -simpl in IHx1. -intros c l H. -elim H. -intuition. - -clear H. -generalize (IHx1 l y1 (@nil A)). -intuition. - -simpl. -intros c l c0 l0. -intro H. -elim H. -intuition. - -generalize (IHx1 l0 y1 (cons c l)). -intuition. +Proof. + unfold bin_fun_strext. + intros x1. + induction x1. + simpl. + intro x2. + case x2. + simpl. + intuition. + intuition. + intros x2 y1 y2. + simpl. + case x2. + case y2. + simpl. + intuition. + simpl. + intuition. + case y2. + simpl. + simpl in IHx1. + intros c l H. + elim H. + intuition. + clear H. + generalize (IHx1 l y1 (@nil A)). + intuition. + simpl. + intros c l c0 l0. + intro H. + elim H. + intuition. + generalize (IHx1 l0 y1 (cons c l)). + intuition. Qed. -Definition app_as_csb_fun: -(CSetoid_bin_fun free_csetoid_as_csetoid free_csetoid_as_csetoid +Definition app_as_csb_fun: +(CSetoid_bin_fun free_csetoid_as_csetoid free_csetoid_as_csetoid free_csetoid_as_csetoid):= - (Build_CSetoid_bin_fun free_csetoid_as_csetoid free_csetoid_as_csetoid + (Build_CSetoid_bin_fun free_csetoid_as_csetoid free_csetoid_as_csetoid free_csetoid_as_csetoid appA app_strext). Lemma eq_fm_reflexive: forall (x:Astar), (eq_fm x x). -intro x. -induction x. -simpl. -intuition. - -simpl. -intuition. +Proof. + intro x. + induction x. + simpl. + intuition. + simpl. + intuition. Qed. End p66E2b4. @@ -645,21 +638,22 @@ Variables P Q : S -> CProp. Definition conjP (x : S) : CProp := P x and Q x. Lemma prj1 : forall x : S, conjP x -> P x. -intros x H; inversion_clear H; assumption. +Proof. + intros x H; inversion_clear H; assumption. Qed. Lemma prj2 : forall x : S, conjP x -> Q x. -intros x H; inversion_clear H; assumption. +Proof. + intros x H; inversion_clear H; assumption. Qed. Lemma conj_wd : pred_wd _ P -> pred_wd _ Q -> pred_wd _ conjP. -intros H H0. -red in |- *; intros x y H1 H2. -inversion_clear H1; split. - -apply H with x; assumption. - -apply H0 with x; assumption. +Proof. + intros H H0. + red in |- *; intros x y H1 H2. + inversion_clear H1; split. + apply H with x; assumption. + apply H0 with x; assumption. Qed. End Conjunction. @@ -675,21 +669,22 @@ Although at this stage we never use it, for completeness's sake we also treat di Definition disj (x : S) : CProp := P x or Q x. Lemma inj1 : forall x : S, P x -> disj x. -intros; left; assumption. +Proof. + intros; left; assumption. Qed. Lemma inj2 : forall x : S, Q x -> disj x. -intros; right; assumption. +Proof. + intros; right; assumption. Qed. Lemma disj_wd : pred_wd _ P -> pred_wd _ Q -> pred_wd _ disj. -intros H H0. -red in |- *; intros x y H1 H2. -inversion_clear H1. - -left; apply H with x; assumption. - -right; apply H0 with x; assumption. +Proof. + intros H H0. + red in |- *; intros x y H1 H2. + inversion_clear H1. + left; apply H with x; assumption. + right; apply H0 with x; assumption. Qed. End Disjunction. @@ -706,27 +701,29 @@ Variable R : forall x : S, P x -> CProp. Definition extend (x : S) : CProp := P x and (forall H : P x, R x H). Lemma ext1 : forall x : S, extend x -> P x. -intros x H; inversion_clear H; assumption. +Proof. + intros x H; inversion_clear H; assumption. Qed. Lemma ext2_a : forall x : S, extend x -> {H : P x | R x H}. -intros x H; inversion_clear H. -exists X; auto. +Proof. + intros x H; inversion_clear H. + exists X; auto. Qed. Lemma ext2 : forall (x : S) (Hx : extend x), R x (ProjT1 (ext2_a x Hx)). -intros; apply projT2. +Proof. + intros; apply projT2. Qed. Lemma extension_wd : pred_wd _ P -> (forall (x y : S) Hx Hy, x [=] y -> R x Hx -> R y Hy) -> pred_wd _ extend. -intros H H0. -red in |- *; intros x y H1 H2. -elim H1; intros H3 H4; split. - -apply H with x; assumption. - -intro H5; apply H0 with x H3; [ apply H2 | apply H4 ]. +Proof. + intros H H0. + red in |- *; intros x y H1 H2. + elim H1; intros H3 H4; split. + apply H with x; assumption. + intro H5; apply H0 with x H3; [ apply H2 | apply H4 ]. Qed. End Extension. @@ -746,7 +743,7 @@ Implicit Arguments ext2 [S P R x]. We are now ready to define the concept of partial function between arbitrary setoids. *) -Record BinPartFunct (S1 S2 : CSetoid) : Type := +Record BinPartFunct (S1 S2 : CSetoid) : Type := {bpfdom : S1 -> CProp; bdom_wd : pred_wd S1 bpfdom; bpfpfun :> forall x : S1, bpfdom x -> S2; @@ -762,15 +759,16 @@ The next lemma states that every partial function is well defined. Lemma bpfwdef : forall S1 S2 (F : BinPartFunct S1 S2) x y Hx Hy, x [=] y -> F x Hx [=] F y Hy. -intros. -apply not_ap_imp_eq; intro H0. -generalize (bpfstrx _ _ _ _ _ _ _ H0). -exact (eq_imp_not_ap _ _ _ H). +Proof. + intros. + apply not_ap_imp_eq; intro H0. + generalize (bpfstrx _ _ _ _ _ _ _ H0). + exact (eq_imp_not_ap _ _ _ H). Qed. (** Similar for automorphisms. *) -Record PartFunct (S : CSetoid) : Type := +Record PartFunct (S : CSetoid) : Type := {pfdom : S -> CProp; dom_wd : pred_wd S pfdom; pfpfun :> forall x : S, pfdom x -> S; @@ -785,10 +783,11 @@ The next lemma states that every partial function is well defined. *) Lemma pfwdef : forall S (F : PartFunct S) x y Hx Hy, x [=] y -> F x Hx [=] F y Hy. -intros. -apply not_ap_imp_eq; intro H0. -generalize (pfstrx _ _ _ _ _ _ H0). -exact (eq_imp_not_ap _ _ _ H). +Proof. + intros. + apply not_ap_imp_eq; intro H0. + generalize (pfstrx _ _ _ _ _ _ H0). + exact (eq_imp_not_ap _ _ _ H). Qed. (** @@ -846,12 +845,12 @@ To begin with, we want to be able to ``see'' each total function as a partial fu *) Definition total_eq_part : CSetoid_un_op S -> PartFunct S. -intros f. -apply - Build_PartFunct with (fun x : S => CTrue) (fun (x : S) (H : CTrue) => f x). -red in |- *; intros; auto. -intros x y Hx Hy H. -exact (csf_strext _ _ f _ _ H). +Proof. + intros f. + apply Build_PartFunct with (fun x : S => CTrue) (fun (x : S) (H : CTrue) => f x). + red in |- *; intros; auto. + intros x y Hx Hy H. + exact (csf_strext _ _ f _ _ H). Defined. Section Part_Function_Const. @@ -896,17 +895,19 @@ Let R x := {Hx : P x | Q (F x Hx)}. Lemma part_function_comp_strext : forall x y (Hx : R x) (Hy : R y), G (F x (ProjT1 Hx)) (ProjT2 Hx) [#] G (F y (ProjT1 Hy)) (ProjT2 Hy) -> x [#] y. -intros x y Hx Hy H. -exact (pfstrx _ _ _ _ _ _ (pfstrx _ _ _ _ _ _ H)). +Proof. + intros x y Hx Hy H. + exact (pfstrx _ _ _ _ _ _ (pfstrx _ _ _ _ _ _ H)). Qed. Lemma part_function_comp_dom_wd : pred_wd S R. -red in |- *; intros x y H H0. -unfold R in |- *; inversion_clear H. -exists (dom_wd _ F x y x0 H0). -apply (dom_wd _ G) with (F x x0). -assumption. -apply pfwdef; assumption. +Proof. + red in |- *; intros x y H H0. + unfold R in |- *; inversion_clear H. + exists (dom_wd _ F x y x0 H0). + apply (dom_wd _ G) with (F x x0). + assumption. + apply pfwdef; assumption. Qed. Definition Fcomp := Build_PartFunct _ R part_function_comp_dom_wd @@ -937,17 +938,19 @@ Let R x := {Hx : P x | Q (F x Hx)}. Lemma bin_part_function_comp_strext : forall x y (Hx : R x) (Hy : R y), G (F x (ProjT1 Hx)) (ProjT2 Hx) [#] G (F y (ProjT1 Hy)) (ProjT2 Hy) -> x [#] y. -intros x y Hx Hy H. -exact (bpfstrx _ _ _ _ _ _ _ (bpfstrx _ _ _ _ _ _ _ H)). +Proof. + intros x y Hx Hy H. + exact (bpfstrx _ _ _ _ _ _ _ (bpfstrx _ _ _ _ _ _ _ H)). Qed. Lemma bin_part_function_comp_dom_wd : pred_wd S1 R. -red in |- *; intros x y H H0. -unfold R in |- *; inversion_clear H. -exists (bdom_wd _ _ F x y x0 H0). -apply (bdom_wd _ _ G) with (F x x0). -assumption. -apply bpfwdef; assumption. +Proof. + red in |- *; intros x y H H0. + unfold R in |- *; inversion_clear H. + exists (bdom_wd _ _ F x y x0 H0). + apply (bdom_wd _ _ G) with (F x x0). + assumption. + apply bpfwdef; assumption. Qed. Definition BinFcomp := Build_BinPartFunct _ _ R bin_part_function_comp_dom_wd @@ -986,19 +989,20 @@ Implicit Arguments surjective [A B]. Lemma injective_imp_injective_weak : forall A B (f : CSetoid_fun A B), injective f -> injective_weak f. -intros A B f. -unfold injective in |- *. -intro H. -unfold injective_weak in |- *. -intros a0 a1 H0. -apply not_ap_imp_eq. -red in |- *. -intro H1. -set (H2 := H a0 a1 H1) in *. -set (H3 := ap_imp_neq B (f a0) (f a1) H2) in *. -set (H4 := eq_imp_not_neq B (f a0) (f a1) H0) in *. -apply H4. -exact H3. +Proof. + intros A B f. + unfold injective in |- *. + intro H. + unfold injective_weak in |- *. + intros a0 a1 H0. + apply not_ap_imp_eq. + red in |- *. + intro H1. + set (H2 := H a0 a1 H1) in *. + set (H3 := ap_imp_neq B (f a0) (f a1) H2) in *. + set (H4 := eq_imp_not_neq B (f a0) (f a1) H0) in *. + apply H4. + exact H3. Qed. Definition bijective A B (f:CSetoid_fun A B) := injective f and surjective f. @@ -1006,80 +1010,86 @@ Definition bijective A B (f:CSetoid_fun A B) := injective f and surjective f. Implicit Arguments bijective [A B]. Lemma id_is_bij : forall A, bijective (id_un_op A). -intro A. -split. - red; simpl; auto. -intro b; exists b; apply eq_reflexive. +Proof. + intro A. + split. + red; simpl; auto. + intro b; exists b; apply eq_reflexive. Qed. Lemma comp_resp_bij : forall A B C f g, bijective f -> bijective g -> bijective (compose_CSetoid_fun A B C f g). -intros A B C f g. -intros H0 H1. -elim H0; clear H0; intros H00 H01. -elim H1; clear H1; intros H10 H11. -split. - intros a0 a1; simpl; intro. - apply H10; apply H00; auto. -intro c; simpl. -elim (H11 c); intros b H20. -elim (H01 b); intros a H30. -exists a. -Step_final (g b). +Proof. + intros A B C f g. + intros H0 H1. + elim H0; clear H0; intros H00 H01. + elim H1; clear H1; intros H10 H11. + split. + intros a0 a1; simpl; intro. + apply H10; apply H00; auto. + intro c; simpl. + elim (H11 c); intros b H20. + elim (H01 b); intros a H30. + exists a. + Step_final (g b). Qed. Lemma inv : forall A B (f:CSetoid_fun A B), bijective f -> forall b : B, {a : A | f a [=] b}. -unfold bijective in |- *. -unfold surjective in |- *. -intuition. +Proof. + unfold bijective in |- *. + unfold surjective in |- *. + intuition. Qed. Implicit Arguments inv [A B]. Definition invfun A B (f : CSetoid_fun A B) (H : bijective f) : B -> A. -intros A B f H H0. -elim (inv f H H0); intros a H2. -apply a. +Proof. + intros A B f H H0. + elim (inv f H H0); intros a H2. + apply a. Defined. Implicit Arguments invfun [A B]. Lemma inv1 : forall A B (f : CSetoid_fun A B) (H : bijective f) (b : B), f (invfun f H b) [=] b. -intros A B f H b. -unfold invfun in |- *; case inv. -simpl; auto. +Proof. + intros A B f H b. + unfold invfun in |- *; case inv. + simpl; auto. Qed. Lemma inv2 : forall A B (f : CSetoid_fun A B) (H : bijective f) (a : A), invfun f H (f a) [=] a. -intros. -unfold invfun in |- *; case inv; simpl. -move:H => [H0 H1] x. -by apply injective_imp_injective_weak. +Proof. + intros. + unfold invfun in |- *; case inv; simpl. + move:H => [H0 H1] x. + by apply injective_imp_injective_weak. Qed. Lemma inv_strext : forall A B (f : CSetoid_fun A B) (H : bijective f), fun_strext (invfun f H). -intros A B f H x y H1. -elim H => [H00 H01]. -elim (H01 x) => a0 H2. -elim (H01 y) => a1 H3. -astepl (f a0). -astepr (f a1). -apply H00. -astepl (invfun f H x). -astepr (invfun f H y); first exact H1. -astepl (invfun f H (f a1)); first apply inv2. -apply injective_imp_injective_weak with (f := f); auto. -astepl (f a1). -astepl y. -apply eq_symmetric; apply inv1. - apply eq_symmetric; apply inv1. - -apply injective_imp_injective_weak with (f := f); auto. -rewrite inv1. algebra. +Proof. + intros A B f H x y H1. + elim H => [H00 H01]. + elim (H01 x) => a0 H2. + elim (H01 y) => a1 H3. + astepl (f a0). + astepr (f a1). + apply H00. + astepl (invfun f H x). + astepr (invfun f H y); first exact H1. + astepl (invfun f H (f a1)); first apply inv2. + apply injective_imp_injective_weak with (f := f); auto. + astepl (f a1). + astepl y. + apply eq_symmetric; apply inv1. + apply eq_symmetric; apply inv1. + apply injective_imp_injective_weak with (f := f); auto. + rewrite inv1. algebra. Qed. Definition Inv A B f (H : bijective f) := @@ -1089,35 +1099,35 @@ Implicit Arguments Inv [A B]. Definition Inv_bij : forall A B (f : CSetoid_fun A B) (H : bijective f), bijective (Inv f H). -intros A B f H. -split. -unfold injective in |- *. -unfold bijective in H. -unfold surjective in H. -elim H => H0 H1. -intros b0 b1 H2. -elim (H1 b0) => a0 H3. -elim (H1 b1) => a1 H4. -astepl (Inv f (CAnd_intro _ _ H0 H1) (f a0)). -astepr (Inv f (CAnd_intro _ _ H0 H1) (f a1)). -cut (fun_strext f). -intros H5. -apply H5. -astepl (f a0). -astepr (f a1). -astepl b0. -by astepr b1. -apply eq_symmetric. -unfold Inv in |- *. -apply inv1. -apply eq_symmetric. -simpl in |- *; apply inv1. -elim f; intuition. - -intro a. -exists (f a). -unfold Inv in |- *. -apply inv2. +Proof. + intros A B f H. + split. + unfold injective in |- *. + unfold bijective in H. + unfold surjective in H. + elim H => H0 H1. + intros b0 b1 H2. + elim (H1 b0) => a0 H3. + elim (H1 b1) => a1 H4. + astepl (Inv f (CAnd_intro _ _ H0 H1) (f a0)). + astepr (Inv f (CAnd_intro _ _ H0 H1) (f a1)). + cut (fun_strext f). + intros H5. + apply H5. + astepl (f a0). + astepr (f a1). + astepl b0. + by astepr b1. + apply eq_symmetric. + unfold Inv in |- *. + apply inv1. + apply eq_symmetric. + simpl in |- *; apply inv1. + elim f; intuition. + intro a. + exists (f a). + unfold Inv in |- *. + apply inv2. Qed. diff --git a/algebra/CSetoidInc.v b/algebra/CSetoidInc.v index 921d66ec6..d6bb0f8cc 100644 --- a/algebra/CSetoidInc.v +++ b/algebra/CSetoidInc.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing included %\ensuremath{\subseteq}% #⊆# *) @@ -54,53 +54,61 @@ Section Basics. Variables P Q R : S -> CProp. Lemma included_refl : included P P. -red in |- *; intros. -auto. +Proof. + red in |- *; intros. + auto. Qed. Lemma included_trans : included P Q -> included Q R -> included P R. -intros. -red in |- *; intros. -apply X0; apply X; auto. +Proof. + intros. + red in |- *; intros. + apply X0; apply X; auto. Qed. Lemma included_conj : forall P Q R, included P Q -> included P R -> included P (Conj Q R). -intros. -red in |- *; red in X, X0. -intros; red in |- *. -split. -apply X; assumption. -apply X0; assumption. +Proof. + intros. + red in |- *; red in X, X0. + intros; red in |- *. + split. + apply X; assumption. + apply X0; assumption. Qed. Lemma included_conj' : included (Conj P Q) P. -exact (prj1 _ P Q). +Proof. + exact (prj1 _ P Q). Qed. Lemma included_conj'' : included (Conj P Q) Q. -exact (prj2 _ P Q). +Proof. + exact (prj2 _ P Q). Qed. Lemma included_conj_lft : included R (Conj P Q) -> included R P. -red in |- *. -unfold conjP. -intros H1 x H2. -elim (H1 x); auto. +Proof. + red in |- *. + unfold conjP. + intros H1 x H2. + elim (H1 x); auto. Qed. Lemma included_conj_rht : included R (Conj P Q) -> included R Q. -red in |- *. unfold conjP. -intros H1 x H2. -elim (H1 x); auto. +Proof. + red in |- *. unfold conjP. + intros H1 x H2. + elim (H1 x); auto. Qed. Lemma included_extend : forall (H : forall x, P x -> CProp), included R (extend P H) -> included R P. -intros H0 H1. -red in |- *. -unfold extend in H1. -intros. -elim (H1 x); auto. +Proof. + intros H0 H1. + red in |- *. + unfold extend in H1. + intros. + elim (H1 x); auto. Qed. End Basics. @@ -121,17 +129,19 @@ Let Q := Dom G. Variable R : S -> CProp. Lemma included_FComp : included R P -> (forall x Hx, (R x) -> Q (F x Hx)) -> included R (Dom (G[o]F)). -intros HP HQ. -simpl in |- *. -red in |- *; intros x Hx. -exists (HP x Hx). -apply HQ. -assumption. +Proof. + intros HP HQ. + simpl in |- *. + red in |- *; intros x Hx. + exists (HP x Hx). + apply HQ. + assumption. Qed. Lemma included_FComp' : included R (Dom (G[o]F)) -> included R P. -intro H; simpl in H; red in |- *; intros x Hx. -elim (H x Hx); auto. +Proof. + intro H; simpl in H; red in |- *; intros x Hx. + elim (H x Hx); auto. Qed. End inclusion. diff --git a/algebra/CSetoids.v b/algebra/CSetoids.v index 3863252b0..6aa192d45 100644 --- a/algebra/CSetoids.v +++ b/algebra/CSetoids.v @@ -19,21 +19,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing != %\ensuremath{\mathrel\#}% *) (** printing == %\ensuremath{\equiv}% #≡# *) @@ -107,7 +107,7 @@ Unset Implicit Arguments. Apartness, being the main relation, needs to be [CProp]-valued. Equality, as it is characterized by a negative statement, lives in [Prop]. *) -Record is_CSetoid (A : Type) (eq : Relation A) (ap : Crelation A) : CProp := +Record is_CSetoid (A : Type) (eq : Relation A) (ap : Crelation A) : CProp := {ax_ap_irreflexive : irreflexive ap; ax_ap_symmetric : Csymmetric ap; ax_ap_cotransitive : cotransitive ap; @@ -154,19 +154,23 @@ Lemma CSetoid_is_CSetoid : is_CSetoid S (cs_eq (s:=S)) (cs_ap (c:=S)). Proof cs_proof S. Lemma ap_irreflexive : irreflexive (cs_ap (c:=S)). -elim CSetoid_is_CSetoid; auto. +Proof. + elim CSetoid_is_CSetoid; auto. Qed. Lemma ap_symmetric : Csymmetric (cs_ap (c:=S)). -elim CSetoid_is_CSetoid; auto. +Proof. + elim CSetoid_is_CSetoid; auto. Qed. Lemma ap_cotransitive : cotransitive (cs_ap (c:=S)). -elim CSetoid_is_CSetoid; auto. +Proof. + elim CSetoid_is_CSetoid; auto. Qed. Lemma ap_tight : tight_apart (cs_eq (s:=S)) (cs_ap (c:=S)). -elim CSetoid_is_CSetoid; auto. +Proof. + elim CSetoid_is_CSetoid; auto. Qed. End CSetoid_axioms. @@ -179,23 +183,24 @@ End CSetoid_axioms. Lemma is_CSetoid_Setoid : forall S eq ap, is_CSetoid S eq ap -> Setoid_Theory S eq. Proof. -intros S eq ap p. -destruct p. -split. + intros S eq ap p. + destruct p. + split. + firstorder. + intros a b. red in ax_ap_tight0 . + repeat rewrite <- ax_ap_tight0. firstorder. - intros a b. red in ax_ap_tight0 . + intros a b c. red in ax_ap_tight0 . repeat rewrite <- ax_ap_tight0. - firstorder. -intros a b c. red in ax_ap_tight0 . -repeat rewrite <- ax_ap_tight0. -intros H H0 H1. -destruct (ax_ap_cotransitive0 _ _ H1 b); auto. + intros H H0 H1. + destruct (ax_ap_cotransitive0 _ _ H1 b); auto. Qed. Definition Build_CSetoid (X:Type) (eq:Relation X) (ap:Crelation X) (p:is_CSetoid X eq ap) : CSetoid. -intros X eq ap H. -exists (Build_Setoid (is_CSetoid_Setoid _ _ _ H)) ap. -assumption. +Proof. + intros X eq ap H. + exists (Build_Setoid (is_CSetoid_Setoid _ _ _ H)) ap. + assumption. Defined. Section CSetoid_basics. @@ -210,18 +215,21 @@ In `there exists a unique [a:S] such that %\ldots%#...#', we now mean unique wit Definition ex_unq (P : S -> CProp) := {x : S | forall y : S, P y -> x [=] y | P x}. Lemma eq_reflexive : Treflexive (cs_eq (s:=S)). -intro x. -reflexivity. +Proof. + intro x. + reflexivity. Qed. Lemma eq_symmetric : Tsymmetric (cs_eq (s:=S)). -intro x; intros y H. -symmetry; assumption. +Proof. + intro x; intros y H. + symmetry; assumption. Qed. Lemma eq_transitive : Ttransitive (cs_eq (s:=S)). -intro x; intros y z H H0. -transitivity y; assumption. +Proof. + intro x; intros y z H H0. + transitivity y; assumption. Qed. (** @@ -250,7 +258,8 @@ Proof eq_transitive. Require Import ssreflect. Lemma eq_wdl : forall x y z : S, x [=] y -> x [=] z -> z [=] y. -intros. by apply: (eq_transitive _ x);[apply: eq_symmetric|]. +Proof. + intros. by apply: (eq_transitive _ x);[apply: eq_symmetric|]. Qed. @@ -258,8 +267,9 @@ Lemma ap_irreflexive_unfolded : forall x : S, Not (x [#] x). Proof ap_irreflexive S. Lemma ap_cotransitive_unfolded : forall a b : S, a [#] b -> forall c : S, a [#] c or c [#] b. -intros a b H c. -exact (ap_cotransitive _ _ _ H c). +Proof. + intros a b H c. + exact (ap_cotransitive _ _ _ H c). Qed. Lemma ap_symmetric_unfolded : forall x y : S, x [#] y -> y [#] x. @@ -276,43 +286,50 @@ For this we should fix the Prop CProp problem. *) Lemma eq_imp_not_ap : forall x y : S, x [=] y -> Not (x [#] y). -intros x y. -elim (ap_tight S x y). -intros H1 H2. -assumption. +Proof. + intros x y. + elim (ap_tight S x y). + intros H1 H2. + assumption. Qed. Lemma not_ap_imp_eq : forall x y : S, Not (x [#] y) -> x [=] y. -intros x y. -elim (ap_tight S x y). -intros H1 H2. -assumption. +Proof. + intros x y. + elim (ap_tight S x y). + intros H1 H2. + assumption. Qed. Lemma neq_imp_notnot_ap : forall x y : S, x [~=] y -> ~ Not (x [#] y). -intros x y H H0. -by apply: H; apply: not_ap_imp_eq. +Proof. + intros x y H H0. + by apply: H; apply: not_ap_imp_eq. Qed. Lemma notnot_ap_imp_neq : forall x y : S, ~ Not (x [#] y) -> x [~=] y. -intros x y H H0. -by apply H; apply eq_imp_not_ap. +Proof. + intros x y H H0. + by apply H; apply eq_imp_not_ap. Qed. Lemma ap_imp_neq : forall x y : S, x [#] y -> x [~=] y. -intros x y H H1. -by apply (eq_imp_not_ap _ _ H1). +Proof. + intros x y H H1. + by apply (eq_imp_not_ap _ _ H1). Qed. Lemma not_neq_imp_eq : forall x y : S, ~ x [~=] y -> x [=] y. -intros x y H. -apply: not_ap_imp_eq. -move => H0. -apply: H. by apply: ap_imp_neq. +Proof. + intros x y H. + apply: not_ap_imp_eq. + move => H0. + apply: H. by apply: ap_imp_neq. Qed. Lemma eq_imp_not_neq : forall x y : S, x [=] y -> ~ x [~=] y. -intros x y H H0. by []. +Proof. + intros x y H H0. by []. Qed. End CSetoid_basics. @@ -322,87 +339,79 @@ Section product_csetoid. ** The product of setoids *) Definition prod_ap (A B : CSetoid) (c d : prodT A B) : CProp. -intros A B H0 H1. -elim H0. -intros. -elim H1. -intros. -exact (cs_ap (c:=A) a a0 or cs_ap (c:=B) b b0). +Proof. + intros A B H0 H1. + elim H0. + intros. + elim H1. + intros. + exact (cs_ap (c:=A) a a0 or cs_ap (c:=B) b b0). Defined. Definition prod_eq (A B : CSetoid) (c d : prodT A B) : Prop. -intros A B H0 H1. -elim H0. -intros. -elim H1. -intros. -exact (a [=] a0 /\ b [=] b0). +Proof. + intros A B H0 H1. + elim H0. + intros. + elim H1. + intros. + exact (a [=] a0 /\ b [=] b0). Defined. Lemma prodcsetoid_is_CSetoid : forall A B : CSetoid, is_CSetoid (prodT A B) (prod_eq A B) (prod_ap A B). -(* Can be shortened *) -intros A B. -apply (Build_is_CSetoid _ (prod_eq A B) (prod_ap A B)). -move => x. case x. move => c c0 H. -elim H. -move =>H1. -by apply: (ap_irreflexive A _ H1). - -apply (ap_irreflexive B _ ). - -intros x y. case x. case y. -intros c c0 c1 c2 H. -elim H. -intros. -left. -by apply ap_symmetric. - -intros. -right. -by apply ap_symmetric. - -intros x y. case x. case y. -intros c c0 c1 c2 H z. case z. -intros c3 c4. -generalize H. -intros. -elim H. -intros. -cut (c1 [#] c3 or c3 [#] c). -move => [H1|H2]. -left. -by left. - -intros. -right. -by left. -by apply: ap_cotransitive. - -intros. -cut (c2 [#] c4 or c4 [#] c0). -intros [H1|H2]. -left;by right. - -by right;right. - -by apply: ap_cotransitive. - -intros x y. case x. case y. -intros c c0 c1 c2. -split. -intros. -split. -apply not_ap_imp_eq. -move =>H1. by cut (c1 [#] c or c2 [#] c0);[|left]. - -apply not_ap_imp_eq. move =>H1. by cut (c1 [#] c or c2 [#] c0);[|right]. - -intros. -elim H. -intros H0 H1 H2. -by elim H2;apply eq_imp_not_ap. +Proof. + (* Can be shortened *) + intros A B. + apply (Build_is_CSetoid _ (prod_eq A B) (prod_ap A B)). + move => x. case x. move => c c0 H. + elim H. + move =>H1. + by apply: (ap_irreflexive A _ H1). + apply (ap_irreflexive B _ ). + intros x y. case x. case y. + intros c c0 c1 c2 H. + elim H. + intros. + left. + by apply ap_symmetric. + intros. + right. + by apply ap_symmetric. + intros x y. case x. case y. + intros c c0 c1 c2 H z. case z. + intros c3 c4. + generalize H. + intros. + elim H. + intros. + cut (c1 [#] c3 or c3 [#] c). + move => [H1|H2]. + left. + by left. + intros. + right. + by left. + by apply: ap_cotransitive. + intros. + cut (c2 [#] c4 or c4 [#] c0). + intros [H1|H2]. + left;by right. + by right;right. + by apply: ap_cotransitive. + intros x y. case x. case y. + intros c c0 c1 c2. + split. + intros. + split. + apply not_ap_imp_eq. + move =>H1. by cut (c1 [#] c or c2 [#] c0);[|left]. + apply not_ap_imp_eq. move =>H1. by cut (c1 [#] c or c2 [#] c0);[|right]. + intros. + elim H. + intros H0 H1 H2. + by elim H2;apply eq_imp_not_ap. Qed. Definition ProdCSetoid (A B : CSetoid) : CSetoid := Build_CSetoid @@ -458,18 +467,17 @@ Record wd_pred : Type := {wdp_pred :> S -> CProp; wdp_well_def : pred_wd wdp_pred}. -Record CSetoid_predicate : Type := +Record CSetoid_predicate : Type := {csp_pred :> S -> CProp; csp_strext : pred_strong_ext csp_pred}. Lemma csp_wd : forall P : CSetoid_predicate, pred_wd P. -intro P. -intro x; intros y H H0. -elim (csp_strext P x y H). - -auto. - -set (eq_imp_not_ap _ _ _ H0); contradiction. +Proof. + intro P. + intro x; intros y H H0. + elim (csp_strext P x y H). + auto. + set (eq_imp_not_ap _ _ _ H0); contradiction. Qed. (** Similar, with [Prop] instead of [CProp]. *) @@ -486,18 +494,17 @@ End CSetoidPPredicates. (** *** Definition of a setoid predicate *) -Record CSetoid_predicate' : Type := +Record CSetoid_predicate' : Type := {csp'_pred :> S -> Prop; csp'_strext : pred_strong_ext' csp'_pred}. Lemma csp'_wd : forall P : CSetoid_predicate', pred_wd' P. -intro P. -intro x; intros y H H0. -elim (csp'_strext P x y H). - -auto. - -set (eq_imp_not_ap _ _ _ H0); contradiction. +Proof. + intro P. + intro x; intros y H H0. + elim (csp'_strext P x y H). + auto. + set (eq_imp_not_ap _ _ _ H0); contradiction. Qed. (** @@ -522,24 +529,26 @@ Definition rel_strext_rht : CProp := forall x y1 y2 : S, R x y1 -> y1 [#] y2 or Lemma rel_strext_imp_lftarg : rel_strext -> rel_strext_lft. Proof. -intros H x1 x2 y H0. -generalize (H x1 x2 y y). -intros H1. -elim (H1 H0);[|auto]. -intros [H2|H3];[auto|]. -elim (ap_irreflexive S _ H3). + intros H x1 x2 y H0. + generalize (H x1 x2 y y). + intros H1. + elim (H1 H0);[|auto]. + intros [H2|H3];[auto|]. + elim (ap_irreflexive S _ H3). Qed. Lemma rel_strext_imp_rhtarg : rel_strext -> rel_strext_rht. -intros H x y1 y2 H0. -generalize (H x x y1 y2 H0). intros [[H1|H2]|H3]; auto. -elim (ap_irreflexive _ _ H1). +Proof. + intros H x y1 y2 H0. + generalize (H x x y1 y2 H0). intros [[H1|H2]|H3]; auto. + elim (ap_irreflexive _ _ H1). Qed. Lemma rel_strextarg_imp_strext : rel_strext_rht -> rel_strext_lft -> rel_strext. +Proof. intros H H0 x1 x2 y1 y2 H1. -elim (H x1 y1 y2 H1); intro H2;[|elim (H0 x1 x2 y2 H2)];auto. + elim (H x1 y1 y2 H1); intro H2;[|elim (H0 x1 x2 y2 H2)];auto. Qed. @@ -549,7 +558,7 @@ End CsetoidRelations. *** Definition of a setoid relation The type of relations over a setoid. *) -Record CSetoid_relation : Type := +Record CSetoid_relation : Type := {csr_rel :> S -> S -> Prop; csr_wdr : rel_wdr csr_rel; csr_wdl : rel_wdl csr_rel; @@ -579,23 +588,25 @@ Definition Crel_strext_rht : CProp := forall x y1 y2 : S, R x y1 -> R x y2 or y1 Lemma Crel_strext_imp_lftarg : Crel_strext -> Crel_strext_lft. Proof. -intros H x1 x2 y H0. generalize (H x1 x2 y y). -intros [H1|H2];auto. -case H2. auto. intro H3. elim (ap_irreflexive _ _ H3). + intros H x1 x2 y H0. generalize (H x1 x2 y y). + intros [H1|H2];auto. + case H2. auto. intro H3. elim (ap_irreflexive _ _ H3). Qed. Lemma Crel_strext_imp_rhtarg : Crel_strext -> Crel_strext_rht. -intros H x y1 y2 H0. -generalize (H x x y1 y2 H0). intros [H1|H2];auto. -case H2; auto. intro H3. elim (ap_irreflexive _ _ H3). +Proof. + intros H x y1 y2 H0. + generalize (H x x y1 y2 H0). intros [H1|H2];auto. + case H2; auto. intro H3. elim (ap_irreflexive _ _ H3). Qed. Lemma Crel_strextarg_imp_strext : Crel_strext_rht -> Crel_strext_lft -> Crel_strext. -intros H H0 x1 x2 y1 y2 H1. -elim (H x1 y1 y2 H1); auto. -intro H2. -elim (H0 x1 x2 y2 H2); auto. +Proof. + intros H H0 x1 x2 y1 y2 H1. + elim (H x1 y1 y2 H1); auto. + intro H2. + elim (H0 x1 x2 y2 H2); auto. Qed. End CCsetoidRelations. @@ -605,42 +616,42 @@ End CCsetoidRelations. The type of relations over a setoid. *) -Record CCSetoid_relation : Type := +Record CCSetoid_relation : Type := {Ccsr_rel :> S -> S -> CProp; Ccsr_strext : Crel_strext Ccsr_rel}. Lemma Ccsr_wdr : forall R : CCSetoid_relation, Crel_wdr R. -intro R. -intros x y z H H0. -elim (Ccsr_strext R x x y z H);auto. - -intros [H1|H2]. elim (ap_irreflexive _ _ H1). -set (eq_imp_not_ap _ _ _ H0). contradiction. +Proof. + intro R. + intros x y z H H0. + elim (Ccsr_strext R x x y z H);auto. + intros [H1|H2]. elim (ap_irreflexive _ _ H1). + set (eq_imp_not_ap _ _ _ H0). contradiction. Qed. Lemma Ccsr_wdl : forall R : CCSetoid_relation, Crel_wdl R. -intros R x y z H H0. -elim (Ccsr_strext R x z y y H);auto. - -intros [H1|H2]; [set (eq_imp_not_ap _ _ _ H0); contradiction| elim (ap_irreflexive _ _ H2)]. +Proof. + intros R x y z H H0. + elim (Ccsr_strext R x z y y H);auto. + intros [H1|H2]; [set (eq_imp_not_ap _ _ _ H0); contradiction| elim (ap_irreflexive _ _ H2)]. Qed. Lemma ap_wdr : Crel_wdr (cs_ap (c:=S)). -intros x y z H H0. -generalize (eq_imp_not_ap _ _ _ H0); intro H1. -elim (ap_cotransitive _ _ _ H z); intro H2. - -assumption. - -elim H1. -by apply: ap_symmetric. +Proof. + intros x y z H H0. + generalize (eq_imp_not_ap _ _ _ H0); intro H1. + elim (ap_cotransitive _ _ _ H z); intro H2. + assumption. + elim H1. + by apply: ap_symmetric. Qed. Lemma ap_wdl : Crel_wdl (cs_ap (c:=S)). -intros x y z H H0. -generalize (ap_wdr y x z); intro H1. -apply ap_symmetric. -by apply H1;[apply ap_symmetric|]. +Proof. + intros x y z H H0. + generalize (ap_wdr y x z); intro H1. + apply ap_symmetric. + by apply H1;[apply ap_symmetric|]. Qed. Lemma ap_wdr_unfolded : forall x y z : S, x [#] y -> y [=] z -> x [#] z. @@ -650,12 +661,12 @@ Lemma ap_wdl_unfolded : forall x y z : S, x [#] y -> x [=] z -> z [#] y. Proof ap_wdl. Lemma ap_strext : Crel_strext (cs_ap (c:=S)). -intros x1 x2 y1 y2 H. -case (ap_cotransitive _ _ _ H x2); intro H0;auto. -case (ap_cotransitive _ _ _ H0 y2); intro H1;auto. - -right; right. -by apply ap_symmetric. +Proof. + intros x1 x2 y1 y2 H. + case (ap_cotransitive _ _ _ H x2); intro H0;auto. + case (ap_cotransitive _ _ _ H0 y2); intro H1;auto. + right; right. + by apply ap_symmetric. Qed. Definition predS_well_def (P : S -> CProp) : CProp := forall x y : S, @@ -696,31 +707,34 @@ Definition fun_wd : Prop := forall x y : S1, x [=] y -> f x [=] f y. Definition fun_strext : CProp := forall x y : S1, f x [#] f y -> x [#] y. Lemma fun_strext_imp_wd : fun_strext -> fun_wd. -intros H x y H0. -apply not_ap_imp_eq. -intro H1. -generalize (H _ _ H1); intro H2. -generalize (eq_imp_not_ap _ _ _ H0). by apply. +Proof. + intros H x y H0. + apply not_ap_imp_eq. + intro H1. + generalize (H _ _ H1); intro H2. + generalize (eq_imp_not_ap _ _ _ H0). by apply. Qed. End unary_functions. -Record CSetoid_fun : Type := +Record CSetoid_fun : Type := {csf_fun :> S1 -> S2; csf_strext : fun_strext csf_fun}. Lemma csf_wd : forall f : CSetoid_fun, fun_wd f. -intro f. -apply fun_strext_imp_wd. -apply csf_strext. +Proof. + intro f. + apply fun_strext_imp_wd. + apply csf_strext. Qed. Lemma csf_wd_unfolded: forall (f : CSetoid_fun) (x y : S1), x[=]y -> f x[=]f y. Proof csf_wd. Definition Const_CSetoid_fun : S2 -> CSetoid_fun. -intro c; apply (Build_CSetoid_fun (fun x : S1 => c)); intros x y H. -elim (ap_irreflexive _ _ H). +Proof. + intro c; apply (Build_CSetoid_fun (fun x : S1 => c)); intros x y H. + elim (ap_irreflexive _ _ H). Defined. Section binary_functions. @@ -739,25 +753,26 @@ Definition bin_fun_strext : CProp := forall x1 x2 y1 y2, f x1 y1 [#] f x2 y2 -> x1 [#] x2 or y1 [#] y2. Lemma bin_fun_strext_imp_wd : bin_fun_strext -> bin_fun_wd. -intros H x1 x2 y1 y2 H0 H1. -apply not_ap_imp_eq. -intro H2. -generalize (H _ _ _ _ H2); intro H3. -elim H3; intro H4. - -by set (eq_imp_not_ap _ _ _ H0). -by set (eq_imp_not_ap _ _ _ H1). +Proof. + intros H x1 x2 y1 y2 H0 H1. + apply not_ap_imp_eq. + intro H2. + generalize (H _ _ _ _ H2); intro H3. + elim H3; intro H4. + by set (eq_imp_not_ap _ _ _ H0). + by set (eq_imp_not_ap _ _ _ H1). Qed. End binary_functions. -Record CSetoid_bin_fun : Type := +Record CSetoid_bin_fun : Type := {csbf_fun :> S1 -> S2 -> S3; csbf_strext : bin_fun_strext csbf_fun}. Lemma csbf_wd : forall f : CSetoid_bin_fun, bin_fun_wd f. -intro f. apply: bin_fun_strext_imp_wd. -apply csbf_strext. +Proof. + intro f. apply: bin_fun_strext_imp_wd. + apply csbf_strext. Qed. Lemma csbf_wd_unfolded : forall (f : CSetoid_bin_fun) (x x' : S1) (y y' : S2), @@ -765,37 +780,37 @@ Lemma csbf_wd_unfolded : forall (f : CSetoid_bin_fun) (x x' : S1) (y y' : S2), Proof csbf_wd. Lemma csf_strext_unfolded : forall (f : CSetoid_fun) (x y : S1), f x [#] f y -> x [#] y. -Proof csf_strext. +Proof csf_strext. End CSetoid_functions. Lemma bin_fun_is_wd_fun_lft : forall S1 S2 S3 (f : CSetoid_bin_fun S1 S2 S3) (c : S2), fun_wd _ _ (fun x : S1 => f x c). Proof. -intros S1 S2 S3 f c x y H. -by apply csbf_wd; [|apply eq_reflexive]. + intros S1 S2 S3 f c x y H. + by apply csbf_wd; [|apply eq_reflexive]. Qed. Lemma bin_fun_is_wd_fun_rht : forall S1 S2 S3 (f : CSetoid_bin_fun S1 S2 S3) (c : S1), fun_wd _ _ (fun x : S2 => f c x). Proof. -intros S1 S2 S3 f c x y H. by apply csbf_wd; [apply eq_reflexive|]. + intros S1 S2 S3 f c x y H. by apply csbf_wd; [apply eq_reflexive|]. Qed. Lemma bin_fun_is_strext_fun_lft : forall S1 S2 S3 (f : CSetoid_bin_fun S1 S2 S3) (c : S2), fun_strext _ _ (fun x : S1 => f x c). Proof. -intros S1 S2 S3 f c x y H. cut (x [#] y or c [#] c). intros [H1|H2];auto. -by set (ap_irreflexive _ c H2). -eapply csbf_strext. apply H. + intros S1 S2 S3 f c x y H. cut (x [#] y or c [#] c). intros [H1|H2];auto. + by set (ap_irreflexive _ c H2). + eapply csbf_strext. apply H. Defined. Lemma bin_fun_is_strext_fun_rht : forall S1 S2 S3 (f : CSetoid_bin_fun S1 S2 S3) (c : S1), fun_strext _ _ (fun x : S2 => f c x). Proof. -intros S1 S2 S3 op c x y H. cut (c [#] c or x [#] y). intro Hv. elim Hv. intro Hf. -generalize (ap_irreflexive _ c Hf). tauto. auto. -eapply csbf_strext. apply H. + intros S1 S2 S3 op c x y H. cut (c [#] c or x [#] y). intro Hv. elim Hv. intro Hf. + generalize (ap_irreflexive _ c Hf). tauto. auto. + eapply csbf_strext. apply H. Defined. Definition bin_fun2fun_rht (S1 S2 S3:CSetoid) (f : CSetoid_bin_fun S1 S2 S3) (c : S1) : CSetoid_fun S2 S3 := @@ -844,11 +859,13 @@ Definition CSetoid_un_op := CSetoid_fun S S. Definition Build_CSetoid_un_op := Build_CSetoid_fun S S. Lemma id_strext : un_op_strext (fun x : S => x). -by[]. +Proof. + by[]. Qed. Lemma id_pres_eq : un_op_wd (fun x : S => x). -by[]. Qed. +Proof. + by[]. Qed. Definition id_un_op := Build_CSetoid_un_op (fun x : S => x) id_strext. @@ -876,13 +893,13 @@ Identity Coercion bin_op_bin_fun : CSetoid_bin_op >-> CSetoid_bin_fun. Lemma bin_op_is_wd_un_op_lft : forall (op : CSetoid_bin_op) (c : S), un_op_wd (fun x : S => op x c). Proof. -apply bin_fun_is_wd_fun_lft. + apply bin_fun_is_wd_fun_lft. Qed. Lemma bin_op_is_wd_un_op_rht : forall (op : CSetoid_bin_op) (c : S), un_op_wd (fun x : S => op c x). Proof. -apply bin_fun_is_wd_fun_rht. + apply bin_fun_is_wd_fun_rht. Qed. Lemma bin_op_is_strext_un_op_lft : forall (op : CSetoid_bin_op) (c : S), @@ -965,7 +982,7 @@ Section SubCSetoids. Variable S : CSetoid. Variable P : S -> CProp. -Record subcsetoid_crr : Type := +Record subcsetoid_crr : Type := {scs_elem :> S; scs_prf : P scs_elem}. @@ -993,35 +1010,37 @@ Definition subcsetoid_ap : Crelation subcsetoid_crr := Crestrict_relation (cs_ap (c:=S)). Remark subcsetoid_equiv : Tequiv _ subcsetoid_eq. -split. -(* reflexive *) -intros a; case a. -intros x s. apply (eq_reflexive S). -(* transitive *) -split. -intros a b c; case a. -intros x s; case b. -intros y t; case c. -intros z u. apply eq_transitive. -(* symmetric *) -intros a b; case a. -intros x s; case b. -intros y t. apply eq_symmetric. +Proof. + split. + (* reflexive *) + intros a; case a. + intros x s. apply (eq_reflexive S). + (* transitive *) + split. + intros a b c; case a. + intros x s; case b. + intros y t; case c. + intros z u. apply eq_transitive. + (* symmetric *) + intros a b; case a. + intros x s; case b. + intros y t. apply eq_symmetric. Qed. Lemma subcsetoid_is_CSetoid : is_CSetoid _ subcsetoid_eq subcsetoid_ap. -apply (Build_is_CSetoid _ subcsetoid_eq subcsetoid_ap). -(* irreflexive *) -intro x. case x. intros. apply ap_irreflexive. -(* symmetric *) -intros x y. case x. case y. intros. -exact (ap_symmetric S _ _ X). -(* cotransitive *) -intros x y. case x. case y. intros; case z. intros. -exact (ap_cotransitive S _ _ X scs_elem2). -(* tight *) -intros x y. case x. case y. intros. -exact (ap_tight S scs_elem1 scs_elem0). +Proof. + apply (Build_is_CSetoid _ subcsetoid_eq subcsetoid_ap). + (* irreflexive *) + intro x. case x. intros. apply ap_irreflexive. + (* symmetric *) + intros x y. case x. case y. intros. + exact (ap_symmetric S _ _ X). + (* cotransitive *) + intros x y. case x. case y. intros; case z. intros. + exact (ap_cotransitive S _ _ X scs_elem2). + (* tight *) + intros x y. case x. case y. intros. + exact (ap_tight S scs_elem1 scs_elem0). Qed. Definition Build_SubCSetoid : CSetoid := Build_CSetoid @@ -1051,11 +1070,13 @@ Definition restr_un_op (a : subcsetoid_crr) : subcsetoid_crr := end. Lemma restr_un_op_wd : un_op_wd Build_SubCSetoid restr_un_op. -intros x y. case y. case x. intros. by apply: (csf_wd _ _ f). +Proof. + intros x y. case y. case x. intros. by apply: (csf_wd _ _ f). Qed. Lemma restr_un_op_strext : un_op_strext Build_SubCSetoid restr_un_op. -intros x y. case y. case x. intros. exact (cs_un_op_strext _ f _ _ X). +Proof. + intros x y. case y. case x. intros. exact (cs_un_op_strext _ f _ _ X). Qed. Definition Build_SubCSetoid_un_op : CSetoid_un_op Build_SubCSetoid := @@ -1092,13 +1113,15 @@ Definition restr_bin_op (a b : subcsetoid_crr) : subcsetoid_crr := end. Lemma restr_bin_op_well_def : bin_op_wd Build_SubCSetoid restr_bin_op. -intros x1 x2 y1 y2. case y2. case y1. case x2. case x1. intros. - exact (cs_bin_op_wd _ f _ _ _ _ H H0). +Proof. + intros x1 x2 y1 y2. case y2. case y1. case x2. case x1. intros. + exact (cs_bin_op_wd _ f _ _ _ _ H H0). Qed. Lemma restr_bin_op_strext : bin_op_strext Build_SubCSetoid restr_bin_op. -intros x1 x2 y1 y2. case y2. case y1. case x2. case x1. intros. - exact (cs_bin_op_strext _ f _ _ _ _ X). +Proof. + intros x1 x2 y1 y2. case y2. case y1. case x2. case x1. intros. + exact (cs_bin_op_strext _ f _ _ _ _ X). Qed. Definition Build_SubCSetoid_bin_op : CSetoid_bin_op Build_SubCSetoid := @@ -1106,7 +1129,8 @@ Definition Build_SubCSetoid_bin_op : CSetoid_bin_op Build_SubCSetoid := Lemma restr_f_assoc : associative f -> associative Build_SubCSetoid_bin_op. -intros assf x y z. case z. case y. case x. intros. apply: assf. +Proof. + intros assf x y z. case z. case y. case x. intros. apply: assf. Qed. @@ -1127,21 +1151,22 @@ Tactic Notation "Step_final" constr(c) := Step_final c. Lemma proper_caseZ_diff_CS : forall (S : CSetoid) (f : nat -> nat -> S), (forall m n p q : nat, m + q = n + p -> f m n [=] f p q) -> forall m n : nat, caseZ_diff (m - n) f [=] f m n. -intro CS. intros. -pattern m, n in |- *. -apply nat_double_ind. - intro. replace (0%nat - n0)%Z with (- n0)%Z;auto. rewrite caseZ_diff_Neg; reflexivity. - intros. replace (S n0 - 0%nat)%Z with (S n0:Z);auto. rewrite caseZ_diff_Pos; reflexivity. -intros. generalize (H (S n0) (S m0) n0 m0); intro. -cut (S n0 + m0 = S m0 + n0). - intro. generalize (H1 H2); intro. - apply eq_transitive with (f n0 m0). - apply eq_transitive with (caseZ_diff (n0 - m0) f);auto. - replace (S n0 - S m0)%Z with (n0 - m0)%Z. - apply eq_reflexive. - repeat rewrite Znat.inj_S; clear H1; auto with zarith. - by apply eq_symmetric. -clear H1; auto with zarith. +Proof. + intro CS. intros. + pattern m, n in |- *. + apply nat_double_ind. + intro. replace (0%nat - n0)%Z with (- n0)%Z;auto. rewrite caseZ_diff_Neg; reflexivity. + intros. replace (S n0 - 0%nat)%Z with (S n0:Z);auto. rewrite caseZ_diff_Pos; reflexivity. + intros. generalize (H (S n0) (S m0) n0 m0); intro. + cut (S n0 + m0 = S m0 + n0). + intro. generalize (H1 H2); intro. + apply eq_transitive with (f n0 m0). + apply eq_transitive with (caseZ_diff (n0 - m0) f);auto. + replace (S n0 - S m0)%Z with (n0 - m0)%Z. + apply eq_reflexive. + repeat rewrite Znat.inj_S; clear H1; auto with zarith. + by apply eq_symmetric. + clear H1; auto with zarith. Qed. (** @@ -1164,11 +1189,13 @@ Add Parametric Relation c : (cs_crr c) (@cs_eq c) as CSetoid_eq_Setoid. Add Parametric Morphism (c1 c2 c3 : CSetoid) f: (csbf_fun c1 c2 c3 f) with signature (@cs_eq c1) ==> (@cs_eq c2) ==> (@cs_eq c3) as csbf_fun_wd. -intros x1 x2 Hx y1 y2 Hy. -by apply csbf_wd. +Proof. + intros x1 x2 Hx y1 y2 Hy. + by apply csbf_wd. Qed. Add Parametric Morphism (c1 c2 : CSetoid) f: (@csf_fun c1 c2 f) with signature (@cs_eq c1) ==> (@cs_eq c2) as csf_fun_wd. -intros x1 x2 Hx. -by apply csf_wd. -Qed. \ No newline at end of file +Proof. + intros x1 x2 Hx. + by apply csf_wd. +Qed. diff --git a/algebra/CSums.v b/algebra/CSums.v index 540606aff..3c8ec31bd 100644 --- a/algebra/CSums.v +++ b/algebra/CSums.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Sum0 %\ensuremath{\sum_0}% #∑0# *) (** printing Sum1 %\ensuremath{\sum_1}% #∑1# *) @@ -73,28 +73,31 @@ It is sometimes useful to view a function defined on $\{0,\ldots,i-1\}$ *) Definition part_tot_nat_fun n (f : forall i, i < n -> G) : nat -> G. -intros n f i. -elim (le_lt_dec n i). - intro a; apply (Zero:G). -intro b; apply (f i b). +Proof. + intros n f i. + elim (le_lt_dec n i). + intro a; apply (Zero:G). + intro b; apply (f i b). Defined. Lemma part_tot_nat_fun_ch1 : forall n (f : forall i, i < n -> G), nat_less_n_fun f -> forall i Hi, part_tot_nat_fun n f i [=] f i Hi. -intros n f Hf i Hi. -unfold part_tot_nat_fun in |- *. -elim le_lt_dec; intro. - elimtype False; apply (le_not_lt n i); auto. -simpl in |- *; apply Hf; auto. +Proof. + intros n f Hf i Hi. + unfold part_tot_nat_fun in |- *. + elim le_lt_dec; intro. + elimtype False; apply (le_not_lt n i); auto. + simpl in |- *; apply Hf; auto. Qed. Lemma part_tot_nat_fun_ch2 : forall n (f : forall i, i < n -> G) i, n <= i -> part_tot_nat_fun n f i [=] Zero. -intros n f i Hi. -unfold part_tot_nat_fun in |- *. -elim le_lt_dec; intro. - simpl in |- *; algebra. -elimtype False; apply (le_not_lt n i); auto. +Proof. + intros n f i Hi. + unfold part_tot_nat_fun in |- *. + elim le_lt_dec; intro. + simpl in |- *; algebra. + elimtype False; apply (le_not_lt n i); auto. Qed. (** [Sum0] defines the sum for [i=0..(n-1)] *) @@ -116,84 +119,91 @@ Definition Sum m n : (nat -> G) -> G := Sum1 m (S n). defined outside where it is being added. *) Definition Sum2 m n (h : forall i : nat, m <= i -> i <= n -> G) : G. -intros m n h. -apply (Sum m n). -intro i. -elim (le_lt_dec m i); intro H. - elim (le_lt_dec i n); intro H0. - apply (h i H H0). +Proof. + intros m n h. + apply (Sum m n). + intro i. + elim (le_lt_dec m i); intro H. + elim (le_lt_dec i n); intro H0. + apply (h i H H0). + apply (Zero:G). apply (Zero:G). -apply (Zero:G). Defined. Lemma Sum_one : forall n f, Sum n n f [=] f n. -intros n f. -unfold Sum in |- *. -unfold Sum1 in |- *. -simpl in |- *. -Step_final (f n[+]Sum0 n f[-]Sum0 n f). +Proof. + intros n f. + unfold Sum in |- *. + unfold Sum1 in |- *. + simpl in |- *. + Step_final (f n[+]Sum0 n f[-]Sum0 n f). Qed. Hint Resolve Sum_one: algebra. Lemma Sum_empty : forall n f, 0 < n -> Sum n (pred n) f [=] Zero. -intros n f H. -unfold Sum in |- *. -rewrite <- (S_pred _ _ H). -unfold Sum1 in |- *; algebra. +Proof. + intros n f H. + unfold Sum in |- *. + rewrite <- (S_pred _ _ H). + unfold Sum1 in |- *; algebra. Qed. Hint Resolve Sum_empty: algebra. Lemma Sum_Sum : forall l m n f, Sum l m f[+]Sum (S m) n f [=] Sum l n f. -intros l m n f. -unfold Sum in |- *. -unfold Sum1 in |- *. -astepl (Sum0 (S n) f[-]Sum0 (S m) f[+] (Sum0 (S m) f[-]Sum0 l f)). -astepl (Sum0 (S n) f[-]Sum0 (S m) f[+]Sum0 (S m) f[-]Sum0 l f). -astepl (Sum0 (S n) f[-] (Sum0 (S m) f[-]Sum0 (S m) f) [-]Sum0 l f). -astepl (Sum0 (S n) f[-]Zero[-]Sum0 l f). -astepl (Sum0 (S n) f[+] [--]Zero[-]Sum0 l f). -Step_final (Sum0 (S n) f[+]Zero[-]Sum0 l f). +Proof. + intros l m n f. + unfold Sum in |- *. + unfold Sum1 in |- *. + astepl (Sum0 (S n) f[-]Sum0 (S m) f[+] (Sum0 (S m) f[-]Sum0 l f)). + astepl (Sum0 (S n) f[-]Sum0 (S m) f[+]Sum0 (S m) f[-]Sum0 l f). + astepl (Sum0 (S n) f[-] (Sum0 (S m) f[-]Sum0 (S m) f) [-]Sum0 l f). + astepl (Sum0 (S n) f[-]Zero[-]Sum0 l f). + astepl (Sum0 (S n) f[+] [--]Zero[-]Sum0 l f). + Step_final (Sum0 (S n) f[+]Zero[-]Sum0 l f). Qed. Hint Resolve Sum_Sum: algebra. Lemma Sum_first : forall m n f, Sum m n f [=] f m[+]Sum (S m) n f. -intros m n f. -unfold Sum in |- *. -unfold Sum1 in |- *. -astepr (f m[+]Sum0 (S n) f[-]Sum0 (S m) f). -astepr (Sum0 (S n) f[+]f m[-]Sum0 (S m) f). -astepr (Sum0 (S n) f[+] (f m[-]Sum0 (S m) f)). -unfold cg_minus in |- *. -apply bin_op_wd_unfolded. -algebra. -simpl in |- *. -astepr (f m[+] [--] (f m[+]Sum0 m f)). -astepr (f m[+] ([--] (f m) [+] [--] (Sum0 m f))). -astepr (f m[+] [--] (f m) [+] [--] (Sum0 m f)). -astepr (Zero[+] [--] (Sum0 m f)). -algebra. +Proof. + intros m n f. + unfold Sum in |- *. + unfold Sum1 in |- *. + astepr (f m[+]Sum0 (S n) f[-]Sum0 (S m) f). + astepr (Sum0 (S n) f[+]f m[-]Sum0 (S m) f). + astepr (Sum0 (S n) f[+] (f m[-]Sum0 (S m) f)). + unfold cg_minus in |- *. + apply bin_op_wd_unfolded. + algebra. + simpl in |- *. + astepr (f m[+] [--] (f m[+]Sum0 m f)). + astepr (f m[+] ([--] (f m) [+] [--] (Sum0 m f))). + astepr (f m[+] [--] (f m) [+] [--] (Sum0 m f)). + astepr (Zero[+] [--] (Sum0 m f)). + algebra. Qed. Lemma Sum_last : forall m n f, Sum m (S n) f [=] Sum m n f[+]f (S n). -intros m n f. -unfold Sum in |- *. -unfold Sum1 in |- *. -simpl in |- *. -unfold cg_minus in |- *. -astepl (Sum0 n f[+]f n[+] (f (S n) [+] [--] (Sum0 m f))). -astepr (Sum0 n f[+]f n[+] ([--] (Sum0 m f) [+]f (S n))). -algebra. +Proof. + intros m n f. + unfold Sum in |- *. + unfold Sum1 in |- *. + simpl in |- *. + unfold cg_minus in |- *. + astepl (Sum0 n f[+]f n[+] (f (S n) [+] [--] (Sum0 m f))). + astepr (Sum0 n f[+]f n[+] ([--] (Sum0 m f) [+]f (S n))). + algebra. Qed. Hint Resolve Sum_last: algebra. Lemma Sum_last' : forall m n f, 0 < n -> Sum m n f [=] Sum m (pred n) f[+]f n. -intros m n f H. induction n as [| n Hrecn]. +Proof. + intros m n f H. induction n as [| n Hrecn]. elim (lt_irrefl 0 H). -apply Sum_last. + apply Sum_last. Qed. (** @@ -202,209 +212,211 @@ when working with integration. *) Lemma Sum0_strext : forall f g n, Sum0 n f [#] Sum0 n g -> {i:nat | i < n | f i [#] g i}. -intros f g n H. -induction n as [| n Hrecn]. +Proof. + intros f g n H. + induction n as [| n Hrecn]. + simpl in H. + elim (ap_irreflexive_unfolded _ _ H). simpl in H. - elim (ap_irreflexive_unfolded _ _ H). -simpl in H. -cut ({i : nat | i < n | f i [#] g i} or f n [#] g n). -intro H0. -elim H0; intro H1. - elim H1; intros i H2 H3; exists i; auto with arith. -exists n; auto with arith. - -cut (Sum0 n f [#] Sum0 n g or f n [#] g n). -intro H0; elim H0; intro H1. - left; apply Hrecn; assumption. -auto. - -apply bin_op_strext_unfolded with (csg_op (c:=G)). -assumption. + cut ({i : nat | i < n | f i [#] g i} or f n [#] g n). + intro H0. + elim H0; intro H1. + elim H1; intros i H2 H3; exists i; auto with arith. + exists n; auto with arith. + cut (Sum0 n f [#] Sum0 n g or f n [#] g n). + intro H0; elim H0; intro H1. + left; apply Hrecn; assumption. + auto. + apply bin_op_strext_unfolded with (csg_op (c:=G)). + assumption. Qed. Lemma Sum_strext : forall f g m n, m <= S n -> Sum m n f [#] Sum m n g -> {i : nat | m <= i /\ i <= n | f i [#] g i}. -intros f g m n H H0. -induction n as [| n Hrecn]. - elim (le_lt_eq_dec _ _ H); intro H2. - cut (m = 0). - intro H1. - rewrite H1; exists 0; auto. - rewrite H1 in H0. - astepl (Sum 0 0 f); astepr (Sum 0 0 g); assumption. - - inversion H2; [ auto | inversion H3 ]. +Proof. + intros f g m n H H0. + induction n as [| n Hrecn]. + elim (le_lt_eq_dec _ _ H); intro H2. + cut (m = 0). + intro H1. + rewrite H1; exists 0; auto. + rewrite H1 in H0. + astepl (Sum 0 0 f); astepr (Sum 0 0 g); assumption. + inversion H2; [ auto | inversion H3 ]. + elimtype False. + cut (0 = pred 1); [ intro H3 | auto ]. + rewrite H3 in H0. + rewrite H2 in H0. + apply (ap_irreflexive_unfolded G Zero). + eapply ap_wdl_unfolded. + eapply ap_wdr_unfolded. + apply H0. + apply Sum_empty; auto. + apply Sum_empty; auto. + elim (le_lt_eq_dec _ _ H); intro Hmn. + cut (Sum m n f [#] Sum m n g or f (S n) [#] g (S n)). + intro H1; elim H1; intro H2. + cut {i : nat | m <= i /\ i <= n | f i [#] g i}. + intro H3; elim H3; intros i H4 H5; elim H4; intros H6 H7; clear H1 H4. + exists i; try split; auto with arith. + apply Hrecn; auto with arith. + exists (S n); try split; auto with arith. + apply bin_op_strext_unfolded with (csg_op (c:=G)). + astepl (Sum m (S n) f); astepr (Sum m (S n) g); assumption. + clear Hrecn. elimtype False. - cut (0 = pred 1); [ intro H3 | auto ]. - rewrite H3 in H0. - rewrite H2 in H0. + cut (S n = pred (S (S n))); [ intro H1 | auto ]. + rewrite H1 in H0. + rewrite Hmn in H0. apply (ap_irreflexive_unfolded G Zero). eapply ap_wdl_unfolded. eapply ap_wdr_unfolded. apply H0. - apply Sum_empty; auto. - apply Sum_empty; auto. -elim (le_lt_eq_dec _ _ H); intro Hmn. - cut (Sum m n f [#] Sum m n g or f (S n) [#] g (S n)). - intro H1; elim H1; intro H2. - cut {i : nat | m <= i /\ i <= n | f i [#] g i}. - intro H3; elim H3; intros i H4 H5; elim H4; intros H6 H7; clear H1 H4. - exists i; try split; auto with arith. - - apply Hrecn; auto with arith. - exists (S n); try split; auto with arith. - - apply bin_op_strext_unfolded with (csg_op (c:=G)). - astepl (Sum m (S n) f); astepr (Sum m (S n) g); assumption. -clear Hrecn. -elimtype False. -cut (S n = pred (S (S n))); [ intro H1 | auto ]. -rewrite H1 in H0. -rewrite Hmn in H0. -apply (ap_irreflexive_unfolded G Zero). -eapply ap_wdl_unfolded. - eapply ap_wdr_unfolded. - apply H0. + apply Sum_empty; auto with arith. apply Sum_empty; auto with arith. -apply Sum_empty; auto with arith. Qed. Lemma Sumx_strext : forall n f g, nat_less_n_fun f -> nat_less_n_fun g -> Sumx _ f [#] Sumx _ g -> {N : nat | {HN : N < n | f N HN [#] g N HN}}. -intro n; induction n as [| n Hrecn]. -intros f g H H0 H1. -elim (ap_irreflexive_unfolded _ _ H1). -intros f g H H0 H1. -simpl in H1. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H1); clear H1; intro H1. - cut (nat_less_n_fun (fun (i : nat) (l : i < n) => f i (lt_S _ _ l))); - [ intro H2 | red in |- *; intros; apply H; assumption ]. - cut (nat_less_n_fun (fun (i : nat) (l : i < n) => g i (lt_S _ _ l))); - [ intro H3 | red in |- *; intros; apply H0; assumption ]. - elim (Hrecn _ _ H2 H3 H1); intros N HN. - elim HN; clear HN; intros HN H'. - exists N. exists (lt_S _ _ HN). +Proof. + intro n; induction n as [| n Hrecn]. + intros f g H H0 H1. + elim (ap_irreflexive_unfolded _ _ H1). + intros f g H H0 H1. + simpl in H1. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H1); clear H1; intro H1. + cut (nat_less_n_fun (fun (i : nat) (l : i < n) => f i (lt_S _ _ l))); + [ intro H2 | red in |- *; intros; apply H; assumption ]. + cut (nat_less_n_fun (fun (i : nat) (l : i < n) => g i (lt_S _ _ l))); + [ intro H3 | red in |- *; intros; apply H0; assumption ]. + elim (Hrecn _ _ H2 H3 H1); intros N HN. + elim HN; clear HN; intros HN H'. + exists N. exists (lt_S _ _ HN). + eapply ap_wdl_unfolded. + eapply ap_wdr_unfolded. + apply H'. + algebra. + algebra. + exists n. exists (lt_n_Sn n). eapply ap_wdl_unfolded. eapply ap_wdr_unfolded. - apply H'. + apply H1. algebra. algebra. -exists n. exists (lt_n_Sn n). -eapply ap_wdl_unfolded. - eapply ap_wdr_unfolded. - apply H1. - algebra. -algebra. Qed. Lemma Sum0_strext' : forall f g n, Sum0 n f [#] Sum0 n g -> {i : nat | f i [#] g i}. -intros f g n H. -elim (Sum0_strext _ _ _ H); intros i Hi Hi'; exists i; auto. +Proof. + intros f g n H. + elim (Sum0_strext _ _ _ H); intros i Hi Hi'; exists i; auto. Qed. Lemma Sum_strext' : forall f g m n, Sum m n f [#] Sum m n g -> {i : nat | f i [#] g i}. -intros f g m n H. -unfold Sum, Sum1 in H. -elim (cg_minus_strext _ _ _ _ _ H); intro H1; elim (Sum0_strext _ _ _ H1); - intros i Hi Hi'; exists i; assumption. +Proof. + intros f g m n H. + unfold Sum, Sum1 in H. + elim (cg_minus_strext _ _ _ _ _ H); intro H1; elim (Sum0_strext _ _ _ H1); + intros i Hi Hi'; exists i; assumption. Qed. Lemma Sum0_wd : forall m f f', (forall i, f i [=] f' i) -> Sum0 m f [=] Sum0 m f'. -intros m f f' H. -elim m; simpl in |- *; algebra. +Proof. + intros m f f' H. + elim m; simpl in |- *; algebra. Qed. Lemma Sum_wd : forall m n f f', (forall i, f i [=] f' i) -> Sum m n f [=] Sum m n f'. -intros m n f f' H. -unfold Sum in |- *. -unfold Sum1 in |- *. -unfold cg_minus in |- *. -apply bin_op_wd_unfolded. +Proof. + intros m n f f' H. + unfold Sum in |- *. + unfold Sum1 in |- *. + unfold cg_minus in |- *. + apply bin_op_wd_unfolded. + apply Sum0_wd; exact H. + apply un_op_wd_unfolded. apply Sum0_wd; exact H. -apply un_op_wd_unfolded. -apply Sum0_wd; exact H. Qed. Lemma Sumx_wd : forall n f g, (forall i H, f i H [=] g i H) -> Sumx n f [=] Sumx n g. -intro n; elim n; intros; simpl in |- *; algebra. +Proof. + intro n; elim n; intros; simpl in |- *; algebra. Qed. Lemma Sum_wd' : forall m n, m <= S n -> forall f f', (forall i, m <= i -> i <= n -> f i [=] f' i) -> Sum m n f [=] Sum m n f'. -intros m n. induction n as [| n Hrecn]; intros H f f' H0. +Proof. + intros m n. induction n as [| n Hrecn]; intros H f f' H0. inversion H. - unfold Sum in |- *. unfold Sum1 in |- *. Step_final (Zero:G). - inversion H2. astepl (f 0). astepr (f' 0). auto. -elim (le_lt_eq_dec m (S (S n)) H); intro H1. - astepl (Sum m n f[+]f (S n)). - astepr (Sum m n f'[+]f' (S n)). - apply bin_op_wd_unfolded; auto with arith. -rewrite H1. -unfold Sum in |- *. unfold Sum1 in |- *. Step_final (Zero:G). + unfold Sum in |- *. unfold Sum1 in |- *. Step_final (Zero:G). + inversion H2. astepl (f 0). astepr (f' 0). auto. + elim (le_lt_eq_dec m (S (S n)) H); intro H1. + astepl (Sum m n f[+]f (S n)). + astepr (Sum m n f'[+]f' (S n)). + apply bin_op_wd_unfolded; auto with arith. + rewrite H1. + unfold Sum in |- *. unfold Sum1 in |- *. Step_final (Zero:G). Qed. Lemma Sum2_wd : forall m n, m <= S n -> forall f g, (forall i Hm Hn, f i Hm Hn [=] g i Hm Hn) -> Sum2 m n f [=] Sum2 m n g. -intros m n H f g H0. -unfold Sum2 in |- *. -apply Sum_wd'. - assumption. -intros i H1 H2. -elim le_lt_dec; intro H3; - [ simpl in |- * | elimtype False; apply (le_not_lt i n); auto ]. -elim le_lt_dec; intro H4; - [ simpl in |- * | elimtype False; apply (le_not_lt m i); auto ]. -algebra. +Proof. + intros m n H f g H0. + unfold Sum2 in |- *. + apply Sum_wd'. + assumption. + intros i H1 H2. + elim le_lt_dec; intro H3; [ simpl in |- * | elimtype False; apply (le_not_lt i n); auto ]. + elim le_lt_dec; intro H4; [ simpl in |- * | elimtype False; apply (le_not_lt m i); auto ]. + algebra. Qed. Lemma Sum0_plus_Sum0 : forall f g m, Sum0 m (fun i => f i[+]g i) [=] Sum0 m f[+]Sum0 m g. -intros f g m. -elim m. - simpl in |- *; algebra. -intros n H. -simpl in |- *. -astepl (Sum0 n f[+]Sum0 n g[+] (f n[+]g n)). -astepl (Sum0 n f[+] (Sum0 n g[+] (f n[+]g n))). -astepl (Sum0 n f[+] (Sum0 n g[+]f n[+]g n)). -astepl (Sum0 n f[+] (f n[+]Sum0 n g[+]g n)). -astepl (Sum0 n f[+] (f n[+]Sum0 n g) [+]g n). -Step_final (Sum0 n f[+]f n[+]Sum0 n g[+]g n). +Proof. + intros f g m. + elim m. + simpl in |- *; algebra. + intros n H. + simpl in |- *. + astepl (Sum0 n f[+]Sum0 n g[+] (f n[+]g n)). + astepl (Sum0 n f[+] (Sum0 n g[+] (f n[+]g n))). + astepl (Sum0 n f[+] (Sum0 n g[+]f n[+]g n)). + astepl (Sum0 n f[+] (f n[+]Sum0 n g[+]g n)). + astepl (Sum0 n f[+] (f n[+]Sum0 n g) [+]g n). + Step_final (Sum0 n f[+]f n[+]Sum0 n g[+]g n). Qed. Hint Resolve Sum0_plus_Sum0: algebra. Lemma Sum_plus_Sum : forall f g m n, Sum m n (fun i => f i[+]g i) [=] Sum m n f[+]Sum m n g. -intros f g m n. -unfold Sum in |- *. -unfold Sum1 in |- *. -astepl (Sum0 (S n) f[+]Sum0 (S n) g[-] (Sum0 m f[+]Sum0 m g)). -astepl (Sum0 (S n) f[+]Sum0 (S n) g[-]Sum0 m f[-]Sum0 m g). -unfold cg_minus in |- *. -astepr (Sum0 (S n) f[+] [--] (Sum0 m f) [+]Sum0 (S n) g[+] [--] (Sum0 m g)). -apply bin_op_wd_unfolded. - astepl (Sum0 (S n) f[+] (Sum0 (S n) g[+] [--] (Sum0 m f))). - astepl (Sum0 (S n) f[+] ([--] (Sum0 m f) [+]Sum0 (S n) g)). +Proof. + intros f g m n. + unfold Sum in |- *. + unfold Sum1 in |- *. + astepl (Sum0 (S n) f[+]Sum0 (S n) g[-] (Sum0 m f[+]Sum0 m g)). + astepl (Sum0 (S n) f[+]Sum0 (S n) g[-]Sum0 m f[-]Sum0 m g). + unfold cg_minus in |- *. + astepr (Sum0 (S n) f[+] [--] (Sum0 m f) [+]Sum0 (S n) g[+] [--] (Sum0 m g)). + apply bin_op_wd_unfolded. + astepl (Sum0 (S n) f[+] (Sum0 (S n) g[+] [--] (Sum0 m f))). + astepl (Sum0 (S n) f[+] ([--] (Sum0 m f) [+]Sum0 (S n) g)). + algebra. algebra. -algebra. Qed. Lemma Sumx_plus_Sumx : forall n f g, Sumx n f[+]Sumx n g [=] Sumx n (fun i Hi => f i Hi[+]g i Hi). -intro n; induction n as [| n Hrecn]. - intros; simpl in |- *; algebra. -intros f g; simpl in |- *. -apply - eq_transitive_unfolded - with - (Sumx _ (fun (i : nat) (l : i < n) => f i (lt_S i n l)) [+] - Sumx _ (fun (i : nat) (l : i < n) => g i (lt_S i n l)) [+] - (f n (lt_n_Sn n) [+]g n (lt_n_Sn n))). - set (Sf := Sumx _ (fun (i : nat) (l : i < n) => f i (lt_S i n l))) in *. - set (Sg := Sumx _ (fun (i : nat) (l : i < n) => g i (lt_S i n l))) in *. - set (fn := f n (lt_n_Sn n)) in *; set (gn := g n (lt_n_Sn n)) in *. - astepl (Sf[+]fn[+]Sg[+]gn). - astepl (Sf[+] (fn[+]Sg) [+]gn). - astepl (Sf[+] (Sg[+]fn) [+]gn). - Step_final (Sf[+]Sg[+]fn[+]gn). -apply bin_op_wd_unfolded; algebra. +Proof. + intro n; induction n as [| n Hrecn]. + intros; simpl in |- *; algebra. + intros f g; simpl in |- *. + apply eq_transitive_unfolded with (Sumx _ (fun (i : nat) (l : i < n) => f i (lt_S i n l)) [+] + Sumx _ (fun (i : nat) (l : i < n) => g i (lt_S i n l)) [+] (f n (lt_n_Sn n) [+]g n (lt_n_Sn n))). + set (Sf := Sumx _ (fun (i : nat) (l : i < n) => f i (lt_S i n l))) in *. + set (Sg := Sumx _ (fun (i : nat) (l : i < n) => g i (lt_S i n l))) in *. + set (fn := f n (lt_n_Sn n)) in *; set (gn := g n (lt_n_Sn n)) in *. + astepl (Sf[+]fn[+]Sg[+]gn). + astepl (Sf[+] (fn[+]Sg) [+]gn). + astepl (Sf[+] (Sg[+]fn) [+]gn). + Step_final (Sf[+]Sg[+]fn[+]gn). + apply bin_op_wd_unfolded; algebra. (* useless since V8.1: apply Hrecn @@ -416,208 +428,206 @@ Qed. Lemma Sum2_plus_Sum2 : forall m n, m <= S n -> forall f g, Sum2 m n f[+]Sum2 m n g [=] Sum2 _ _ (fun i Hm Hn => f i Hm Hn[+]g i Hm Hn). -intros m n H f g. -unfold Sum2 in |- *; simpl in |- *. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. - 2: apply Sum_plus_Sum. -apply Sum_wd; intro i. -elim le_lt_dec; intro H0; simpl in |- *; elim le_lt_dec; intro H1; - simpl in |- *; algebra. +Proof. + intros m n H f g. + unfold Sum2 in |- *; simpl in |- *. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + 2: apply Sum_plus_Sum. + apply Sum_wd; intro i. + elim le_lt_dec; intro H0; simpl in |- *; elim le_lt_dec; intro H1; simpl in |- *; algebra. Qed. Lemma inv_Sum0 : forall f n, Sum0 n (fun i => [--] (f i)) [=] [--] (Sum0 n f). -intros f n. -induction n as [| n Hrecn]. - simpl in |- *; algebra. -simpl in |- *. -Step_final ([--] (Sum0 n f) [+] [--] (f n)). +Proof. + intros f n. + induction n as [| n Hrecn]. + simpl in |- *; algebra. + simpl in |- *. + Step_final ([--] (Sum0 n f) [+] [--] (f n)). Qed. Hint Resolve inv_Sum0: algebra. Lemma inv_Sum : forall f m n, Sum m n (fun i => [--] (f i)) [=] [--] (Sum m n f). -intros f a b. -unfold Sum in |- *. -unfold Sum1 in |- *. -astepl ([--] (Sum0 (S b) f) [-][--] (Sum0 a f)). -astepl ([--] (Sum0 (S b) f) [+] [--][--] (Sum0 a f)). -Step_final ([--] (Sum0 (S b) f[+] [--] (Sum0 a f))). +Proof. + intros f a b. + unfold Sum in |- *. + unfold Sum1 in |- *. + astepl ([--] (Sum0 (S b) f) [-][--] (Sum0 a f)). + astepl ([--] (Sum0 (S b) f) [+] [--][--] (Sum0 a f)). + Step_final ([--] (Sum0 (S b) f[+] [--] (Sum0 a f))). Qed. Hint Resolve inv_Sum: algebra. Lemma inv_Sumx : forall n f, [--] (Sumx n f) [=] Sumx _ (fun i Hi => [--] (f i Hi)). -intro n; induction n as [| n Hrecn]. - simpl in |- *; algebra. -intro f; simpl in |- *. -astepl - ([--] (Sumx _ (fun i (l : i < n) => f i (lt_S i n l))) [+] - [--] (f n (lt_n_Sn n))). -apply bin_op_wd_unfolded. - apply Hrecn with (f := fun i (l : i < n) => f i (lt_S i n l)). -algebra. +Proof. + intro n; induction n as [| n Hrecn]. + simpl in |- *; algebra. + intro f; simpl in |- *. + astepl ([--] (Sumx _ (fun i (l : i < n) => f i (lt_S i n l))) [+] [--] (f n (lt_n_Sn n))). + apply bin_op_wd_unfolded. + apply Hrecn with (f := fun i (l : i < n) => f i (lt_S i n l)). + algebra. Qed. Lemma inv_Sum2 : forall m n : nat, m <= S n -> forall f, [--] (Sum2 m n f) [=] Sum2 _ _ (fun i Hm Hn => [--] (f i Hm Hn)). -intros m n H f. -unfold Sum2 in |- *; simpl in |- *. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. - 2: apply inv_Sum. -apply Sum_wd; intro i. -elim le_lt_dec; intro; simpl in |- *; elim le_lt_dec; intro; simpl in |- *; - algebra. +Proof. + intros m n H f. + unfold Sum2 in |- *; simpl in |- *. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + 2: apply inv_Sum. + apply Sum_wd; intro i. + elim le_lt_dec; intro; simpl in |- *; elim le_lt_dec; intro; simpl in |- *; algebra. Qed. Lemma Sum_minus_Sum : forall f g m n, Sum m n (fun i => f i[-]g i) [=] Sum m n f[-]Sum m n g. -(* WHAT A MISERY TO PROVE THIS *) -intros f g a b. -astepl (Sum a b (fun i : nat => f i[+] [--] (g i))). -cut - (Sum a b (fun i : nat => f i[+] (fun j : nat => [--] (g j)) i) [=] - Sum a b f[+]Sum a b (fun j : nat => [--] (g j))). -intro H. -astepl (Sum a b f[+]Sum a b (fun j : nat => [--] (g j))). -Step_final (Sum a b f[+] [--] (Sum a b g)). - -change - (Sum a b (fun i : nat => f i[+] (fun j : nat => [--] (g j)) i) [=] - Sum a b f[+]Sum a b (fun j : nat => [--] (g j))) - in |- *. -apply Sum_plus_Sum. +Proof. + (* WHAT A MISERY TO PROVE THIS *) + intros f g a b. + astepl (Sum a b (fun i : nat => f i[+] [--] (g i))). + cut (Sum a b (fun i : nat => f i[+] (fun j : nat => [--] (g j)) i) [=] + Sum a b f[+]Sum a b (fun j : nat => [--] (g j))). + intro H. + astepl (Sum a b f[+]Sum a b (fun j : nat => [--] (g j))). + Step_final (Sum a b f[+] [--] (Sum a b g)). + change (Sum a b (fun i : nat => f i[+] (fun j : nat => [--] (g j)) i) [=] + Sum a b f[+]Sum a b (fun j : nat => [--] (g j))) in |- *. + apply Sum_plus_Sum. Qed. Hint Resolve Sum_minus_Sum: algebra. Lemma Sumx_minus_Sumx : forall n f g, Sumx n f[-]Sumx n g [=] Sumx _ (fun i Hi => f i Hi[-]g i Hi). -intros n f g; unfold cg_minus in |- *. -eapply eq_transitive_unfolded. - 2: apply - Sumx_plus_Sumx - with (f := f) (g := fun i (Hi : i < n) => [--] (g i Hi)). -apply bin_op_wd_unfolded; algebra. -apply inv_Sumx. +Proof. + intros n f g; unfold cg_minus in |- *. + eapply eq_transitive_unfolded. + 2: apply Sumx_plus_Sumx with (f := f) (g := fun i (Hi : i < n) => [--] (g i Hi)). + apply bin_op_wd_unfolded; algebra. + apply inv_Sumx. Qed. Lemma Sum2_minus_Sum2 : forall m n, m <= S n -> forall f g, Sum2 m n f[-]Sum2 m n g [=] Sum2 _ _ (fun i Hm Hn => f i Hm Hn[-]g i Hm Hn). -intros m n H f g; unfold cg_minus in |- *. -eapply eq_transitive_unfolded. - 2: apply - Sum2_plus_Sum2 - with - (f := f) - (g := fun i (Hm : m <= i) (Hn : i <= n) => [--] (g i Hm Hn)); - assumption. -apply bin_op_wd_unfolded. - algebra. -apply inv_Sum2; assumption. +Proof. + intros m n H f g; unfold cg_minus in |- *. + eapply eq_transitive_unfolded. + 2: apply Sum2_plus_Sum2 with (f := f) (g := fun i (Hm : m <= i) (Hn : i <= n) => [--] (g i Hm Hn)); + assumption. + apply bin_op_wd_unfolded. + algebra. + apply inv_Sum2; assumption. Qed. Lemma Sum_apzero : forall f m n, m <= n -> Sum m n f [#] Zero -> {i : nat | m <= i /\ i <= n | f i [#] Zero}. -intros a k l H H0. induction l as [| l Hrecl]. +Proof. + intros a k l H H0. induction l as [| l Hrecl]. exists 0. split; auto. cut (k = 0). - intro H'. rewrite H' in H0. - astepl (Sum 0 0 a). auto. - inversion H. auto. -elim (le_lt_eq_dec k (S l) H); intro HH. -cut (Sum k l a [#] Zero or a (S l) [#] Zero). intro H1. -elim H1; clear H1; intro H1. - elim Hrecl; auto with arith. - intro i. intros H2 H6. exists i; auto. - elim H2; intros H3 H4; auto. -exists (S l); try split; auto with arith. - -apply cg_add_ap_zero. -apply ap_wdl_unfolded with (Sum k (S l) a). auto. -apply Sum_last. - -rewrite HH in H0. -exists (S l); auto. -astepl (Sum (S l) (S l) a). auto. + intro H'. rewrite H' in H0. + astepl (Sum 0 0 a). auto. + inversion H. auto. + elim (le_lt_eq_dec k (S l) H); intro HH. + cut (Sum k l a [#] Zero or a (S l) [#] Zero). intro H1. + elim H1; clear H1; intro H1. + elim Hrecl; auto with arith. + intro i. intros H2 H6. exists i; auto. + elim H2; intros H3 H4; auto. + exists (S l); try split; auto with arith. + apply cg_add_ap_zero. + apply ap_wdl_unfolded with (Sum k (S l) a). auto. + apply Sum_last. + rewrite HH in H0. + exists (S l); auto. + astepl (Sum (S l) (S l) a). auto. Qed. Lemma Sum_zero : forall f m n, m <= S n -> (forall i, m <= i -> i <= n -> f i [=] Zero) -> Sum m n f [=] Zero. -intros a k l H H0. induction l as [| l Hrecl]. +Proof. + intros a k l H H0. induction l as [| l Hrecl]. elim (le_lt_eq_dec _ _ H); clear H; intro H. - replace k with 0. astepl (a 0). apply H0. auto. - auto with arith. auto. inversion H. auto. inversion H2. - rewrite H. + replace k with 0. astepl (a 0). apply H0. auto. + auto with arith. auto. inversion H. auto. inversion H2. + rewrite H. + unfold Sum in |- *. unfold Sum1 in |- *. algebra. + elim (le_lt_eq_dec k (S (S l)) H); intro HH. + astepl (Sum k l a[+]a (S l)). + astepr (Zero[+] (Zero:G)). + apply bin_op_wd_unfolded. + apply Hrecl; auto with arith. + apply H0; auto with arith. + rewrite HH. unfold Sum in |- *. unfold Sum1 in |- *. algebra. -elim (le_lt_eq_dec k (S (S l)) H); intro HH. - astepl (Sum k l a[+]a (S l)). - astepr (Zero[+] (Zero:G)). - apply bin_op_wd_unfolded. - apply Hrecl; auto with arith. - apply H0; auto with arith. -rewrite HH. -unfold Sum in |- *. unfold Sum1 in |- *. algebra. Qed. Lemma Sum_term : forall f m i n, m <= i -> i <= n -> (forall j, m <= j -> j <> i -> j <= n -> f j [=] Zero) -> Sum m n f [=] f i. -intros a k i0 l H H0 H1. -astepl (Sum k i0 a[+]Sum (S i0) l a). -astepr (a i0[+]Zero). -apply bin_op_wd_unfolded. - elim (O_or_S i0); intro H2. - elim H2; intros m Hm. - rewrite <- Hm. - astepl (Sum k m a[+]a (S m)). - astepr (Zero[+]a (S m)). - apply bin_op_wd_unfolded. - apply Sum_zero. rewrite Hm; auto. - intros i H3 H4. apply H1. auto. omega. omega. - algebra. - rewrite <- H2 in H. rewrite <- H2. - inversion H. algebra. -apply Sum_zero. auto with arith. -intros. apply H1. omega. omega. auto. +Proof. + intros a k i0 l H H0 H1. + astepl (Sum k i0 a[+]Sum (S i0) l a). + astepr (a i0[+]Zero). + apply bin_op_wd_unfolded. + elim (O_or_S i0); intro H2. + elim H2; intros m Hm. + rewrite <- Hm. + astepl (Sum k m a[+]a (S m)). + astepr (Zero[+]a (S m)). + apply bin_op_wd_unfolded. + apply Sum_zero. rewrite Hm; auto. + intros i H3 H4. apply H1. auto. omega. omega. + algebra. + rewrite <- H2 in H. rewrite <- H2. + inversion H. algebra. + apply Sum_zero. auto with arith. + intros. apply H1. omega. omega. auto. Qed. Lemma Sum0_shift : forall f g n, (forall i, f i [=] g (S i)) -> g 0[+]Sum0 n f [=] Sum0 (S n) g. -intros a b l H. induction l as [| l Hrecl]. +Proof. + intros a b l H. induction l as [| l Hrecl]. simpl in |- *; algebra. -simpl in |- *. -astepl (b 0[+]Sum0 l a[+]a l). -Step_final (Sum0 (S l) b[+]a l). + simpl in |- *. + astepl (b 0[+]Sum0 l a[+]a l). + Step_final (Sum0 (S l) b[+]a l). Qed. Hint Resolve Sum0_shift: algebra. Lemma Sum_shift : forall f g m n, (forall i, f i [=] g (S i)) -> Sum m n f [=] Sum (S m) (S n) g. -unfold Sum in |- *. unfold Sum1 in |- *. intros a b k l H. -astepl (Sum0 (S l) a[+]b 0[-]b 0[-]Sum0 k a). -astepl (Sum0 (S l) a[+]b 0[-] (b 0[+]Sum0 k a)). -Step_final (b 0[+]Sum0 (S l) a[-] (b 0[+]Sum0 k a)). +Proof. + unfold Sum in |- *. unfold Sum1 in |- *. intros a b k l H. + astepl (Sum0 (S l) a[+]b 0[-]b 0[-]Sum0 k a). + astepl (Sum0 (S l) a[+]b 0[-] (b 0[+]Sum0 k a)). + Step_final (b 0[+]Sum0 (S l) a[-] (b 0[+]Sum0 k a)). Qed. Lemma Sum_big_shift : forall f g k m n, (forall j, m <= j -> f j [=] g (j + k)) -> m <= S n -> Sum m n f [=] Sum (m + k) (n + k) g. -do 3 intro; generalize f g; clear f g. -induction k as [| k Hreck]. -intros f g n m. repeat rewrite <- plus_n_O. -intros H H0. -apply: Sum_wd'. auto. -intros. set (Hi:= H i). rewrite <- (plus_n_O i) in Hi. apply: Hi. auto. -intros; repeat rewrite <- plus_n_Sm. -apply - eq_transitive_unfolded with (Sum (m + k) (n + k) (fun n : nat => g (S n))). -2: apply Sum_shift; algebra. -apply Hreck. -intros; rewrite plus_n_Sm; apply H; auto with arith. -auto. +Proof. + do 3 intro; generalize f g; clear f g. + induction k as [| k Hreck]. + intros f g n m. repeat rewrite <- plus_n_O. + intros H H0. + apply: Sum_wd'. auto. + intros. set (Hi:= H i). rewrite <- (plus_n_O i) in Hi. apply: Hi. auto. + intros; repeat rewrite <- plus_n_Sm. + apply eq_transitive_unfolded with (Sum (m + k) (n + k) (fun n : nat => g (S n))). + 2: apply Sum_shift; algebra. + apply Hreck. + intros; rewrite plus_n_Sm; apply H; auto with arith. + auto. Qed. Lemma Sumx_Sum0 : forall n f g, (forall i Hi, f i Hi [=] g i) -> Sumx n f [=] Sum0 n g. -intro; induction n as [| n Hrecn]; simpl in |- *; algebra. +Proof. + intro; induction n as [| n Hrecn]; simpl in |- *; algebra. Qed. End Sums. @@ -641,111 +651,109 @@ Variable G : CAbGroup. Lemma Mengolli_Sum : forall n (f : forall i, i <= n -> G) (g : forall i, i < n -> G), nat_less_n_fun' f -> (forall i H, g i H [=] f (S i) H[-]f i (lt_le_weak _ _ H)) -> Sumx g [=] f n (le_n n) [-]f 0 (le_O_n n). -intro n; induction n as [| n Hrecn]; intros f g Hf H; simpl in |- *. - astepl (f 0 (le_n 0) [-]f 0 (le_n 0)). - apply cg_minus_wd; algebra. -apply - eq_transitive_unfolded - with - (f _ (le_n (S n)) [-]f _ (le_S _ _ (le_n n)) [+] - (f _ (le_S _ _ (le_n n)) [-]f 0 (le_O_n (S n)))). - eapply eq_transitive_unfolded. - apply cag_commutes_unfolded. - apply bin_op_wd_unfolded. - eapply eq_transitive_unfolded. - apply H. - apply cg_minus_wd; apply Hf; algebra. - set (f' := fun i (H : i <= n) => f i (le_S _ _ H)) in *. - set (g' := fun i (H : i < n) => g i (lt_S _ _ H)) in *. - apply eq_transitive_unfolded with (f' n (le_n n) [-]f' 0 (le_O_n n)). - apply Hrecn. - red in |- *; intros; unfold f' in |- *; apply Hf; algebra. - intros i Hi. - unfold f' in |- *; unfold g' in |- *. +Proof. + intro n; induction n as [| n Hrecn]; intros f g Hf H; simpl in |- *. + astepl (f 0 (le_n 0) [-]f 0 (le_n 0)). + apply cg_minus_wd; algebra. + apply eq_transitive_unfolded with (f _ (le_n (S n)) [-]f _ (le_S _ _ (le_n n)) [+] + (f _ (le_S _ _ (le_n n)) [-]f 0 (le_O_n (S n)))). eapply eq_transitive_unfolded. - apply H. - apply cg_minus_wd; apply Hf; algebra. - unfold f' in |- *; apply cg_minus_wd; apply Hf; algebra. -astepr (f (S n) (le_n (S n)) [+]Zero[-]f 0 (le_O_n (S n))). -astepr - (f (S n) (le_n (S n)) [+] - ([--] (f n (le_S _ _ (le_n n))) [+]f n (le_S _ _ (le_n n))) [-] - f 0 (le_O_n (S n))). -Step_final - (f (S n) (le_n (S n)) [+] [--] (f n (le_S _ _ (le_n n))) [+] - f n (le_S _ _ (le_n n)) [-]f 0 (le_O_n (S n))). + apply cag_commutes_unfolded. + apply bin_op_wd_unfolded. + eapply eq_transitive_unfolded. + apply H. + apply cg_minus_wd; apply Hf; algebra. + set (f' := fun i (H : i <= n) => f i (le_S _ _ H)) in *. + set (g' := fun i (H : i < n) => g i (lt_S _ _ H)) in *. + apply eq_transitive_unfolded with (f' n (le_n n) [-]f' 0 (le_O_n n)). + apply Hrecn. + red in |- *; intros; unfold f' in |- *; apply Hf; algebra. + intros i Hi. + unfold f' in |- *; unfold g' in |- *. + eapply eq_transitive_unfolded. + apply H. + apply cg_minus_wd; apply Hf; algebra. + unfold f' in |- *; apply cg_minus_wd; apply Hf; algebra. + astepr (f (S n) (le_n (S n)) [+]Zero[-]f 0 (le_O_n (S n))). + astepr (f (S n) (le_n (S n)) [+] ([--] (f n (le_S _ _ (le_n n))) [+]f n (le_S _ _ (le_n n))) [-] + f 0 (le_O_n (S n))). + Step_final (f (S n) (le_n (S n)) [+] [--] (f n (le_S _ _ (le_n n))) [+] + f n (le_S _ _ (le_n n)) [-]f 0 (le_O_n (S n))). Qed. Lemma Mengolli_Sum_gen : forall f g : nat -> G, (forall n, g n [=] f (S n) [-]f n) -> forall m n, m <= S n -> Sum m n g [=] f (S n) [-]f m. -intros f g H m n; induction n as [| n Hrecn]; intro Hmn. - elim (le_lt_eq_dec _ _ Hmn); intro H0. - cut (m = 0); [ intro H1 | inversion H0; auto with arith; inversion H2 ]. - rewrite H1. - eapply eq_transitive_unfolded; [ apply Sum_one | apply H ]. - cut (0 = pred 1); [ intro H1 | auto ]. - rewrite H0; astepr (Zero:G); rewrite H1; apply Sum_empty. - auto with arith. -simpl in Hmn; elim (le_lt_eq_dec _ _ Hmn); intro H0. - apply eq_transitive_unfolded with (f (S (S n)) [-]f (S n) [+] (f (S n) [-]f m)). - eapply eq_transitive_unfolded. - apply Sum_last. - eapply eq_transitive_unfolded. - apply cag_commutes_unfolded. - apply bin_op_wd_unfolded; [ apply H | apply Hrecn ]. +Proof. + intros f g H m n; induction n as [| n Hrecn]; intro Hmn. + elim (le_lt_eq_dec _ _ Hmn); intro H0. + cut (m = 0); [ intro H1 | inversion H0; auto with arith; inversion H2 ]. + rewrite H1. + eapply eq_transitive_unfolded; [ apply Sum_one | apply H ]. + cut (0 = pred 1); [ intro H1 | auto ]. + rewrite H0; astepr (Zero:G); rewrite H1; apply Sum_empty. auto with arith. - astepr (f (S (S n)) [+]Zero[-]f m). - astepr (f (S (S n)) [+] ([--] (f (S n)) [+]f (S n)) [-]f m). - Step_final (f (S (S n)) [+] [--] (f (S n)) [+]f (S n) [-]f m). -rewrite H0. -astepr (Zero:G). -cut (S n = pred (S (S n))); [ intro H2 | auto ]. -rewrite H2; apply Sum_empty. -auto with arith. + simpl in Hmn; elim (le_lt_eq_dec _ _ Hmn); intro H0. + apply eq_transitive_unfolded with (f (S (S n)) [-]f (S n) [+] (f (S n) [-]f m)). + eapply eq_transitive_unfolded. + apply Sum_last. + eapply eq_transitive_unfolded. + apply cag_commutes_unfolded. + apply bin_op_wd_unfolded; [ apply H | apply Hrecn ]. + auto with arith. + astepr (f (S (S n)) [+]Zero[-]f m). + astepr (f (S (S n)) [+] ([--] (f (S n)) [+]f (S n)) [-]f m). + Step_final (f (S (S n)) [+] [--] (f (S n)) [+]f (S n) [-]f m). + rewrite H0. + astepr (Zero:G). + cut (S n = pred (S (S n))); [ intro H2 | auto ]. + rewrite H2; apply Sum_empty. + auto with arith. Qed. Lemma str_Mengolli_Sum_gen : forall (f g : nat -> G) m n, m <= S n -> (forall i, m <= i -> i <= n -> g i [=] f (S i) [-]f i) -> Sum m n g [=] f (S n) [-]f m. -intros f g m n H H0. -apply eq_transitive_unfolded with (Sum m n (fun i : nat => f (S i) [-]f i)). - apply Sum_wd'; assumption. -apply Mengolli_Sum_gen; [ intro; algebra | assumption ]. +Proof. + intros f g m n H H0. + apply eq_transitive_unfolded with (Sum m n (fun i : nat => f (S i) [-]f i)). + apply Sum_wd'; assumption. + apply Mengolli_Sum_gen; [ intro; algebra | assumption ]. Qed. Lemma Sumx_to_Sum : forall n, 0 < n -> forall f, nat_less_n_fun f -> Sumx f [=] Sum 0 (pred n) (part_tot_nat_fun G n f). -intro n; induction n as [| n Hrecn]; intros H f Hf. -elimtype False; inversion H. -cut (0 <= n); [ intro H0 | auto with arith ]. -elim (le_lt_eq_dec _ _ H0); clear H H0; intro H. - simpl in |- *. - pattern n at 6 in |- *; rewrite -> (S_pred _ _ H). - eapply eq_transitive_unfolded. - 2: apply eq_symmetric_unfolded; apply Sum_last. - apply bin_op_wd_unfolded. - eapply eq_transitive_unfolded. - apply Hrecn; auto. - red in |- *; intros; apply Hf; auto. - apply Sum_wd'. - auto with arith. - intros i H1 H2. - cut (i < n); [ intro | omega ]. - eapply eq_transitive_unfolded. - apply part_tot_nat_fun_ch1 with (Hi := H0). - red in |- *; intros; apply Hf; auto. - apply eq_symmetric_unfolded. +Proof. + intro n; induction n as [| n Hrecn]; intros H f Hf. + elimtype False; inversion H. + cut (0 <= n); [ intro H0 | auto with arith ]. + elim (le_lt_eq_dec _ _ H0); clear H H0; intro H. + simpl in |- *. + pattern n at 6 in |- *; rewrite -> (S_pred _ _ H). eapply eq_transitive_unfolded. - apply part_tot_nat_fun_ch1 with (Hi := lt_S _ _ H0). - red in |- *; intros; apply Hf; auto. - algebra. - rewrite <- (S_pred _ _ H). -apply eq_symmetric_unfolded; apply part_tot_nat_fun_ch1; auto. -generalize f Hf; clear Hf f; rewrite <- H. -simpl in |- *; intros f Hf. -eapply eq_transitive_unfolded. - 2: apply eq_symmetric_unfolded; apply Sum_one. -astepl (f 0 (lt_n_Sn 0)). -apply eq_symmetric_unfolded; apply part_tot_nat_fun_ch1; auto. + 2: apply eq_symmetric_unfolded; apply Sum_last. + apply bin_op_wd_unfolded. + eapply eq_transitive_unfolded. + apply Hrecn; auto. + red in |- *; intros; apply Hf; auto. + apply Sum_wd'. + auto with arith. + intros i H1 H2. + cut (i < n); [ intro | omega ]. + eapply eq_transitive_unfolded. + apply part_tot_nat_fun_ch1 with (Hi := H0). + red in |- *; intros; apply Hf; auto. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply part_tot_nat_fun_ch1 with (Hi := lt_S _ _ H0). + red in |- *; intros; apply Hf; auto. + algebra. + rewrite <- (S_pred _ _ H). + apply eq_symmetric_unfolded; apply part_tot_nat_fun_ch1; auto. + generalize f Hf; clear Hf f; rewrite <- H. + simpl in |- *; intros f Hf. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply Sum_one. + astepl (f 0 (lt_n_Sn 0)). + apply eq_symmetric_unfolded; apply part_tot_nat_fun_ch1; auto. Qed. End More_Sums. diff --git a/algebra/CVectorSpace.v b/algebra/CVectorSpace.v index 8bde14e49..40cfcedb3 100644 --- a/algebra/CVectorSpace.v +++ b/algebra/CVectorSpace.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing ['] %{'}% #'# *) @@ -49,7 +49,7 @@ Set Implicit Arguments. Unset Strict Implicit. (* end hide *) -Record VSpace (F : CField) : Type := +Record VSpace (F : CField) : Type := {vs_vs :> CGroup; vs_op : CSetoid_outer_op F vs_vs; vs_assoc : forall a b v, vs_op (a[*]b) v [=] vs_op a (vs_op b v); @@ -78,86 +78,96 @@ Variable F : CField. Variable V : VSpace F. Lemma vs_op_zero : forall a : F, a['] (Zero:V) [=] Zero. -intros. -apply cg_cancel_lft with (a['] (Zero:V)). -astepl (a['] ((Zero:V) [+]Zero)). -Step_final (a['] (Zero:V)). +Proof. + intros. + apply cg_cancel_lft with (a['] (Zero:V)). + astepl (a['] ((Zero:V) [+]Zero)). + Step_final (a['] (Zero:V)). Qed. Lemma zero_vs_op : forall v : V, Zero[']v [=] Zero. -intros. -apply cg_cancel_lft with (Zero[']v). -astepl ((Zero[+]Zero) [']v). -Step_final (Zero[']v). +Proof. + intros. + apply cg_cancel_lft with (Zero[']v). + astepl ((Zero[+]Zero) [']v). + Step_final (Zero[']v). Qed. Hint Resolve vs_op_zero zero_vs_op: algebra. Lemma vs_op_inv_V : forall (x : F) (y : V), x['][--]y [=] [--] (x[']y). -intros. -apply cg_inv_unique. -astepl (x['] (y[+][--]y)). -Step_final (x['] (Zero:V)). +Proof. + intros. + apply cg_inv_unique. + astepl (x['] (y[+][--]y)). + Step_final (x['] (Zero:V)). Qed. Lemma vs_op_inv_S : forall (x : F) (y : V), [--]x[']y [=] [--] (x[']y). -intros. -apply cg_inv_unique. -astepl ((x[+][--]x) [']y). -Step_final (Zero[']y). +Proof. + intros. + apply cg_inv_unique. + astepl ((x[+][--]x) [']y). + Step_final (Zero[']y). Qed. Hint Resolve vs_op_inv_V vs_op_inv_S: algebra. Lemma vs_inv_assoc : forall (a : F) a_ (v : V), v [=] f_rcpcl a a_['] (a[']v). -intros. -astepl (One[']v). -Step_final ((f_rcpcl a a_[*]a) [']v). +Proof. + intros. + astepl (One[']v). + Step_final ((f_rcpcl a a_[*]a) [']v). Qed. Hint Resolve vs_inv_assoc: algebra. Lemma ap_zero_vs_op_l : forall (a : F) (v : V), a[']v [#] Zero -> a [#] Zero. -intros. -elim (csoo_strext _ _ (vs_op (F:=F) (v:=V)) a Zero v v). -auto. -intro contra; elim (ap_irreflexive _ _ contra). -astepr (Zero:V). auto. +Proof. + intros. + elim (csoo_strext _ _ (vs_op (F:=F) (v:=V)) a Zero v v). + auto. + intro contra; elim (ap_irreflexive _ _ contra). + astepr (Zero:V). auto. Qed. Lemma ap_zero_vs_op_r : forall (a : F) (v : V), a[']v [#] Zero -> v [#] Zero. -intros. -elim (csoo_strext _ _ (vs_op (F:=F) (v:=V)) a a v Zero). -intro contra; elim (ap_irreflexive _ _ contra). -auto. -astepr (Zero:V). auto. +Proof. + intros. + elim (csoo_strext _ _ (vs_op (F:=F) (v:=V)) a a v Zero). + intro contra; elim (ap_irreflexive _ _ contra). + auto. + astepr (Zero:V). auto. Qed. (* note this is the same proof as mult_resp_ap_zero *) Lemma vs_op_resp_ap_rht : forall (a : F) (v u : V), a [#] Zero -> v [#] u -> a[']v [#] a[']u. -intros. -cut (f_rcpcl a X['] (a[']v) [#] f_rcpcl a X['] (a[']u)). -intros H1. -case (csoo_strext _ _ _ _ _ _ _ H1). -intro contra; elim (ap_irreflexive _ _ contra). -auto. -astepr u. -astepl v. auto. +Proof. + intros. + cut (f_rcpcl a X['] (a[']v) [#] f_rcpcl a X['] (a[']u)). + intros H1. + case (csoo_strext _ _ _ _ _ _ _ H1). + intro contra; elim (ap_irreflexive _ _ contra). + auto. + astepr u. + astepl v. auto. Qed. Lemma vs_op_resp_ap_zero : forall (a : F) (v : V), a [#] Zero -> v [#] Zero -> a[']v [#] Zero. -intros. -astepr (a['] (Zero:V)). -apply vs_op_resp_ap_rht; assumption. +Proof. + intros. + astepr (a['] (Zero:V)). + apply vs_op_resp_ap_rht; assumption. Qed. Lemma vs_op_resp_ap_lft : forall (a b : F) (v : V), a [#] b -> v [#] Zero -> a[']v [#] b[']v. -intros. -apply zero_minus_apart. -astepl ((a[-]b) [']v). -apply vs_op_resp_ap_zero; [ idtac | assumption ]. -apply minus_ap_zero; assumption. -unfold cg_minus in |- *. Step_final (a[']v[+][--]b[']v). +Proof. + intros. + apply zero_minus_apart. + astepl ((a[-]b) [']v). + apply vs_op_resp_ap_zero; [ idtac | assumption ]. + apply minus_ap_zero; assumption. + unfold cg_minus in |- *. Step_final (a[']v[+][--]b[']v). Qed. End VS_basics. diff --git a/algebra/Cauchy_COF.v b/algebra/Cauchy_COF.v index 32424ce2e..da642e8ae 100644 --- a/algebra/Cauchy_COF.v +++ b/algebra/Cauchy_COF.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export COrdCauchy. Require Export RingReflection. @@ -73,135 +73,129 @@ Definition R_ap (x y : R_Set) := R_lt x y or R_lt y x. Definition R_eq (x y : R_Set) := Not (R_ap x y). Lemma R_lt_cotrans : cotransitive R_lt. -red in |- *. -intros x y. -elim x; intros x_ px. -elim y; intros y_ py. -intros Hxy z. -elim z; intros z_ pz. -elim Hxy; intros N H. -elim H; clear Hxy H; intros e He HN. -simpl in HN. -set (e3 := e [/]ThreeNZ) in *. -cut (Zero [<] e3); [ intro He3 | unfold e3 in |- *; apply pos_div_three; auto ]. -set (e6 := e [/]SixNZ) in *. -cut (Zero [<] e6); [ intro He6 | unfold e6 in |- *; apply pos_div_six; auto ]. -set (e12 := e [/]TwelveNZ) in *. -cut (Zero [<] e12); - [ intro He12 | unfold e12 in |- *; apply pos_div_twelve; auto ]. -set (e24 := e [/]TwentyFourNZ) in *. -cut (Zero [<] e24); - [ intro He24 | unfold e24 in |- *; apply pos_div_twentyfour; auto ]. -elim (px e24 He24); intros Nx HNx. -elim (py e24 He24); intros Ny HNy. -elim (pz e24 He24); intros Nz HNz. -set (NN := max N (max Nx (max Ny Nz))) in *. -set (x0 := x_ NN) in *. -set (y0 := y_ NN) in *. -set (z0 := z_ NN) in *. -elim (less_cotransitive_unfolded _ (x0[+]e3) (y0[-]e3)) with z0. - -intro Hyz. -left. -exists NN; exists e6; auto. -intros n Hn; simpl in |- *. -apply leEq_wdl with (e3[-] (e24[+]e24[+]e24[+]e24)). -2: unfold e3, e6, e12, e24 in |- *; rational. -apply - leEq_transitive - with (e3[-] (z0[-]z_ Nz[+] (z_ Nz[-]z_ n) [+] (x_ n[-]x_ Nx) [+] (x_ Nx[-]x0))). -apply minus_resp_leEq_rht. -repeat apply plus_resp_leEq_both. -unfold z0 in |- *; elim (HNz NN); auto; unfold NN in |- *; eauto with arith. -apply shift_minus_leEq; apply shift_leEq_plus'. -unfold cg_minus in |- *; apply shift_plus_leEq'. -elim (HNz n); auto; apply le_trans with NN; auto; unfold NN in |- *; - eauto with arith. -elim (HNx n); auto; apply le_trans with NN; auto; unfold NN in |- *; - eauto with arith. -apply shift_minus_leEq; apply shift_leEq_plus'. -unfold cg_minus in |- *; apply shift_plus_leEq'. -unfold x0 in |- *; elim (HNx NN); auto; unfold NN in |- *; eauto with arith. -apply shift_minus_leEq. -rstepr (z0[-]x0). -apply shift_leEq_minus; astepl (x0[+]e3); apply less_leEq; auto. - -intro Hzx. -right. -exists NN; exists e6; auto. -intros n Hn; simpl in |- *. -apply leEq_wdl with (e3[-] (e24[+]e24[+]e24[+]e24)). -2: unfold e3, e6, e12, e24 in |- *; rational. -apply - leEq_transitive - with (e3[-] (z_ Nz[-]z0[+] (z_ n[-]z_ Nz) [+] (y_ Ny[-]y_ n) [+] (y0[-]y_ Ny))). -apply minus_resp_leEq_rht. -repeat apply plus_resp_leEq_both. -apply shift_minus_leEq; apply shift_leEq_plus'. -unfold cg_minus in |- *; apply shift_plus_leEq'. -unfold z0 in |- *; elim (HNz NN); auto; unfold NN in |- *; eauto with arith. -elim (HNz n); auto; apply le_trans with NN; auto; unfold NN in |- *; - eauto with arith. -apply shift_minus_leEq; apply shift_leEq_plus'. -unfold cg_minus in |- *; apply shift_plus_leEq'. -elim (HNy n); auto; apply le_trans with NN; auto; unfold NN in |- *; - eauto with arith. -unfold y0 in |- *; elim (HNy NN); auto; unfold NN in |- *; eauto with arith. -apply shift_minus_leEq. -rstepr (y0[-]z0). -apply shift_leEq_minus; apply shift_plus_leEq'; apply less_leEq; auto. - -apply shift_less_minus. -astepl (x0[+] (e3[+]e3)); apply shift_plus_less'. -apply less_leEq_trans with e. -apply shift_plus_less. -apply less_wdl with ((e[-]e3) [/]TwoNZ). -2: unfold e3 in |- *; rational. -apply pos_div_two'. -apply shift_less_minus; astepl e3; unfold e3 in |- *; apply pos_div_three'; - auto. - -unfold x0, y0, NN in |- *; apply HN; eauto with arith. +Proof. + red in |- *. + intros x y. + elim x; intros x_ px. + elim y; intros y_ py. + intros Hxy z. + elim z; intros z_ pz. + elim Hxy; intros N H. + elim H; clear Hxy H; intros e He HN. + simpl in HN. + set (e3 := e [/]ThreeNZ) in *. + cut (Zero [<] e3); [ intro He3 | unfold e3 in |- *; apply pos_div_three; auto ]. + set (e6 := e [/]SixNZ) in *. + cut (Zero [<] e6); [ intro He6 | unfold e6 in |- *; apply pos_div_six; auto ]. + set (e12 := e [/]TwelveNZ) in *. + cut (Zero [<] e12); [ intro He12 | unfold e12 in |- *; apply pos_div_twelve; auto ]. + set (e24 := e [/]TwentyFourNZ) in *. + cut (Zero [<] e24); [ intro He24 | unfold e24 in |- *; apply pos_div_twentyfour; auto ]. + elim (px e24 He24); intros Nx HNx. + elim (py e24 He24); intros Ny HNy. + elim (pz e24 He24); intros Nz HNz. + set (NN := max N (max Nx (max Ny Nz))) in *. + set (x0 := x_ NN) in *. + set (y0 := y_ NN) in *. + set (z0 := z_ NN) in *. + elim (less_cotransitive_unfolded _ (x0[+]e3) (y0[-]e3)) with z0. + intro Hyz. + left. + exists NN; exists e6; auto. + intros n Hn; simpl in |- *. + apply leEq_wdl with (e3[-] (e24[+]e24[+]e24[+]e24)). + 2: unfold e3, e6, e12, e24 in |- *; rational. + apply leEq_transitive + with (e3[-] (z0[-]z_ Nz[+] (z_ Nz[-]z_ n) [+] (x_ n[-]x_ Nx) [+] (x_ Nx[-]x0))). + apply minus_resp_leEq_rht. + repeat apply plus_resp_leEq_both. + unfold z0 in |- *; elim (HNz NN); auto; unfold NN in |- *; eauto with arith. + apply shift_minus_leEq; apply shift_leEq_plus'. + unfold cg_minus in |- *; apply shift_plus_leEq'. + elim (HNz n); auto; apply le_trans with NN; auto; unfold NN in |- *; eauto with arith. + elim (HNx n); auto; apply le_trans with NN; auto; unfold NN in |- *; eauto with arith. + apply shift_minus_leEq; apply shift_leEq_plus'. + unfold cg_minus in |- *; apply shift_plus_leEq'. + unfold x0 in |- *; elim (HNx NN); auto; unfold NN in |- *; eauto with arith. + apply shift_minus_leEq. + rstepr (z0[-]x0). + apply shift_leEq_minus; astepl (x0[+]e3); apply less_leEq; auto. + intro Hzx. + right. + exists NN; exists e6; auto. + intros n Hn; simpl in |- *. + apply leEq_wdl with (e3[-] (e24[+]e24[+]e24[+]e24)). + 2: unfold e3, e6, e12, e24 in |- *; rational. + apply leEq_transitive + with (e3[-] (z_ Nz[-]z0[+] (z_ n[-]z_ Nz) [+] (y_ Ny[-]y_ n) [+] (y0[-]y_ Ny))). + apply minus_resp_leEq_rht. + repeat apply plus_resp_leEq_both. + apply shift_minus_leEq; apply shift_leEq_plus'. + unfold cg_minus in |- *; apply shift_plus_leEq'. + unfold z0 in |- *; elim (HNz NN); auto; unfold NN in |- *; eauto with arith. + elim (HNz n); auto; apply le_trans with NN; auto; unfold NN in |- *; eauto with arith. + apply shift_minus_leEq; apply shift_leEq_plus'. + unfold cg_minus in |- *; apply shift_plus_leEq'. + elim (HNy n); auto; apply le_trans with NN; auto; unfold NN in |- *; eauto with arith. + unfold y0 in |- *; elim (HNy NN); auto; unfold NN in |- *; eauto with arith. + apply shift_minus_leEq. + rstepr (y0[-]z0). + apply shift_leEq_minus; apply shift_plus_leEq'; apply less_leEq; auto. + apply shift_less_minus. + astepl (x0[+] (e3[+]e3)); apply shift_plus_less'. + apply less_leEq_trans with e. + apply shift_plus_less. + apply less_wdl with ((e[-]e3) [/]TwoNZ). + 2: unfold e3 in |- *; rational. + apply pos_div_two'. + apply shift_less_minus; astepl e3; unfold e3 in |- *; apply pos_div_three'; auto. + unfold x0, y0, NN in |- *; apply HN; eauto with arith. Qed. Lemma R_ap_cotrans : cotransitive R_ap. -red in |- *; intros x y Hxy z. -elim Hxy; intro H; elim (R_lt_cotrans _ _ H z); unfold R_ap in |- *; auto. +Proof. + red in |- *; intros x y Hxy z. + elim Hxy; intro H; elim (R_lt_cotrans _ _ H z); unfold R_ap in |- *; auto. Qed. Lemma R_ap_symmetric : Csymmetric R_ap. -red in |- *; intros x y Hxy. -elim Hxy; unfold R_ap in |- *; auto. +Proof. + red in |- *; intros x y Hxy. + elim Hxy; unfold R_ap in |- *; auto. Qed. Lemma R_lt_irreflexive : irreflexive R_lt. -red in |- *; intros x Hx. -elim Hx; intros N HN. -elim HN; clear Hx HN; intros e He HN. -apply (ap_irreflexive_unfolded _ (x N)). -apply less_imp_ap. -apply less_leEq_trans with (x N[+]e). -astepl (x N[+]Zero); apply plus_resp_less_lft; auto. -apply shift_plus_leEq'; auto with arith. +Proof. + red in |- *; intros x Hx. + elim Hx; intros N HN. + elim HN; clear Hx HN; intros e He HN. + apply (ap_irreflexive_unfolded _ (x N)). + apply less_imp_ap. + apply less_leEq_trans with (x N[+]e). + astepl (x N[+]Zero); apply plus_resp_less_lft; auto. + apply shift_plus_leEq'; auto with arith. Qed. Lemma R_ap_irreflexive : irreflexive R_ap. -red in |- *; intros x Hx. -elim (R_lt_irreflexive x). -elim Hx; auto. +Proof. + red in |- *; intros x Hx. + elim (R_lt_irreflexive x). + elim Hx; auto. Qed. Lemma R_ap_eq_tight : tight_apart R_eq R_ap. -split; auto. +Proof. + split; auto. Qed. Definition R_CSetoid : CSetoid. -apply Build_CSetoid with R_Set R_eq R_ap. -split. -exact R_ap_irreflexive. -exact R_ap_symmetric. -exact R_ap_cotrans. -exact R_ap_eq_tight. +Proof. + apply Build_CSetoid with R_Set R_eq R_ap. + split. + exact R_ap_irreflexive. + exact R_ap_symmetric. + exact R_ap_cotrans. + exact R_ap_eq_tight. Defined. End CSetoid_Structure. @@ -220,95 +214,85 @@ Definition R_plus (x y : R_CSetoid) : R_CSetoid := Definition R_zero := Build_CauchySeq _ _ (CS_seq_const F Zero). Lemma R_plus_lft_ext : forall x y z, R_plus x z [#] R_plus y z -> x [#] y. -intros x y z Hxy. -elim Hxy; clear Hxy; intro H; [ left | right ]; elim H; intros N HN; elim HN; - clear H HN; intros e He HN; exists N; exists e; auto; - intros n Hn; simpl in HN. -rstepr (CS_seq _ y n[+]CS_seq _ z n[-] (CS_seq _ x n[+]CS_seq _ z n)); auto. -rstepr (CS_seq _ x n[+]CS_seq _ z n[-] (CS_seq _ y n[+]CS_seq _ z n)); auto. +Proof. + intros x y z Hxy. + elim Hxy; clear Hxy; intro H; [ left | right ]; elim H; intros N HN; elim HN; + clear H HN; intros e He HN; exists N; exists e; auto; intros n Hn; simpl in HN. + rstepr (CS_seq _ y n[+]CS_seq _ z n[-] (CS_seq _ x n[+]CS_seq _ z n)); auto. + rstepr (CS_seq _ x n[+]CS_seq _ z n[-] (CS_seq _ y n[+]CS_seq _ z n)); auto. Qed. Lemma R_plus_assoc : associative R_plus. -intros x y z Hap. -elim Hap; clear Hap; intro H; elim H; intros N HN; elim HN; clear H HN; - intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). -apply - leEq_less_trans - with - (CS_seq _ x N[+]CS_seq _ y N[+]CS_seq _ z N[-] - (CS_seq _ x N[+] (CS_seq _ y N[+]CS_seq _ z N))); - auto. -rstepl (Zero:F); auto. -apply - leEq_less_trans - with - (CS_seq _ x N[+] (CS_seq _ y N[+]CS_seq _ z N) [-] - (CS_seq _ x N[+]CS_seq _ y N[+]CS_seq _ z N)); - auto. -rstepl (Zero:F); auto. +Proof. + intros x y z Hap. + elim Hap; clear Hap; intro H; elim H; intros N HN; elim HN; clear H HN; + intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). + apply leEq_less_trans with (CS_seq _ x N[+]CS_seq _ y N[+]CS_seq _ z N[-] + (CS_seq _ x N[+] (CS_seq _ y N[+]CS_seq _ z N))); auto. + rstepl (Zero:F); auto. + apply leEq_less_trans with (CS_seq _ x N[+] (CS_seq _ y N[+]CS_seq _ z N) [-] + (CS_seq _ x N[+]CS_seq _ y N[+]CS_seq _ z N)); auto. + rstepl (Zero:F); auto. Qed. Lemma R_zero_lft_unit : forall x, R_plus R_zero x [=] x. -intro x; intro x_ap. -apply (R_lt_irreflexive x). -elim x_ap; clear x_ap; intro x_lt; elim x_lt; intros N H; elim H; - clear x_lt H; intros e He HN; exists N; exists e; - auto; simpl in HN; intros n Hn. -astepr (CS_seq _ x n[-] (Zero[+]CS_seq _ x n)); auto. -astepr (Zero[+]CS_seq _ x n[-]CS_seq _ x n); auto. +Proof. + intro x; intro x_ap. + apply (R_lt_irreflexive x). + elim x_ap; clear x_ap; intro x_lt; elim x_lt; intros N H; elim H; + clear x_lt H; intros e He HN; exists N; exists e; auto; simpl in HN; intros n Hn. + astepr (CS_seq _ x n[-] (Zero[+]CS_seq _ x n)); auto. + astepr (Zero[+]CS_seq _ x n[-]CS_seq _ x n); auto. Qed. Lemma R_plus_comm : forall x y, R_plus x y [=] R_plus y x. -intros x y Hxy. -elim Hxy; clear Hxy; intro H; elim H; intros N HN; elim HN; clear H HN; - intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). -apply - leEq_less_trans - with (CS_seq _ y N[+]CS_seq _ x N[-] (CS_seq _ x N[+]CS_seq _ y N)); - auto. -rstepl (Zero:F); auto. -apply - leEq_less_trans - with (CS_seq _ x N[+]CS_seq _ y N[-] (CS_seq _ y N[+]CS_seq _ x N)); - auto. -rstepl (Zero:F); auto. +Proof. + intros x y Hxy. + elim Hxy; clear Hxy; intro H; elim H; intros N HN; elim HN; clear H HN; + intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). + apply leEq_less_trans with (CS_seq _ y N[+]CS_seq _ x N[-] (CS_seq _ x N[+]CS_seq _ y N)); auto. + rstepl (Zero:F); auto. + apply leEq_less_trans with (CS_seq _ x N[+]CS_seq _ y N[-] (CS_seq _ y N[+]CS_seq _ x N)); auto. + rstepl (Zero:F); auto. Qed. Definition R_inv (x : R_CSetoid) : R_CSetoid := Build_CauchySeq _ _ (CS_seq_inv F _ (CS_proof _ x)). Lemma R_inv_is_inv : forall x, R_plus x (R_inv x) [=] R_zero. -intro x; intro x_ap. -apply (R_lt_irreflexive R_zero). -elim x_ap; clear x_ap; intro x_lt; elim x_lt; intros N H; elim H; - clear x_lt H; intros e He HN; exists N; exists e; - auto; simpl in HN; intros n Hn. -simpl in |- *; astepr (Zero[-] (CS_seq _ x n[+][--] (CS_seq _ x n))); auto. -simpl in |- *; astepr (CS_seq _ x n[+][--] (CS_seq _ x n) [-]Zero); auto. +Proof. + intro x; intro x_ap. + apply (R_lt_irreflexive R_zero). + elim x_ap; clear x_ap; intro x_lt; elim x_lt; intros N H; elim H; + clear x_lt H; intros e He HN; exists N; exists e; auto; simpl in HN; intros n Hn. + simpl in |- *; astepr (Zero[-] (CS_seq _ x n[+][--] (CS_seq _ x n))); auto. + simpl in |- *; astepr (CS_seq _ x n[+][--] (CS_seq _ x n) [-]Zero); auto. Qed. Lemma R_inv_ext : un_op_strext _ R_inv. -intros x y Hxy. -elim Hxy; clear Hxy; intro x_lt; [ right | left ]; elim x_lt; intros N H; - elim H; clear x_lt H; intros e He HN; exists N; exists e; - auto; simpl in HN; intros n Hn. -rstepr ([--] (CS_seq _ y n) [-][--] (CS_seq _ x n)); auto. -rstepr ([--] (CS_seq _ x n) [-][--] (CS_seq _ y n)); auto. +Proof. + intros x y Hxy. + elim Hxy; clear Hxy; intro x_lt; [ right | left ]; elim x_lt; intros N H; + elim H; clear x_lt H; intros e He HN; exists N; exists e; auto; simpl in HN; intros n Hn. + rstepr ([--] (CS_seq _ y n) [-][--] (CS_seq _ x n)); auto. + rstepr ([--] (CS_seq _ x n) [-][--] (CS_seq _ y n)); auto. Qed. Definition Rinv : CSetoid_un_op R_CSetoid. -red in |- *. -apply Build_CSetoid_un_op with R_inv. -exact R_inv_ext. +Proof. + red in |- *. + apply Build_CSetoid_un_op with R_inv. + exact R_inv_ext. Defined. Definition R_CAbGroup : CAbGroup. -apply Build_CAbGroup' with R_CSetoid R_zero R_plus Rinv. -exact R_plus_lft_ext. -exact R_zero_lft_unit. -exact R_plus_comm. -exact R_plus_assoc. -exact R_inv_is_inv. +Proof. + apply Build_CAbGroup' with R_CSetoid R_zero R_plus Rinv. + exact R_plus_lft_ext. + exact R_zero_lft_unit. + exact R_plus_comm. + exact R_plus_assoc. + exact R_inv_is_inv. Defined. End Group_Structure. @@ -325,240 +309,213 @@ Definition R_mult (x y : R_CAbGroup) : R_CAbGroup := Definition R_one : R_CAbGroup := Build_CauchySeq _ _ (CS_seq_const F One). Lemma R_one_ap_zero : R_one [#] Zero. -right; exists 0; exists (One:F). -apply pos_one. -intros; simpl in |- *; astepr (One:F); apply leEq_reflexive. +Proof. + right; exists 0; exists (One:F). + apply pos_one. + intros; simpl in |- *; astepr (One:F); apply leEq_reflexive. Qed. Lemma R_mult_dist_plus : forall x y z, R_mult x (y[+]z) [=] R_mult x y[+]R_mult x z. -intros x y z H. -elim H; intro Hlt; elim Hlt; intros N HN; elim HN; clear H Hlt HN; - intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). -eapply leEq_less_trans. -apply (HN N (le_n _)). -rstepl (Zero:F); auto. -eapply leEq_less_trans. -apply (HN N (le_n _)). -rstepl (Zero:F); auto. +Proof. + intros x y z H. + elim H; intro Hlt; elim Hlt; intros N HN; elim HN; clear H Hlt HN; + intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). + eapply leEq_less_trans. + apply (HN N (le_n _)). + rstepl (Zero:F); auto. + eapply leEq_less_trans. + apply (HN N (le_n _)). + rstepl (Zero:F); auto. Qed. Lemma R_mult_dist_minus : forall x y z, R_mult x (y[-]z) [=] R_mult x y[-]R_mult x z. -intros x y z H. -elim H; intro Hlt; elim Hlt; intros N HN; elim HN; clear H Hlt HN; - intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). -eapply leEq_less_trans. -apply (HN N (le_n _)). -rstepl (Zero:F); auto. -eapply leEq_less_trans. -apply (HN N (le_n _)). -rstepl (Zero:F); auto. +Proof. + intros x y z H. + elim H; intro Hlt; elim Hlt; intros N HN; elim HN; clear H Hlt HN; + intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). + eapply leEq_less_trans. + apply (HN N (le_n _)). + rstepl (Zero:F); auto. + eapply leEq_less_trans. + apply (HN N (le_n _)). + rstepl (Zero:F); auto. Qed. Lemma R_one_rht_unit : forall x, R_mult x R_one [=] x. -intro x; intro x_ap. -apply (R_lt_irreflexive x). -elim x_ap; clear x_ap; intro x_lt; elim x_lt; intros N H; elim H; - clear x_lt H; intros e He HN; exists N; exists e; - auto; simpl in HN; intros n Hn. -astepr (CS_seq _ x n[-]CS_seq _ x n[*]One); auto. -astepr (CS_seq _ x n[*]One[-]CS_seq _ x n); auto. +Proof. + intro x; intro x_ap. + apply (R_lt_irreflexive x). + elim x_ap; clear x_ap; intro x_lt; elim x_lt; intros N H; elim H; + clear x_lt H; intros e He HN; exists N; exists e; auto; simpl in HN; intros n Hn. + astepr (CS_seq _ x n[-]CS_seq _ x n[*]One); auto. + astepr (CS_seq _ x n[*]One[-]CS_seq _ x n); auto. Qed. Lemma R_mult_comm : forall x y, R_mult x y [=] R_mult y x. -intros x y Hxy. -elim Hxy; clear Hxy; intro H; elim H; intros N HN; elim HN; clear H HN; - intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). -apply - leEq_less_trans - with (CS_seq _ y N[*]CS_seq _ x N[-]CS_seq _ x N[*]CS_seq _ y N); - auto. -rstepl (Zero:F); auto. -apply - leEq_less_trans - with (CS_seq _ x N[*]CS_seq _ y N[-]CS_seq _ y N[*]CS_seq _ x N); - auto. -rstepl (Zero:F); auto. +Proof. + intros x y Hxy. + elim Hxy; clear Hxy; intro H; elim H; intros N HN; elim HN; clear H HN; + intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). + apply leEq_less_trans with (CS_seq _ y N[*]CS_seq _ x N[-]CS_seq _ x N[*]CS_seq _ y N); auto. + rstepl (Zero:F); auto. + apply leEq_less_trans with (CS_seq _ x N[*]CS_seq _ y N[-]CS_seq _ y N[*]CS_seq _ x N); auto. + rstepl (Zero:F); auto. Qed. Lemma R_mult_ap_zero' : forall x y, R_mult x y [#] Zero -> x [#] Zero. -intros x y Hxy. -elim (CS_seq_bounded _ (CS_seq _ y) (CS_proof _ y)); intros K HK Hy; elim Hy; - clear Hy; intros Ny HNY. -set - (z := - Build_CauchySeq _ _ - (CS_seq_mult _ _ _ (CS_seq_const _ (Two[*]K)) (CS_proof _ x)) - :R_CAbGroup) in *. -elim (ap_cotransitive_unfolded _ _ _ Hxy z); intro Hap; elim Hap; intro Hlt; - elim Hlt; intros N HN; elim HN; clear Hap Hlt HN; - intros e He HN. - -right. -cut (forall n : nat, Ny <= n -> Zero [<] Two[*]K[-]CS_seq _ y n); - [ intro Hy' | intros n Hn ]. -set - (KK := - e[/] _[//]mult_resp_ap_zero _ _ _ (three_ap_zero _) (pos_ap_zero _ _ HK)) - in *. -exists (max N Ny); exists KK. -unfold KK in |- *; apply div_resp_pos; auto. -apply mult_resp_pos; auto; apply pos_three. -intros; simpl in |- *; unfold KK in |- *. -cut (N <= n); [ intro Hn | apply le_trans with (max N Ny); auto with arith ]. -cut (Ny <= n); - [ intro Hn' | apply le_trans with (max N Ny); auto with arith ]. -apply leEq_transitive with (e[/] _[//]pos_ap_zero _ _ (Hy' n Hn')). -apply mult_cancel_leEq with (One[/] _[//]pos_ap_zero _ _ He). -apply recip_resp_pos; auto. -rstepl - (One[/] _[//]mult_resp_ap_zero _ _ _ (three_ap_zero _) (pos_ap_zero _ _ HK)). -rstepr (One[/] _[//]pos_ap_zero _ _ (Hy' n Hn')). -apply recip_resp_leEq; auto. -unfold cg_minus in |- *; apply shift_plus_leEq'; rstepr ([--][--]K). -apply inv_resp_leEq; elim (HNY n); auto. -apply shift_div_leEq; auto. -eapply leEq_wdr. -apply (HN n); auto. -simpl in |- *; rational. -apply shift_zero_less_minus; apply leEq_less_trans with K. -elim (HNY n); auto. -astepl (Zero[+]K); astepr (K[+]K); apply plus_resp_less_rht; auto. - -left. -cut (forall n : nat, Ny <= n -> Zero [<] Two[*]K[-]CS_seq _ y n); - [ intro Hy' | intros n Hn ]. -set - (KK := - e[/] _[//]mult_resp_ap_zero _ _ _ (three_ap_zero _) (pos_ap_zero _ _ HK)) - in *. -exists (max N Ny); exists KK. -unfold KK in |- *; apply div_resp_pos; auto. -apply mult_resp_pos; auto; apply pos_three. -intros; simpl in |- *; unfold KK in |- *. -cut (N <= n); [ intro Hn | apply le_trans with (max N Ny); auto with arith ]. -cut (Ny <= n); - [ intro Hn' | apply le_trans with (max N Ny); auto with arith ]. -apply leEq_transitive with (e[/] _[//]pos_ap_zero _ _ (Hy' n Hn')). -apply mult_cancel_leEq with (One[/] _[//]pos_ap_zero _ _ He). -apply recip_resp_pos; auto. -rstepl - (One[/] _[//]mult_resp_ap_zero _ _ _ (three_ap_zero _) (pos_ap_zero _ _ HK)). -rstepr (One[/] _[//]pos_ap_zero _ _ (Hy' n Hn')). -apply recip_resp_leEq; auto. -unfold cg_minus in |- *; apply shift_plus_leEq'; rstepr ([--][--]K). -apply inv_resp_leEq; elim (HNY n); auto. -apply shift_div_leEq; auto. -eapply leEq_wdr. -apply (HN n); auto. -simpl in |- *; rational. -apply shift_zero_less_minus; apply leEq_less_trans with K. -elim (HNY n); auto. -astepl (Zero[+]K); astepr (K[+]K); apply plus_resp_less_rht; auto. - -left. -set - (KK := - e[/] _[//]mult_resp_ap_zero _ _ _ (two_ap_zero _) (pos_ap_zero _ _ HK)) - in *. -exists N; exists KK. -unfold KK in |- *; apply div_resp_pos; auto. -apply mult_resp_pos; auto; apply pos_two. -intros; simpl in |- *; unfold KK in |- *. -apply shift_div_leEq. -apply mult_resp_pos; auto; apply pos_two. -eapply leEq_wdr. -apply (HN n H). -simpl in |- *; rational. - -right. -set - (KK := - e[/] _[//]mult_resp_ap_zero _ _ _ (two_ap_zero _) (pos_ap_zero _ _ HK)) - in *. -exists N; exists KK. -unfold KK in |- *; apply div_resp_pos; auto. -apply mult_resp_pos; auto; apply pos_two. -intros; simpl in |- *; unfold KK in |- *. -apply shift_div_leEq. -apply mult_resp_pos; auto; apply pos_two. -eapply leEq_wdr. -apply (HN n H). -simpl in |- *; rational. +Proof. + intros x y Hxy. + elim (CS_seq_bounded _ (CS_seq _ y) (CS_proof _ y)); intros K HK Hy; elim Hy; + clear Hy; intros Ny HNY. + set (z := Build_CauchySeq _ _ (CS_seq_mult _ _ _ (CS_seq_const _ (Two[*]K)) (CS_proof _ x)) + :R_CAbGroup) in *. + elim (ap_cotransitive_unfolded _ _ _ Hxy z); intro Hap; elim Hap; intro Hlt; + elim Hlt; intros N HN; elim HN; clear Hap Hlt HN; intros e He HN. + right. + cut (forall n : nat, Ny <= n -> Zero [<] Two[*]K[-]CS_seq _ y n); [ intro Hy' | intros n Hn ]. + set (KK := e[/] _[//]mult_resp_ap_zero _ _ _ (three_ap_zero _) (pos_ap_zero _ _ HK)) in *. + exists (max N Ny); exists KK. + unfold KK in |- *; apply div_resp_pos; auto. + apply mult_resp_pos; auto; apply pos_three. + intros; simpl in |- *; unfold KK in |- *. + cut (N <= n); [ intro Hn | apply le_trans with (max N Ny); auto with arith ]. + cut (Ny <= n); [ intro Hn' | apply le_trans with (max N Ny); auto with arith ]. + apply leEq_transitive with (e[/] _[//]pos_ap_zero _ _ (Hy' n Hn')). + apply mult_cancel_leEq with (One[/] _[//]pos_ap_zero _ _ He). + apply recip_resp_pos; auto. + rstepl (One[/] _[//]mult_resp_ap_zero _ _ _ (three_ap_zero _) (pos_ap_zero _ _ HK)). + rstepr (One[/] _[//]pos_ap_zero _ _ (Hy' n Hn')). + apply recip_resp_leEq; auto. + unfold cg_minus in |- *; apply shift_plus_leEq'; rstepr ([--][--]K). + apply inv_resp_leEq; elim (HNY n); auto. + apply shift_div_leEq; auto. + eapply leEq_wdr. + apply (HN n); auto. + simpl in |- *; rational. + apply shift_zero_less_minus; apply leEq_less_trans with K. + elim (HNY n); auto. + astepl (Zero[+]K); astepr (K[+]K); apply plus_resp_less_rht; auto. + left. + cut (forall n : nat, Ny <= n -> Zero [<] Two[*]K[-]CS_seq _ y n); [ intro Hy' | intros n Hn ]. + set (KK := e[/] _[//]mult_resp_ap_zero _ _ _ (three_ap_zero _) (pos_ap_zero _ _ HK)) in *. + exists (max N Ny); exists KK. + unfold KK in |- *; apply div_resp_pos; auto. + apply mult_resp_pos; auto; apply pos_three. + intros; simpl in |- *; unfold KK in |- *. + cut (N <= n); [ intro Hn | apply le_trans with (max N Ny); auto with arith ]. + cut (Ny <= n); [ intro Hn' | apply le_trans with (max N Ny); auto with arith ]. + apply leEq_transitive with (e[/] _[//]pos_ap_zero _ _ (Hy' n Hn')). + apply mult_cancel_leEq with (One[/] _[//]pos_ap_zero _ _ He). + apply recip_resp_pos; auto. + rstepl (One[/] _[//]mult_resp_ap_zero _ _ _ (three_ap_zero _) (pos_ap_zero _ _ HK)). + rstepr (One[/] _[//]pos_ap_zero _ _ (Hy' n Hn')). + apply recip_resp_leEq; auto. + unfold cg_minus in |- *; apply shift_plus_leEq'; rstepr ([--][--]K). + apply inv_resp_leEq; elim (HNY n); auto. + apply shift_div_leEq; auto. + eapply leEq_wdr. + apply (HN n); auto. + simpl in |- *; rational. + apply shift_zero_less_minus; apply leEq_less_trans with K. + elim (HNY n); auto. + astepl (Zero[+]K); astepr (K[+]K); apply plus_resp_less_rht; auto. + left. + set (KK := e[/] _[//]mult_resp_ap_zero _ _ _ (two_ap_zero _) (pos_ap_zero _ _ HK)) in *. + exists N; exists KK. + unfold KK in |- *; apply div_resp_pos; auto. + apply mult_resp_pos; auto; apply pos_two. + intros; simpl in |- *; unfold KK in |- *. + apply shift_div_leEq. + apply mult_resp_pos; auto; apply pos_two. + eapply leEq_wdr. + apply (HN n H). + simpl in |- *; rational. + right. + set (KK := e[/] _[//]mult_resp_ap_zero _ _ _ (two_ap_zero _) (pos_ap_zero _ _ HK)) in *. + exists N; exists KK. + unfold KK in |- *; apply div_resp_pos; auto. + apply mult_resp_pos; auto; apply pos_two. + intros; simpl in |- *; unfold KK in |- *. + apply shift_div_leEq. + apply mult_resp_pos; auto; apply pos_two. + eapply leEq_wdr. + apply (HN n H). + simpl in |- *; rational. Qed. Lemma R_mult_lft_ext : forall x y z, R_mult x z [#] R_mult y z -> x [#] y. -intros x y z Hxy. -apply zero_minus_apart. -apply R_mult_ap_zero' with z. -apply ap_wdl_unfolded with (R_mult x z[-]R_mult y z). -apply minus_ap_zero; auto. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -apply R_mult_comm. -eapply eq_transitive_unfolded. -apply R_mult_dist_minus. -apply cg_minus_wd; apply R_mult_comm. +Proof. + intros x y z Hxy. + apply zero_minus_apart. + apply R_mult_ap_zero' with z. + apply ap_wdl_unfolded with (R_mult x z[-]R_mult y z). + apply minus_ap_zero; auto. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply R_mult_comm. + eapply eq_transitive_unfolded. + apply R_mult_dist_minus. + apply cg_minus_wd; apply R_mult_comm. Qed. Lemma R_mult_rht_ext : forall x y z, R_mult x y [#] R_mult x z -> y [#] z. -intros x y z Hxy. -apply R_mult_lft_ext with x. -eapply ap_wdl_unfolded. -eapply ap_wdr_unfolded. -apply Hxy. -apply R_mult_comm. -apply R_mult_comm. +Proof. + intros x y z Hxy. + apply R_mult_lft_ext with x. + eapply ap_wdl_unfolded. + eapply ap_wdr_unfolded. + apply Hxy. + apply R_mult_comm. + apply R_mult_comm. Qed. Lemma R_mult_strext : bin_op_strext _ R_mult. -red in |- *; red in |- *. -intros x y a b Hap. -elim (ap_cotransitive_unfolded _ _ _ Hap (R_mult x b)); intro H. -right; apply R_mult_rht_ext with x; auto. -left; apply R_mult_lft_ext with b; auto. +Proof. + red in |- *; red in |- *. + intros x y a b Hap. + elim (ap_cotransitive_unfolded _ _ _ Hap (R_mult x b)); intro H. + right; apply R_mult_rht_ext with x; auto. + left; apply R_mult_lft_ext with b; auto. Qed. Definition Rmult : CSetoid_bin_op R_CAbGroup. -red in |- *. -apply Build_CSetoid_bin_fun with R_mult. -apply R_mult_strext. +Proof. + red in |- *. + apply Build_CSetoid_bin_fun with R_mult. + apply R_mult_strext. Defined. Lemma R_mult_assoc : associative Rmult. -intros x y z Hap. -elim Hap; clear Hap; intro H; elim H; intros N HN; elim HN; clear H HN; - intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). -apply - leEq_less_trans - with - (CS_seq _ x N[*]CS_seq _ y N[*]CS_seq _ z N[-] - CS_seq _ x N[*] (CS_seq _ y N[*]CS_seq _ z N)); - auto. -rstepl (Zero:F); auto. -apply - leEq_less_trans - with - (CS_seq _ x N[*] (CS_seq _ y N[*]CS_seq _ z N) [-] - CS_seq _ x N[*]CS_seq _ y N[*]CS_seq _ z N); auto. -rstepl (Zero:F); auto. +Proof. + intros x y z Hap. + elim Hap; clear Hap; intro H; elim H; intros N HN; elim HN; clear H HN; + intros e He HN; simpl in HN; apply (less_irreflexive_unfolded _ e). + apply leEq_less_trans with (CS_seq _ x N[*]CS_seq _ y N[*]CS_seq _ z N[-] + CS_seq _ x N[*] (CS_seq _ y N[*]CS_seq _ z N)); auto. + rstepl (Zero:F); auto. + apply leEq_less_trans with (CS_seq _ x N[*] (CS_seq _ y N[*]CS_seq _ z N) [-] + CS_seq _ x N[*]CS_seq _ y N[*]CS_seq _ z N); auto. + rstepl (Zero:F); auto. Qed. Lemma R_one_lft_unit : forall x, R_mult R_one x [=] x. -intro. -eapply eq_transitive_unfolded. -apply R_mult_comm. -apply R_one_rht_unit. +Proof. + intro. + eapply eq_transitive_unfolded. + apply R_mult_comm. + apply R_one_rht_unit. Qed. Definition R_CRing : CRing. -apply Build_CRing with R_CAbGroup R_one Rmult. -apply Build_is_CRing with R_mult_assoc. -apply Build_is_CMonoid. -exact R_one_rht_unit. -exact R_one_lft_unit. -exact R_mult_comm. -exact R_mult_dist_plus. -exact R_one_ap_zero. +Proof. + apply Build_CRing with R_CAbGroup R_one Rmult. + apply Build_is_CRing with R_mult_assoc. + apply Build_is_CMonoid. + exact R_one_rht_unit. + exact R_one_lft_unit. + exact R_mult_comm. + exact R_mult_dist_plus. + exact R_one_ap_zero. Defined. End Ring_Structure. @@ -574,127 +531,120 @@ quite straightforwardly. Lemma R_integral_domain : forall x y : R_CRing, x [#] Zero -> y [#] Zero -> x[*]y [#] Zero. -intros x y Hx Hy. -elim Hx; intro Hlt; elim Hlt; intros Nx HN; elim HN; clear Hx Hlt HN; - intros ex Hex HNx; simpl in HNx; elim Hy; intro Hlt; - elim Hlt; intros Ny HN; elim HN; clear Hy Hlt HN; - intros ey Hey HNy; simpl in HNy. - -right. -exists (max Nx Ny); exists (ex[*]ey). -apply mult_resp_pos; auto. -intros; simpl in |- *; rstepr ([--] (CS_seq _ x n) [*][--] (CS_seq _ y n)). -apply mult_resp_leEq_both; try (apply less_leEq; assumption). -astepr (Zero[-]CS_seq _ x n); eauto with arith. -astepr (Zero[-]CS_seq _ y n); eauto with arith. - -left. -exists (max Nx Ny); exists (ex[*]ey). -apply mult_resp_pos; auto. -intros; simpl in |- *; rstepr ([--] (CS_seq _ x n) [*]CS_seq _ y n). -apply mult_resp_leEq_both; try (apply less_leEq; assumption). -astepr (Zero[-]CS_seq _ x n); eauto with arith. -astepr (CS_seq _ y n[-]Zero); eauto with arith. - -left. -exists (max Nx Ny); exists (ex[*]ey). -apply mult_resp_pos; auto. -intros; simpl in |- *; rstepr (CS_seq _ x n[*][--] (CS_seq _ y n)). -apply mult_resp_leEq_both; try (apply less_leEq; assumption). -astepr (CS_seq _ x n[-]Zero); eauto with arith. -astepr (Zero[-]CS_seq _ y n); eauto with arith. - -right. -exists (max Nx Ny); exists (ex[*]ey). -apply mult_resp_pos; auto. -intros; simpl in |- *; astepr (CS_seq _ x n[*]CS_seq _ y n). -apply mult_resp_leEq_both; try (apply less_leEq; assumption). -astepr (CS_seq _ x n[-]Zero); eauto with arith. -astepr (CS_seq _ y n[-]Zero); eauto with arith. +Proof. + intros x y Hx Hy. + elim Hx; intro Hlt; elim Hlt; intros Nx HN; elim HN; clear Hx Hlt HN; + intros ex Hex HNx; simpl in HNx; elim Hy; intro Hlt; + elim Hlt; intros Ny HN; elim HN; clear Hy Hlt HN; intros ey Hey HNy; simpl in HNy. + right. + exists (max Nx Ny); exists (ex[*]ey). + apply mult_resp_pos; auto. + intros; simpl in |- *; rstepr ([--] (CS_seq _ x n) [*][--] (CS_seq _ y n)). + apply mult_resp_leEq_both; try (apply less_leEq; assumption). + astepr (Zero[-]CS_seq _ x n); eauto with arith. + astepr (Zero[-]CS_seq _ y n); eauto with arith. + left. + exists (max Nx Ny); exists (ex[*]ey). + apply mult_resp_pos; auto. + intros; simpl in |- *; rstepr ([--] (CS_seq _ x n) [*]CS_seq _ y n). + apply mult_resp_leEq_both; try (apply less_leEq; assumption). + astepr (Zero[-]CS_seq _ x n); eauto with arith. + astepr (CS_seq _ y n[-]Zero); eauto with arith. + left. + exists (max Nx Ny); exists (ex[*]ey). + apply mult_resp_pos; auto. + intros; simpl in |- *; rstepr (CS_seq _ x n[*][--] (CS_seq _ y n)). + apply mult_resp_leEq_both; try (apply less_leEq; assumption). + astepr (CS_seq _ x n[-]Zero); eauto with arith. + astepr (Zero[-]CS_seq _ y n); eauto with arith. + right. + exists (max Nx Ny); exists (ex[*]ey). + apply mult_resp_pos; auto. + intros; simpl in |- *; astepr (CS_seq _ x n[*]CS_seq _ y n). + apply mult_resp_leEq_both; try (apply less_leEq; assumption). + astepr (CS_seq _ x n[-]Zero); eauto with arith. + astepr (CS_seq _ y n[-]Zero); eauto with arith. Qed. Definition R_recip : forall x : R_CRing, x [#] Zero -> R_CRing. -intros x Hx; elim Hx; intro Hlt; elim Hlt; intros N HN; elim HN; - clear Hx Hlt HN; intros e He HN. -cut (forall n : nat, N <= n -> e [<=] [--] (CS_seq _ x n)); intros. -apply - (Build_CauchySeq _ _ - (CS_seq_inv _ _ - (CS_seq_recip _ _ (CS_seq_inv _ _ (CS_proof _ x)) e He N H))). -astepr (Zero[-]CS_seq _ x n); simpl in HN; auto. - -cut (forall n : nat, N <= n -> e [<=] CS_seq _ x n); intros. -apply (Build_CauchySeq _ _ (CS_seq_recip _ _ (CS_proof _ x) e He N H)). -astepr (CS_seq _ x n[-]Zero); simpl in HN; auto. + intros x Hx; elim Hx; intro Hlt; elim Hlt; intros N HN; elim HN; clear Hx Hlt HN; intros e He HN. +Proof. + cut (forall n : nat, N <= n -> e [<=] [--] (CS_seq _ x n)); intros. + apply (Build_CauchySeq _ _ (CS_seq_inv _ _ + (CS_seq_recip _ _ (CS_seq_inv _ _ (CS_proof _ x)) e He N H))). + astepr (Zero[-]CS_seq _ x n); simpl in HN; auto. + cut (forall n : nat, N <= n -> e [<=] CS_seq _ x n); intros. + apply (Build_CauchySeq _ _ (CS_seq_recip _ _ (CS_proof _ x) e He N H)). + astepr (CS_seq _ x n[-]Zero); simpl in HN; auto. Defined. Lemma R_recip_inverse : forall x x_, x[*]R_recip x x_ [=] One. -intros x Hx; elim Hx; intro Hlt; elim Hlt; intros N HN; elim HN; - clear Hx Hlt HN; simpl in |- *; intros e He HN Hap; - elim Hap; intro Hlt; elim Hlt; intros K HK; elim HK; - clear Hap Hlt HK; intros d Hd HM; simpl in HM. - -apply (less_irreflexive_unfolded _ d). -apply leEq_less_trans with (Zero:F); auto. -simpl in HM. -eapply leEq_wdr. -apply (HM (max K N)); auto with arith. -unfold CS_seq_recip_seq in |- *; elim lt_le_dec; intro. -elimtype False; apply le_not_lt with N (max K N); auto with arith. -simpl in |- *; rational. - -apply (less_irreflexive_unfolded _ d). -apply leEq_less_trans with (Zero:F); auto. -simpl in HM. -eapply leEq_wdr. -apply (HM (max K N)); auto with arith. -unfold CS_seq_recip_seq in |- *; elim lt_le_dec; intro. -elimtype False; apply le_not_lt with N (max K N); auto with arith. -simpl in |- *; rational. - -apply (less_irreflexive_unfolded _ d). -apply leEq_less_trans with (Zero:F); auto. -simpl in HM. -eapply leEq_wdr. -apply (HM (max K N)); auto with arith. -unfold CS_seq_recip_seq in |- *; elim lt_le_dec; intro. -elimtype False; apply le_not_lt with N (max K N); auto with arith. -simpl in |- *; rational. - -apply (less_irreflexive_unfolded _ d). -apply leEq_less_trans with (Zero:F); auto. -simpl in HM. -eapply leEq_wdr. -apply (HM (max K N)); auto with arith. -unfold CS_seq_recip_seq in |- *; elim lt_le_dec; intro. -elimtype False; apply le_not_lt with N (max K N); auto with arith. -simpl in |- *; rational. +Proof. + intros x Hx; elim Hx; intro Hlt; elim Hlt; intros N HN; elim HN; + clear Hx Hlt HN; simpl in |- *; intros e He HN Hap; + elim Hap; intro Hlt; elim Hlt; intros K HK; elim HK; + clear Hap Hlt HK; intros d Hd HM; simpl in HM. + apply (less_irreflexive_unfolded _ d). + apply leEq_less_trans with (Zero:F); auto. + simpl in HM. + eapply leEq_wdr. + apply (HM (max K N)); auto with arith. + unfold CS_seq_recip_seq in |- *; elim lt_le_dec; intro. + elimtype False; apply le_not_lt with N (max K N); auto with arith. + simpl in |- *; rational. + apply (less_irreflexive_unfolded _ d). + apply leEq_less_trans with (Zero:F); auto. + simpl in HM. + eapply leEq_wdr. + apply (HM (max K N)); auto with arith. + unfold CS_seq_recip_seq in |- *; elim lt_le_dec; intro. + elimtype False; apply le_not_lt with N (max K N); auto with arith. + simpl in |- *; rational. + apply (less_irreflexive_unfolded _ d). + apply leEq_less_trans with (Zero:F); auto. + simpl in HM. + eapply leEq_wdr. + apply (HM (max K N)); auto with arith. + unfold CS_seq_recip_seq in |- *; elim lt_le_dec; intro. + elimtype False; apply le_not_lt with N (max K N); auto with arith. + simpl in |- *; rational. + apply (less_irreflexive_unfolded _ d). + apply leEq_less_trans with (Zero:F); auto. + simpl in HM. + eapply leEq_wdr. + apply (HM (max K N)); auto with arith. + unfold CS_seq_recip_seq in |- *; elim lt_le_dec; intro. + elimtype False; apply le_not_lt with N (max K N); auto with arith. + simpl in |- *; rational. Qed. Lemma R_recip_strext : forall x y x_ y_, R_recip x x_ [#] R_recip y y_ -> x [#] y. -intros. -apply zero_minus_apart. -apply ap_wdl with (x[*]y[*] (R_recip y y_[-]R_recip x x_)). -apply R_integral_domain. -apply R_integral_domain; auto. -apply minus_ap_zero; apply ap_symmetric_unfolded; auto. -rstepl (y[*]R_recip y y_[*]x[-]x[*]R_recip x x_[*]y). -rstepr (One[*]x[-]One[*]y). -apply cg_minus_wd; apply mult_wdl; apply R_recip_inverse. +Proof. + intros. + apply zero_minus_apart. + apply ap_wdl with (x[*]y[*] (R_recip y y_[-]R_recip x x_)). + apply R_integral_domain. + apply R_integral_domain; auto. + apply minus_ap_zero; apply ap_symmetric_unfolded; auto. + rstepl (y[*]R_recip y y_[*]x[-]x[*]R_recip x x_[*]y). + rstepr (One[*]x[-]One[*]y). + apply cg_minus_wd; apply mult_wdl; apply R_recip_inverse. Qed. Lemma R_recip_inverse' : forall x x_, R_recip x x_[*]x [=] One. -intros. -astepl (x[*]R_recip x x_). -apply R_recip_inverse. +Proof. + intros. + astepl (x[*]R_recip x x_). + apply R_recip_inverse. Qed. Definition R_CField : CField. -apply Build_CField with R_CRing R_recip. -split. -apply R_recip_inverse. -apply R_recip_inverse'. -exact R_recip_strext. +Proof. + apply Build_CField with R_CRing R_recip. + split. + apply R_recip_inverse. + apply R_recip_inverse'. + exact R_recip_strext. Defined. End Field_Structure. @@ -708,68 +658,70 @@ defined at the beginning. *) Lemma R_lt_strext : Crel_strext R_CSetoid R_lt. -intros x a y b Hxy. -elim (R_lt_cotrans x y Hxy a); intro H. -right; left; left; auto. -elim (R_lt_cotrans a y H b); intro H'. -left; auto. -right; right; right; auto. +Proof. + intros x a y b Hxy. + elim (R_lt_cotrans x y Hxy a); intro H. + right; left; left; auto. + elim (R_lt_cotrans a y H b); intro H'. + left; auto. + right; right; right; auto. Qed. Definition Rlt : CCSetoid_relation R_CField. -apply Build_CCSetoid_relation with R_lt. -exact R_lt_strext. +Proof. + apply Build_CCSetoid_relation with R_lt. + exact R_lt_strext. Defined. Lemma Rlt_transitive : Ctransitive Rlt. -intros x y z H H'. -simpl in H, H'. -elim H; intros N1 HN1; elim HN1; clear H HN1; intros e1 He1 HN1. -elim H'; intros N2 HN2; elim HN2; clear H' HN2; intros e2 He2 HN2. -exists (max N1 N2); exists (e1[+]e2). -apply plus_resp_pos; auto. -intros; rstepr (CS_seq _ y n[-]CS_seq _ x n[+] (CS_seq _ z n[-]CS_seq _ y n)). -apply plus_resp_leEq_both; eauto with arith. +Proof. + intros x y z H H'. + simpl in H, H'. + elim H; intros N1 HN1; elim HN1; clear H HN1; intros e1 He1 HN1. + elim H'; intros N2 HN2; elim HN2; clear H' HN2; intros e2 He2 HN2. + exists (max N1 N2); exists (e1[+]e2). + apply plus_resp_pos; auto. + intros; rstepr (CS_seq _ y n[-]CS_seq _ x n[+] (CS_seq _ z n[-]CS_seq _ y n)). + apply plus_resp_leEq_both; eauto with arith. Qed. Lemma Rlt_strict : strictorder Rlt. -apply Build_strictorder. - -exact Rlt_transitive. - -intros x y H H'. -apply R_lt_irreflexive with x. -apply Rlt_transitive with y; auto. +Proof. + apply Build_strictorder. + exact Rlt_transitive. + intros x y H H'. + apply R_lt_irreflexive with x. + apply Rlt_transitive with y; auto. Qed. Lemma R_plus_resp_lt : forall x y, Rlt x y -> forall z, Rlt (x[+]z) (y[+]z). -intros x y Hxy z. -elim Hxy; intros N HN; elim HN; clear Hxy HN; intros e He HN; exists N; - exists e; auto; intros n Hn. -simpl in |- *; rstepr (CS_seq _ y n[-]CS_seq _ x n); auto. +Proof. + intros x y Hxy z. + elim Hxy; intros N HN; elim HN; clear Hxy HN; intros e He HN; exists N; exists e; auto; intros n Hn. + simpl in |- *; rstepr (CS_seq _ y n[-]CS_seq _ x n); auto. Qed. Lemma R_mult_resp_lt : forall x y, Rlt Zero x -> Rlt Zero y -> Rlt Zero (x[*]y). -intros x y Hx Hy. -elim Hx; intros Nx HN; elim HN; clear Hx HN; intros ex Hex HNx; simpl in HNx; - elim Hy; intros Ny HN; elim HN; clear Hy HN; intros ey Hey HNy; - simpl in HNy. - -exists (max Nx Ny); exists (ex[*]ey). -apply mult_resp_pos; auto. -intros; simpl in |- *; astepr (CS_seq _ x n[*]CS_seq _ y n). -apply mult_resp_leEq_both; try (apply less_leEq; assumption). -astepr (CS_seq _ x n[-]Zero); eauto with arith. -astepr (CS_seq _ y n[-]Zero); eauto with arith. +Proof. + intros x y Hx Hy. + elim Hx; intros Nx HN; elim HN; clear Hx HN; intros ex Hex HNx; simpl in HNx; + elim Hy; intros Ny HN; elim HN; clear Hy HN; intros ey Hey HNy; simpl in HNy. + exists (max Nx Ny); exists (ex[*]ey). + apply mult_resp_pos; auto. + intros; simpl in |- *; astepr (CS_seq _ x n[*]CS_seq _ y n). + apply mult_resp_leEq_both; try (apply less_leEq; assumption). + astepr (CS_seq _ x n[-]Zero); eauto with arith. + astepr (CS_seq _ y n[-]Zero); eauto with arith. Qed. Definition R_COrdField : COrdField. -apply Build_COrdField with R_CField Rlt (default_leEq _ Rlt) (default_greater _ Rlt) (default_grEq _ (default_leEq _ Rlt)). -apply Build_is_COrdField; try solve [unfold Iff; tauto]. -exact Rlt_strict. -exact R_plus_resp_lt. -exact R_mult_resp_lt. -split; auto. +Proof. + apply Build_COrdField with R_CField Rlt (default_leEq _ Rlt) (default_greater _ Rlt) (default_grEq _ (default_leEq _ Rlt)). + apply Build_is_COrdField; try solve [unfold Iff; tauto]. + exact Rlt_strict. + exact R_plus_resp_lt. + exact R_mult_resp_lt. + split; auto. Defined. End Order. @@ -784,44 +736,43 @@ Section Auxiliary. Lemma Rlt_alt_1 : forall x y : R_Set, {e : F | Zero [<] e | {N : nat | forall m, N <= m -> e [<=] CS_seq F y m[-]CS_seq F x m}} -> Rlt x y. Proof. -intros x y H. -case H. -intro e1. -intros H1 H2. -case H2. -intro N1. -intros H3. -unfold Rlt in |- *. -exists N1. -exists (e1 [/]TwoNZ). -apply pos_div_two. -assumption. -intros. -apply leEq_transitive with e1. -apply mult_cancel_leEq with (Two:F). -apply pos_two. - -rstepl (e1[+] (Zero:F)). -rstepr (e1[+]e1). -apply plus_resp_leEq_lft. -apply less_leEq; assumption. -apply H3. -assumption. + intros x y H. + case H. + intro e1. + intros H1 H2. + case H2. + intro N1. + intros H3. + unfold Rlt in |- *. + exists N1. + exists (e1 [/]TwoNZ). + apply pos_div_two. + assumption. + intros. + apply leEq_transitive with e1. + apply mult_cancel_leEq with (Two:F). + apply pos_two. + rstepl (e1[+] (Zero:F)). + rstepr (e1[+]e1). + apply plus_resp_leEq_lft. + apply less_leEq; assumption. + apply H3. + assumption. Qed. Lemma Rlt_alt_2 : forall x y : R_Set, Rlt x y -> {e : F | Zero [<] e | {N : nat | forall m, N <= m -> e [<=] CS_seq F y m[-]CS_seq F x m}}. Proof. intros x y H. -unfold Rlt in H. -case H. -intros N H2. -case H2. -intros e H1 H0. -exists e. -assumption. -exists N. -auto. + unfold Rlt in H. + case H. + intros N H2. + case H2. + intros e H1 H0. + exists e. + assumption. + exists N. + auto. Qed. Lemma R_ap_alt_1 : forall x y : R_CSetoid, x [#] y -> {e : F | Zero [<] e | @@ -829,25 +780,23 @@ Lemma R_ap_alt_1 : forall x y : R_CSetoid, x [#] y -> {e : F | Zero [<] e | Proof. intros x y H. case H; intros H0. - - case H0; intros N1 HN1. - case HN1; intros e1 H2 H31. - exists e1. - assumption. - exists N1. - split. - assumption. - right. - apply inv_cancel_leEq. - rstepl e1. - rstepr (CS_seq F y m[-]CS_seq F x m). - apply H31. - assumption. - + case H0; intros N1 HN1. + case HN1; intros e1 H2 H31. + exists e1. + assumption. + exists N1. + split. + assumption. + right. + apply inv_cancel_leEq. + rstepl e1. + rstepr (CS_seq F y m[-]CS_seq F x m). + apply H31. + assumption. case H0; intros N1 HN1. case HN1; intros e1 H2 H31. exists e1. - assumption. + assumption. exists N1. split; try left; auto. Qed. @@ -874,62 +823,52 @@ Proof. unfold CS_seq in |- *; intro. case (px e16 He16); intros N1 px2. case (py e16 He16); intros N2 py2. - set (NN := max N1 N2) in *. assert (N1_NN : N1 <= NN). unfold NN in |- *; auto with arith. assert (N2_NN : N2 <= NN). unfold NN in |- *; auto with arith. - exists NN. - cut (forall m : nat, Not (NN <= m and AbsBig e2 (x_ m[-]y_ m))). - intros. - unfold AbsSmall in |- *. - assert (H3 : Not (AbsBig e2 (x_ m[-]y_ m))). - intro; elim (H1 m); split; assumption. - assert (H4 : ~ e2 [<=] x_ m[-]y_ m). - intro; apply H3; split; try left; assumption. - assert (H5 : ~ x_ m[-]y_ m [<=] [--]e2). - intro; apply H3; split; try right; assumption. - split; rewrite leEq_def; intro. - apply H5. - apply leEq_transitive with ([--]e). - apply less_leEq; assumption. - apply less_leEq; apply inv_resp_less. - unfold e2 in |- *; apply pos_div_two'; assumption. - apply H4. - apply leEq_transitive with e. - apply less_leEq; unfold e2 in |- *; apply pos_div_two'; auto. - apply less_leEq; assumption. - + intros. + unfold AbsSmall in |- *. + assert (H3 : Not (AbsBig e2 (x_ m[-]y_ m))). + intro; elim (H1 m); split; assumption. + assert (H4 : ~ e2 [<=] x_ m[-]y_ m). + intro; apply H3; split; try left; assumption. + assert (H5 : ~ x_ m[-]y_ m [<=] [--]e2). + intro; apply H3; split; try right; assumption. + split; rewrite leEq_def; intro. + apply H5. + apply leEq_transitive with ([--]e). + apply less_leEq; assumption. + apply less_leEq; apply inv_resp_less. + unfold e2 in |- *; apply pos_div_two'; assumption. + apply H4. + apply leEq_transitive with e. + apply less_leEq; unfold e2 in |- *; apply pos_div_two'; auto. + apply less_leEq; assumption. intro. intro H1. elim H1; intros X Y. - elim H0. exists NN. intros. - apply AbsBig_wdl with (e2[-]e8[-]e8). - 2: unfold e2, e4, e8 in |- *; rational. - + 2: unfold e2, e4, e8 in |- *; rational. apply AbsBig_wdr with (x_ m[-]y_ m[-] (x_ m[-]x_ m0) [-] (y_ m0[-]y_ m)). - 2: rational. - + 2: rational. assert (e8 [<] e2). unfold e2, e8 in |- *. rstepl ((e [/]TwoNZ) [/]FourNZ). rstepr (e [/]TwoNZ). apply pos_div_four'. assumption. - assert (Zero [<] e2[-]e8). apply plus_cancel_less with e8. rstepl e8. rstepr e2. assumption. - assert (e8 [<] e2[-]e8). apply plus_cancel_less with e8. rstepr e2. @@ -937,28 +876,23 @@ Proof. rstepl ((e [/]TwoNZ) [/]TwoNZ). apply pos_div_two'. assumption. - apply AbsBigSmall_minus; auto. - apply AbsBigSmall_minus; auto. - - unfold e8 in |- *. - rstepl (e [/]SixteenNZ[+]e [/]SixteenNZ). - rstepr (x_ m[-]x_ N1[+] (x_ N1[-]x_ m0)). - apply AbsSmall_plus. - apply px2. - apply le_trans with NN; assumption. - - apply AbsSmall_minus. - apply px2. - apply le_trans with NN; assumption. - + apply AbsBigSmall_minus; auto. + unfold e8 in |- *. + rstepl (e [/]SixteenNZ[+]e [/]SixteenNZ). + rstepr (x_ m[-]x_ N1[+] (x_ N1[-]x_ m0)). + apply AbsSmall_plus. + apply px2. + apply le_trans with NN; assumption. + apply AbsSmall_minus. + apply px2. + apply le_trans with NN; assumption. unfold e8 in |- *. rstepl (e [/]SixteenNZ[+]e [/]SixteenNZ). rstepr (y_ m0[-]y_ N2[+] (y_ N2[-]y_ m)). apply AbsSmall_plus. - apply py2. - apply le_trans with NN; assumption. - + apply py2. + apply le_trans with NN; assumption. apply AbsSmall_minus. apply py2. apply le_trans with NN; assumption. @@ -987,7 +921,6 @@ Proof. case (px e16 He16); intros N1 H31. case (py e16 He16); intros N2 H41. simpl in |- *; intro H2; case H2; intros N H21. - set (NN := max N (max N1 N2)) in *. assert (N_NN : N <= NN). unfold NN in |- *; auto with arith. @@ -995,131 +928,106 @@ Proof. unfold NN in |- *; apply le_trans with (max N1 N2); auto with arith. assert (N2_NN : N2 <= NN). unfold NN in |- *; apply le_trans with (max N1 N2); auto with arith. - set (x0 := x_ NN) in *. set (y0 := y_ NN) in *. - simpl in |- *. unfold R_ap in |- *. unfold R_lt in |- *. simpl in |- *. - assert (H5 : AbsBig e2 (x0[-]y0)). assert (e2 [<=] e). unfold e2 in |- *; apply less_leEq; apply pos_div_two'; auto. split; auto. elim (H21 NN). - intros H' Haux; elim Haux; intros; [ left | right ]. - apply leEq_transitive with e; auto. - apply leEq_transitive with ([--]e); auto; apply inv_resp_leEq; auto. + intros H' Haux; elim Haux; intros; [ left | right ]. + apply leEq_transitive with e; auto. + apply leEq_transitive with ([--]e); auto; apply inv_resp_leEq; auto. unfold NN in |- *; auto with arith. case H5; intros Hx s; case s; intro H6. - - right. - exists NN. - - exists e4. - - assumption. - - intro m; intros. - astepl ([--]e8[+]e2[+][--]e8). - 2: unfold e2, e8, e4 in |- *; rational. - rstepr (x_ m[-]x0[+] (x0[-]y0) [+] (y0[-]y_ m)). - apply plus_resp_leEq_both. - apply plus_resp_leEq_both. - - astepl ([--]e16[+][--]e16). - 2: unfold e16, e8 in |- *; rational. - rstepr (x_ m[-]x_ N1[+] (x_ N1[-]x0)). - apply plus_resp_leEq_both. - - assert (H7 : AbsSmall e16 (x_ m[-]x_ N1)). - apply H31; apply le_trans with NN; auto. - elim H7; intros. - rstepl ([--]e16). - assumption. - - assert (H7 : AbsSmall e16 (x_ N1[-]x0)). - apply AbsSmall_minus. - unfold x0 in |- *; auto. - elim H7; intros. - rstepl ([--]e16). - assumption. - - (* e *) - assumption. - (* e *) - - astepl ([--]e16[+][--]e16). - 2: unfold e16, e8 in |- *; rational. - rstepr (y0[-]y_ N2[+] (y_ N2[-]y_ m)). - apply plus_resp_leEq_both. - - assert (H7 : AbsSmall e16 (y0[-]y_ N2)). - unfold y0 in |- *; auto. - elim H7; intros. - rstepl ([--]e16). - assumption. - - assert (H7 : AbsSmall e16 (y_ N2[-]y_ m)). - apply AbsSmall_minus. - apply H41. - apply le_trans with NN; auto. - elim H7; intros. - rstepl ([--]e16). - assumption. - + right. + exists NN. + exists e4. + assumption. + intro m; intros. + astepl ([--]e8[+]e2[+][--]e8). + 2: unfold e2, e8, e4 in |- *; rational. + rstepr (x_ m[-]x0[+] (x0[-]y0) [+] (y0[-]y_ m)). + apply plus_resp_leEq_both. + apply plus_resp_leEq_both. + astepl ([--]e16[+][--]e16). + 2: unfold e16, e8 in |- *; rational. + rstepr (x_ m[-]x_ N1[+] (x_ N1[-]x0)). + apply plus_resp_leEq_both. + assert (H7 : AbsSmall e16 (x_ m[-]x_ N1)). + apply H31; apply le_trans with NN; auto. + elim H7; intros. + rstepl ([--]e16). + assumption. + assert (H7 : AbsSmall e16 (x_ N1[-]x0)). + apply AbsSmall_minus. + unfold x0 in |- *; auto. + elim H7; intros. + rstepl ([--]e16). + assumption. + (* e *) + assumption. + (* e *) + astepl ([--]e16[+][--]e16). + 2: unfold e16, e8 in |- *; rational. + rstepr (y0[-]y_ N2[+] (y_ N2[-]y_ m)). + apply plus_resp_leEq_both. + assert (H7 : AbsSmall e16 (y0[-]y_ N2)). + unfold y0 in |- *; auto. + elim H7; intros. + rstepl ([--]e16). + assumption. + assert (H7 : AbsSmall e16 (y_ N2[-]y_ m)). + apply AbsSmall_minus. + apply H41. + apply le_trans with NN; auto. + elim H7; intros. + rstepl ([--]e16). + assumption. left. exists NN. - exists e4. - - assumption. - + assumption. intro m; intros. astepl ([--]e8[+]e2[+][--]e8). - 2: unfold e8, e2, e4 in |- *; rational. + 2: unfold e8, e2, e4 in |- *; rational. rstepr (y_ m[-]y0[+] (y0[-]x0) [+] (x0[-]x_ m)). apply plus_resp_leEq_both. - apply plus_resp_leEq_both. - - astepl ([--]e16[+][--]e16). - 2: unfold e16, e8 in |- *; rational. - rstepr (y_ m[-]y_ N2[+] (y_ N2[-]y0)). - apply plus_resp_leEq_both. - - assert (H8 : AbsSmall e16 (y_ m[-]y_ N2)). - apply H41. - apply le_trans with NN; auto. - elim H8; intros. - rstepl ([--]e16). - assumption. - - assert (H8 : AbsSmall e16 (y_ N2[-]y0)). - apply AbsSmall_minus. - unfold y0 in |- *; auto. - elim H8; intros. - rstepl ([--]e16). - assumption. - - (* e *) - apply inv_cancel_leEq. - rstepl (x0[-]y0). - assumption. + apply plus_resp_leEq_both. + astepl ([--]e16[+][--]e16). + 2: unfold e16, e8 in |- *; rational. + rstepr (y_ m[-]y_ N2[+] (y_ N2[-]y0)). + apply plus_resp_leEq_both. + assert (H8 : AbsSmall e16 (y_ m[-]y_ N2)). + apply H41. + apply le_trans with NN; auto. + elim H8; intros. + rstepl ([--]e16). + assumption. + assert (H8 : AbsSmall e16 (y_ N2[-]y0)). + apply AbsSmall_minus. + unfold y0 in |- *; auto. + elim H8; intros. + rstepl ([--]e16). + assumption. + (* e *) + apply inv_cancel_leEq. + rstepl (x0[-]y0). + assumption. (* e *) - astepl ([--]e16[+][--]e16). - 2: unfold e16, e8 in |- *; rational. + 2: unfold e16, e8 in |- *; rational. rstepr (x0[-]x_ N1[+] (x_ N1[-]x_ m)). apply plus_resp_leEq_both. - - assert (H8 : AbsSmall e16 (x0[-]x_ N1)). - unfold x0 in |- *; auto. - elim H8; intros. - rstepl ([--]e16). - assumption. - + assert (H8 : AbsSmall e16 (x0[-]x_ N1)). + unfold x0 in |- *; auto. + elim H8; intros. + rstepl ([--]e16). + assumption. assert (H8 : AbsSmall e16 (x_ N1[-]x_ m)). apply AbsSmall_minus. apply H31. @@ -1134,13 +1042,12 @@ Lemma Eq_alt_2_1 : forall x y : R_Set, Not (R_ap x y) -> forall e : F, Zero [<] Proof. intros. apply Eq_alt_1. - assumption. - + assumption. intro. apply H. apply R_ap_alt_2. exists (e [/]FourNZ). - apply pos_div_four; auto. + apply pos_div_four; auto. assumption. Qed. @@ -1152,10 +1059,7 @@ Proof. case y; intros y_ py. simpl in |- *. intros H. intro H0. - - assert - (H1 : - {e : F | Zero [<] e | + assert (H1 : {e : F | Zero [<] e | {N : nat | forall m : nat, N <= m -> AbsBig (Two[*]e) (x_ m[-]y_ m)}}). elim (R_ap_alt_1 _ _ H0). intros e H1 H2. @@ -1164,38 +1068,30 @@ Proof. elim H2; intros N HN. exists N. intros. apply AbsBig_wdl with e; [ auto | rational ]. - case H1. intros e H2 H3. - case H3; intros N1 A. case (H e H2); intros N2 B. - set (NN := max N1 N2) in *. assert (N1_NN : N1 <= NN). unfold NN in |- *; auto with arith. assert (N2_NN : N2 <= NN). unfold NN in |- *; auto with arith. - assert (H4 := A NN N1_NN). assert (H5 := B NN N2_NN). - unfold AbsSmall in H5. rewrite -> leEq_def in H5. - elim H5; intros. elim H4; intros. elim b; intros. - - rewrite -> leEq_def in H7; apply H7. - apply less_leEq_trans with (Two[*]e). - astepl (Zero[+]e). rstepr (e[+]e). - apply plus_resp_less_rht; auto. - assumption. - + rewrite -> leEq_def in H7; apply H7. + apply less_leEq_trans with (Two[*]e). + astepl (Zero[+]e). rstepr (e[+]e). + apply plus_resp_less_rht; auto. + assumption. apply H6. apply leEq_less_trans with ([--] (Two[*]e)). - auto. + auto. apply inv_resp_less. astepl (Zero[+]e); rstepr (e[+]e). apply plus_resp_less_rht; auto. diff --git a/algebra/Expon.v b/algebra/Expon.v index bccd0018c..f74b5d810 100644 --- a/algebra/Expon.v +++ b/algebra/Expon.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing [^^] %\ensuremath{\hat{\ }}% #^# *) @@ -53,289 +53,299 @@ Section More_Nexp. Variable R : COrdField. Lemma nexp_resp_ap_zero : forall (x : R) n, x [#] Zero -> x[^]n [#] Zero. -intros. -elim n. -simpl in |- *. -algebra. -intros. -simpl in |- *. -apply mult_resp_ap_zero. -assumption. -assumption. +Proof. + intros. + elim n. + simpl in |- *. + algebra. + intros. + simpl in |- *. + apply mult_resp_ap_zero. + assumption. + assumption. Qed. Hint Resolve nexp_resp_ap_zero: algebra. Lemma nexp_distr_div : forall (x y : R) n y_ yn_, (x[/] y[//]y_) [^]n [=] (x[^]n[/] y[^]n[//]yn_). -simple induction n. -intros. -simpl in |- *. -algebra. -intros. -simpl in |- *. -generalize (H y_ (nexp_resp_ap_zero y n0 y_)); intro. -astepl ((x[^]n0[/] y[^]n0[//]nexp_resp_ap_zero y n0 y_) [*] (x[/] y[//]y_)). -simpl in |- *. -rational. +Proof. + simple induction n. + intros. + simpl in |- *. + algebra. + intros. + simpl in |- *. + generalize (H y_ (nexp_resp_ap_zero y n0 y_)); intro. + astepl ((x[^]n0[/] y[^]n0[//]nexp_resp_ap_zero y n0 y_) [*] (x[/] y[//]y_)). + simpl in |- *. + rational. Qed. Lemma nexp_distr_div' : forall (x y : R) n y_, (x[/] y[//]y_) [^]n [=] (x[^]n[/] y[^]n[//]nexp_resp_ap_zero y n y_). -intros. -apply nexp_distr_div. +Proof. + intros. + apply nexp_distr_div. Qed. Lemma small_nexp_resp_lt : forall (x : R) m n, Zero [<] x -> x [<] One -> m < n -> x[^]n [<] x[^]m. -intros. -cut (forall k : nat, 0 < k -> x[^]k [<] One). -intro H2. -replace n with (m + (n - m)). -astepl (x[^]m[*]x[^] (n - m)). -astepr (x[^]m[*]One). -apply mult_resp_less_lft. -apply H2. -omega. -apply nexp_resp_pos. -assumption. -auto with arith. -simple induction k. -intro H2. -elimtype False. -inversion H2. -intros. -elim n0. -astepl x. -assumption. -intros. -astepl (x[*]x[^]S n1). -astepr (One[*] (One:R)). -apply mult_resp_less_both. -apply less_leEq. -assumption. -assumption. -apply less_leEq. -apply nexp_resp_pos. -assumption. -assumption. +Proof. + intros. + cut (forall k : nat, 0 < k -> x[^]k [<] One). + intro H2. + replace n with (m + (n - m)). + astepl (x[^]m[*]x[^] (n - m)). + astepr (x[^]m[*]One). + apply mult_resp_less_lft. + apply H2. + omega. + apply nexp_resp_pos. + assumption. + auto with arith. + simple induction k. + intro H2. + elimtype False. + inversion H2. + intros. + elim n0. + astepl x. + assumption. + intros. + astepl (x[*]x[^]S n1). + astepr (One[*] (One:R)). + apply mult_resp_less_both. + apply less_leEq. + assumption. + assumption. + apply less_leEq. + apply nexp_resp_pos. + assumption. + assumption. Qed. Lemma great_nexp_resp_lt : forall (x : R) m n, One [<] x -> m < n -> x[^]m [<] x[^]n. -intros. induction n as [| n Hrecn]; intros. -elimtype False. -inversion H. -cut (m <= n). intro. -cut (x[^]n [<] x[^]S n). intro. -elim (le_lt_eq_dec _ _ H0); intro y. -apply less_transitive_unfolded with (x[^]n); auto. -rewrite y. auto. -astepl (x[^]n[*]One). -astepr (x[^]n[*]x). -apply mult_resp_less_lft. auto. -apply nexp_resp_pos. -apply leEq_less_trans with (One:R). apply less_leEq. apply pos_one. auto. -auto with arith. +Proof. + intros. induction n as [| n Hrecn]; intros. + elimtype False. + inversion H. + cut (m <= n). intro. + cut (x[^]n [<] x[^]S n). intro. + elim (le_lt_eq_dec _ _ H0); intro y. + apply less_transitive_unfolded with (x[^]n); auto. + rewrite y. auto. + astepl (x[^]n[*]One). + astepr (x[^]n[*]x). + apply mult_resp_less_lft. auto. + apply nexp_resp_pos. + apply leEq_less_trans with (One:R). apply less_leEq. apply pos_one. auto. + auto with arith. Qed. Lemma small_nexp_resp_le : forall (x : R) m n, Zero [<=] x -> x [<=] One -> m <= n -> x[^]n [<=] x[^]m. -intros. -cut (forall k : nat, x[^]k [<=] One). -intro. -replace n with (m + (n - m)). -astepl (x[^]m[*]x[^] (n - m)). -astepr (x[^]m[*]One). -apply mult_resp_leEq_lft. -apply H2. -apply nexp_resp_nonneg. auto. -auto with arith. -simple induction k. -apply leEq_reflexive. -clear H1 n; intros. -astepl (x[^]n[*]x); astepr ((One:R)[*]One). -apply mult_resp_leEq_both; auto. -apply nexp_resp_nonneg; auto. +Proof. + intros. + cut (forall k : nat, x[^]k [<=] One). + intro. + replace n with (m + (n - m)). + astepl (x[^]m[*]x[^] (n - m)). + astepr (x[^]m[*]One). + apply mult_resp_leEq_lft. + apply H2. + apply nexp_resp_nonneg. auto. + auto with arith. + simple induction k. + apply leEq_reflexive. + clear H1 n; intros. + astepl (x[^]n[*]x); astepr ((One:R)[*]One). + apply mult_resp_leEq_both; auto. + apply nexp_resp_nonneg; auto. Qed. Lemma great_nexp_resp_le : forall (x : R) m n, One [<=] x -> m <= n -> x[^]m [<=] x[^]n. -intros. -induction n as [| n Hrecn]; intros. -replace m with 0. -apply leEq_reflexive. -auto with arith. -elim (le_lt_eq_dec _ _ H0); intro. -astepl (x[^]m[*]One). -astepr (x[^]n[*]x). -apply mult_resp_leEq_both; auto with arith. -apply nexp_resp_nonneg; auto. -apply leEq_transitive with (One:R); auto. -apply less_leEq. apply pos_one. -apply less_leEq. apply pos_one. -rewrite b. apply leEq_reflexive. +Proof. + intros. + induction n as [| n Hrecn]; intros. + replace m with 0. + apply leEq_reflexive. + auto with arith. + elim (le_lt_eq_dec _ _ H0); intro. + astepl (x[^]m[*]One). + astepr (x[^]n[*]x). + apply mult_resp_leEq_both; auto with arith. + apply nexp_resp_nonneg; auto. + apply leEq_transitive with (One:R); auto. + apply less_leEq. apply pos_one. + apply less_leEq. apply pos_one. + rewrite b. apply leEq_reflexive. Qed. Lemma nexp_resp_leEq : forall (x y : R) k, Zero [<=] x -> x [<=] y -> x[^]k [<=] y[^]k. -intros. rewrite -> leEq_def in *. intro. apply H0. -apply power_cancel_less with k; firstorder using leEq_def. +Proof. + intros. rewrite -> leEq_def in *. intro. apply H0. + apply power_cancel_less with k; firstorder using leEq_def. Qed. Lemma nexp_resp_leEq_one : forall c : R, Zero [<=] c -> c [<=] One -> forall n, c[^]n [<=] One. -simple induction n. -red in |- *; apply eq_imp_leEq. -algebra. -clear n; intros. -astepl (c[^]n[*]c). -astepr ((One:R)[*]One). -apply mult_resp_leEq_both; auto. -apply nexp_resp_nonneg; assumption. +Proof. + simple induction n. + red in |- *; apply eq_imp_leEq. + algebra. + clear n; intros. + astepl (c[^]n[*]c). + astepr ((One:R)[*]One). + apply mult_resp_leEq_both; auto. + apply nexp_resp_nonneg; assumption. Qed. Lemma nexp_resp_leEq_neg_even : forall n, even n -> forall x y : R, y [<=] Zero -> x [<=] y -> y[^]n [<=] x[^]n. -do 2 intro; pattern n in |- *; apply even_ind. -intros; simpl in |- *; apply leEq_reflexive. -clear H n; intros. -astepr (x[^]n[*]x[*]x); astepl (y[^]n[*]y[*]y). -astepr (x[^]n[*] (x[*]x)); astepl (y[^]n[*] (y[*]y)). -apply mult_resp_leEq_both. -eapply leEq_wdr. -2: apply inv_nexp_even; auto. -apply nexp_resp_nonneg; astepl ([--] (Zero:R)); apply inv_resp_leEq; auto. -astepr (y[^]2); apply sqr_nonneg. -auto. -astepl (y[^]2); astepr (x[^]2). -eapply leEq_wdr. -2: apply inv_nexp_even; auto with arith. -eapply leEq_wdl. -2: apply inv_nexp_even; auto with arith. -apply nexp_resp_leEq. -astepl ([--] (Zero:R)); apply inv_resp_leEq; auto. -apply inv_resp_leEq; auto. -auto. +Proof. + do 2 intro; pattern n in |- *; apply even_ind. + intros; simpl in |- *; apply leEq_reflexive. + clear H n; intros. + astepr (x[^]n[*]x[*]x); astepl (y[^]n[*]y[*]y). + astepr (x[^]n[*] (x[*]x)); astepl (y[^]n[*] (y[*]y)). + apply mult_resp_leEq_both. + eapply leEq_wdr. + 2: apply inv_nexp_even; auto. + apply nexp_resp_nonneg; astepl ([--] (Zero:R)); apply inv_resp_leEq; auto. + astepr (y[^]2); apply sqr_nonneg. + auto. + astepl (y[^]2); astepr (x[^]2). + eapply leEq_wdr. + 2: apply inv_nexp_even; auto with arith. + eapply leEq_wdl. + 2: apply inv_nexp_even; auto with arith. + apply nexp_resp_leEq. + astepl ([--] (Zero:R)); apply inv_resp_leEq; auto. + apply inv_resp_leEq; auto. + auto. Qed. Lemma nexp_resp_leEq_neg_odd : forall n, odd n -> forall x y : R, y [<=] Zero -> x [<=] y -> x[^]n [<=] y[^]n. -intro; case n. -intros; elimtype False; inversion H. -clear n; intros. -astepl (x[^]n[*]x); astepr (y[^]n[*]y). -rstepl ([--] (x[^]n[*][--]x)); rstepr ([--] (y[^]n[*][--]y)). -apply inv_resp_leEq; apply mult_resp_leEq_both. -eapply leEq_wdr. -2: apply inv_nexp_even; inversion H; auto. -apply nexp_resp_nonneg; astepl ([--] (Zero:R)); apply inv_resp_leEq; auto. -astepl ([--] (Zero:R)); apply inv_resp_leEq; auto. -apply nexp_resp_leEq_neg_even; auto; inversion H; auto. -apply inv_resp_leEq; auto. +Proof. + intro; case n. + intros; elimtype False; inversion H. + clear n; intros. + astepl (x[^]n[*]x); astepr (y[^]n[*]y). + rstepl ([--] (x[^]n[*][--]x)); rstepr ([--] (y[^]n[*][--]y)). + apply inv_resp_leEq; apply mult_resp_leEq_both. + eapply leEq_wdr. + 2: apply inv_nexp_even; inversion H; auto. + apply nexp_resp_nonneg; astepl ([--] (Zero:R)); apply inv_resp_leEq; auto. + astepl ([--] (Zero:R)); apply inv_resp_leEq; auto. + apply nexp_resp_leEq_neg_even; auto; inversion H; auto. + apply inv_resp_leEq; auto. Qed. Lemma nexp_distr_recip : forall (x : R) n x_ xn_, (One[/] x[//]x_) [^]n [=] (One[/] x[^]n[//]xn_). -intros. induction n as [| n Hrecn]; intros. -simpl in |- *. algebra. -astepl ((One[/] x[//]x_)[^]n[*] (One[/] x[//]x_)). -cut (x[^]n [#] Zero). intro H. -astepl ((One[/] x[^]n[//]H)[*] (One[/] x[//]x_)). -cut (x[^]n[*]x [#] Zero). intro H2. -rstepl (One[/] x[^]n[*]x[//]H2). -apply div_wd; algebra. -apply mult_resp_ap_zero; auto. -apply nexp_resp_ap_zero. auto. +Proof. + intros. induction n as [| n Hrecn]; intros. + simpl in |- *. algebra. + astepl ((One[/] x[//]x_)[^]n[*] (One[/] x[//]x_)). + cut (x[^]n [#] Zero). intro H. + astepl ((One[/] x[^]n[//]H)[*] (One[/] x[//]x_)). + cut (x[^]n[*]x [#] Zero). intro H2. + rstepl (One[/] x[^]n[*]x[//]H2). + apply div_wd; algebra. + apply mult_resp_ap_zero; auto. + apply nexp_resp_ap_zero. auto. Qed. Hint Resolve nexp_distr_recip: algebra. Lemma nexp_even_nonneg : forall n, even n -> forall x : R, Zero [<=] x[^]n. -do 2 intro. -pattern n in |- *; apply even_ind; intros. -simpl in |- *; apply less_leEq; apply pos_one. -apply leEq_wdr with (x[^]n0[*]x[^]2). -2: simpl in |- *; rational. -apply mult_resp_nonneg. -auto. -apply sqr_nonneg. -auto. +Proof. + do 2 intro. + pattern n in |- *; apply even_ind; intros. + simpl in |- *; apply less_leEq; apply pos_one. + apply leEq_wdr with (x[^]n0[*]x[^]2). + 2: simpl in |- *; rational. + apply mult_resp_nonneg. + auto. + apply sqr_nonneg. + auto. Qed. Lemma nexp_resp_le' : forall c : R, Zero [<=] c -> c [<=] One -> forall m n, m <= n -> c[^]n [<=] c[^]m. -intros. -astepl (Zero[+]c[^]n); apply shift_plus_leEq. -set (N := n - m) in *. -apply leEq_wdr with (c[^]m[-]c[^]m[*]c[^]N). -rstepr (c[^]m[*] (One[-]c[^]N)). -astepl ((Zero:R)[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. -apply nexp_resp_nonneg; auto. -apply shift_leEq_minus. -astepl (c[^]N). -apply nexp_resp_leEq_one; assumption. -apply cg_minus_wd. -algebra. -eapply eq_transitive_unfolded. -apply nexp_plus. -replace n with (m + (n - m)). -algebra. -auto with arith. +Proof. + intros. + astepl (Zero[+]c[^]n); apply shift_plus_leEq. + set (N := n - m) in *. + apply leEq_wdr with (c[^]m[-]c[^]m[*]c[^]N). + rstepr (c[^]m[*] (One[-]c[^]N)). + astepl ((Zero:R)[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. + apply nexp_resp_nonneg; auto. + apply shift_leEq_minus. + astepl (c[^]N). + apply nexp_resp_leEq_one; assumption. + apply cg_minus_wd. + algebra. + eapply eq_transitive_unfolded. + apply nexp_plus. + replace n with (m + (n - m)). + algebra. + auto with arith. Qed. Lemma nexp_resp_le : forall c : R, One [<=] c -> forall m n, m <= n -> c[^]m [<=] c[^]n. -intros. -cut (Zero [<] c); intros. -2: apply less_leEq_trans with (One:R); [ apply pos_one | assumption ]. -cut (c [#] Zero); intros. -2: apply Greater_imp_ap; assumption. -cut (forall n : nat, c[^]n [#] Zero); intros H3. -2: apply nexp_resp_ap_zero; assumption. -cut (forall n : nat, (One[/] _[//]H3 n) [#] Zero); intros H4. -2: apply div_resp_ap_zero_rev; apply one_ap_zero. -rstepl (One[/] _[//]H4 m). -rstepr (One[/] _[//]H4 n). -apply recip_resp_leEq. -apply recip_resp_pos; apply nexp_resp_pos; assumption. -eapply leEq_wdl. -2: apply nexp_distr_recip with (x_ := X0). -eapply leEq_wdr. -2: apply nexp_distr_recip with (x_ := X0). -apply nexp_resp_le'. -apply less_leEq. apply recip_resp_pos; assumption. -apply shift_div_leEq. -assumption. -astepr c; assumption. -assumption. +Proof. + intros. + cut (Zero [<] c); intros. + 2: apply less_leEq_trans with (One:R); [ apply pos_one | assumption ]. + cut (c [#] Zero); intros. + 2: apply Greater_imp_ap; assumption. + cut (forall n : nat, c[^]n [#] Zero); intros H3. + 2: apply nexp_resp_ap_zero; assumption. + cut (forall n : nat, (One[/] _[//]H3 n) [#] Zero); intros H4. + 2: apply div_resp_ap_zero_rev; apply one_ap_zero. + rstepl (One[/] _[//]H4 m). + rstepr (One[/] _[//]H4 n). + apply recip_resp_leEq. + apply recip_resp_pos; apply nexp_resp_pos; assumption. + eapply leEq_wdl. + 2: apply nexp_distr_recip with (x_ := X0). + eapply leEq_wdr. + 2: apply nexp_distr_recip with (x_ := X0). + apply nexp_resp_le'. + apply less_leEq. apply recip_resp_pos; assumption. + apply shift_div_leEq. + assumption. + astepr c; assumption. + assumption. Qed. Lemma bin_less_un : forall n H H1, (One[/] (Two:R) [^]S n[//]H) [<] (One[/] nring (S n) [//]H1). -intros n H H1. -apply recip_resp_less. -simpl in |- *. -apply plus_resp_nonneg_pos. -apply nring_nonneg. - -apply pos_one. -induction n as [| n Hrecn]. -simpl in |- *. -astepl (One:R). -astepr ((One:R)[+]One). -astepr (Two:R). -apply one_less_two. -rational. - -astepr ((Two:R)[*]Two[^]S n). -apply leEq_less_trans with ((Two:R)[*]nring (S n)). -apply suc_leEq_dub. - -apply mult_resp_less_lft. -apply Hrecn. - -red; unfold f_rcpcl'. -apply nexp_resp_ap_zero. -apply Greater_imp_ap. -apply pos_two. - -red; unfold f_rcpcl'. -apply nring_ap_zero. -auto. - -apply pos_two. +Proof. + intros n H H1. + apply recip_resp_less. + simpl in |- *. + apply plus_resp_nonneg_pos. + apply nring_nonneg. + apply pos_one. + induction n as [| n Hrecn]. + simpl in |- *. + astepl (One:R). + astepr ((One:R)[+]One). + astepr (Two:R). + apply one_less_two. + rational. + astepr ((Two:R)[*]Two[^]S n). + apply leEq_less_trans with ((Two:R)[*]nring (S n)). + apply suc_leEq_dub. + apply mult_resp_less_lft. + apply Hrecn. + red; unfold f_rcpcl'. + apply nexp_resp_ap_zero. + apply Greater_imp_ap. + apply pos_two. + red; unfold f_rcpcl'. + apply nring_ap_zero. + auto. + apply pos_two. Qed. End More_Nexp. @@ -382,391 +392,398 @@ Section Zexp_properties. Variable R : COrdField. Lemma zexp_zero : forall (x : R) x_, (x[//]x_) [^^] (0) [=] One. -intros. -unfold zexp in |- *. -algebra. +Proof. + intros. + unfold zexp in |- *. + algebra. Qed. Hint Resolve zexp_zero: algebra. Lemma zexp_nexp : forall (x : R) x_ (n : nat), (x[//]x_) [^^] (n) [=] x[^]n. -intros. -unfold zexp in |- *. -simpl in |- *. -elim n. -simpl in |- *. -algebra. -intros. -simpl in |- *. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -simpl in |- *. -algebra. +Proof. + intros. + unfold zexp in |- *. + simpl in |- *. + elim n. + simpl in |- *. + algebra. + intros. + simpl in |- *. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + simpl in |- *. + algebra. Qed. Hint Resolve zexp_nexp: algebra. Lemma zexp_inv_nexp : forall (x : R) x_ (n : nat), (x[//]x_) [^^] (- n) [=] (One[/] x[//]x_) [^]n. -intros. -unfold zexp in |- *. -simpl in |- *. -elim n. -simpl in |- *. -algebra. -intros. -simpl in |- *. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -simpl in |- *. -algebra. +Proof. + intros. + unfold zexp in |- *. + simpl in |- *. + elim n. + simpl in |- *. + algebra. + intros. + simpl in |- *. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + simpl in |- *. + algebra. Qed. Hint Resolve zexp_inv_nexp: algebra. Lemma zexp_inv_nexp' : forall (x : R) (n : nat) x_ xn_, (x[//]x_) [^^] (- n) [=] (One[/] x[^]n[//]xn_). -intros x n Hx H1. -astepl ((One[/] x[//]Hx) [^]n). -astepr (One[^]n[/] x[^]n[//]H1). -apply nexp_distr_div. +Proof. + intros x n Hx H1. + astepl ((One[/] x[//]Hx) [^]n). + astepr (One[^]n[/] x[^]n[//]H1). + apply nexp_distr_div. Qed. Hint Resolve zexp_inv_nexp': algebra. Lemma zexp_strext : forall (x y : R) m x_ y_, (x[//]x_) [^^] (m) [#] (y[//]y_) [^^] (m) -> x [#] y. -intros x y m Hx Hy. -pattern m in |- *. -apply Cnats_Z_ind. -intros. -apply (nexp_strong_ext R n). -change (x[^]n [#] y[^]n) in |- *. -astepl (x[//]Hx)[^^] (n). -astepr (y[//]Hy)[^^] (n). auto. -intros. -apply (nexp_strong_ext R n). -change (x[^]n [#] y[^]n) in |- *. -cut - ((One[/] x[^]n[//]nexp_resp_ap_zero n Hx) [#] - (One[/] y[^]n[//]nexp_resp_ap_zero n Hy)). -intro H0. -generalize (div_strext _ _ _ _ _ _ _ H0); intro. -elim X0; intros H2. -elim (ap_irreflexive_unfolded _ _ H2). -assumption. -astepl (x[//]Hx)[^^] (- n). -astepr (y[//]Hy)[^^] (- n). auto. +Proof. + intros x y m Hx Hy. + pattern m in |- *. + apply Cnats_Z_ind. + intros. + apply (nexp_strong_ext R n). + change (x[^]n [#] y[^]n) in |- *. + astepl (x[//]Hx)[^^] (n). + astepr (y[//]Hy)[^^] (n). auto. + intros. + apply (nexp_strong_ext R n). + change (x[^]n [#] y[^]n) in |- *. + cut ((One[/] x[^]n[//]nexp_resp_ap_zero n Hx) [#] (One[/] y[^]n[//]nexp_resp_ap_zero n Hy)). + intro H0. + generalize (div_strext _ _ _ _ _ _ _ H0); intro. + elim X0; intros H2. + elim (ap_irreflexive_unfolded _ _ H2). + assumption. + astepl (x[//]Hx)[^^] (- n). + astepr (y[//]Hy)[^^] (- n). auto. Qed. Lemma zexp_wd : forall (x y : R) m x_ y_, x [=] y -> (x[//]x_) [^^] (m) [=] (y[//]y_) [^^] (m). -intros x y m Hx Hy; intros. -apply not_ap_imp_eq. -intro H0. -generalize (zexp_strext _ _ _ _ _ H0); intro. -apply (eq_imp_not_ap _ _ _ H). -assumption. +Proof. + intros x y m Hx Hy; intros. + apply not_ap_imp_eq. + intro H0. + generalize (zexp_strext _ _ _ _ _ H0); intro. + apply (eq_imp_not_ap _ _ _ H). + assumption. Qed. Hint Resolve zexp_wd: algebra_c. Lemma zexp_plus1 : forall (x : R) x_ m, (x[//]x_) [^^] (m + 1) [=] (x[//]x_) [^^] (m) [*]x. -intros x Hx m. -pattern m in |- *. -apply nats_Z_ind. -intro. -replace (Z_of_nat n + 1)%Z with (S n:Z). -astepl (x[^]S n). -astepr (x[^]n[*]x). -algebra. -rewrite Znat.inj_S. -reflexivity. -intros. -induction n as [| n Hrecn]. -simpl in |- *. -algebra. -replace (- Z_of_nat (S n) + 1)%Z with (- n)%Z. -astepl ((One[/] x[//]Hx) [^]n). -astepr ((One[/] x[//]Hx) [^]S n[*]x). -simpl in |- *. -rational. -rewrite Znat.inj_S. -replace (Zsucc (Z_of_nat n)) with (1 + Z_of_nat n)%Z. -rewrite Zopp_plus_distr. -rewrite Zplus_comm. -unfold Zopp at 2 in |- *. -rewrite Zplus_assoc. -reflexivity. -unfold Zsucc in |- *. -apply Zplus_comm. +Proof. + intros x Hx m. + pattern m in |- *. + apply nats_Z_ind. + intro. + replace (Z_of_nat n + 1)%Z with (S n:Z). + astepl (x[^]S n). + astepr (x[^]n[*]x). + algebra. + rewrite Znat.inj_S. + reflexivity. + intros. + induction n as [| n Hrecn]. + simpl in |- *. + algebra. + replace (- Z_of_nat (S n) + 1)%Z with (- n)%Z. + astepl ((One[/] x[//]Hx) [^]n). + astepr ((One[/] x[//]Hx) [^]S n[*]x). + simpl in |- *. + rational. + rewrite Znat.inj_S. + replace (Zsucc (Z_of_nat n)) with (1 + Z_of_nat n)%Z. + rewrite Zopp_plus_distr. + rewrite Zplus_comm. + unfold Zopp at 2 in |- *. + rewrite Zplus_assoc. + reflexivity. + unfold Zsucc in |- *. + apply Zplus_comm. Qed. Hint Resolve zexp_plus1: algebra. Lemma zexp_resp_ap_zero : forall (x : R) m x_, (x[//]x_) [^^] (m) [#] Zero. -intros. -pattern m in |- *. -apply Cnats_Z_ind. -intros. -astepl (x[^]n). -apply nexp_resp_ap_zero. -assumption. -intro. -astepl ((One[/] x[//]x_) [^]n). -apply nexp_resp_ap_zero. -apply div_resp_ap_zero_rev. -algebra. +Proof. + intros. + pattern m in |- *. + apply Cnats_Z_ind. + intros. + astepl (x[^]n). + apply nexp_resp_ap_zero. + assumption. + intro. + astepl ((One[/] x[//]x_) [^]n). + apply nexp_resp_ap_zero. + apply div_resp_ap_zero_rev. + algebra. Qed. Hint Resolve zexp_resp_ap_zero: algebra. Lemma zexp_inv : forall (x : R) x_ m xm_, (x[//]x_) [^^] (- m) [=] (One[/] (x[//]x_) [^^] (m) [//]xm_). -intros x Hx m. -pattern m in |- *. -apply nats_Z_ind. -intros. -(* Here I would like to use Rewrite zexp_inv_nexp', i.e. Rewriting with our - own equality. *) -apply eq_transitive_unfolded with (One[/] x[^]n[//]nexp_resp_ap_zero n Hx). -apply zexp_inv_nexp'. -apply div_wd. -algebra. -algebra. - -intros. -rewrite Zopp_involutive. -astepl (x[^]n). -astepl ((x[^]n) [/]OneNZ). -apply eq_div. -astepl (x[^]n[*] (One[/] x[//]Hx) [^]n). -astepl ((x[*] (One[/] x[//]Hx)) [^]n). -astepr (One:R). -astepr ((One:R) [^]n). -apply nexp_wd. -algebra. +Proof. + intros x Hx m. + pattern m in |- *. + apply nats_Z_ind. + intros. + (* Here I would like to use Rewrite zexp_inv_nexp', i.e. Rewriting with our own equality. *) + apply eq_transitive_unfolded with (One[/] x[^]n[//]nexp_resp_ap_zero n Hx). + apply zexp_inv_nexp'. + apply div_wd. + algebra. + algebra. + intros. + rewrite Zopp_involutive. + astepl (x[^]n). + astepl ((x[^]n) [/]OneNZ). + apply eq_div. + astepl (x[^]n[*] (One[/] x[//]Hx) [^]n). + astepl ((x[*] (One[/] x[//]Hx)) [^]n). + astepr (One:R). + astepr ((One:R) [^]n). + apply nexp_wd. + algebra. Qed. Hint Resolve zexp_inv: algebra. Lemma zexp_inv1 : forall (x : R) x_ m, (x[//]x_) [^^] (m - 1) [=] ((x[//]x_) [^^] (m) [/] x[//]x_). -intros x Hx; intros. -replace (m - 1)%Z with (- (- m + 1))%Z. -(* Here I would like to use Rewriting with our own equality. *) -astepl (One[/] (x[//]Hx) [^^] (- m + 1) [//]zexp_resp_ap_zero x (- m + 1) Hx). -apply eq_div. -astepr ((x[//]Hx) [^^] (m) [*] ((x[//]Hx) [^^] (- m) [*]x)). -astepr - ((x[//]Hx) [^^] (m) [*] - ((One[/] (x[//]Hx) [^^] (m) [//]zexp_resp_ap_zero x m Hx) [*]x)). -rational. -rewrite Zopp_plus_distr. -rewrite Zopp_involutive. -reflexivity. +Proof. + intros x Hx; intros. + replace (m - 1)%Z with (- (- m + 1))%Z. + (* Here I would like to use Rewriting with our own equality. *) + astepl (One[/] (x[//]Hx) [^^] (- m + 1) [//]zexp_resp_ap_zero x (- m + 1) Hx). + apply eq_div. + astepr ((x[//]Hx) [^^] (m) [*] ((x[//]Hx) [^^] (- m) [*]x)). + astepr ((x[//]Hx) [^^] (m) [*] ((One[/] (x[//]Hx) [^^] (m) [//]zexp_resp_ap_zero x m Hx) [*]x)). + rational. + rewrite Zopp_plus_distr. + rewrite Zopp_involutive. + reflexivity. Qed. Hint Resolve zexp_inv1: algebra. Lemma zexp_plus : forall (x : R) x_ m n, (x[//]x_) [^^] (m + n) [=] (x[//]x_) [^^] (m) [*] (x[//]x_) [^^] (n). -intros x Hx; intros. -pattern n in |- *. -apply pred_succ_Z_ind. -simpl in |- *. -replace (m + 0)%Z with m. -algebra. -auto with zarith. -intros. -replace (m + (n0 + 1))%Z with (m + n0 + 1)%Z. -astepl ((x[//]Hx) [^^] (m + n0) [*]x). -astepr ((x[//]Hx) [^^] (m) [*] ((x[//]Hx) [^^] (n0) [*]x)). -astepr ((x[//]Hx) [^^] (m) [*] (x[//]Hx) [^^] (n0) [*]x). -algebra. -auto with zarith. -intros. -replace (m + (n0 - 1))%Z with (m + n0 - 1)%Z. -astepl ((x[//]Hx) [^^] (m + n0) [/] x[//]Hx). -astepr ((x[//]Hx) [^^] (m) [*] ((x[//]Hx) [^^] (n0) [/] x[//]Hx)). -astepr ((x[//]Hx) [^^] (m) [*] (x[//]Hx) [^^] (n0) [/] x[//]Hx). -algebra. -unfold Zminus in |- *. -auto with zarith. +Proof. + intros x Hx; intros. + pattern n in |- *. + apply pred_succ_Z_ind. + simpl in |- *. + replace (m + 0)%Z with m. + algebra. + auto with zarith. + intros. + replace (m + (n0 + 1))%Z with (m + n0 + 1)%Z. + astepl ((x[//]Hx) [^^] (m + n0) [*]x). + astepr ((x[//]Hx) [^^] (m) [*] ((x[//]Hx) [^^] (n0) [*]x)). + astepr ((x[//]Hx) [^^] (m) [*] (x[//]Hx) [^^] (n0) [*]x). + algebra. + auto with zarith. + intros. + replace (m + (n0 - 1))%Z with (m + n0 - 1)%Z. + astepl ((x[//]Hx) [^^] (m + n0) [/] x[//]Hx). + astepr ((x[//]Hx) [^^] (m) [*] ((x[//]Hx) [^^] (n0) [/] x[//]Hx)). + astepr ((x[//]Hx) [^^] (m) [*] (x[//]Hx) [^^] (n0) [/] x[//]Hx). + algebra. + unfold Zminus in |- *. + auto with zarith. Qed. Hint Resolve zexp_plus: algebra. Lemma zexp_minus : forall (x : R) x_ m n xn_, (x[//]x_) [^^] (m - n) [=] ((x[//]x_) [^^] (m) [/] (x[//]x_) [^^] (n) [//]xn_). -intros x Hx m n Hexp. -replace (m - n)%Z with (m + - n)%Z. -astepl ((x[//]Hx) [^^] (m) [*] (x[//]Hx) [^^] (- n)). -astepl ((x[//]Hx) [^^] (m) [*] (One[/] (x[//]Hx) [^^] (n) [//]Hexp)). -astepl ((x[//]Hx) [^^] (m) [*]One[/] (x[//]Hx) [^^] (n) [//]Hexp). -algebra. -reflexivity. +Proof. + intros x Hx m n Hexp. + replace (m - n)%Z with (m + - n)%Z. + astepl ((x[//]Hx) [^^] (m) [*] (x[//]Hx) [^^] (- n)). + astepl ((x[//]Hx) [^^] (m) [*] (One[/] (x[//]Hx) [^^] (n) [//]Hexp)). + astepl ((x[//]Hx) [^^] (m) [*]One[/] (x[//]Hx) [^^] (n) [//]Hexp). + algebra. + reflexivity. Qed. Hint Resolve zexp_minus: algebra. Lemma one_zexp : forall z, (One[//]ring_non_triv _) [^^] (z) [=] (One:R). -intro. -pattern z in |- *. -apply nats_Z_ind. -intro. -(* Rewrite would be nice *) -astepl ((One:R) [^]n). -apply one_nexp. -intros. -astepl - (One[/] (One[//]ring_non_triv _) [^^] (n) [//] - zexp_resp_ap_zero One n (ring_non_triv _)). -astepr ((One:R) [/]OneNZ). -apply eq_div. -astepr ((One:R) [*]One[^]n). -astepr ((One:R) [*]One). -algebra. +Proof. + intro. + pattern z in |- *. + apply nats_Z_ind. + intro. + (* Rewrite would be nice *) + astepl ((One:R) [^]n). + apply one_nexp. + intros. + astepl (One[/] (One[//]ring_non_triv _) [^^] (n) [//] zexp_resp_ap_zero One n (ring_non_triv _)). + astepr ((One:R) [/]OneNZ). + apply eq_div. + astepr ((One:R) [*]One[^]n). + astepr ((One:R) [*]One). + algebra. Qed. Hint Resolve one_zexp: algebra. Lemma mult_zexp : forall (x y : R) z x_ y_ xy_, (x[*]y[//]xy_) [^^] (z) [=] (x[//]x_) [^^] (z) [*] (y[//]y_) [^^] (z). -intros x y z Hx Hy Hp. -pattern z in |- *. -apply nats_Z_ind. -intros. -astepl ((x[*]y) [^]n). -astepr (x[^]n[*]y[^]n). -apply mult_nexp. -intros. -astepl (One[/] (x[*]y[//]Hp) [^^] (n) [//]zexp_resp_ap_zero (x[*]y) n Hp). -astepr - ((One[/] (x[//]Hx) [^^] (n) [//]zexp_resp_ap_zero x n Hx) [*] - (One[/] (y[//]Hy) [^^] (n) [//]zexp_resp_ap_zero y n Hy)). -astepl (One[/] (x[*]y) [^]n[//]nexp_resp_ap_zero n Hp). -astepr - ((One[/] x[^]n[//]nexp_resp_ap_zero n Hx) [*] - (One[/] y[^]n[//]nexp_resp_ap_zero n Hy)). -rstepr - (One[/] x[^]n[*]y[^]n[//] - mult_resp_ap_zero _ _ _ (nexp_resp_ap_zero n Hx) (nexp_resp_ap_zero n Hy)). -apply eq_div. -algebra. +Proof. + intros x y z Hx Hy Hp. + pattern z in |- *. + apply nats_Z_ind. + intros. + astepl ((x[*]y) [^]n). + astepr (x[^]n[*]y[^]n). + apply mult_nexp. + intros. + astepl (One[/] (x[*]y[//]Hp) [^^] (n) [//]zexp_resp_ap_zero (x[*]y) n Hp). + astepr ((One[/] (x[//]Hx) [^^] (n) [//]zexp_resp_ap_zero x n Hx) [*] + (One[/] (y[//]Hy) [^^] (n) [//]zexp_resp_ap_zero y n Hy)). + astepl (One[/] (x[*]y) [^]n[//]nexp_resp_ap_zero n Hp). + astepr ((One[/] x[^]n[//]nexp_resp_ap_zero n Hx) [*] (One[/] y[^]n[//]nexp_resp_ap_zero n Hy)). + rstepr (One[/] x[^]n[*]y[^]n[//] + mult_resp_ap_zero _ _ _ (nexp_resp_ap_zero n Hx) (nexp_resp_ap_zero n Hy)). + apply eq_div. + algebra. Qed. Hint Resolve mult_zexp: algebra. Lemma zexp_mult : forall (x : R) m n x_ xm_, (x[//]x_) [^^] (m * n) [=] ((x[//]x_) [^^] (m) [//]xm_) [^^] (n). -intros x m n Hx He. -pattern n in |- *. -apply pred_succ_Z_ind. -rewrite <- Zmult_0_r_reverse. -algebra. -intros. -rewrite Zmult_plus_distr_r. -astepr (((x[//]Hx) [^^] (m) [//]He) [^^] (n0) [*] (x[//]Hx) [^^] (m)). -rewrite Zmult_1_r. -astepl ((x[//]Hx) [^^] (m * n0) [*] (x[//]Hx) [^^] (m)). -algebra. - -intros. -rewrite Basics.Zmult_minus_distr_r. -astepr (((x[//]Hx) [^^] (m) [//]He) [^^] (n0) [/] (x[//]Hx) [^^] (m) [//]He). -rewrite Zmult_1_r. -astepl ((x[//]Hx) [^^] (m * n0) [/] (x[//]Hx) [^^] (m) [//]He). -algebra. +Proof. + intros x m n Hx He. + pattern n in |- *. + apply pred_succ_Z_ind. + rewrite <- Zmult_0_r_reverse. + algebra. + intros. + rewrite Zmult_plus_distr_r. + astepr (((x[//]Hx) [^^] (m) [//]He) [^^] (n0) [*] (x[//]Hx) [^^] (m)). + rewrite Zmult_1_r. + astepl ((x[//]Hx) [^^] (m * n0) [*] (x[//]Hx) [^^] (m)). + algebra. + intros. + rewrite Basics.Zmult_minus_distr_r. + astepr (((x[//]Hx) [^^] (m) [//]He) [^^] (n0) [/] (x[//]Hx) [^^] (m) [//]He). + rewrite Zmult_1_r. + astepl ((x[//]Hx) [^^] (m * n0) [/] (x[//]Hx) [^^] (m) [//]He). + algebra. Qed. Hint Resolve zexp_mult: algebra. Lemma zexp_two : forall (x : R) x_, (x[//]x_) [^^] (2) [=] x[*]x. -intros. -simpl in |- *. -algebra. +Proof. + intros. + simpl in |- *. + algebra. Qed. Hint Resolve zexp_two: algebra. Lemma inv_zexp_even : forall (x : R) m, Zeven m -> forall x_ x__, ([--]x[//]x__) [^^] (m) [=] (x[//]x_) [^^] (m). -intros x m H Hx Hneg. -pattern m in |- *. -rewrite -> Zeven.Zeven_div2. -astepl - (([--]x[//]Hneg) [^^] (2) [//]zexp_resp_ap_zero [--]x 2 Hneg) [^^] - (Zeven.Zdiv2 m). -astepl - ([--]x[*][--]x[//]mult_resp_ap_zero _ _ _ Hneg Hneg) [^^] (Zeven.Zdiv2 m). -astepl (x[*]x[//]mult_resp_ap_zero _ _ _ Hx Hx) [^^] (Zeven.Zdiv2 m). -astepl ((x[//]Hx) [^^] (2) [//]zexp_resp_ap_zero x 2 Hx) [^^] (Zeven.Zdiv2 m). -algebra. -assumption. +Proof. + intros x m H Hx Hneg. + pattern m in |- *. + rewrite -> Zeven.Zeven_div2. + astepl (([--]x[//]Hneg) [^^] (2) [//]zexp_resp_ap_zero [--]x 2 Hneg) [^^] (Zeven.Zdiv2 m). + astepl ([--]x[*][--]x[//]mult_resp_ap_zero _ _ _ Hneg Hneg) [^^] (Zeven.Zdiv2 m). + astepl (x[*]x[//]mult_resp_ap_zero _ _ _ Hx Hx) [^^] (Zeven.Zdiv2 m). + astepl ((x[//]Hx) [^^] (2) [//]zexp_resp_ap_zero x 2 Hx) [^^] (Zeven.Zdiv2 m). + algebra. + assumption. Qed. Hint Resolve inv_zexp_even: algebra. Lemma inv_zexp_two : forall (x : R) x_ x__, ([--]x[//]x__) [^^] (2) [=] (x[//]x_) [^^] (2). -intros. -apply inv_zexp_even. -simpl in |- *. -auto. +Proof. + intros. + apply inv_zexp_even. + simpl in |- *. + auto. Qed. Hint Resolve inv_zexp_two: algebra. Lemma inv_zexp_odd : forall (x : R) m, Zodd m -> forall x_ x__, ([--]x[//]x__) [^^] (m) [=] [--] (x[//]x_) [^^] (m). -intros x m H Hx Hneg. -replace m with (m - 1 + 1)%Z. -astepl (([--]x[//]Hneg) [^^] (m - 1) [*][--]x). -astepr ([--] ((x[//]Hx) [^^] (m - 1) [*]x)). -rstepr ((x[//]Hx) [^^] (m - 1) [*][--]x). -apply mult_wd. -apply inv_zexp_even. -apply Zodd_Zeven_min1. -assumption. -simpl in |- *. -auto. -algebra. -change ((m + -1 + 1)%Z = m) in |- *. -rewrite <- Zplus_assoc. -simpl in |- *. -rewrite <- Zplus_0_r_reverse. -reflexivity. +Proof. + intros x m H Hx Hneg. + replace m with (m - 1 + 1)%Z. + astepl (([--]x[//]Hneg) [^^] (m - 1) [*][--]x). + astepr ([--] ((x[//]Hx) [^^] (m - 1) [*]x)). + rstepr ((x[//]Hx) [^^] (m - 1) [*][--]x). + apply mult_wd. + apply inv_zexp_even. + apply Zodd_Zeven_min1. + assumption. + simpl in |- *. + auto. + algebra. + change ((m + -1 + 1)%Z = m) in |- *. + rewrite <- Zplus_assoc. + simpl in |- *. + rewrite <- Zplus_0_r_reverse. + reflexivity. Qed. Lemma zexp_one : forall (x : R) x_, (x[//]x_) [^^] (1) [=] x. -intros. -simpl in |- *. -algebra. +Proof. + intros. + simpl in |- *. + algebra. Qed. Hint Resolve zexp_one: algebra. Lemma zexp_funny : forall (x y : R) x_ y_, (x[+]y) [*] (x[-]y) [=] (x[//]x_) [^^] (2) [-] (y[//]y_) [^^] (2). -intros. -astepr (x[*]x[-]y[*]y). -rational. +Proof. + intros. + astepr (x[*]x[-]y[*]y). + rational. Qed. Hint Resolve zexp_funny: algebra. Lemma zexp_funny' : forall (x y : R) x_ y_, (x[-]y) [*] (x[+]y) [=] (x[//]x_) [^^] (2) [-] (y[//]y_) [^^] (2). -intros. -astepl ((x[+]y) [*] (x[-]y)). -apply zexp_funny. +Proof. + intros. + astepl ((x[+]y) [*] (x[-]y)). + apply zexp_funny. Qed. Hint Resolve zexp_funny': algebra. Lemma zexp_pos : forall (x : R) x_ z, Zero [<] x -> Zero [<] (x[//]x_) [^^] (z). -intros. -pattern z in |- *. -apply Cnats_Z_ind. -intros. -astepr (x[^]n). -apply nexp_resp_pos. -assumption. -intros. -astepr (One[/] x[^]n[//]nexp_resp_ap_zero n x_). -apply div_resp_pos. -apply nexp_resp_pos. -assumption. -apply pos_one. +Proof. + intros. + pattern z in |- *. + apply Cnats_Z_ind. + intros. + astepr (x[^]n). + apply nexp_resp_pos. + assumption. + intros. + astepr (One[/] x[^]n[//]nexp_resp_ap_zero n x_). + apply div_resp_pos. + apply nexp_resp_pos. + assumption. + apply pos_one. Qed. End Zexp_properties. @@ -784,21 +801,23 @@ Variable R : COrdField. Lemma root_unique : forall x y : R, Zero [<=] x -> Zero [<=] y -> forall n, 0 < n -> x[^]n [=] y[^]n -> x [=] y. -intros. -apply leEq_imp_eq. -apply power_cancel_leEq with n; auto. -astepr (x[^]n). -apply leEq_reflexive. -apply power_cancel_leEq with n; auto. -astepl (x[^]n). -apply leEq_reflexive. +Proof. + intros. + apply leEq_imp_eq. + apply power_cancel_leEq with n; auto. + astepr (x[^]n). + apply leEq_reflexive. + apply power_cancel_leEq with n; auto. + astepl (x[^]n). + apply leEq_reflexive. Qed. Lemma root_one : forall x : R, Zero [<=] x -> forall n, 0 < n -> x[^]n [=] One -> x [=] One. -intros. -apply root_unique with n; auto. -apply less_leEq. apply pos_one. -Step_final (One:R). +Proof. + intros. + apply root_unique with n; auto. + apply less_leEq. apply pos_one. + Step_final (One:R). Qed. End Root_Unique. diff --git a/algebra/OperationClasses.v b/algebra/OperationClasses.v index fd6d9c5e9..ef10a1c34 100644 --- a/algebra/OperationClasses.v +++ b/algebra/OperationClasses.v @@ -120,10 +120,10 @@ Existing Instance mulC_id_l. Global Instance opA_zero_l : left_absorbing mul zero. Proof. -intro; rewrite <- (left_id (mul _ _)); rewrite <- (left_id zero) at 3. -set (e := left_inv (mul zero x)); rewrite <- e at 1 3; clear e. -rewrite (commut (mul _ _)), <- assoc, <- assoc; apply add_morph; try reflexivity. -rewrite <- left_dist, (left_id zero), (right_id (mul _ _)); reflexivity. + intro; rewrite <- (left_id (mul _ _)); rewrite <- (left_id zero) at 3. + set (e := left_inv (mul zero x)); rewrite <- e at 1 3; clear e. + rewrite (commut (mul _ _)), <- assoc, <- assoc; apply add_morph; try reflexivity. + rewrite <- left_dist, (left_id zero), (right_id (mul _ _)); reflexivity. Qed. End Left. Section Right. @@ -136,10 +136,10 @@ Existing Instance mulC_id_r. Global Instance opA_zero_r : right_absorbing mul zero. Proof. -intro; rewrite <- (right_id (mul _ _)); rewrite <- (right_id zero) at 3. -set (e := right_inv (mul x zero)); rewrite <- e at 2 4; clear e. -rewrite (commut (opp _)), assoc, assoc; apply add_morph; try reflexivity. -rewrite <- right_dist, (right_id zero), (left_id (mul _ _)); reflexivity. + intro; rewrite <- (right_id (mul _ _)); rewrite <- (right_id zero) at 3. + set (e := right_inv (mul x zero)); rewrite <- e at 2 4; clear e. + rewrite (commut (opp _)), assoc, assoc; apply add_morph; try reflexivity. + rewrite <- right_dist, (right_id zero), (left_id (mul _ _)); reflexivity. Qed. End Right. End AssociativeCommutative. diff --git a/algebra/RSetoid.v b/algebra/RSetoid.v index 30adfa243..741a2f512 100644 --- a/algebra/RSetoid.v +++ b/algebra/RSetoid.v @@ -44,8 +44,9 @@ Add Parametric Relation s : (st_car s) (@st_eq s) (** Propositions form a setoid under iff *) Definition iffSetoid : Setoid. -exists Prop iff. -firstorder. +Proof. + exists Prop iff. + firstorder. Defined. (** @@ -58,25 +59,27 @@ Record Morphism (X Y:Setoid) := Definition extEq (X:Type) (Y:Setoid) (f g:X -> Y) := forall x, st_eq (f x) (g x). Definition extSetoid (X Y:Setoid) : Setoid. -intros X Y. -exists (Morphism X Y) (extEq Y). -split. - intros x y; reflexivity. - intros x y H a; symmetry; auto. -intros x y z Hxy Hyz a; transitivity (y a); auto. +Proof. + intros X Y. + exists (Morphism X Y) (extEq Y). + split. + intros x y; reflexivity. + intros x y H a; symmetry; auto. + intros x y z Hxy Hyz a; transitivity (y a); auto. Defined. Notation "x --> y" := (extSetoid x y) (at level 55, right associativity) : setoid_scope. Open Local Scope setoid_scope. (** -** Basic Combinators for Setoids +** Basic Combinators for Setoids *) Definition id (X:Setoid) : X-->X. -intros X. -exists (fun x => x). -abstract (auto). +Proof. + intros X. + exists (fun x => x). + abstract (auto). Defined. (* begin hide *) Implicit Arguments id [X]. @@ -84,103 +87,81 @@ Implicit Arguments id [X]. Definition compose0 X Y Z (x : Y ->Z) (y:X -> Y) z := x (y z). Definition compose1 (X Y Z:Setoid) : (Y-->Z) -> (X --> Y) -> X --> Z. -intros X Y Z f0 f1. -exists (compose0 f0 f1). -abstract ( -destruct f0 as [f0 Hf0]; -destruct f1 as [f1 Hf1]; -intros x1 x2 Hx; -apply Hf0; -apply Hf1; -assumption). +Proof. + intros X Y Z f0 f1. + exists (compose0 f0 f1). + abstract ( destruct f0 as [f0 Hf0]; destruct f1 as [f1 Hf1]; intros x1 x2 Hx; apply Hf0; apply Hf1; + assumption). Defined. Definition compose2 (X Y Z:Setoid) : (Y-->Z) -> (X --> Y) --> X --> Z. -intros X Y Z f0. -exists (compose1 f0). -abstract ( -destruct f0 as [f0 Hf0]; -intros x1 x2 H y; -apply: Hf0; -apply H). +Proof. + intros X Y Z f0. + exists (compose1 f0). + abstract ( destruct f0 as [f0 Hf0]; intros x1 x2 H y; apply: Hf0; apply H). Defined. Definition compose (X Y Z:Setoid) : (Y-->Z) --> (X --> Y) --> X --> Z. -intros X Y Z. -exists (@compose2 X Y Z). -abstract ( -intros x1 x2 H y z; -apply: H). +Proof. + intros X Y Z. + exists (@compose2 X Y Z). + abstract ( intros x1 x2 H y z; apply: H). Defined. (* begin hide *) Implicit Arguments compose [X Y Z]. (* end hide *) Definition const0 (X Y:Setoid) : X->Y-->X. -intros X Y x. -exists (fun y => x). -abstract reflexivity. +Proof. + intros X Y x. + exists (fun y => x). + abstract reflexivity. Defined. Definition const (X Y:Setoid) : X-->Y-->X. -intros X Y. -exists (@const0 X Y). -abstract ( intros x1 x2 Hx y; -assumption). +Proof. + intros X Y. + exists (@const0 X Y). + abstract ( intros x1 x2 Hx y; assumption). Defined. (* begin hide *) Implicit Arguments const [X Y]. (* end hide *) Definition flip0 (X Y Z:Setoid) : (X-->Y-->Z)->Y->X-->Z. -intros X Y Z f y. -exists (fun x => f x y). -abstract ( -destruct f as [f Hf]; -intros x1 x2 H; -apply Hf; -auto). +Proof. + intros X Y Z f y. + exists (fun x => f x y). + abstract ( destruct f as [f Hf]; intros x1 x2 H; apply Hf; auto). Defined. Definition flip1 (X Y Z:Setoid) : (X-->Y-->Z)->Y-->X-->Z. -intros X Y Z f. -exists (flip0 f). -abstract ( -destruct f as [f Hf]; -intros x1 x2 H y; -simpl; -destruct (f y) as [g Hg]; -apply Hg; -auto). +Proof. + intros X Y Z f. + exists (flip0 f). + abstract ( destruct f as [f Hf]; intros x1 x2 H y; simpl; destruct (f y) as [g Hg]; apply Hg; auto). Defined. Definition flip (X Y Z:Setoid) : (X-->Y-->Z)-->Y-->X-->Z. -intros X Y Z. -exists (@flip1 X Y Z). -abstract ( -intros x1 x2 H y z; -apply: H). +Proof. + intros X Y Z. + exists (@flip1 X Y Z). + abstract ( intros x1 x2 H y z; apply: H). Defined. (* begin hide *) Implicit Arguments flip [X Y Z]. (* end hide *) Definition join0 (X Y:Setoid) : (X-->X-->Y)->X-->Y. -intros X Y f. -exists (fun y => f y y). -abstract ( -destruct f as [f Hf]; -intros x1 x2 H; -simpl; -transitivity (f x1 x2); -[destruct (f x1) as [g Hg]; - apply Hg; auto -|apply Hf; auto]). +Proof. + intros X Y f. + exists (fun y => f y y). + abstract ( destruct f as [f Hf]; intros x1 x2 H; simpl; transitivity (f x1 x2); + [destruct (f x1) as [g Hg]; apply Hg; auto |apply Hf; auto]). Defined. Definition join (X Y:Setoid) : (X-->X-->Y)-->X-->Y. -intros X Y. -exists (@join0 X Y). -abstract ( -intros x1 x2 H y; -apply: H). +Proof. + intros X Y. + exists (@join0 X Y). + abstract ( intros x1 x2 H y; apply: H). Defined. (* begin hide *) Implicit Arguments join [X Y]. @@ -194,10 +175,10 @@ Implicit Arguments ap [X Y Z]. Definition bind (X Y Z:Setoid) : (X--> Y) --> (Y --> X--> Z) --> (X--> Z):= (compose (compose (@join _ _)) (flip (@compose X Y (X-->Z)))). -Definition bind_compose (X Y Z W:Setoid) : +Definition bind_compose (X Y Z W:Setoid) : (W--> X--> Y) --> (Y --> X--> Z) --> (W--> X--> Z):= (flip (compose (@compose W _ _) ((flip (@bind X Y Z))))). (* begin hide *) Implicit Arguments bind [X Y Z]. Implicit Arguments bind_compose [X Y Z W]. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/algebra/RingClass.v b/algebra/RingClass.v index 3eb92feea..6009c8415 100644 --- a/algebra/RingClass.v +++ b/algebra/RingClass.v @@ -56,8 +56,8 @@ Global Instance rmul_morph : Morphism (req==>req==>req) rmul. Proof. reduce; apply (Rmul_ext r_ree); auto. Qed. Global Instance rsub_morph : Morphism (req==>req==>req) rsub. Proof. -reduce; rewrite (Rsub_def r_rt), (Rsub_def r_rt y y0). -apply (Radd_ext r_ree); auto; apply (Ropp_ext r_ree); auto. + reduce; rewrite (Rsub_def r_rt), (Rsub_def r_rt y y0). + apply (Radd_ext r_ree); auto; apply (Ropp_ext r_ree); auto. Qed. Global Instance ropp_morph : Morphism (req==>req) ropp. Proof. reduce; apply (Ropp_ext r_ree); auto. Qed. @@ -100,11 +100,9 @@ Coercion proj1' : R'>->R. Let req' : relation R' := fun x y => req (projT1 x) (projT1 y). Instance r_st' : Equivalence req'. Proof. -constructor; -intro x; destruct x as [x Px]; -try (intro y; destruct y as [y Py]); -try (intro z; destruct z as [z Pz]); -unfold req'; [ reflexivity | intro; symmetry; assumption | intros eqxy eqyz; rewrite eqxy; assumption ]. + constructor; intro x; destruct x as [x Px]; try (intro y; destruct y as [y Py]); + try (intro z; destruct z as [z Pz]); + unfold req'; [ reflexivity | intro; symmetry; assumption | intros eqxy eqyz; rewrite eqxy; assumption ]. Qed. Let rO' := existT P rO zero_stab. Let rI' := existT P rI one_stab. @@ -114,15 +112,13 @@ Let rsub' : binop R' := fun x y => existT P (rsub x y) (rsub_int (projT2 x) (pro Let ropp' : unop R' := fun x => existT P (ropp x) (ropp_int (projT2 x)). Global Instance sr_ring : @Ring R' req' r_st' rO' rI' radd' rmul' rsub' ropp'. Proof. -constructor. -constructor; unfold R', req', radd', rmul', rsub', ropp', proj1'; -intro x; destruct x as [ x Px ]; -try (intro y; destruct y as [ y Py ]); -try (intro z; destruct z as [ z Pz ]); simpl; ring. -constructor; unfold R', req', radd', rmul', rsub', ropp', proj1'; simpl; -intros x x'; destruct x as [ x Px ]; destruct x' as [ x' Px' ]; simpl; intro eqx; -try (intros y y'; destruct y as [ y Py ]; destruct y' as [ y' Py' ]; simpl; intro eqy; simpl); -[ apply radd_morph | apply rmul_morph | apply ropp_morph ]; assumption. + constructor. + constructor; unfold R', req', radd', rmul', rsub', ropp', proj1'; intro x; destruct x as [ x Px ]; + try (intro y; destruct y as [ y Py ]); try (intro z; destruct z as [ z Pz ]); simpl; ring. + constructor; unfold R', req', radd', rmul', rsub', ropp', proj1'; simpl; + intros x x'; destruct x as [ x Px ]; destruct x' as [ x' Px' ]; simpl; intro eqx; + try (intros y y'; destruct y as [ y Py ]; destruct y' as [ y' Py' ]; simpl; intro eqy; simpl); + [ apply radd_morph | apply rmul_morph | apply ropp_morph ]; assumption. Qed. End SubRing_is_Ring. diff --git a/complex/AbsCC.v b/complex/AbsCC.v index c4fed1283..152be62f9 100644 --- a/complex/AbsCC.v +++ b/complex/AbsCC.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CComplex. @@ -43,166 +43,181 @@ Require Export CComplex. Section AbsCC_properties. Lemma AbsCC_nonneg : forall x : CC, Zero [<=] AbsCC x. -unfold AbsCC in |- *. intros. -apply sqrt_nonneg. +Proof. + unfold AbsCC in |- *. intros. + apply sqrt_nonneg. Qed. Lemma AbsCC_ap_zero_imp_pos : forall z : CC, AbsCC z [#] Zero -> Zero [<] AbsCC z. -intros z H. -apply leEq_not_eq. -apply AbsCC_nonneg. -apply ap_symmetric_unfolded. assumption. +Proof. + intros z H. + apply leEq_not_eq. + apply AbsCC_nonneg. + apply ap_symmetric_unfolded. assumption. Qed. Lemma AbsCC_wd : forall x y : CC, x [=] y -> AbsCC x [=] AbsCC y. -intros x y. elim x. intros x1 x2. elim y. intros y1 y2. -simpl in |- *. unfold cc_eq in |- *. unfold AbsCC in |- *. simpl in |- *. intros. -change - (sqrt (x1[^]2[+]x2[^]2) (cc_abs_aid _ x1 x2) [=] +Proof. + intros x y. elim x. intros x1 x2. elim y. intros y1 y2. + simpl in |- *. unfold cc_eq in |- *. unfold AbsCC in |- *. simpl in |- *. intros. + change (sqrt (x1[^]2[+]x2[^]2) (cc_abs_aid _ x1 x2) [=] sqrt (y1[^]2[+]y2[^]2) (cc_abs_aid _ y1 y2)) in |- *. -elim H. clear H. intros. -apply sqrt_wd. algebra. + elim H. clear H. intros. + apply sqrt_wd. algebra. Qed. Hint Resolve AbsCC_wd: algebra_c. Lemma cc_inv_abs : forall x : CC, AbsCC [--]x [=] AbsCC x. -intros. -unfold AbsCC in |- *. -apply sqrt_wd. -apply bin_op_wd_unfolded. -Step_final ( [--] (Re x) [^]2). -Step_final ( [--] (Im x) [^]2). +Proof. + intros. + unfold AbsCC in |- *. + apply sqrt_wd. + apply bin_op_wd_unfolded. + Step_final ( [--] (Re x) [^]2). + Step_final ( [--] (Im x) [^]2). Qed. Hint Resolve cc_inv_abs: algebra. Lemma cc_minus_abs : forall x y : CC, AbsCC (x[-]y) [=] AbsCC (y[-]x). -intros. -apply eq_transitive_unfolded with (AbsCC [--] (y[-]x)). -apply AbsCC_wd. rational. -apply cc_inv_abs. +Proof. + intros. + apply eq_transitive_unfolded with (AbsCC [--] (y[-]x)). + apply AbsCC_wd. rational. + apply cc_inv_abs. Qed. Lemma cc_mult_abs : forall x y : CC, AbsCC (x[*]y) [=] AbsCC x[*]AbsCC y. -intros x y. elim x. intros x1 x2. elim y. intros y1 y2. intros. -unfold AbsCC in |- *. -apply sqrt_mult_wd. -simpl in |- *. -rational. +Proof. + intros x y. elim x. intros x1 x2. elim y. intros y1 y2. intros. + unfold AbsCC in |- *. + apply sqrt_mult_wd. + simpl in |- *. + rational. Qed. Hint Resolve cc_mult_abs: algebra. Lemma AbsCC_minzero : forall x : CC, AbsCC (x[-]Zero) [=] AbsCC x. -intros. -apply AbsCC_wd. -algebra. +Proof. + intros. + apply AbsCC_wd. + algebra. Qed. Lemma AbsCC_IR : forall x : IR, Zero [<=] x -> AbsCC (cc_IR x) [=] x. -intros. unfold AbsCC in |- *. -change (sqrt (x[^]2[+]Zero[^]2) (cc_abs_aid _ x Zero) [=] x) in |- *. -apply eq_transitive_unfolded with (sqrt (x[^]2) (sqr_nonneg _ x)). -apply sqrt_wd. rational. -apply sqrt_to_nonneg. auto. +Proof. + intros. unfold AbsCC in |- *. + change (sqrt (x[^]2[+]Zero[^]2) (cc_abs_aid _ x Zero) [=] x) in |- *. + apply eq_transitive_unfolded with (sqrt (x[^]2) (sqr_nonneg _ x)). + apply sqrt_wd. rational. + apply sqrt_to_nonneg. auto. Qed. Hint Resolve AbsCC_IR: algebra. Lemma cc_div_abs : forall (x y : CC) y_ y__, AbsCC (x[/] y[//]y_) [=] (AbsCC x[/] AbsCC y[//]y__). -intros x y nz anz. -rstepl (AbsCC y[*]AbsCC (x[/] y[//]nz) [/] AbsCC y[//]anz). -apply div_wd. 2: algebra. -astepl (AbsCC (y[*] (x[/] y[//]nz))). -apply AbsCC_wd. rational. +Proof. + intros x y nz anz. + rstepl (AbsCC y[*]AbsCC (x[/] y[//]nz) [/] AbsCC y[//]anz). + apply div_wd. 2: algebra. + astepl (AbsCC (y[*] (x[/] y[//]nz))). + apply AbsCC_wd. rational. Qed. Lemma cc_div_abs' : forall (x : CC) (y : IR) y_ y__, Zero [<=] y -> AbsCC (x[/] cc_IR y[//]y__) [=] (AbsCC x[/] y[//]y_). -intros x y nz cnz H. -rstepl (y[*]AbsCC (x[/] cc_IR y[//]cnz) [/] y[//]nz). -apply div_wd. 2: algebra. -astepl (AbsCC (cc_IR y) [*]AbsCC (x[/] cc_IR y[//]cnz)). -astepl (AbsCC (cc_IR y[*] (x[/] cc_IR y[//]cnz))). -apply AbsCC_wd. -rational. +Proof. + intros x y nz cnz H. + rstepl (y[*]AbsCC (x[/] cc_IR y[//]cnz) [/] y[//]nz). + apply div_wd. 2: algebra. + astepl (AbsCC (cc_IR y) [*]AbsCC (x[/] cc_IR y[//]cnz)). + astepl (AbsCC (cc_IR y[*] (x[/] cc_IR y[//]cnz))). + apply AbsCC_wd. + rational. Qed. Lemma AbsCC_zero : AbsCC Zero [=] Zero. -astepl (AbsCC (cc_IR Zero)). -apply AbsCC_IR. -apply leEq_reflexive. +Proof. + astepl (AbsCC (cc_IR Zero)). + apply AbsCC_IR. + apply leEq_reflexive. Qed. Hint Resolve AbsCC_zero: algebra. Lemma AbsCC_one : AbsCC One [=] One. -astepl (AbsCC (cc_IR One)). -apply AbsCC_IR. -apply less_leEq. apply pos_one. +Proof. + astepl (AbsCC (cc_IR One)). + apply AbsCC_IR. + apply less_leEq. apply pos_one. Qed. Lemma cc_pow_abs : forall (x : CC) (n : nat), AbsCC (x[^]n) [=] AbsCC x[^]n. -intros. induction n as [| n Hrecn]; intros. -simpl in |- *. apply AbsCC_one. -simpl in |- *. Step_final (AbsCC (x[^]n) [*]AbsCC x). +Proof. + intros. induction n as [| n Hrecn]; intros. + simpl in |- *. apply AbsCC_one. + simpl in |- *. Step_final (AbsCC (x[^]n) [*]AbsCC x). Qed. Lemma AbsCC_pos : forall x : CC, x [#] Zero -> Zero [<] AbsCC x. -intro. elim x. intros x1 x2. -unfold AbsCC in |- *. simpl in |- *. unfold cc_ap in |- *. simpl in |- *. intros H. -change (Zero [<] sqrt (x1[^]2[+]x2[^]2) (cc_abs_aid _ x1 x2)) in |- *. -apply power_cancel_less with 2. apply sqrt_nonneg. -astepl ZeroR. -astepr (x1[^]2[+]x2[^]2). -elim H; clear H; intros. -apply plus_resp_pos_nonneg. -apply pos_square. auto. apply sqr_nonneg. -apply plus_resp_nonneg_pos. -apply sqr_nonneg. apply pos_square. auto. +Proof. + intro. elim x. intros x1 x2. + unfold AbsCC in |- *. simpl in |- *. unfold cc_ap in |- *. simpl in |- *. intros H. + change (Zero [<] sqrt (x1[^]2[+]x2[^]2) (cc_abs_aid _ x1 x2)) in |- *. + apply power_cancel_less with 2. apply sqrt_nonneg. + astepl ZeroR. + astepr (x1[^]2[+]x2[^]2). + elim H; clear H; intros. + apply plus_resp_pos_nonneg. + apply pos_square. auto. apply sqr_nonneg. + apply plus_resp_nonneg_pos. + apply sqr_nonneg. apply pos_square. auto. Qed. Lemma AbsCC_ap_zero : forall x : CC, Zero [#] AbsCC x -> x [#] Zero. -intro. elim x. intros x1 x2. simpl in |- *. unfold AbsCC in |- *. unfold cc_ap in |- *. -change - (Zero [#] sqrt (x1[^]2[+]x2[^]2) (cc_abs_aid _ x1 x2) -> - x1 [#] Zero or x2 [#] Zero) in |- *. -intros H. -cut (x1[^]2 [#] Zero or x2[^]2 [#] Zero). intro H0. -elim H0; clear H0; intros. -left. -apply cring_mult_ap_zero with x1. -astepl (x1[^]2). auto. -right. -apply cring_mult_ap_zero with x2. -astepl (x2[^]2). auto. -apply cg_add_ap_zero. -astepl (sqrt (x1[^]2[+]x2[^]2) (cc_abs_aid _ x1 x2) [^]2). -apply nexp_resp_ap_zero. -apply ap_symmetric_unfolded. auto. +Proof. + intro. elim x. intros x1 x2. simpl in |- *. unfold AbsCC in |- *. unfold cc_ap in |- *. + change (Zero [#] sqrt (x1[^]2[+]x2[^]2) (cc_abs_aid _ x1 x2) -> x1 [#] Zero or x2 [#] Zero) in |- *. + intros H. + cut (x1[^]2 [#] Zero or x2[^]2 [#] Zero). intro H0. + elim H0; clear H0; intros. + left. + apply cring_mult_ap_zero with x1. + astepl (x1[^]2). auto. + right. + apply cring_mult_ap_zero with x2. + astepl (x2[^]2). auto. + apply cg_add_ap_zero. + astepl (sqrt (x1[^]2[+]x2[^]2) (cc_abs_aid _ x1 x2) [^]2). + apply nexp_resp_ap_zero. + apply ap_symmetric_unfolded. auto. Qed. Lemma AbsCC_small_imp_eq : forall x : CC, (forall e, Zero [<] e -> AbsCC x [<] e) -> x [=] Zero. -intros x H. -apply not_ap_imp_eq. intro. -elim (less_irreflexive_unfolded _ (AbsCC x)). -apply H. -apply AbsCC_pos. auto. +Proof. + intros x H. + apply not_ap_imp_eq. intro. + elim (less_irreflexive_unfolded _ (AbsCC x)). + apply H. + apply AbsCC_pos. auto. Qed. (* begin hide *) Let l_1_1_2 : forall x y : IR, (x[+I*]y) [*] (x[+I*][--]y) [=] cc_IR (x[^]2[+]y[^]2). -intros. apply calculate_norm with (x := x) (y := y). +Proof. + intros. apply calculate_norm with (x := x) (y := y). Qed. (* end hide *) Hint Resolve l_1_1_2: algebra. Lemma AbsCC_square_Re_Im : forall x y : IR, x[^]2[+]y[^]2 [=] AbsCC (x[+I*]y) [^]2. -intros. unfold AbsCC in |- *. -Step_final (Re (x[+I*]y) [^]2[+]Im (x[+I*]y) [^]2). +Proof. + intros. unfold AbsCC in |- *. + Step_final (Re (x[+I*]y) [^]2[+]Im (x[+I*]y) [^]2). Qed. Hint Resolve AbsCC_square_Re_Im: algebra. @@ -210,21 +225,22 @@ Hint Resolve AbsCC_square_Re_Im: algebra. (* begin hide *) Let l_1_2_3_CC : forall x y : IR, cc_IR (x[^]2[+]y[^]2) [=] cc_IR (AbsCC (x[+I*]y) [^]2). -intros. apply cc_IR_wd. apply AbsCC_square_Re_Im. +Proof. + intros. apply cc_IR_wd. apply AbsCC_square_Re_Im. Qed. (* end hide *) Hint Resolve l_1_2_3_CC: algebra. Lemma AbsCC_mult_conj : forall z : CC, z[*]CC_conj z [=] cc_IR (AbsCC z[^]2). -intro z. unfold cc_IR in |- *. -elim z. intros x y. -apply - eq_transitive_unfolded with (S := cc_csetoid) (y := cc_IR (x[^]2[+]y[^]2)). -eapply l_1_1_2 with (x := x) (y := y). -split; simpl in |- *. -2: algebra. -eapply AbsCC_square_Re_Im with (x := x) (y := y). +Proof. + intro z. unfold cc_IR in |- *. + elim z. intros x y. + apply eq_transitive_unfolded with (S := cc_csetoid) (y := cc_IR (x[^]2[+]y[^]2)). + eapply l_1_1_2 with (x := x) (y := y). + split; simpl in |- *. + 2: algebra. + eapply AbsCC_square_Re_Im with (x := x) (y := y). Qed. Hint Resolve CC_conj_mult: algebra. @@ -233,154 +249,143 @@ Hint Resolve CC_conj_mult: algebra. Lemma l_2_1_2 : forall z1 z2 : CC, cc_IR (AbsCC (z1[*]z2) [^]2) [=] z1[*]z2[*]CC_conj z1[*]CC_conj z2. -intros z1 z2. apply eq_symmetric_unfolded. -apply eq_transitive_unfolded with (z1[*]z2[*]CC_conj (z1[*]z2)). -Step_final (z1[*]z2[*] (CC_conj z1[*]CC_conj z2)). -apply AbsCC_mult_conj. +Proof. + intros z1 z2. apply eq_symmetric_unfolded. + apply eq_transitive_unfolded with (z1[*]z2[*]CC_conj (z1[*]z2)). + Step_final (z1[*]z2[*] (CC_conj z1[*]CC_conj z2)). + apply AbsCC_mult_conj. Qed. Hint Resolve l_2_1_2: algebra. (* end hide *) Lemma AbsCC_mult_square : forall x y : CC, AbsCC (x[*]y) [^]2 [=] AbsCC x[^]2[*]AbsCC y[^]2. -intros. rstepr ((AbsCC x[*]AbsCC y) [^]2). algebra. +Proof. + intros. rstepr ((AbsCC x[*]AbsCC y) [^]2). algebra. Qed. Lemma AbsCC_square_ap_zero : forall z : CC, z [#] Zero -> AbsCC z[^]2 [#] Zero. -intros z H. -astepl (Re z[^]2[+]Im z[^]2). -apply (cc_inv_aid (Re z) (Im z) H). -apply AbsCC_square_Re_Im with (x := Re z) (y := Im z). +Proof. + intros z H. + astepl (Re z[^]2[+]Im z[^]2). + apply (cc_inv_aid (Re z) (Im z) H). + apply AbsCC_square_Re_Im with (x := Re z) (y := Im z). Qed. Lemma cc_recip_char : forall (z : CC) z_ z__, cc_recip z z_ [=] (CC_conj z[/] cc_IR (AbsCC z[^]2) [//]z__). -intros z z_ HAbsCCz. -unfold cc_recip in |- *. -astepl - (Re z[+I*][--] (Im z) [/] _[//] - cc_IR_resp_ap _ _ (cc_inv_aid _ _ (cc_ap_zero _ z_))). -2: simpl in |- *; split; simpl in |- *; rational. -apply - div_wd - with - (F := CC) - (x := Re z[+I*][--] (Im z)) - (y := cc_IR (Re z[^]2[+]Im z[^]2)) - (x' := CC_conj z) - (y' := cc_IR (AbsCC z[^]2)). -elim z. intros x y. simpl in |- *. split; simpl in |- *; algebra. -apply cc_IR_wd. -apply AbsCC_square_Re_Im with (x := Re z) (y := Im z). +Proof. + intros z z_ HAbsCCz. + unfold cc_recip in |- *. + astepl (Re z[+I*][--] (Im z) [/] _[//] cc_IR_resp_ap _ _ (cc_inv_aid _ _ (cc_ap_zero _ z_))). + 2: simpl in |- *; split; simpl in |- *; rational. + apply div_wd with (F := CC) (x := Re z[+I*][--] (Im z)) (y := cc_IR (Re z[^]2[+]Im z[^]2)) + (x' := CC_conj z) (y' := cc_IR (AbsCC z[^]2)). + elim z. intros x y. simpl in |- *. split; simpl in |- *; algebra. + apply cc_IR_wd. + apply AbsCC_square_Re_Im with (x := Re z) (y := Im z). Qed. Lemma AbsCC_strext : fun_strext AbsCC. -unfold fun_strext in |- *. -intros z1 z2 H. -cut (AbsCC z1[^]2 [#] AbsCC z2[^]2). -elim z1. intros x1 y1. elim z2. intros x2 y2. -intro H'. -assert (H'' : x1[^]2[+]y1[^]2 [#] x2[^]2[+]y2[^]2). -astepl (AbsCC (x1[+I*]y1) [^]2). astepr (AbsCC (x2[+I*]y2) [^]2). assumption. - -cut (x1[^]2 [#] x2[^]2 or y1[^]2 [#] y2[^]2). -intros H'''. elim H'''; intro H0. -cut (x1 [#] x2). -intro H1. -simpl in |- *. unfold cc_ap in |- *. unfold Re, Im in |- *. -left. -assumption. -apply (nexp_strong_ext IR 2). -assumption. - -simpl in |- *. unfold cc_ap in |- *. simpl in |- *. -right. -apply (nexp_strong_ext IR 2). -assumption. -apply (bin_op_strext_unfolded _ _ _ _ _ _ H''). -assert (H1 : AbsCC z1[-]AbsCC z2 [#] Zero). -cut (AbsCC z1[-]AbsCC z2 [#] AbsCC z2[-]AbsCC z2). -intro H0. astepr (AbsCC z2[-]AbsCC z2). assumption. -apply minus_resp_ap_rht. assumption. - -assert (H2 : AbsCC z1[+]AbsCC z2 [#] Zero). -apply Greater_imp_ap. -assert (H0 : AbsCC z1 [#] Zero or Zero [#] AbsCC z2). -apply ap_cotransitive_unfolded. assumption. -elim H0. -intro H'. -assert (H'' : Zero [<] AbsCC z1). -apply (AbsCC_ap_zero_imp_pos _ H'). -apply leEq_less_trans with (y := AbsCC z2). -apply AbsCC_nonneg. -rstepl (AbsCC z2[+]Zero). -rstepr (AbsCC z2[+]AbsCC z1). -apply plus_resp_less_lft. -assumption. - -intro H'. -assert (H'' : Zero [<] AbsCC z2). -apply AbsCC_ap_zero_imp_pos. -apply ap_symmetric_unfolded. assumption. -apply leEq_less_trans with (y := AbsCC z1). -apply AbsCC_nonneg. -rstepl (AbsCC z1[+]Zero). -apply plus_resp_less_lft. -assumption. -cut (AbsCC z1[^]2[-]AbsCC z2[^]2 [#] Zero). -intro H3. -cut (AbsCC z1[^]2[-]AbsCC z2[^]2 [#] AbsCC z2[^]2[-]AbsCC z2[^]2). -intro H4. -rstepl (AbsCC z1[^]2[-]AbsCC z2[^]2[+]AbsCC z2[^]2). -rstepr (Zero[+]AbsCC z2[^]2). - -apply - op_rht_resp_ap - with (x := AbsCC z1[^]2[-]AbsCC z2[^]2) (y := ZeroR) (z := AbsCC z2[^]2). -rstepr (AbsCC z2[^]2[-]AbsCC z2[^]2). -assumption. - -rstepr ZeroR. -assumption. - -astepl ((AbsCC z1[-]AbsCC z2) [*] (AbsCC z1[+]AbsCC z2)). -apply mult_resp_ap_zero; assumption. +Proof. + unfold fun_strext in |- *. + intros z1 z2 H. + cut (AbsCC z1[^]2 [#] AbsCC z2[^]2). + elim z1. intros x1 y1. elim z2. intros x2 y2. + intro H'. + assert (H'' : x1[^]2[+]y1[^]2 [#] x2[^]2[+]y2[^]2). + astepl (AbsCC (x1[+I*]y1) [^]2). astepr (AbsCC (x2[+I*]y2) [^]2). assumption. + cut (x1[^]2 [#] x2[^]2 or y1[^]2 [#] y2[^]2). + intros H'''. elim H'''; intro H0. + cut (x1 [#] x2). + intro H1. + simpl in |- *. unfold cc_ap in |- *. unfold Re, Im in |- *. + left. + assumption. + apply (nexp_strong_ext IR 2). + assumption. + simpl in |- *. unfold cc_ap in |- *. simpl in |- *. + right. + apply (nexp_strong_ext IR 2). + assumption. + apply (bin_op_strext_unfolded _ _ _ _ _ _ H''). + assert (H1 : AbsCC z1[-]AbsCC z2 [#] Zero). + cut (AbsCC z1[-]AbsCC z2 [#] AbsCC z2[-]AbsCC z2). + intro H0. astepr (AbsCC z2[-]AbsCC z2). assumption. + apply minus_resp_ap_rht. assumption. + assert (H2 : AbsCC z1[+]AbsCC z2 [#] Zero). + apply Greater_imp_ap. + assert (H0 : AbsCC z1 [#] Zero or Zero [#] AbsCC z2). + apply ap_cotransitive_unfolded. assumption. + elim H0. + intro H'. + assert (H'' : Zero [<] AbsCC z1). + apply (AbsCC_ap_zero_imp_pos _ H'). + apply leEq_less_trans with (y := AbsCC z2). + apply AbsCC_nonneg. + rstepl (AbsCC z2[+]Zero). + rstepr (AbsCC z2[+]AbsCC z1). + apply plus_resp_less_lft. + assumption. + intro H'. + assert (H'' : Zero [<] AbsCC z2). + apply AbsCC_ap_zero_imp_pos. + apply ap_symmetric_unfolded. assumption. + apply leEq_less_trans with (y := AbsCC z1). + apply AbsCC_nonneg. + rstepl (AbsCC z1[+]Zero). + apply plus_resp_less_lft. + assumption. + cut (AbsCC z1[^]2[-]AbsCC z2[^]2 [#] Zero). + intro H3. + cut (AbsCC z1[^]2[-]AbsCC z2[^]2 [#] AbsCC z2[^]2[-]AbsCC z2[^]2). + intro H4. + rstepl (AbsCC z1[^]2[-]AbsCC z2[^]2[+]AbsCC z2[^]2). + rstepr (Zero[+]AbsCC z2[^]2). + apply op_rht_resp_ap with (x := AbsCC z1[^]2[-]AbsCC z2[^]2) (y := ZeroR) (z := AbsCC z2[^]2). + rstepr (AbsCC z2[^]2[-]AbsCC z2[^]2). + assumption. + rstepr ZeroR. + assumption. + astepl ((AbsCC z1[-]AbsCC z2) [*] (AbsCC z1[+]AbsCC z2)). + apply mult_resp_ap_zero; assumption. Qed. Definition AbsSmallCC (e : IR) (x : CC) := AbsCC x [<=] e. Lemma Cexis_AFS_CC : forall x y eps, Zero [<] eps -> {y' : CC | AbsSmallCC eps (y'[-]y) | y' [#] x}. -unfold AbsSmallCC in |- *. intros. -set (e := cc_IR eps) in *. -elim (ap_cotransitive_unfolded _ (y[-]e) (y[+]e)) with x; try intro H0. -exists (y[-]e). -apply leEq_wdl with (AbsCC [--]e). -unfold e in |- *. -astepl (AbsCC (cc_IR eps)). -apply eq_imp_leEq. -apply AbsCC_IR. -apply less_leEq; auto. -apply AbsCC_wd. rational. -auto. -exists (y[+]e). -apply leEq_wdl with (AbsCC e). -apply eq_imp_leEq. -unfold e in |- *; apply AbsCC_IR. -apply less_leEq; auto. -apply AbsCC_wd. rational. -apply ap_symmetric_unfolded. auto. -apply zero_minus_apart. -apply ap_wdl_unfolded with (cc_IR ( [--]Two[*]eps)). -astepr (cc_IR Zero). -apply cc_IR_resp_ap. apply mult_resp_ap_zero. -apply inv_resp_ap_zero. apply two_ap_zero. -apply pos_ap_zero; auto. -unfold e in |- *. -astepl (cc_IR [--]Two[*]cc_IR eps). -rstepr ( [--]Two[*]cc_IR eps). -apply mult_wdl. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. -split; [ algebra | rational ]. +Proof. + unfold AbsSmallCC in |- *. intros. + set (e := cc_IR eps) in *. + elim (ap_cotransitive_unfolded _ (y[-]e) (y[+]e)) with x; try intro H0. + exists (y[-]e). + apply leEq_wdl with (AbsCC [--]e). + unfold e in |- *. + astepl (AbsCC (cc_IR eps)). + apply eq_imp_leEq. + apply AbsCC_IR. + apply less_leEq; auto. + apply AbsCC_wd. rational. + auto. + exists (y[+]e). + apply leEq_wdl with (AbsCC e). + apply eq_imp_leEq. + unfold e in |- *; apply AbsCC_IR. + apply less_leEq; auto. + apply AbsCC_wd. rational. + apply ap_symmetric_unfolded. auto. + apply zero_minus_apart. + apply ap_wdl_unfolded with (cc_IR ( [--]Two[*]eps)). + astepr (cc_IR Zero). + apply cc_IR_resp_ap. apply mult_resp_ap_zero. + apply inv_resp_ap_zero. apply two_ap_zero. + apply pos_ap_zero; auto. + unfold e in |- *. + astepl (cc_IR [--]Two[*]cc_IR eps). + rstepr ( [--]Two[*]cc_IR eps). + apply mult_wdl. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. + split; [ algebra | rational ]. Qed. (* The following lemmas are just auxiliary results *) @@ -388,53 +393,40 @@ Qed. (* begin hide *) Let l_4_1_2 : forall (z : CC) (H : z [#] Zero), - z[*]cc_recip z H [=] + z[*]cc_recip z H [=] (z[*]CC_conj z[/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H)). -intros z H. -apply - eq_transitive_unfolded - with - (S := cc_csetoid) - (y := z[*] - (CC_conj z[/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H))). -2: algebra. -astepr (z[*] (CC_conj z[/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H))). -apply - bin_op_wd_unfolded - with - (S := CC) - (x1 := z) - (x2 := z) - (y1 := cc_recip z H) +Proof. + intros z H. + apply eq_transitive_unfolded with (S := cc_csetoid) (y := z[*] + (CC_conj z[/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H))). + 2: algebra. + astepr (z[*] (CC_conj z[/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H))). + apply bin_op_wd_unfolded with (S := CC) (x1 := z) (x2 := z) (y1 := cc_recip z H) (y2 := CC_conj z[/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H)). -algebra. -apply cc_recip_char. -generalize H. clear H. elim z. intros x y H. simpl in |- *. split; simpl in |- *; rational. + algebra. + apply cc_recip_char. + generalize H. clear H. elim z. intros x y H. simpl in |- *. split; simpl in |- *; rational. Qed. Let l_4_2_3 : forall (z : CC) (H : z [#] Zero), - (z[*]CC_conj z[/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H)) [=] + (z[*]CC_conj z[/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H)) [=] (cc_IR (AbsCC z[^]2) [/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H)). -intros z H. -apply - div_wd - with - (F := CC) - (x := z[*]CC_conj z) - (y := cc_IR (AbsCC z[^]2)) - (x' := cc_IR (AbsCC z[^]2)) - (y' := cc_IR (AbsCC z[^]2)). -apply AbsCC_mult_conj. -algebra. +Proof. + intros z H. + apply div_wd with (F := CC) (x := z[*]CC_conj z) (y := cc_IR (AbsCC z[^]2)) + (x' := cc_IR (AbsCC z[^]2)) (y' := cc_IR (AbsCC z[^]2)). + apply AbsCC_mult_conj. + algebra. Qed. Let l_4_3_4 : forall (z : CC) (H : z [#] Zero), - (cc_IR (AbsCC z[^]2) [/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H)) [=] + (cc_IR (AbsCC z[^]2) [/] _[//]cc_IR_resp_ap _ _ (AbsCC_square_ap_zero _ H)) [=] One. -intros. -rational. +Proof. + intros. + rational. Qed. (* end hide *) @@ -449,71 +441,67 @@ Hint Resolve cc_inv_abs cc_mult_abs cc_div_abs cc_div_abs' cc_pow_abs ** The triangle inequality *) Lemma triangle : forall x y : CC, AbsCC (x[+]y) [<=] AbsCC x[+]AbsCC y. -intros. -elim x. intros x1 x2. -elim y. intros y1 y2. -unfold AbsCC in |- *. simpl in |- *. -apply power_cancel_leEq with 2. auto. -astepl (Zero[+]ZeroR). -apply plus_resp_leEq_both; apply sqrt_nonneg. -astepl (One[*](x1[+]y1)[*](x1[+]y1)[+]One[*](x2[+]y2)[*](x2[+]y2)). -rstepr - (sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[^]2[+] - sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)[^]2[+] - Two[*]sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[*] - sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)). -astepr - (One[*]x1[*]x1[+]One[*]x2[*]x2[+](One[*]y1[*]y1[+]One[*]y2[*]y2)[+] - Two[*]sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[*] - sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)). -apply shift_leEq_rht. -rstepr - (Two[*] - (sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[*] - sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)[-] - (x1[*]y1[+]x2[*]y2))). -apply mult_resp_nonneg. apply less_leEq. apply pos_two. -apply shift_leEq_lft. -apply power_cancel_leEq with 2. auto. -apply mult_resp_nonneg; apply sqrt_nonneg. -astepr - (sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[^]2[*] - sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)[^]2). -astepr ((One[*]x1[*]x1[+]One[*]x2[*]x2)[*](One[*]y1[*]y1[+]One[*]y2[*]y2)). -apply shift_leEq_rht. -rstepr ((x1[*]y2[-]x2[*]y1)[^]2). -apply sqr_nonneg. +Proof. + intros. + elim x. intros x1 x2. + elim y. intros y1 y2. + unfold AbsCC in |- *. simpl in |- *. + apply power_cancel_leEq with 2. auto. + astepl (Zero[+]ZeroR). + apply plus_resp_leEq_both; apply sqrt_nonneg. + astepl (One[*](x1[+]y1)[*](x1[+]y1)[+]One[*](x2[+]y2)[*](x2[+]y2)). + rstepr (sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[^]2[+] + sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)[^]2[+] + Two[*]sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[*] + sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)). + astepr (One[*]x1[*]x1[+]One[*]x2[*]x2[+](One[*]y1[*]y1[+]One[*]y2[*]y2)[+] + Two[*]sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[*] + sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)). + apply shift_leEq_rht. + rstepr (Two[*] (sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[*] + sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)[-] (x1[*]y1[+]x2[*]y2))). + apply mult_resp_nonneg. apply less_leEq. apply pos_two. + apply shift_leEq_lft. + apply power_cancel_leEq with 2. auto. + apply mult_resp_nonneg; apply sqrt_nonneg. + astepr (sqrt (One[*]x1[*]x1[+]One[*]x2[*]x2) (cc_abs_aid _ x1 x2)[^]2[*] + sqrt (One[*]y1[*]y1[+]One[*]y2[*]y2) (cc_abs_aid _ y1 y2)[^]2). + astepr ((One[*]x1[*]x1[+]One[*]x2[*]x2)[*](One[*]y1[*]y1[+]One[*]y2[*]y2)). + apply shift_leEq_rht. + rstepr ((x1[*]y2[-]x2[*]y1)[^]2). + apply sqr_nonneg. Qed. Lemma triangle_Sum : forall m n (z : nat -> CC), m <= S n -> AbsCC (Sum m n z) [<=] Sum m n (fun i => AbsCC (z i)). -intros. induction n as [| n Hrecn]; intros. -generalize (toCle _ _ H); clear H; intro H. -inversion H as [|m0 H1 H2]. -unfold Sum in |- *. unfold Sum1 in |- *. -astepl (AbsCC Zero). -astepr ZeroR. -astepr (AbsCC Zero). -apply leEq_reflexive. -inversion H1. -unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. -cut (AbsCC (Zero[+]z 0[-]Zero)[<=]Zero[+]AbsCC (z 0)[-]Zero). -auto. -apply eq_imp_leEq. -rstepr (AbsCC (z 0)). -apply AbsCC_wd. -rational. -elim (le_lt_eq_dec _ _ H); intro y. -astepl (AbsCC (Sum m n z[+]z (S n))). -apply leEq_wdr with (Sum m n (fun i : nat => AbsCC (z i))[+]AbsCC (z (S n))). -apply leEq_transitive with (AbsCC (Sum m n z)[+]AbsCC (z (S n))). -apply triangle. -apply plus_resp_leEq. -apply Hrecn. auto with arith. -apply eq_symmetric_unfolded. apply Sum_last with (f := fun i : nat => AbsCC (z i)). -rewrite y. unfold Sum in |- *. unfold Sum1 in |- *. -astepl (AbsCC Zero). -astepr ZeroR. -astepr (AbsCC Zero). -apply leEq_reflexive. +Proof. + intros. induction n as [| n Hrecn]; intros. + generalize (toCle _ _ H); clear H; intro H. + inversion H as [|m0 H1 H2]. + unfold Sum in |- *. unfold Sum1 in |- *. + astepl (AbsCC Zero). + astepr ZeroR. + astepr (AbsCC Zero). + apply leEq_reflexive. + inversion H1. + unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. + cut (AbsCC (Zero[+]z 0[-]Zero)[<=]Zero[+]AbsCC (z 0)[-]Zero). + auto. + apply eq_imp_leEq. + rstepr (AbsCC (z 0)). + apply AbsCC_wd. + rational. + elim (le_lt_eq_dec _ _ H); intro y. + astepl (AbsCC (Sum m n z[+]z (S n))). + apply leEq_wdr with (Sum m n (fun i : nat => AbsCC (z i))[+]AbsCC (z (S n))). + apply leEq_transitive with (AbsCC (Sum m n z)[+]AbsCC (z (S n))). + apply triangle. + apply plus_resp_leEq. + apply Hrecn. auto with arith. + apply eq_symmetric_unfolded. apply Sum_last with (f := fun i : nat => AbsCC (z i)). + rewrite y. unfold Sum in |- *. unfold Sum1 in |- *. + astepl (AbsCC Zero). + astepr ZeroR. + astepr (AbsCC Zero). + apply leEq_reflexive. Qed. diff --git a/complex/CComplex.v b/complex/CComplex.v index 36893f010..03f6513c1 100644 --- a/complex/CComplex.v +++ b/complex/CComplex.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Re %\ensuremath{\Re}% #ℜ# *) (** printing Im %\ensuremath{\Im}% #ℑ# *) @@ -59,36 +59,37 @@ Definition cc_ap (x y : CC_set) : CProp := Re x [#] Re y or Im x [#] Im y. Definition cc_eq (x y : CC_set) : Prop := Re x [=] Re y /\ Im x [=] Im y. Lemma cc_is_CSetoid : is_CSetoid _ cc_eq cc_ap. -apply Build_is_CSetoid. -unfold irreflexive in |- *. -intros. elim x. intros x1 x2. unfold cc_ap in |- *. simpl in |- *. -intro H. elim H; clear H; intros H. -cut (Not (x1 [#] x1)). intros H0. elim (H0 H). apply ap_irreflexive_unfolded. -cut (Not (x2 [#] x2)). intros H0. elim (H0 H). apply ap_irreflexive_unfolded. -unfold Csymmetric in |- *. -intros x y. elim x. intros x1 x2. elim y. intros y1 y2. unfold cc_ap in |- *. -simpl in |- *. intros H. elim H; clear H; intros H. -left. apply ap_symmetric_unfolded. auto. -right. apply ap_symmetric_unfolded. auto. -unfold cotransitive in |- *. -intros x y. elim x. intros x1 x2. elim y. intros y1 y2. unfold cc_ap in |- *. -simpl in |- *. intro H. intro. elim z. intros z1 z2. simpl in |- *. intros. -elim H; clear H; intros H. -cut (x1 [#] z1 or z1 [#] y1). intro H0. -elim H0; clear H0; intros H0. left. left. auto. right. left. auto. -apply ap_cotransitive_unfolded. auto. -cut (x2 [#] z2 or z2 [#] y2). intro H0. -elim H0; clear H0; intros H0. left. right. auto. right. right. auto. -apply ap_cotransitive_unfolded. auto. -unfold tight_apart in |- *. -intros x y. elim x. intros x1 x2. elim y. intros y1 y2. -unfold cc_ap in |- *. unfold cc_eq in |- *. simpl in |- *. split. -intros. split. -apply not_ap_imp_eq. intro. apply H. left. auto. -apply not_ap_imp_eq. intro. apply H. right. auto. -intros. elim H. clear H. intros H H0. intro H1. elim H1; clear H1; intros H1. -cut (Not (x1 [#] y1)). intro. elim (H2 H1). apply eq_imp_not_ap. auto. -cut (Not (x2 [#] y2)). intro. elim (H2 H1). apply eq_imp_not_ap. auto. +Proof. + apply Build_is_CSetoid. + unfold irreflexive in |- *. + intros. elim x. intros x1 x2. unfold cc_ap in |- *. simpl in |- *. + intro H. elim H; clear H; intros H. + cut (Not (x1 [#] x1)). intros H0. elim (H0 H). apply ap_irreflexive_unfolded. + cut (Not (x2 [#] x2)). intros H0. elim (H0 H). apply ap_irreflexive_unfolded. + unfold Csymmetric in |- *. + intros x y. elim x. intros x1 x2. elim y. intros y1 y2. unfold cc_ap in |- *. + simpl in |- *. intros H. elim H; clear H; intros H. + left. apply ap_symmetric_unfolded. auto. + right. apply ap_symmetric_unfolded. auto. + unfold cotransitive in |- *. + intros x y. elim x. intros x1 x2. elim y. intros y1 y2. unfold cc_ap in |- *. + simpl in |- *. intro H. intro. elim z. intros z1 z2. simpl in |- *. intros. + elim H; clear H; intros H. + cut (x1 [#] z1 or z1 [#] y1). intro H0. + elim H0; clear H0; intros H0. left. left. auto. right. left. auto. + apply ap_cotransitive_unfolded. auto. + cut (x2 [#] z2 or z2 [#] y2). intro H0. + elim H0; clear H0; intros H0. left. right. auto. right. right. auto. + apply ap_cotransitive_unfolded. auto. + unfold tight_apart in |- *. + intros x y. elim x. intros x1 x2. elim y. intros y1 y2. + unfold cc_ap in |- *. unfold cc_eq in |- *. simpl in |- *. split. + intros. split. + apply not_ap_imp_eq. intro. apply H. left. auto. + apply not_ap_imp_eq. intro. apply H. right. auto. + intros. elim H. clear H. intros H H0. intro H1. elim H1; clear H1; intros H1. + cut (Not (x1 [#] y1)). intro. elim (H2 H1). apply eq_imp_not_ap. auto. + cut (Not (x2 [#] y2)). intro. elim (H2 H1). apply eq_imp_not_ap. auto. Qed. Definition cc_csetoid := Build_CSetoid CC_set cc_eq cc_ap cc_is_CSetoid. @@ -132,43 +133,45 @@ Qed. *) Lemma cc_inv_strext : un_op_strext cc_csetoid cc_inv. -unfold un_op_strext in |- *. unfold fun_strext in |- *. -intros x y. elim x. elim y. -simpl in |- *. unfold cc_ap in |- *. simpl in |- *. do 4 intro. intro H. -elim H; clear H; intros. -left. apply un_op_strext_unfolded with (cg_inv (c:=IR)). auto. -right. apply un_op_strext_unfolded with (cg_inv (c:=IR)). auto. +Proof. + unfold un_op_strext in |- *. unfold fun_strext in |- *. + intros x y. elim x. elim y. + simpl in |- *. unfold cc_ap in |- *. simpl in |- *. do 4 intro. intro H. + elim H; clear H; intros. + left. apply un_op_strext_unfolded with (cg_inv (c:=IR)). auto. + right. apply un_op_strext_unfolded with (cg_inv (c:=IR)). auto. Qed. Lemma cc_plus_strext : bin_op_strext cc_csetoid cc_plus. -unfold bin_op_strext in |- *. unfold bin_fun_strext in |- *. -intros x1 x2 y1 y2. elim x1. elim x2. elim y1. elim y2. -simpl in |- *. unfold cc_ap in |- *. simpl in |- *. do 8 intro. intro H. -elim H; clear H; intros H. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intros. -left. left. auto. right. left. auto. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intros. -left. right. auto. right. right. auto. +Proof. + unfold bin_op_strext in |- *. unfold bin_fun_strext in |- *. + intros x1 x2 y1 y2. elim x1. elim x2. elim y1. elim y2. + simpl in |- *. unfold cc_ap in |- *. simpl in |- *. do 8 intro. intro H. + elim H; clear H; intros H. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intros. + left. left. auto. right. left. auto. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intros. + left. right. auto. right. right. auto. Qed. Lemma cc_mult_strext : bin_op_strext cc_csetoid cc_mult. -unfold bin_op_strext in |- *. unfold bin_fun_strext in |- *. -intros x1 x2 y1 y2. elim x1. elim x2. elim y1. elim y2. -simpl in |- *. unfold cc_ap in |- *. simpl in |- *. do 8 intro. intro H. -elim H; clear H; intros H. -elim (bin_op_strext_unfolded _ (cg_minus_is_csetoid_bin_op _) _ _ _ _ H); - intros H0. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H0); intros H1. -left. left. auto. right. left. auto. -cut (Im3[*]Im1 [#] Im2[*]Im0). intro H1. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H1); intros H2. -left. right. auto. right. right. auto. -auto. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intros H0. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H0); intros H1. -left. left. auto. right. right. auto. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H0); intros. -left. right. auto. right. left. auto. +Proof. + unfold bin_op_strext in |- *. unfold bin_fun_strext in |- *. + intros x1 x2 y1 y2. elim x1. elim x2. elim y1. elim y2. + simpl in |- *. unfold cc_ap in |- *. simpl in |- *. do 8 intro. intro H. + elim H; clear H; intros H. + elim (bin_op_strext_unfolded _ (cg_minus_is_csetoid_bin_op _) _ _ _ _ H); intros H0. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H0); intros H1. + left. left. auto. right. left. auto. + cut (Im3[*]Im1 [#] Im2[*]Im0). intro H1. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H1); intros H2. + left. right. auto. right. right. auto. + auto. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intros H0. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H0); intros H1. + left. left. auto. right. right. auto. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H0); intros. + left. right. auto. right. left. auto. Qed. Definition cc_inv_op := Build_CSetoid_un_op _ _ cc_inv_strext. @@ -178,89 +181,101 @@ Definition cc_plus_op := Build_CSetoid_bin_op _ _ cc_plus_strext. Definition cc_mult_op := Build_CSetoid_bin_op _ _ cc_mult_strext. Lemma cc_csg_associative : associative cc_plus_op. -unfold associative in |- *. intros. elim x. elim y. elim z. intros. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + unfold associative in |- *. intros. elim x. elim y. elim z. intros. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Lemma cc_cr_mult_associative : associative cc_mult_op. -unfold associative in |- *. intros. elim x. elim y. elim z. intros. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + unfold associative in |- *. intros. elim x. elim y. elim z. intros. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Definition cc_csemi_grp := Build_CSemiGroup cc_csetoid _ cc_csg_associative. Lemma cc_cm_proof : is_CMonoid cc_csemi_grp cc_zero. -apply Build_is_CMonoid. -unfold is_rht_unit in |- *. intros. elim x. intros. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. -unfold is_lft_unit in |- *. intros. elim x. intros. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + apply Build_is_CMonoid. + unfold is_rht_unit in |- *. intros. elim x. intros. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. + unfold is_lft_unit in |- *. intros. elim x. intros. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Definition cc_cmonoid := Build_CMonoid _ _ cc_cm_proof. Lemma cc_cg_proof : is_CGroup cc_cmonoid cc_inv_op. -unfold is_CGroup in |- *. intros. elim x. intros. -split. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + unfold is_CGroup in |- *. intros. elim x. intros. + split. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Lemma cc_cr_dist : distributive cc_mult_op cc_plus_op. -unfold distributive in |- *. intros. elim x. elim y. elim z. intros. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + unfold distributive in |- *. intros. elim x. elim y. elim z. intros. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Lemma cc_cr_non_triv : cc_ap cc_one cc_zero. -unfold cc_ap in |- *. simpl in |- *. left. apply Greater_imp_ap. apply pos_one. +Proof. + unfold cc_ap in |- *. simpl in |- *. left. apply Greater_imp_ap. apply pos_one. Qed. Definition cc_cgroup := Build_CGroup cc_cmonoid cc_inv_op cc_cg_proof. Definition cc_cabgroup : CAbGroup. -apply Build_CAbGroup with cc_cgroup. -red in |- *; unfold commutes in |- *. -intros. -elim x; elim y; split; simpl in |- *; algebra. +Proof. + apply Build_CAbGroup with cc_cgroup. + red in |- *; unfold commutes in |- *. + intros. + elim x; elim y; split; simpl in |- *; algebra. Defined. Lemma cc_cr_mult_mon : is_CMonoid (Build_CSemiGroup (csg_crr cc_cgroup) _ cc_cr_mult_associative) cc_one. -apply Build_is_CMonoid. -unfold is_rht_unit in |- *. -intros. elim x. intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. -split; rational. -unfold is_lft_unit in |- *. -intros. elim x. intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. -split; rational. +Proof. + apply Build_is_CMonoid. + unfold is_rht_unit in |- *. + intros. elim x. intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. + split; rational. + unfold is_lft_unit in |- *. + intros. elim x. intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. + split; rational. Qed. Lemma cc_mult_commutes : commutes cc_mult_op. -unfold commutes in |- *. -intros. elim x. intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. -split; rational. +Proof. + unfold commutes in |- *. + intros. elim x. intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. + split; rational. Qed. Lemma cc_isCRing : is_CRing cc_cabgroup cc_one cc_mult_op. -apply Build_is_CRing with cc_cr_mult_associative. -exact cc_cr_mult_mon. -exact cc_mult_commutes. -exact cc_cr_dist. -exact cc_cr_non_triv. +Proof. + apply Build_is_CRing with cc_cr_mult_associative. + exact cc_cr_mult_mon. + exact cc_mult_commutes. + exact cc_cr_dist. + exact cc_cr_non_triv. Qed. Definition cc_cring : CRing := Build_CRing _ _ _ cc_isCRing. Lemma cc_ap_zero : forall z : cc_cring, z [#] Zero -> Re z [#] Zero or Im z [#] Zero. -intro z. unfold cc_ap in |- *. intuition. +Proof. + intro z. unfold cc_ap in |- *. intuition. Qed. Lemma cc_inv_aid : forall x y : IR, x [#] Zero or y [#] Zero -> x[^]2[+]y[^]2 [#] Zero. -intros x y H. -apply Greater_imp_ap. -elim H; clear H; intros. -apply plus_resp_pos_nonneg. apply pos_square. auto. apply sqr_nonneg. -apply plus_resp_nonneg_pos. apply sqr_nonneg. apply pos_square. auto. +Proof. + intros x y H. + apply Greater_imp_ap. + elim H; clear H; intros. + apply plus_resp_pos_nonneg. apply pos_square. auto. apply sqr_nonneg. + apply plus_resp_nonneg_pos. apply sqr_nonneg. apply pos_square. auto. Qed. (** @@ -270,11 +285,12 @@ If [x [~=] Zero] or [y [~=] Zero], then [x [/] x[^]2 [+] y[^]2 [~=] Zero] or Lemma cc_inv_aid2 : forall (x y : IR) (H : x [#] Zero or y [#] Zero), (x[/] _[//]cc_inv_aid _ _ H) [#] Zero or ( [--]y[/] _[//]cc_inv_aid _ _ H) [#] Zero. -intros x y H. -elim H; intro H0. -left. -apply div_resp_ap_zero_rev. auto. -right. apply div_resp_ap_zero_rev. apply inv_resp_ap_zero. auto. +Proof. + intros x y H. + elim H; intro H0. + left. + apply div_resp_ap_zero_rev. auto. + right. apply div_resp_ap_zero_rev. apply inv_resp_ap_zero. auto. Qed. (* @@ -287,42 +303,43 @@ actual function. *) Definition cc_recip : forall z : cc_cring, z [#] Zero -> cc_cring. -intros z z_. -apply - (Build_CC_set (Re z[/] _[//]cc_inv_aid _ _ z_) - ( [--] (Im z) [/] _[//]cc_inv_aid _ _ z_)). +Proof. + intros z z_. + apply (Build_CC_set (Re z[/] _[//]cc_inv_aid _ _ z_) ( [--] (Im z) [/] _[//]cc_inv_aid _ _ z_)). Defined. Lemma cc_cfield_proof : is_CField cc_cring cc_recip. -unfold is_CField in |- *. unfold is_inverse in |- *. -intro. elim x. intros x1 x2 Hx. -split; simpl in |- *; unfold cc_eq in |- *; simpl in |- *; split; rational. +Proof. + unfold is_CField in |- *. unfold is_inverse in |- *. + intro. elim x. intros x1 x2 Hx. + split; simpl in |- *; unfold cc_eq in |- *; simpl in |- *; split; rational. Qed. Lemma cc_Recip_proof : forall x y x_ y_, cc_recip x x_ [#] cc_recip y y_ -> x [#] y. -intro. elim x. intros x1 x2 y. -intro Hx. elim y. intros y1 y2 Hy. -simpl in |- *. unfold cc_ap in |- *. simpl in |- *. intros H. -elim H; clear H; intros H. -cut (x1 [#] y1 or x1[^]2[+]x2[^]2 [#] y1[^]2[+]y2[^]2). intro H0. -elim H0; clear H0; intros H0. -left. auto. -cut (x1[^]2 [#] y1[^]2 or x2[^]2 [#] y2[^]2). intro H1. -elim H1; clear H1; intros. -left. apply un_op_strext_unfolded with (nexp_op (R:=IR) 2). auto. -right. apply un_op_strext_unfolded with (nexp_op (R:=IR) 2). auto. -apply bin_op_strext_unfolded with (csg_op (c:=IR)). auto. -apply div_strext with (cc_inv_aid x1 x2 Hx) (cc_inv_aid y1 y2 Hy). auto. -cut ( [--]x2 [#] [--]y2 or x1[^]2[+]x2[^]2 [#] y1[^]2[+]y2[^]2). intro H0. -elim H0; clear H0; intros H0. -right. apply un_op_strext_unfolded with (cg_inv (c:=IR)). auto. -cut (x1[^]2 [#] y1[^]2 or x2[^]2 [#] y2[^]2). intro H1. -elim H1; clear H1; intros H1. -left. apply un_op_strext_unfolded with (nexp_op (R:=IR) 2). auto. -right. apply un_op_strext_unfolded with (nexp_op (R:=IR) 2). auto. -apply bin_op_strext_unfolded with (csg_op (c:=IR)). auto. -apply div_strext with (cc_inv_aid x1 x2 Hx) (cc_inv_aid y1 y2 Hy). auto. +Proof. + intro. elim x. intros x1 x2 y. + intro Hx. elim y. intros y1 y2 Hy. + simpl in |- *. unfold cc_ap in |- *. simpl in |- *. intros H. + elim H; clear H; intros H. + cut (x1 [#] y1 or x1[^]2[+]x2[^]2 [#] y1[^]2[+]y2[^]2). intro H0. + elim H0; clear H0; intros H0. + left. auto. + cut (x1[^]2 [#] y1[^]2 or x2[^]2 [#] y2[^]2). intro H1. + elim H1; clear H1; intros. + left. apply un_op_strext_unfolded with (nexp_op (R:=IR) 2). auto. + right. apply un_op_strext_unfolded with (nexp_op (R:=IR) 2). auto. + apply bin_op_strext_unfolded with (csg_op (c:=IR)). auto. + apply div_strext with (cc_inv_aid x1 x2 Hx) (cc_inv_aid y1 y2 Hy). auto. + cut ( [--]x2 [#] [--]y2 or x1[^]2[+]x2[^]2 [#] y1[^]2[+]y2[^]2). intro H0. + elim H0; clear H0; intros H0. + right. apply un_op_strext_unfolded with (cg_inv (c:=IR)). auto. + cut (x1[^]2 [#] y1[^]2 or x2[^]2 [#] y2[^]2). intro H1. + elim H1; clear H1; intros H1. + left. apply un_op_strext_unfolded with (nexp_op (R:=IR) 2). auto. + right. apply un_op_strext_unfolded with (nexp_op (R:=IR) 2). auto. + apply bin_op_strext_unfolded with (csg_op (c:=IR)). auto. + apply div_strext with (cc_inv_aid x1 x2 Hx) (cc_inv_aid y1 y2 Hy). auto. Qed. Opaque cc_recip. @@ -352,10 +369,11 @@ Definition CC_conj' : CC->CC := [z:CC_set] (CC_set_rec [_:CC_set]CC_set [Re0,Im0 Definition AbsCC (z : CC) : IR := sqrt (Re z[^]2[+]Im z[^]2) (cc_abs_aid _ (Re z) (Im z)). Lemma TwoCC_ap_zero : (Two:CC) [#] Zero. -simpl in |- *. unfold cc_ap in |- *. -simpl in |- *. left. -astepl (Two:IR). -apply Greater_imp_ap. apply pos_two. +Proof. + simpl in |- *. unfold cc_ap in |- *. + simpl in |- *. left. + astepl (Two:IR). + apply Greater_imp_ap. apply pos_two. Qed. End Complex_Numbers. @@ -374,83 +392,99 @@ Infix "[+I*]" := cc_set_CC (at level 48, no associativity). Section I_properties. Lemma I_square : II[*]II [=] [--]One. -simpl in |- *. unfold cc_mult in |- *. simpl in |- *. unfold cc_inv in |- *. simpl in |- *. -split. simpl in |- *. rational. simpl in |- *. rational. +Proof. + simpl in |- *. unfold cc_mult in |- *. simpl in |- *. unfold cc_inv in |- *. simpl in |- *. + split. simpl in |- *. rational. simpl in |- *. rational. Qed. Hint Resolve I_square: algebra. Lemma I_square' : II[^]2 [=] [--]One. -Step_final (II[*]II). +Proof. + Step_final (II[*]II). Qed. Lemma I_recip_lft : [--]II[*]II [=] One. -astepl ( [--] (II[*]II)). -Step_final ( [--][--] (One:CC)). +Proof. + astepl ( [--] (II[*]II)). + Step_final ( [--][--] (One:CC)). Qed. Lemma I_recip_rht : II[*][--]II [=] One. -astepl ( [--] (II[*]II)). -Step_final ( [--][--] (One:CC)). +Proof. + astepl ( [--] (II[*]II)). + Step_final ( [--][--] (One:CC)). Qed. Lemma mult_I : forall x y : IR, (x[+I*]y) [*]II [=] [--]y[+I*]x. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Lemma I_wd : forall x x' y y' : IR, x [=] x' -> y [=] y' -> x[+I*]y [=] x'[+I*]y'. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. algebra. +Proof. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. algebra. Qed. (** ** Properties of [Re] and [Im] *) Lemma calculate_norm : forall x y : IR, (x[+I*]y) [*]CC_conj (x[+I*]y) [=] cc_IR (x[^]2[+]y[^]2). -intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Lemma calculate_Re : forall c : CC, cc_IR (Re c) [*]Two [=] c[+]CC_conj c. -intros. elim c. intros x y. intros. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + intros. elim c. intros x y. intros. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Lemma calculate_Im : forall c : CC, cc_IR (Im c) [*] (Two[*]II) [=] c[-]CC_conj c. -intros. elim c. intros x y. intros. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + intros. elim c. intros x y. intros. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Lemma Re_wd : forall c c' : CC, c [=] c' -> Re c [=] Re c'. -intros c c'. elim c. intros x y. elim c'. intros x' y'. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. intros. elim H. auto. +Proof. + intros c c'. elim c. intros x y. elim c'. intros x' y'. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. intros. elim H. auto. Qed. Lemma Im_wd : forall c c' : CC, c [=] c' -> Im c [=] Im c'. -intros c c'. elim c. intros x y. elim c'. intros x' y'. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. intros. elim H. auto. +Proof. + intros c c'. elim c. intros x y. elim c'. intros x' y'. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. intros. elim H. auto. Qed. Lemma Re_resp_plus : forall x y : CC, Re (x[+]y) [=] Re x[+]Re y. -intros. elim x. intros x1 x2. elim y. intros y1 y2. -simpl in |- *. unfold cc_eq in |- *. algebra. +Proof. + intros. elim x. intros x1 x2. elim y. intros y1 y2. + simpl in |- *. unfold cc_eq in |- *. algebra. Qed. Lemma Re_resp_inv : forall x y : CC, Re (x[-]y) [=] Re x[-]Re y. -intros. elim x. intros x1 x2. elim y. intros y1 y2. -simpl in |- *. unfold cc_eq in |- *. algebra. +Proof. + intros. elim x. intros x1 x2. elim y. intros y1 y2. + simpl in |- *. unfold cc_eq in |- *. algebra. Qed. Lemma Im_resp_plus : forall x y : CC, Im (x[+]y) [=] Im x[+]Im y. -intros. elim x. intros x1 x2. elim y. intros y1 y2. -simpl in |- *. unfold cc_eq in |- *. algebra. +Proof. + intros. elim x. intros x1 x2. elim y. intros y1 y2. + simpl in |- *. unfold cc_eq in |- *. algebra. Qed. Lemma Im_resp_inv : forall x y : CC, Im (x[-]y) [=] Im x[-]Im y. -intros. elim x. intros x1 x2. elim y. intros y1 y2. -simpl in |- *. unfold cc_eq in |- *. algebra. +Proof. + intros. elim x. intros x1 x2. elim y. intros y1 y2. + simpl in |- *. unfold cc_eq in |- *. algebra. Qed. Lemma cc_calculate_square : forall x y, (x[+I*]y) [^]2 [=] (x[^]2[-]y[^]2) [+I*]x[*]y[*]Two. -intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. End I_properties. @@ -465,46 +499,53 @@ Hint Resolve I_wd Re_wd Im_wd: algebra_c. Section Conj_properties. Lemma CC_conj_plus : forall c c' : CC, CC_conj (c[+]c') [=] CC_conj c[+]CC_conj c'. -intros c c'. elim c. intros x y. elim c'. intros x' y'. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + intros c c'. elim c. intros x y. elim c'. intros x' y'. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Lemma CC_conj_mult : forall c c' : CC, CC_conj (c[*]c') [=] CC_conj c[*]CC_conj c'. -intros c c'. elim c. intros x y. elim c'. intros x' y'. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + intros c c'. elim c. intros x y. elim c'. intros x' y'. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Hint Resolve CC_conj_mult: algebra. Lemma CC_conj_strext : forall c c' : CC, CC_conj c [#] CC_conj c' -> c [#] c'. -intros c c'. elim c. intros x y. elim c'. intros x' y'. -simpl in |- *. unfold cc_ap in |- *. simpl in |- *. intros H. -elim H; clear H; intros. -left. auto. -right. apply un_op_strext_unfolded with (cg_inv (c:=IR)). auto. +Proof. + intros c c'. elim c. intros x y. elim c'. intros x' y'. + simpl in |- *. unfold cc_ap in |- *. simpl in |- *. intros H. + elim H; clear H; intros. + left. auto. + right. apply un_op_strext_unfolded with (cg_inv (c:=IR)). auto. Qed. Lemma CC_conj_conj : forall c : CC, CC_conj (CC_conj c) [=] c. -intros. elim c. intros x y. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + intros. elim c. intros x y. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Lemma CC_conj_zero : CC_conj Zero [=] Zero. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Lemma CC_conj_one : CC_conj One [=] One. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Hint Resolve CC_conj_one: algebra. Lemma CC_conj_nexp : forall (c : CC) n, CC_conj (c[^]n) [=] CC_conj c[^]n. -intros. induction n as [| n Hrecn]; intros. -astepl (CC_conj One). -Step_final (One:CC). -astepl (CC_conj (c[^]n[*]c)). -astepl (CC_conj (c[^]n) [*]CC_conj c). -Step_final (CC_conj c[^]n[*]CC_conj c). +Proof. + intros. induction n as [| n Hrecn]; intros. + astepl (CC_conj One). + Step_final (One:CC). + astepl (CC_conj (c[^]n[*]c)). + astepl (CC_conj (c[^]n) [*]CC_conj c). + Step_final (CC_conj c[^]n[*]CC_conj c). Qed. End Conj_properties. @@ -518,75 +559,88 @@ Hint Resolve CC_conj_plus CC_conj_mult CC_conj_nexp CC_conj_conj Section cc_IR_properties. Lemma Re_cc_IR : forall x : IR, Re (cc_IR x) [=] x. -intro x. simpl in |- *. apply eq_reflexive. +Proof. + intro x. simpl in |- *. apply eq_reflexive. Qed. Lemma Im_cc_IR : forall x : IR, Im (cc_IR x) [=] Zero. -intro x. simpl in |- *. apply eq_reflexive. +Proof. + intro x. simpl in |- *. apply eq_reflexive. Qed. Lemma cc_IR_wd : forall x y : IR, x [=] y -> cc_IR x [=] cc_IR y. -intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Hint Resolve cc_IR_wd: algebra_c. Lemma cc_IR_resp_ap : forall x y : IR, x [#] y -> cc_IR x [#] cc_IR y. -intros. simpl in |- *. unfold cc_ap in |- *. simpl in |- *. left. auto. +Proof. + intros. simpl in |- *. unfold cc_ap in |- *. simpl in |- *. left. auto. Qed. Lemma cc_IR_mult : forall x y : IR, cc_IR x[*]cc_IR y [=] cc_IR (x[*]y). -intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Hint Resolve cc_IR_mult: algebra. Lemma cc_IR_mult_lft : forall x y z, (x[+I*]y) [*]cc_IR z [=] x[*]z[+I*]y[*]z. -intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Lemma cc_IR_mult_rht : forall x y z, cc_IR z[*] (x[+I*]y) [=] z[*]x[+I*]z[*]y. -intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. +Proof. + intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; rational. Qed. Lemma cc_IR_plus : forall x y : IR, cc_IR x[+]cc_IR y [=] cc_IR (x[+]y). -intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Hint Resolve cc_IR_plus: algebra. Lemma cc_IR_minus : forall x y : IR, cc_IR x[-]cc_IR y [=] cc_IR (x[-]y). -intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + intros. simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Lemma cc_IR_zero : cc_IR Zero [=] Zero. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Hint Resolve cc_IR_zero: algebra. Lemma cc_IR_one : cc_IR One [=] One. -simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. +Proof. + simpl in |- *. unfold cc_eq in |- *. simpl in |- *. split; algebra. Qed. Hint Resolve cc_IR_one: algebra. Lemma cc_IR_nring : forall n : nat, cc_IR (nring n) [=] nring n. -intros. induction n as [| n Hrecn]; intros. -astepl (cc_IR Zero). -Step_final (Zero:CC). -astepl (cc_IR (nring n[+]One)). -astepl (cc_IR (nring n) [+]cc_IR One). -Step_final (nring n[+] (One:CC)). +Proof. + intros. induction n as [| n Hrecn]; intros. + astepl (cc_IR Zero). + Step_final (Zero:CC). + astepl (cc_IR (nring n[+]One)). + astepl (cc_IR (nring n) [+]cc_IR One). + Step_final (nring n[+] (One:CC)). Qed. Lemma cc_IR_nexp : forall (x : IR) (n : nat), cc_IR x[^]n [=] cc_IR (x[^]n). -intros. induction n as [| n Hrecn]; intros. -astepl (One:CC). -Step_final (cc_IR One). -astepl (cc_IR x[^]n[*]cc_IR x). -astepl (cc_IR (x[^]n) [*]cc_IR x). -Step_final (cc_IR (x[^]n[*]x)). +Proof. + intros. induction n as [| n Hrecn]; intros. + astepl (One:CC). + Step_final (cc_IR One). + astepl (cc_IR x[^]n[*]cc_IR x). + astepl (cc_IR (x[^]n) [*]cc_IR x). + Step_final (cc_IR (x[^]n[*]x)). Qed. End cc_IR_properties. @@ -602,28 +656,31 @@ Hint Resolve cc_IR_nring cc_IR_zero: algebra. Load "Transparent_algebra". Lemma char0_CC : Char0 CC. -unfold Char0 in |- *. -intros. -astepl (cc_IR (nring n)). -simpl in |- *. -unfold cc_ap in |- *. -simpl in |- *. -left. -apply char0_IR. -auto. +Proof. + unfold Char0 in |- *. + intros. + astepl (cc_IR (nring n)). + simpl in |- *. + unfold cc_ap in |- *. + simpl in |- *. + left. + apply char0_IR. + auto. Qed. Load "Opaque_algebra". Lemma poly_apzero_CC : forall f : CCX, f [#] Zero -> {c : CC | f ! c [#] Zero}. -intros. -apply poly_apzero. -exact char0_CC. -auto. +Proof. + intros. + apply poly_apzero. + exact char0_CC. + auto. Qed. Lemma poly_CC_extensional : forall p q : CCX, (forall x, p ! x [=] q ! x) -> p [=] q. -intros. -apply poly_extensional. -exact char0_CC. -auto. +Proof. + intros. + apply poly_extensional. + exact char0_CC. + auto. Qed. diff --git a/complex/Complex_Exponential.v b/complex/Complex_Exponential.v index 2ce721b2e..981f73671 100644 --- a/complex/Complex_Exponential.v +++ b/complex/Complex_Exponential.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing ExpCC %\ensuremath{\exp_{\mathbb C}}% *) @@ -46,49 +46,47 @@ Require Export Pi. Definition ExpCC (z : CC) := cc_IR (Exp (Re z)) [*] (Cos (Im z) [+I*]Sin (Im z)). Lemma ExpCC_wd : forall z1 z2 : CC, z1 [=] z2 -> ExpCC z1 [=] ExpCC z2. -intro z1. elim z1. intros x1 y1. -intro z2. elim z2. intros x2 y2. -unfold ExpCC in |- *. unfold Re, Im in |- *. -intros (H1, H2). -simpl in H1. simpl in H2. -apply bin_op_wd_unfolded. - -apply cc_IR_wd. apply Exp_wd. assumption. - -astepl (Cos y2[+I*]Sin y1). -astepl (Cos y2[+I*]Sin y2). -apply eq_reflexive. +Proof. + intro z1. elim z1. intros x1 y1. + intro z2. elim z2. intros x2 y2. + unfold ExpCC in |- *. unfold Re, Im in |- *. + intros (H1, H2). + simpl in H1. simpl in H2. + apply bin_op_wd_unfolded. + apply cc_IR_wd. apply Exp_wd. assumption. + astepl (Cos y2[+I*]Sin y1). + astepl (Cos y2[+I*]Sin y2). + apply eq_reflexive. Qed. (* begin hide *) Lemma ExpCC_equation_aid_1 : forall z1 z2 : CC, - ExpCC (z1[+]z2) [=] + ExpCC (z1[+]z2) [=] cc_IR (Exp (Re z1[+]Re z2)) [*] (Cos (Im z1[+]Im z2) [+I*]Sin (Im z1[+]Im z2)). -intro z1. elim z1. intros x1 y1. -intro z2. elim z2. intros x2 y2. -unfold Re, Im in |- *. -unfold ExpCC in |- *. -apply bin_op_wd_unfolded. -apply cc_IR_wd. -apply Exp_wd. -algebra. - -split; algebra. +Proof. + intro z1. elim z1. intros x1 y1. + intro z2. elim z2. intros x2 y2. + unfold Re, Im in |- *. + unfold ExpCC in |- *. + apply bin_op_wd_unfolded. + apply cc_IR_wd. + apply Exp_wd. + algebra. + split; algebra. Qed. Lemma ExpCC_equation_aid_2 : forall z1 z2 : CC, - cc_IR (Exp (Re z1[+]Re z2)) [*] (Cos (Im z1[+]Im z2) [+I*]Sin (Im z1[+]Im z2)) [=] + cc_IR (Exp (Re z1[+]Re z2)) [*] (Cos (Im z1[+]Im z2) [+I*]Sin (Im z1[+]Im z2)) [=] cc_IR (Exp (Re z1) [*]Exp (Re z2)) [*] ((Cos (Im z1) [*]Cos (Im z2) [-]Sin (Im z1) [*]Sin (Im z2)) [+I*] (Sin (Im z1) [*]Cos (Im z2) [+]Cos (Im z1) [*]Sin (Im z2))). -intros z1 z2. apply bin_op_wd_unfolded. - -apply cc_IR_wd. algebra. - -split; algebra. +Proof. + intros z1 z2. apply bin_op_wd_unfolded. + apply cc_IR_wd. algebra. + split; algebra. Qed. @@ -96,192 +94,192 @@ Lemma ExpCC_equation_aid_3 : forall z1 z2 : CC, cc_IR (Exp (Re z1) [*]Exp (Re z2)) [*] ((Cos (Im z1) [*]Cos (Im z2) [-]Sin (Im z1) [*]Sin (Im z2)) [+I*] - (Sin (Im z1) [*]Cos (Im z2) [+]Cos (Im z1) [*]Sin (Im z2))) [=] + (Sin (Im z1) [*]Cos (Im z2) [+]Cos (Im z1) [*]Sin (Im z2))) [=] cc_IR (Exp (Re z1) [*]Exp (Re z2)) [*] ((Cos (Im z1) [+I*]Sin (Im z1)) [*] (Cos (Im z2) [+I*]Sin (Im z2))). -intros z1 z2. apply bin_op_wd_unfolded. - -apply eq_reflexive. - -set (c1 := Cos (Im z1)) in *. -set (c2 := Cos (Im z2)) in *. -set (s1 := Sin (Im z1)) in *. -set (s2 := Sin (Im z2)) in *. -split; simpl in |- *; algebra. +Proof. + intros z1 z2. apply bin_op_wd_unfolded. + apply eq_reflexive. + set (c1 := Cos (Im z1)) in *. + set (c2 := Cos (Im z2)) in *. + set (s1 := Sin (Im z1)) in *. + set (s2 := Sin (Im z2)) in *. + split; simpl in |- *; algebra. Qed. Lemma ExpCC_equation_aid_4 : forall z1 z2 : CC, cc_IR (Exp (Re z1) [*]Exp (Re z2)) [*] - ((Cos (Im z1) [+I*]Sin (Im z1)) [*] (Cos (Im z2) [+I*]Sin (Im z2))) [=] + ((Cos (Im z1) [+I*]Sin (Im z1)) [*] (Cos (Im z2) [+I*]Sin (Im z2))) [=] ExpCC z1[*]ExpCC z2. -intros z1 z2. -unfold ExpCC in |- *. -set (c := Cos (Im z1) [+I*]Sin (Im z1)) in *. -set (d := Cos (Im z2) [+I*]Sin (Im z2)) in *. -astepl (cc_IR (Exp (Re z1)) [*]cc_IR (Exp (Re z2)) [*] (c[*]d)). -rational. +Proof. + intros z1 z2. + unfold ExpCC in |- *. + set (c := Cos (Im z1) [+I*]Sin (Im z1)) in *. + set (d := Cos (Im z2) [+I*]Sin (Im z2)) in *. + astepl (cc_IR (Exp (Re z1)) [*]cc_IR (Exp (Re z2)) [*] (c[*]d)). + rational. Qed. (* end hide *) Lemma ExpCC_plus : forall z1 z2 : CC, ExpCC (z1[+]z2) [=] ExpCC z1[*]ExpCC z2. -intros z1 z2. -apply - eq_transitive_unfolded - with - (S := cc_csetoid) - (y := cc_IR (Exp (Re z1) [*]Exp (Re z2)) [*] - ((Cos (Im z1) [*]Cos (Im z2) [-]Sin (Im z1) [*]Sin (Im z2)) [+I*] - (Sin (Im z1) [*]Cos (Im z2) [+]Cos (Im z1) [*]Sin (Im z2)))). -eapply eq_transitive_unfolded. -apply ExpCC_equation_aid_1. apply ExpCC_equation_aid_2. -eapply eq_transitive_unfolded. -apply ExpCC_equation_aid_3. apply ExpCC_equation_aid_4. +Proof. + intros z1 z2. + apply eq_transitive_unfolded with (S := cc_csetoid) (y := cc_IR (Exp (Re z1) [*]Exp (Re z2)) [*] + ((Cos (Im z1) [*]Cos (Im z2) [-]Sin (Im z1) [*]Sin (Im z2)) [+I*] + (Sin (Im z1) [*]Cos (Im z2) [+]Cos (Im z1) [*]Sin (Im z2)))). + eapply eq_transitive_unfolded. + apply ExpCC_equation_aid_1. apply ExpCC_equation_aid_2. + eapply eq_transitive_unfolded. + apply ExpCC_equation_aid_3. apply ExpCC_equation_aid_4. Qed. Hint Resolve ExpCC_plus: algebra. Lemma ExpCC_Zero : ExpCC Zero [=] One. -unfold ExpCC in |- *. -astepl (cc_IR (Exp Zero) [*] (Cos Zero[+I*]Sin Zero)). -astepl (cc_IR One[*] (Cos Zero[+I*]Sin Zero)). -astepl (cc_IR One[*] (One[+I*]Zero)). -simpl in |- *. split; simpl in |- *; rational. +Proof. + unfold ExpCC in |- *. + astepl (cc_IR (Exp Zero) [*] (Cos Zero[+I*]Sin Zero)). + astepl (cc_IR One[*] (Cos Zero[+I*]Sin Zero)). + astepl (cc_IR One[*] (One[+I*]Zero)). + simpl in |- *. split; simpl in |- *; rational. Qed. Hint Resolve ExpCC_Zero: algebra. Lemma ExpCC_inv_aid : forall z : CC, ExpCC z[*]ExpCC [--]z [=] One. -intro z. -apply eq_transitive_unfolded with (S := cc_csetoid) (y := ExpCC Zero). -astepl (ExpCC (z[+][--]z)). -apply ExpCC_wd. -rational. -algebra. +Proof. + intro z. + apply eq_transitive_unfolded with (S := cc_csetoid) (y := ExpCC Zero). + astepl (ExpCC (z[+][--]z)). + apply ExpCC_wd. + rational. + algebra. Qed. Hint Resolve ExpCC_inv_aid: algebra. Lemma ExpCC_ap_zero : forall z : CC, ExpCC z [#] Zero. -intro z. -cut (ExpCC z[*]ExpCC [--]z [#] Zero). -intro H. -apply (mult_cancel_ap_zero_lft _ _ _ H). -astepl (One:CC). -apply cc_cr_non_triv. +Proof. + intro z. + cut (ExpCC z[*]ExpCC [--]z [#] Zero). + intro H. + apply (mult_cancel_ap_zero_lft _ _ _ H). + astepl (One:CC). + apply cc_cr_non_triv. Qed. Lemma ExpCC_inv : forall z z_, (One[/] (ExpCC z) [//]z_) [=] ExpCC [--]z. -intros z H. -astepl (ExpCC z[*]ExpCC [--]z[/] ExpCC z[//]H). rational. +Proof. + intros z H. + astepl (ExpCC z[*]ExpCC [--]z[/] ExpCC z[//]H). rational. Qed. Hint Resolve ExpCC_inv: algebra. Lemma ExpCC_pow : forall z n, ExpCC z[^]n [=] ExpCC (nring n[*]z). -intro z. simple induction n. -unfold nexp in |- *. -astepl (One:CC). -astepr (ExpCC Zero). -astepr (One:CC). -apply eq_reflexive. -apply ExpCC_wd. -rational. - -intros n0 Hrec. -astepl (ExpCC z[^]n0[*]ExpCC z). -astepl (ExpCC (nring n0[*]z) [*]ExpCC z). -astepl (ExpCC (nring n0[*]z[+]z)). -apply ExpCC_wd. -algebra. -rstepl ((nring n0[+]One) [*]z). algebra. +Proof. + intro z. simple induction n. + unfold nexp in |- *. + astepl (One:CC). + astepr (ExpCC Zero). + astepr (One:CC). + apply eq_reflexive. + apply ExpCC_wd. + rational. + intros n0 Hrec. + astepl (ExpCC z[^]n0[*]ExpCC z). + astepl (ExpCC (nring n0[*]z) [*]ExpCC z). + astepl (ExpCC (nring n0[*]z[+]z)). + apply ExpCC_wd. + algebra. + rstepl ((nring n0[+]One) [*]z). algebra. Qed. Hint Resolve ExpCC_pow: algebra. Lemma AbsCC_ExpCC : forall z : CC, AbsCC (ExpCC z) [=] Exp (Re z). -intro z. unfold ExpCC in |- *. -astepl (AbsCC (cc_IR (Exp (Re z))) [*]AbsCC (Cos (Im z) [+I*]Sin (Im z))). -astepr (Exp (Re z) [*]One). -apply bin_op_wd_unfolded. -assert (H : AbsCC (cc_IR (Exp (Re z))) [=] Exp (Re z)). -apply AbsCC_IR. -apply less_leEq. -apply Exp_pos. -astepl (Exp (Re z)). -apply eq_reflexive. -cut (AbsCC (Cos (Im z) [+I*]Sin (Im z)) [^]2 [=] One). -set (x := AbsCC (Cos (Im z) [+I*]Sin (Im z))) in *. -intro H0. - -assert (H1 : x[+]One[~=]Zero). -apply ap_imp_neq. -apply Greater_imp_ap. -apply leEq_less_trans with (y := x). -unfold x in |- *. apply AbsCC_nonneg. -apply less_plusOne. - -assert (H2 : (x[+]One) [*] (x[-]One) [=] Zero). -cut (x[^]2[-]One[^]2 [=] Zero). -intro H'. -astepl (x[^]2[-]One[^]2). -assumption. -astepl (x[^]2[-]One). -astepr (OneR[-]OneR). -apply cg_minus_wd; [ assumption | apply eq_reflexive ]. -assert (H3 : x[-]One [=] Zero). -apply (mult_eq_zero _ _ _ H1 H2). -rstepl (One[+] (x[-]One)). -astepr (OneR[+]ZeroR). -apply plus_resp_eq. assumption. - -astepl (Cos (Im z) [^]2[+]Sin (Im z) [^]2). -astepl OneR. -apply eq_reflexive. -apply AbsCC_square_Re_Im. +Proof. + intro z. unfold ExpCC in |- *. + astepl (AbsCC (cc_IR (Exp (Re z))) [*]AbsCC (Cos (Im z) [+I*]Sin (Im z))). + astepr (Exp (Re z) [*]One). + apply bin_op_wd_unfolded. + assert (H : AbsCC (cc_IR (Exp (Re z))) [=] Exp (Re z)). + apply AbsCC_IR. + apply less_leEq. + apply Exp_pos. + astepl (Exp (Re z)). + apply eq_reflexive. + cut (AbsCC (Cos (Im z) [+I*]Sin (Im z)) [^]2 [=] One). + set (x := AbsCC (Cos (Im z) [+I*]Sin (Im z))) in *. + intro H0. + assert (H1 : x[+]One[~=]Zero). + apply ap_imp_neq. + apply Greater_imp_ap. + apply leEq_less_trans with (y := x). + unfold x in |- *. apply AbsCC_nonneg. + apply less_plusOne. + assert (H2 : (x[+]One) [*] (x[-]One) [=] Zero). + cut (x[^]2[-]One[^]2 [=] Zero). + intro H'. + astepl (x[^]2[-]One[^]2). + assumption. + astepl (x[^]2[-]One). + astepr (OneR[-]OneR). + apply cg_minus_wd; [ assumption | apply eq_reflexive ]. + assert (H3 : x[-]One [=] Zero). + apply (mult_eq_zero _ _ _ H1 H2). + rstepl (One[+] (x[-]One)). + astepr (OneR[+]ZeroR). + apply plus_resp_eq. assumption. + astepl (Cos (Im z) [^]2[+]Sin (Im z) [^]2). + astepl OneR. + apply eq_reflexive. + apply AbsCC_square_Re_Im. Qed. Hint Resolve AbsCC_ExpCC: algebra. Lemma ExpCC_Periodic : forall z, ExpCC (z[+]II[*]Two[*]cc_IR Pi) [=] ExpCC z. -intro z. elim z. intros x y. -astepl (ExpCC (x[+I*] (y[+]Two[*]Pi))). -unfold ExpCC in |- *. -apply bin_op_wd_unfolded. -apply cc_IR_wd. -apply Exp_wd. -simpl in |- *. apply eq_reflexive_unfolded. - -astepl (Cos (y[+]Two[*]Pi) [+I*]Sin (y[+]Two[*]Pi)). -astepl (Cos y[+I*]Sin y). -apply eq_reflexive. - -apply ExpCC_wd. -split; simpl in |- *; rational. +Proof. + intro z. elim z. intros x y. + astepl (ExpCC (x[+I*] (y[+]Two[*]Pi))). + unfold ExpCC in |- *. + apply bin_op_wd_unfolded. + apply cc_IR_wd. + apply Exp_wd. + simpl in |- *. apply eq_reflexive_unfolded. + astepl (Cos (y[+]Two[*]Pi) [+I*]Sin (y[+]Two[*]Pi)). + astepl (Cos y[+I*]Sin y). + apply eq_reflexive. + apply ExpCC_wd. + split; simpl in |- *; rational. Qed. Hint Resolve ExpCC_Periodic: algebra. Lemma ExpCC_Exp : forall x : IR, ExpCC (cc_IR x) [=] cc_IR (Exp x). -intro x. unfold ExpCC in |- *. -astepl (cc_IR (Exp x) [*] (Cos (Im (cc_IR x)) [+I*]Sin (Im (cc_IR x)))). -astepr (cc_IR (Exp x) [*]One). -apply bin_op_wd_unfolded. -algebra. -astepl (Cos Zero[+I*]Sin Zero). -Step_final (One[+I*]Zero). +Proof. + intro x. unfold ExpCC in |- *. + astepl (cc_IR (Exp x) [*] (Cos (Im (cc_IR x)) [+I*]Sin (Im (cc_IR x)))). + astepr (cc_IR (Exp x) [*]One). + apply bin_op_wd_unfolded. + algebra. + astepl (Cos Zero[+I*]Sin Zero). + Step_final (One[+I*]Zero). Qed. Hint Resolve ExpCC_Exp: algebra. Theorem Euler : (ExpCC (II[*] (cc_IR Pi))) [+]One [=] Zero. -split. -Opaque Sin Cos Exp. -simpl. -rstepl ((Exp Zero) [*] (Cos Pi) [+]One). -astepl ((One:IR) [*][--]One[+]One). -rational. -simpl. -rstepl ((Exp Zero) [*] (Sin Pi)). -Step_final ((One:IR) [*]Zero). +Proof. + split. + Opaque Sin Cos Exp. + simpl. + rstepl ((Exp Zero) [*] (Cos Pi) [+]One). + astepl ((One:IR) [*][--]One[+]One). + rational. + simpl. + rstepl ((Exp Zero) [*] (Sin Pi)). + Step_final ((One:IR) [*]Zero). Qed. diff --git a/complex/NRootCC.v b/complex/NRootCC.v index 5d41dc414..f5963915a 100644 --- a/complex/NRootCC.v +++ b/complex/NRootCC.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing sqrt_Half %\ensuremath{\sqrt{\frac12}}% *) (** printing sqrt_I %\ensuremath{\sqrt{\imath}}% *) @@ -53,28 +53,30 @@ Section CC_ap_zero. Lemma cc_ap_zero : forall P : CC -> Prop, (forall a b, a [#] Zero -> P (a[+I*]b)) -> (forall a b, b [#] Zero -> P (a[+I*]b)) -> forall c, c [#] Zero -> P c. -intro. intro. intro. intro. -elim c. intros a b. intro H1. -elim H1; intros H2. -apply H. -(* algebra. *) - exact H2. -apply H0. -(* algebra. *) +Proof. + intro. intro. intro. intro. + elim c. intros a b. intro H1. + elim H1; intros H2. + apply H. + (* algebra. *) exact H2. + apply H0. + (* algebra. *) + exact H2. Qed. Lemma C_cc_ap_zero : forall P : CC -> CProp, (forall a b, a [#] Zero -> P (a[+I*]b)) -> (forall a b, b [#] Zero -> P (a[+I*]b)) -> forall c, c [#] Zero -> P c. -intro. intro H. intro H0. intro. -elim c. intros a b. intro H1. -elim H1; intros H2. -apply H. -(* algebra. *) - exact H2. -apply H0. -(* algebra. *) +Proof. + intro. intro H. intro H0. intro. + elim c. intros a b. intro H1. + elim H1; intros H2. + apply H. + (* algebra. *) exact H2. + apply H0. + (* algebra. *) + exact H2. Qed. End CC_ap_zero. @@ -84,19 +86,20 @@ End CC_ap_zero. Section Imag_to_Real. Lemma imag_to_real : forall a b a' b', a'[+I*]b' [=] (a[+I*]b) [*]II -> a [#] Zero -> b' [#] Zero. -do 5 intro. intro H0. -cut (b' [=] a); intros. -(* astepl a. *) +Proof. + do 5 intro. intro H0. + cut (b' [=] a); intros. + (* astepl a. *) apply ap_wdl_unfolded with a. - exact H0. + exact H0. apply eq_symmetric_unfolded. exact H1. -(* astepl (Im a'[+I*]b'). *) + (* astepl (Im a'[+I*]b'). *) apply eq_transitive_unfolded with (Im (a'[+I*]b')). apply eq_reflexive_unfolded. -(* astepl (Im a[+I*]b[*]II). *) - apply eq_transitive_unfolded with (Im ((a[+I*]b) [*]II)). + (* astepl (Im a[+I*]b[*]II). *) + apply eq_transitive_unfolded with (Im ((a[+I*]b) [*]II)). apply Im_wd. exact H. -(* Step_final (Im ( [--]b) [+I*]a). *) + (* Step_final (Im ( [--]b) [+I*]a). *) apply eq_transitive_unfolded with (Im ( [--]b[+I*]a)). apply Im_wd. apply mult_I. apply eq_reflexive_unfolded. @@ -113,94 +116,95 @@ Definition sqrt_Half := sqrt Half (less_leEq _ _ _ (pos_half IR)). Definition sqrt_I := sqrt_Half[+I*]sqrt_Half. Lemma sqrt_I_nexp : sqrt_I[^]2 [=] II. -(* astepl sqrt_I[*]sqrt_I. *) - apply eq_transitive_unfolded with (sqrt_I[*]sqrt_I). +Proof. + (* astepl sqrt_I[*]sqrt_I. *) + apply eq_transitive_unfolded with (sqrt_I[*]sqrt_I). apply nexp_two. -unfold sqrt_I in |- *. -(* astepl (sqrt_Half[*]sqrt_Half[-]sqrt_Half[*]sqrt_Half) [+I*] - (sqrt_Half[*]sqrt_Half[+]sqrt_Half[*]sqrt_Half). *) - apply - eq_transitive_unfolded - with - ((sqrt_Half[*]sqrt_Half[-]sqrt_Half[*]sqrt_Half) [+I*] - (sqrt_Half[*]sqrt_Half[+]sqrt_Half[*]sqrt_Half)). + unfold sqrt_I in |- *. + (* astepl (sqrt_Half[*]sqrt_Half[-]sqrt_Half[*]sqrt_Half) [+I*] + (sqrt_Half[*]sqrt_Half[+]sqrt_Half[*]sqrt_Half). *) + apply eq_transitive_unfolded with ((sqrt_Half[*]sqrt_Half[-]sqrt_Half[*]sqrt_Half) [+I*] + (sqrt_Half[*]sqrt_Half[+]sqrt_Half[*]sqrt_Half)). apply eq_reflexive_unfolded. -cut (sqrt_Half[*]sqrt_Half [=] Half); intros. -(* astepl Zero[+I*] (Half[+]Half). *) + cut (sqrt_Half[*]sqrt_Half [=] Half); intros. + (* astepl Zero[+I*] (Half[+]Half). *) apply eq_transitive_unfolded with (Zero[+I*] (Half[+]Half)). - apply I_wd. apply cg_minus_correct. apply bin_op_wd_unfolded. exact H. + apply I_wd. apply cg_minus_correct. apply bin_op_wd_unfolded. exact H. exact H. -(* Step_final Zero[+I*]One. *) + (* Step_final Zero[+I*]One. *) apply eq_transitive_unfolded with (Zero[+I*]One). - apply I_wd. apply eq_reflexive_unfolded. apply half_2. - apply eq_reflexive_unfolded. -(* astepl sqrt_Half[^] (2). *) - apply eq_transitive_unfolded with (sqrt_Half[^]2). + apply I_wd. apply eq_reflexive_unfolded. apply half_2. + apply eq_reflexive_unfolded. + (* astepl sqrt_Half[^] (2). *) + apply eq_transitive_unfolded with (sqrt_Half[^]2). apply eq_symmetric_unfolded. apply nexp_two. -unfold sqrt_Half in |- *. -(* algebra. *) - apply sqrt_sqr. + unfold sqrt_Half in |- *. + (* algebra. *) + apply sqrt_sqr. Qed. Lemma nroot_I_nexp_aux : forall n, odd n -> {m : nat | n * n = 4 * m + 1}. -intros n on. -elim (odd_S2n n); try assumption. -intros n' H. -rewrite H. -exists (n' * n' + n'). -unfold double in |- *. -ring. +Proof. + intros n on. + elim (odd_S2n n); try assumption. + intros n' H. + rewrite H. + exists (n' * n' + n'). + unfold double in |- *. + ring. Qed. Definition nroot_I (n : nat) (n_ : odd n) : CC := II[^]n. Lemma nroot_I_nexp : forall n n_, nroot_I n n_[^]n [=] II. -intros n on. -unfold nroot_I in |- *. -(* astepl II[^] (mult n n). *) - apply eq_transitive_unfolded with (II[^] (n * n)). +Proof. + intros n on. + unfold nroot_I in |- *. + (* astepl II[^] (mult n n). *) + apply eq_transitive_unfolded with (II[^] (n * n)). apply nexp_mult. -elim (nroot_I_nexp_aux n); try assumption. -intros m H. -rewrite H. -(* astepl II[^] (mult (4) m) [*]II[^] (1). *) - apply eq_transitive_unfolded with (II[^] (4 * m) [*]II[^]1). + elim (nroot_I_nexp_aux n); try assumption. + intros m H. + rewrite H. + (* astepl II[^] (mult (4) m) [*]II[^] (1). *) + apply eq_transitive_unfolded with (II[^] (4 * m) [*]II[^]1). apply eq_symmetric_unfolded. apply nexp_plus. -(* astepl (II[^] (4)) [^]m[*]II. *) + (* astepl (II[^] (4)) [^]m[*]II. *) apply eq_transitive_unfolded with ((II[^]4) [^]m[*]II). apply bin_op_wd_unfolded. apply eq_symmetric_unfolded. apply nexp_mult. - apply nexp_one. -cut (II[^]4 [=] One); intros. -(* astepl One[^]m[*]II. *) + apply nexp_one. + cut (II[^]4 [=] One); intros. + (* astepl One[^]m[*]II. *) apply eq_transitive_unfolded with (One[^]m[*]II). - apply bin_op_wd_unfolded. apply un_op_wd_unfolded. exact H0. + apply bin_op_wd_unfolded. apply un_op_wd_unfolded. exact H0. apply eq_reflexive_unfolded. -(* Step_final One[*]II. *) + (* Step_final One[*]II. *) apply eq_transitive_unfolded with (One[*]II). - apply bin_op_wd_unfolded. apply one_nexp. apply eq_reflexive_unfolded. - apply one_mult. -replace 4 with (2 * 2). -(* astepl (II[^] (2)) [^] (2). *) + apply bin_op_wd_unfolded. apply one_nexp. apply eq_reflexive_unfolded. + apply one_mult. + replace 4 with (2 * 2). + (* astepl (II[^] (2)) [^] (2). *) apply eq_transitive_unfolded with ((II[^]2) [^]2). - apply eq_symmetric_unfolded. apply nexp_mult. -(* astepl ( [--] (One::CC)) [^] (2). *) - apply eq_transitive_unfolded with ( [--] (One:CC) [^]2). - apply un_op_wd_unfolded. exact I_square'. -(* Step_final (One::CC) [^] (2). *) - apply eq_transitive_unfolded with ((One:CC) [^]2). - apply inv_nexp_two. + apply eq_symmetric_unfolded. apply nexp_mult. + (* astepl ( [--] (One::CC)) [^] (2). *) + apply eq_transitive_unfolded with ( [--] (One:CC) [^]2). + apply un_op_wd_unfolded. exact I_square'. + (* Step_final (One::CC) [^] (2). *) + apply eq_transitive_unfolded with ((One:CC) [^]2). + apply inv_nexp_two. apply one_nexp. -auto with arith. + auto with arith. Qed. Hint Resolve nroot_I_nexp: algebra. Definition nroot_minus_I (n : nat) (n_ : odd n) : CC := [--] (nroot_I n n_). Lemma nroot_minus_I_nexp : forall n n_, nroot_minus_I n n_[^]n [=] [--]II. -intros n on. -unfold nroot_minus_I in |- *. -(* Step_final [--] ((nroot_I n on) [^]n). *) - apply eq_transitive_unfolded with ( [--] (nroot_I n on[^]n)). +Proof. + intros n on. + unfold nroot_minus_I in |- *. + (* Step_final [--] ((nroot_I n on) [^]n). *) + apply eq_transitive_unfolded with ( [--] (nroot_I n on[^]n)). apply inv_nexp_odd. exact on. apply un_op_wd_unfolded. apply nroot_I_nexp. Qed. @@ -231,11 +235,12 @@ Let c2 := a[^]2[+]b[^]2. (* end hide *) Lemma nrCC1_c2pos : Zero [<] c2. -unfold c2 in |- *. -apply plus_resp_nonneg_pos. -apply sqr_nonneg. -apply pos_square. -assumption. +Proof. + unfold c2 in |- *. + apply plus_resp_nonneg_pos. + apply sqr_nonneg. + apply pos_square. + assumption. Qed. (* begin hide *) @@ -244,20 +249,21 @@ Let a'2 := (c[+]a) [*]Half. (* end hide *) Lemma nrCC1_a'2pos : Zero [<] a'2. -unfold a'2 in |- *. -apply (mult_resp_pos IR). -rstepr (c[-][--]a). -apply shift_zero_less_minus. -unfold c in |- *. -apply sqrt_less'. -unfold c2 in |- *. -apply (Ccsr_wdl _ (cof_less (c:=IR)) (a[^]2[+]Zero) (a[^]2[+]b[^]2)). -apply plus_resp_less_lft. -change (Zero [<] b[^]2) in |- *. -apply pos_square. assumption. -(* algebra. *) - apply cm_rht_unit_unfolded. -apply pos_half. +Proof. + unfold a'2 in |- *. + apply (mult_resp_pos IR). + rstepr (c[-][--]a). + apply shift_zero_less_minus. + unfold c in |- *. + apply sqrt_less'. + unfold c2 in |- *. + apply (Ccsr_wdl _ (cof_less (c:=IR)) (a[^]2[+]Zero) (a[^]2[+]b[^]2)). + apply plus_resp_less_lft. + change (Zero [<] b[^]2) in |- *. + apply pos_square. assumption. + (* algebra. *) + apply cm_rht_unit_unfolded. + apply pos_half. Qed. (* begin hide *) @@ -266,18 +272,19 @@ Let b'2 := (c[-]a) [*]Half. (* end hide *) Lemma nrCC1_b'2pos : Zero [<] b'2. -unfold b'2 in |- *. -apply (mult_resp_pos IR). -change (Zero [<] c[-]a) in |- *. -apply shift_zero_less_minus. -unfold c in |- *. -apply sqrt_less. -unfold c2 in |- *. -rstepl (a[^]2[+]Zero). -apply plus_resp_less_lft. -change (Zero [<] b[^]2) in |- *. -apply pos_square. assumption. -apply pos_half. +Proof. + unfold b'2 in |- *. + apply (mult_resp_pos IR). + change (Zero [<] c[-]a) in |- *. + apply shift_zero_less_minus. + unfold c in |- *. + apply sqrt_less. + unfold c2 in |- *. + rstepl (a[^]2[+]Zero). + apply plus_resp_less_lft. + change (Zero [<] b[^]2) in |- *. + apply pos_square. assumption. + apply pos_half. Qed. (* begin hide *) @@ -285,191 +292,194 @@ Let b' := sqrt b'2 (less_leEq _ _ _ nrCC1_b'2pos). (* end hide *) Lemma nrCC1_a3 : a'[^]2[-]b'[^]2 [=] a. -unfold a', b' in |- *. -(* astepl a'2[-]b'2. *) - apply eq_transitive_unfolded with (a'2[-]b'2). +Proof. + unfold a', b' in |- *. + (* astepl a'2[-]b'2. *) + apply eq_transitive_unfolded with (a'2[-]b'2). apply cg_minus_wd. apply sqrt_sqr. apply sqrt_sqr. -unfold a'2, b'2 in |- *. -unfold Half in |- *. -rational. + unfold a'2, b'2 in |- *. + unfold Half in |- *. + rational. Qed. Lemma nrCC1_a4 : (c[+]a) [*] (c[-]a) [=] b[^]2. -(* astepl c[^] (2) [-]a[^] (2). *) - apply eq_transitive_unfolded with (c[^]2[-]a[^]2). +Proof. + (* astepl c[^] (2) [-]a[^] (2). *) + apply eq_transitive_unfolded with (c[^]2[-]a[^]2). apply nexp_funny. -unfold c in |- *. -(* astepl c2[-]a[^] (2). *) - apply eq_transitive_unfolded with (c2[-]a[^]2). + unfold c in |- *. + (* astepl c2[-]a[^] (2). *) + apply eq_transitive_unfolded with (c2[-]a[^]2). apply cg_minus_wd. apply sqrt_sqr. apply eq_reflexive_unfolded. -unfold c2 in |- *. -(* astepl (a[^] (2) [+]b[^] (2)) [+][--] (a[^] (2)). *) - apply eq_transitive_unfolded with (a[^]2[+]b[^]2[+][--] (a[^]2)). + unfold c2 in |- *. + (* astepl (a[^] (2) [+]b[^] (2)) [+][--] (a[^] (2)). *) + apply eq_transitive_unfolded with (a[^]2[+]b[^]2[+][--] (a[^]2)). apply eq_reflexive_unfolded. -(* astepl (b[^] (2) [+]a[^] (2)) [+][--] (a[^] (2)). *) - apply eq_transitive_unfolded with (b[^]2[+]a[^]2[+][--] (a[^]2)). + (* astepl (b[^] (2) [+]a[^] (2)) [+][--] (a[^] (2)). *) + apply eq_transitive_unfolded with (b[^]2[+]a[^]2[+][--] (a[^]2)). apply bin_op_wd_unfolded. apply cag_commutes_unfolded. - apply eq_reflexive_unfolded. -(* astepl b[^] (2) [+] (a[^] (2) [+][--] (a[^] (2))). *) - apply eq_transitive_unfolded with (b[^]2[+] (a[^]2[+][--] (a[^]2))). + apply eq_reflexive_unfolded. + (* astepl b[^] (2) [+] (a[^] (2) [+][--] (a[^] (2))). *) + apply eq_transitive_unfolded with (b[^]2[+] (a[^]2[+][--] (a[^]2))). apply eq_symmetric_unfolded. apply plus_assoc_unfolded. -(* Step_final b[^] (2) [+]Zero. *) + (* Step_final b[^] (2) [+]Zero. *) apply eq_transitive_unfolded with (b[^]2[+]Zero). apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. - apply cg_rht_inv_unfolded. - apply cm_rht_unit_unfolded. + apply cg_rht_inv_unfolded. + apply cm_rht_unit_unfolded. Qed. Hint Resolve nrCC1_a4: algebra. Lemma nrCC1_a5 : a'2[*]b'2 [=] (b[*]Half) [^]2. -unfold a'2, b'2 in |- *. -(* astepl (c[+]a) [*] (Half[*] ((c[-]a) [*]Half)). *) - apply eq_transitive_unfolded with ((c[+]a) [*] (Half[*] ((c[-]a) [*]Half))). +Proof. + unfold a'2, b'2 in |- *. + (* astepl (c[+]a) [*] (Half[*] ((c[-]a) [*]Half)). *) + apply eq_transitive_unfolded with ((c[+]a) [*] (Half[*] ((c[-]a) [*]Half))). apply eq_symmetric_unfolded. apply mult_assoc_unfolded. -(* astepl (c[+]a) [*] (((c[-]a) [*]Half) [*]Half). *) + (* astepl (c[+]a) [*] (((c[-]a) [*]Half) [*]Half). *) apply eq_transitive_unfolded with ((c[+]a) [*] ((c[-]a) [*]Half[*]Half)). apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. apply mult_commutes. -(* astepl (c[+]a) [*] ((c[-]a) [*] (Half[*]Half)). *) - apply eq_transitive_unfolded with ((c[+]a) [*] ((c[-]a) [*] (Half[*]Half))). + (* astepl (c[+]a) [*] ((c[-]a) [*] (Half[*]Half)). *) + apply eq_transitive_unfolded with ((c[+]a) [*] ((c[-]a) [*] (Half[*]Half))). apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. apply mult_assoc_unfolded. -(* astepl ((c[+]a) [*] (c[-]a)) [*] (Half[*]Half). *) + apply eq_symmetric_unfolded. apply mult_assoc_unfolded. + (* astepl ((c[+]a) [*] (c[-]a)) [*] (Half[*]Half). *) apply eq_transitive_unfolded with ((c[+]a) [*] (c[-]a) [*] (Half[*]Half)). apply mult_assoc_unfolded. -(* astepl b[^] (2) [*] (Half[*]Half). *) - apply eq_transitive_unfolded with (b[^]2[*] (Half[*]Half)). + (* astepl b[^] (2) [*] (Half[*]Half). *) + apply eq_transitive_unfolded with (b[^]2[*] (Half[*]Half)). apply bin_op_wd_unfolded. exact nrCC1_a4. apply eq_reflexive_unfolded. -(* astepl (b[*]b) [*] (Half[*]Half). *) - apply eq_transitive_unfolded with (b[*]b[*] (Half[*]Half)). + (* astepl (b[*]b) [*] (Half[*]Half). *) + apply eq_transitive_unfolded with (b[*]b[*] (Half[*]Half)). apply bin_op_wd_unfolded. apply nexp_two. apply eq_reflexive_unfolded. -(* astepl ((b[*]b) [*]Half) [*]Half. *) - apply eq_transitive_unfolded with (b[*]b[*]Half[*]Half). + (* astepl ((b[*]b) [*]Half) [*]Half. *) + apply eq_transitive_unfolded with (b[*]b[*]Half[*]Half). apply mult_assoc_unfolded. -(* astepl (b[*] (b[*]Half)) [*]Half. *) - apply eq_transitive_unfolded with (b[*] (b[*]Half) [*]Half). + (* astepl (b[*] (b[*]Half)) [*]Half. *) + apply eq_transitive_unfolded with (b[*] (b[*]Half) [*]Half). apply bin_op_wd_unfolded. apply eq_symmetric_unfolded. - apply mult_assoc_unfolded. apply eq_reflexive_unfolded. -(* astepl ((b[*]Half) [*]b) [*]Half. *) + apply mult_assoc_unfolded. apply eq_reflexive_unfolded. + (* astepl ((b[*]Half) [*]b) [*]Half. *) apply eq_transitive_unfolded with (b[*]Half[*]b[*]Half). apply bin_op_wd_unfolded. apply mult_commutes. apply eq_reflexive_unfolded. -(* Step_final (b[*]Half) [*] (b[*]Half). *) - apply eq_transitive_unfolded with (b[*]Half[*] (b[*]Half)). + (* Step_final (b[*]Half) [*] (b[*]Half). *) + apply eq_transitive_unfolded with (b[*]Half[*] (b[*]Half)). apply eq_symmetric_unfolded. apply mult_assoc_unfolded. apply eq_symmetric_unfolded. apply nexp_two. Qed. Lemma nrCC1_a6 : Zero [<] a'2[*]b'2. -apply (mult_resp_pos IR). -apply nrCC1_a'2pos. -apply nrCC1_b'2pos. +Proof. + apply (mult_resp_pos IR). + apply nrCC1_a'2pos. + apply nrCC1_b'2pos. Qed. Lemma nrCC1_a6' : Zero [<] (b[*]Half) [^]2. -apply pos_square. -(* astepr Zero[*]Half. *) - apply ap_wdr_unfolded with (ZeroR[*]Half). +Proof. + apply pos_square. + (* astepr Zero[*]Half. *) + apply ap_wdr_unfolded with (ZeroR[*]Half). 2: apply cring_mult_zero_op. -apply mult_rht_resp_ap; try assumption. -apply pos_ap_zero. -apply pos_half. + apply mult_rht_resp_ap; try assumption. + apply pos_ap_zero. + apply pos_half. Qed. Hint Resolve nrCC1_a5: algebra. Lemma nrCC1_a7_upper : Zero [<] b -> a'[*]b' [=] b[*]Half. -intros. -unfold a', b' in |- *. -(* astepl (sqrt a'2[*]b'2 (less_leEq ? ? ? nrCC1_a6)). *) - apply - eq_transitive_unfolded with (sqrt (a'2[*]b'2) (less_leEq _ _ _ nrCC1_a6)). +Proof. + intros. + unfold a', b' in |- *. + (* astepl (sqrt a'2[*]b'2 (less_leEq ? ? ? nrCC1_a6)). *) + apply eq_transitive_unfolded with (sqrt (a'2[*]b'2) (less_leEq _ _ _ nrCC1_a6)). apply eq_symmetric_unfolded. apply NRootIR.sqrt_mult. -(* astepl (sqrt (b[*]Half) [^] (2) nrCC1_a6'). *) - apply - eq_transitive_unfolded - with (sqrt ((b[*]Half) [^]2) (less_leEq _ _ _ nrCC1_a6')). + (* astepl (sqrt (b[*]Half) [^] (2) nrCC1_a6'). *) + apply eq_transitive_unfolded with (sqrt ((b[*]Half) [^]2) (less_leEq _ _ _ nrCC1_a6')). apply sqrt_wd. exact nrCC1_a5. -apply sqrt_to_nonneg. -apply less_leEq. -rstepl (ZeroR[*]Half). -apply mult_resp_less. assumption. -apply pos_half. + apply sqrt_to_nonneg. + apply less_leEq. + rstepl (ZeroR[*]Half). + apply mult_resp_less. assumption. + apply pos_half. Qed. Lemma nrCC1_a7_lower : b [<] Zero -> a'[*][--]b' [=] b[*]Half. -intros. -(* astepl [--] (a'[*]b'). *) - apply eq_transitive_unfolded with ( [--] (a'[*]b')). +Proof. + intros. + (* astepl [--] (a'[*]b'). *) + apply eq_transitive_unfolded with ( [--] (a'[*]b')). apply cring_inv_mult_lft. -cut (a'[*]b' [=] [--] (b[*]Half)); intros. rename H into H0. rename X into H. -(* Step_final [--][--] (b[*]Half). *) + cut (a'[*]b' [=] [--] (b[*]Half)); intros. rename H into H0. rename X into H. + (* Step_final [--][--] (b[*]Half). *) apply eq_transitive_unfolded with ( [--][--] (b[*]Half)). - apply un_op_wd_unfolded. exact H0. - apply cg_inv_inv. -unfold a', b' in |- *. -(* astepl (sqrt a'2[*]b'2 (less_leEq ? ? ? nrCC1_a6)). *) - apply - eq_transitive_unfolded with (sqrt (a'2[*]b'2) (less_leEq _ _ _ nrCC1_a6)). + apply un_op_wd_unfolded. exact H0. + apply cg_inv_inv. + unfold a', b' in |- *. + (* astepl (sqrt a'2[*]b'2 (less_leEq ? ? ? nrCC1_a6)). *) + apply eq_transitive_unfolded with (sqrt (a'2[*]b'2) (less_leEq _ _ _ nrCC1_a6)). apply eq_symmetric_unfolded. apply NRootIR.sqrt_mult. -(* astepl (sqrt (b[*]Half) [^] (2) (less_leEq ? ? ? nrCC1_a6')). *) - apply - eq_transitive_unfolded - with (sqrt ((b[*]Half) [^]2) (less_leEq _ _ _ nrCC1_a6')). + (* astepl (sqrt (b[*]Half) [^] (2) (less_leEq ? ? ? nrCC1_a6')). *) + apply eq_transitive_unfolded with (sqrt ((b[*]Half) [^]2) (less_leEq _ _ _ nrCC1_a6')). apply sqrt_wd. exact nrCC1_a5. -apply sqrt_to_nonpos. -apply less_leEq. -rstepr (ZeroR[*]Half). -apply mult_resp_less. assumption. -apply pos_half. + apply sqrt_to_nonpos. + apply less_leEq. + rstepr (ZeroR[*]Half). + apply mult_resp_less. assumption. + apply pos_half. Qed. Hint Resolve nrCC1_a3 nrCC1_a7_upper nrCC1_a7_lower: algebra. Lemma nrootCC_1_upper : Zero [<] b -> (a'[+I*]b') [^]2 [=] a[+I*]b. -intros. -(* astepl (a'[^] (2) [-]b'[^] (2)) [+I*] ((a'[*]b') [*]Two). *) - apply eq_transitive_unfolded with ((a'[^]2[-]b'[^]2) [+I*]a'[*]b'[*]Two). +Proof. + intros. + (* astepl (a'[^] (2) [-]b'[^] (2)) [+I*] ((a'[*]b') [*]Two). *) + apply eq_transitive_unfolded with ((a'[^]2[-]b'[^]2) [+I*]a'[*]b'[*]Two). apply cc_calculate_square. -cut (a'[*]b'[*]Two [=] b); intros. -(* Step_final a[+I*]b. *) + cut (a'[*]b'[*]Two [=] b); intros. + (* Step_final a[+I*]b. *) apply eq_transitive_unfolded with (a[+I*]b). - apply I_wd. exact nrCC1_a3. rename H into H0. exact H0. - apply eq_reflexive_unfolded. -(* astepl (b[*]Half) [*]Two. *) - apply eq_transitive_unfolded with (b[*]Half[*]Two). - apply bin_op_wd_unfolded. apply nrCC1_a7_upper. rename X into H. exact H. + apply I_wd. exact nrCC1_a3. rename H into H0. exact H0. apply eq_reflexive_unfolded. -(* algebra. *) - apply half_1'. + (* astepl (b[*]Half) [*]Two. *) + apply eq_transitive_unfolded with (b[*]Half[*]Two). + apply bin_op_wd_unfolded. apply nrCC1_a7_upper. rename X into H. exact H. + apply eq_reflexive_unfolded. + (* algebra. *) + apply half_1'. Qed. Lemma nrootCC_1_lower : b [<] Zero -> (a'[+I*][--]b') [^]2 [=] a[+I*]b. -intros. -cut (a'[^]2[-][--]b'[^]2 [=] a); intros. -cut (a'[*][--]b'[*]Two [=] b); intros. -(* Step_final (a'[^] (2) [-] ( [--]b') [^] (2)) [+I*] ((a'[*][--]b') [*]Two). *) - apply - eq_transitive_unfolded with ((a'[^]2[-][--]b'[^]2) [+I*]a'[*][--]b'[*]Two). - apply cc_calculate_square. - apply I_wd. rename H0 into H1. rename H into H0. rename X into H. exact H0. -rename H0 into H1. rename H into H0. rename X into H. exact H1. -(* astepl (b[*]Half) [*]Two. *) - apply eq_transitive_unfolded with (b[*]Half[*]Two). - apply bin_op_wd_unfolded. apply nrCC1_a7_lower. -rename H into H0. rename X into H. exact H. +Proof. + intros. + cut (a'[^]2[-][--]b'[^]2 [=] a); intros. + cut (a'[*][--]b'[*]Two [=] b); intros. + (* Step_final (a'[^] (2) [-] ( [--]b') [^] (2)) [+I*] ((a'[*][--]b') [*]Two). *) + apply eq_transitive_unfolded with ((a'[^]2[-][--]b'[^]2) [+I*]a'[*][--]b'[*]Two). + apply cc_calculate_square. + apply I_wd. rename H0 into H1. rename H into H0. rename X into H. exact H0. + rename H0 into H1. rename H into H0. rename X into H. exact H1. + (* astepl (b[*]Half) [*]Two. *) + apply eq_transitive_unfolded with (b[*]Half[*]Two). + apply bin_op_wd_unfolded. apply nrCC1_a7_lower. + rename H into H0. rename X into H. exact H. apply eq_reflexive_unfolded. -(* algebra. *) + (* algebra. *) apply half_1'. -(* Step_final a'[^] (2) [-]b'[^] (2). *) - apply eq_transitive_unfolded with (a'[^]2[-]b'[^]2). + (* Step_final a'[^] (2) [-]b'[^] (2). *) + apply eq_transitive_unfolded with (a'[^]2[-]b'[^]2). apply cg_minus_wd. apply eq_reflexive_unfolded. apply inv_nexp_two. - exact nrCC1_a3. + exact nrCC1_a3. Qed. Lemma nrootCC_1_ap_real : {z : CC | z[^]2 [=] a[+I*]b}. -elim (ap_imp_less _ b Zero). -intro H. -exists (a'[+I*][--]b'). apply nrootCC_1_lower. assumption. -intro H. -exists (a'[+I*]b'). apply nrootCC_1_upper. assumption. -assumption. +Proof. + elim (ap_imp_less _ b Zero). + intro H. + exists (a'[+I*][--]b'). apply nrootCC_1_lower. assumption. + intro H. + exists (a'[+I*]b'). apply nrootCC_1_upper. assumption. + assumption. Qed. End NRootCC_1_ap_real. @@ -494,49 +504,50 @@ Let b' := Im c'. (* end hide *) Lemma nrootCC_1_ap_imag : {z : CC | z[^]2 [=] a[+I*]b}. -elim (nrootCC_1_ap_real a' b'). -intros x H. -exists (x[*]sqrt_I). -(* astepl x[^] (2) [*]sqrt_I[^] (2). *) +Proof. + elim (nrootCC_1_ap_real a' b'). + intros x H. + exists (x[*]sqrt_I). + (* astepl x[^] (2) [*]sqrt_I[^] (2). *) apply eq_transitive_unfolded with (x[^]2[*]sqrt_I[^]2). - apply mult_nexp. -Hint Resolve sqrt_I_nexp: algebra. -(* astepl (a'[+I*]b') [*]II. *) + apply mult_nexp. + Hint Resolve sqrt_I_nexp: algebra. + (* astepl (a'[+I*]b') [*]II. *) apply eq_transitive_unfolded with ((a'[+I*]b') [*]II). - apply bin_op_wd_unfolded. exact H. exact sqrt_I_nexp. -(* astepl ((a[+I*]b) [*][--]II) [*]II. *) - apply eq_transitive_unfolded with ((a[+I*]b) [*][--]II[*]II). - apply eq_reflexive_unfolded. -(* astepl (a[+I*]b) [*] ( [--]II[*]II). *) + apply bin_op_wd_unfolded. exact H. exact sqrt_I_nexp. + (* astepl ((a[+I*]b) [*][--]II) [*]II. *) + apply eq_transitive_unfolded with ((a[+I*]b) [*][--]II[*]II). + apply eq_reflexive_unfolded. + (* astepl (a[+I*]b) [*] ( [--]II[*]II). *) apply eq_transitive_unfolded with ((a[+I*]b) [*] ( [--]II[*]II)). - apply eq_symmetric_unfolded. apply mult_assoc_unfolded. -(* Step_final (a[+I*]b) [*]One. *) - apply eq_transitive_unfolded with ((a[+I*]b) [*]One). - apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. exact I_recip_lft. - apply mult_one. -cut (b[+I*][--]a [=] c'); intros. -(* astepl (Im c'). *) + apply eq_symmetric_unfolded. apply mult_assoc_unfolded. + (* Step_final (a[+I*]b) [*]One. *) + apply eq_transitive_unfolded with ((a[+I*]b) [*]One). + apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. exact I_recip_lft. + apply mult_one. + cut (b[+I*][--]a [=] c'); intros. + (* astepl (Im c'). *) apply ap_wdl_unfolded with (Im c'). - 2: apply eq_reflexive_unfolded. -(* astepl (Im b[+I*][--]a). *) + 2: apply eq_reflexive_unfolded. + (* astepl (Im b[+I*][--]a). *) apply ap_wdl_unfolded with (Im (b[+I*][--]a)). - 2: apply Im_wd. 2: exact H. -(* astepl [--]a. *) - apply ap_wdl_unfolded with ( [--]a). - apply zero_minus_apart. apply minus_ap_zero. apply inv_resp_ap_zero. - exact a_. + 2: apply Im_wd. 2: exact H. + (* astepl [--]a. *) + apply ap_wdl_unfolded with ( [--]a). + apply zero_minus_apart. apply minus_ap_zero. apply inv_resp_ap_zero. + exact a_. apply eq_reflexive_unfolded. -(* astepl ( [--][--]b) [+I*][--]a. *) - apply eq_transitive_unfolded with ( [--][--]b[+I*][--]a). + (* astepl ( [--][--]b) [+I*][--]a. *) + apply eq_transitive_unfolded with ( [--][--]b[+I*][--]a). apply I_wd. apply eq_symmetric_unfolded. apply cg_inv_inv. - apply eq_reflexive_unfolded. -(* astepl [--] (( [--]b) [+I*]a). *) - apply eq_transitive_unfolded with ( [--] ( [--]b[+I*]a)). + apply eq_reflexive_unfolded. + (* astepl [--] (( [--]b) [+I*]a). *) + apply eq_transitive_unfolded with ( [--] ( [--]b[+I*]a)). apply eq_reflexive_unfolded. -(* astepl [--] ((a[+I*]b) [*]II). *) - apply eq_transitive_unfolded with ( [--] ((a[+I*]b) [*]II)). + (* astepl [--] ((a[+I*]b) [*]II). *) + apply eq_transitive_unfolded with ( [--] ((a[+I*]b) [*]II)). apply un_op_wd_unfolded. apply eq_symmetric_unfolded. apply mult_I. -(* Step_final (a[+I*]b) [*][--]II. *) + (* Step_final (a[+I*]b) [*][--]II. *) apply eq_transitive_unfolded with ((a[+I*]b) [*][--]II). apply eq_symmetric_unfolded. apply cring_inv_mult_lft. apply eq_reflexive_unfolded. @@ -547,11 +558,12 @@ End NRootCC_1_ap_imag. (** We now define the roots of arbitrary non zero complex numbers. *) Lemma nrootCC_1 : forall c : CC, c [#] Zero -> {z : CC | z[^]2 [=] c}. -intros. -pattern c in |- *. -apply C_cc_ap_zero; try assumption; intros. -apply nrootCC_1_ap_imag. assumption. -apply nrootCC_1_ap_real. assumption. +Proof. + intros. + pattern c in |- *. + apply C_cc_ap_zero; try assumption; intros. + apply nrootCC_1_ap_imag. assumption. + apply nrootCC_1_ap_real. assumption. Qed. End NRootCC_1. @@ -568,68 +580,70 @@ Hypothesis c_ : c [#] Zero. Lemma nrootCC_2' : (z[*]CC_conj z) [^]n [=] c[*]CC_conj c -> z[^]n[*]CC_conj c[-]CC_conj z[^]n[*]c [=] Zero -> (z[^]n) [^]2 [=] c[^]2. -intros. -cut (z[^]n[*]CC_conj c [=] CC_conj z[^]n[*]c); intros. -apply (mult_cancel_rht _ ((z[^]n) [^]2) (c[^]2) (CC_conj c)). -apply CC_conj_strext. -(* astepl c. *) - apply ap_wdl_unfolded with c. - 2: apply eq_symmetric_unfolded. 2: apply CC_conj_conj. -(* astepr (Zero::CC). *) - apply ap_wdr_unfolded with (Zero:CC). - exact c_. - apply eq_symmetric_unfolded. exact CC_conj_zero. -(* astepl (z[^]n[*]z[^]n) [*] (CC_conj c). *) - apply eq_transitive_unfolded with (z[^]n[*]z[^]n[*]CC_conj c). - apply bin_op_wd_unfolded. apply nexp_two. apply eq_reflexive_unfolded. -(* astepl z[^]n[*] (z[^]n[*] (CC_conj c)). *) - apply eq_transitive_unfolded with (z[^]n[*] (z[^]n[*]CC_conj c)). - apply eq_symmetric_unfolded. apply mult_assoc_unfolded. -(* astepl z[^]n[*] ((CC_conj z) [^]n[*]c). *) - apply eq_transitive_unfolded with (z[^]n[*] (CC_conj z[^]n[*]c)). - apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. exact H1. -(* astepl (z[^]n[*] (CC_conj z) [^]n) [*]c. *) - apply eq_transitive_unfolded with (z[^]n[*]CC_conj z[^]n[*]c). - apply mult_assoc_unfolded. -(* astepl ((z[*] (CC_conj z)) [^]n) [*]c. *) +Proof. + intros. + cut (z[^]n[*]CC_conj c [=] CC_conj z[^]n[*]c); intros. + apply (mult_cancel_rht _ ((z[^]n) [^]2) (c[^]2) (CC_conj c)). + apply CC_conj_strext. + (* astepl c. *) + apply ap_wdl_unfolded with c. + 2: apply eq_symmetric_unfolded. 2: apply CC_conj_conj. + (* astepr (Zero::CC). *) + apply ap_wdr_unfolded with (Zero:CC). + exact c_. + apply eq_symmetric_unfolded. exact CC_conj_zero. + (* astepl (z[^]n[*]z[^]n) [*] (CC_conj c). *) + apply eq_transitive_unfolded with (z[^]n[*]z[^]n[*]CC_conj c). + apply bin_op_wd_unfolded. apply nexp_two. apply eq_reflexive_unfolded. + (* astepl z[^]n[*] (z[^]n[*] (CC_conj c)). *) + apply eq_transitive_unfolded with (z[^]n[*] (z[^]n[*]CC_conj c)). + apply eq_symmetric_unfolded. apply mult_assoc_unfolded. + (* astepl z[^]n[*] ((CC_conj z) [^]n[*]c). *) + apply eq_transitive_unfolded with (z[^]n[*] (CC_conj z[^]n[*]c)). + apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. exact H1. + (* astepl (z[^]n[*] (CC_conj z) [^]n) [*]c. *) + apply eq_transitive_unfolded with (z[^]n[*]CC_conj z[^]n[*]c). + apply mult_assoc_unfolded. + (* astepl ((z[*] (CC_conj z)) [^]n) [*]c. *) apply eq_transitive_unfolded with ((z[*]CC_conj z) [^]n[*]c). - apply bin_op_wd_unfolded. apply eq_symmetric_unfolded. apply mult_nexp. + apply bin_op_wd_unfolded. apply eq_symmetric_unfolded. apply mult_nexp. apply eq_reflexive_unfolded. -(* astepl (c[*] (CC_conj c)) [*]c. *) + (* astepl (c[*] (CC_conj c)) [*]c. *) apply eq_transitive_unfolded with (c[*]CC_conj c[*]c). - apply bin_op_wd_unfolded. exact H. apply eq_reflexive_unfolded. -(* astepl c[*] (c[*] (CC_conj c)). *) - apply eq_transitive_unfolded with (c[*] (c[*]CC_conj c)). - apply mult_commutes. -(* Step_final (c[*]c) [*] (CC_conj c). *) + apply bin_op_wd_unfolded. exact H. apply eq_reflexive_unfolded. + (* astepl c[*] (c[*] (CC_conj c)). *) + apply eq_transitive_unfolded with (c[*] (c[*]CC_conj c)). + apply mult_commutes. + (* Step_final (c[*]c) [*] (CC_conj c). *) apply eq_transitive_unfolded with (c[*]c[*]CC_conj c). - apply mult_assoc_unfolded. + apply mult_assoc_unfolded. apply bin_op_wd_unfolded. apply eq_symmetric_unfolded. apply nexp_two. - apply eq_reflexive_unfolded. -cut (forall (G : CGroup) (x y : G), x[-]y [=] Zero -> x [=] y); intros. -apply H1. assumption. -(* astepl x[+]Zero. *) + apply eq_reflexive_unfolded. + cut (forall (G : CGroup) (x y : G), x[-]y [=] Zero -> x [=] y); intros. + apply H1. assumption. + (* astepl x[+]Zero. *) apply eq_transitive_unfolded with (x[+]Zero). apply eq_symmetric_unfolded. apply cm_rht_unit_unfolded. -(* astepl x[+] ( [--]y[+]y). *) + (* astepl x[+] ( [--]y[+]y). *) apply eq_transitive_unfolded with (x[+] ( [--]y[+]y)). apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. apply cg_lft_inv_unfolded. -(* astepl (x[+][--]y) [+]y. *) + apply eq_symmetric_unfolded. apply cg_lft_inv_unfolded. + (* astepl (x[+][--]y) [+]y. *) apply eq_transitive_unfolded with (x[+][--]y[+]y). apply plus_assoc_unfolded. -(* Step_final Zero[+]y. *) - apply eq_transitive_unfolded with (Zero[+]y). + (* Step_final Zero[+]y. *) + apply eq_transitive_unfolded with (Zero[+]y). apply bin_op_wd_unfolded. exact H1. apply eq_reflexive_unfolded. - apply cm_lft_unit_unfolded. + apply cm_lft_unit_unfolded. Qed. Lemma nrootCC_2 : (z[*]CC_conj z) [^]n [=] c[*]CC_conj c -> z[^]n[*]CC_conj c[-]CC_conj z[^]n[*]c [=] Zero -> z[^]n [=] c or z[^]n [=] [--]c. -intros. -apply cond_square_eq; try assumption. -exact TwoCC_ap_zero. -apply nrootCC_2'; assumption. +Proof. + intros. + apply cond_square_eq; try assumption. + exact TwoCC_ap_zero. + apply nrootCC_2'; assumption. Qed. End NRootCC_2. @@ -643,72 +657,73 @@ Fixpoint Im_poly (p : cpoly CC) : cpoly IR := end. Lemma nrCC3_a1 : forall p r, (Im_poly p) ! r [=] Im p ! (cc_IR r). -intros. -elim p; intros. -unfold Im_poly in |- *. -(* astepl (Zero::IR). *) +Proof. + intros. + elim p; intros. + unfold Im_poly in |- *. + (* astepl (Zero::IR). *) apply eq_transitive_unfolded with ZeroR. - apply eq_reflexive_unfolded. -(* Step_final (Im (Zero::CC)). *) - apply eq_transitive_unfolded with (Im (Zero:CC)); apply eq_reflexive_unfolded. -(* astepl (cpoly_linear ? (Im s) (Im_poly c))!r. *) - apply eq_transitive_unfolded with (cpoly_linear _ (Im s) (Im_poly c)) ! r. + (* Step_final (Im (Zero::CC)). *) + apply eq_transitive_unfolded with (Im (Zero:CC)); apply eq_reflexive_unfolded. + (* astepl (cpoly_linear ? (Im s) (Im_poly c))!r. *) + apply eq_transitive_unfolded with (cpoly_linear _ (Im s) (Im_poly c)) ! r. apply eq_reflexive_unfolded. -(* astepl (Im s) [+]r[*] ((Im_poly c)!r). *) - apply eq_transitive_unfolded with (Im s[+]r[*] (Im_poly c) ! r). + (* astepl (Im s) [+]r[*] ((Im_poly c)!r). *) + apply eq_transitive_unfolded with (Im s[+]r[*] (Im_poly c) ! r). apply eq_reflexive_unfolded. -(* astepl (Im s) [+]r[*] (Im (c!(cc_IR r))). *) - apply eq_transitive_unfolded with (Im s[+]r[*]Im c ! (cc_IR r)). + (* astepl (Im s) [+]r[*] (Im (c!(cc_IR r))). *) + apply eq_transitive_unfolded with (Im s[+]r[*]Im c ! (cc_IR r)). apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. apply bin_op_wd_unfolded. - apply eq_reflexive_unfolded. exact H. -cut (forall (r : IR) (c : CC), r[*]Im c [=] Im (cc_IR r[*]c)); intros. -(* astepl (Im s) [+] (Im (cc_IR r) [*] (c!(cc_IR r))). *) + apply eq_reflexive_unfolded. exact H. + cut (forall (r : IR) (c : CC), r[*]Im c [=] Im (cc_IR r[*]c)); intros. + (* astepl (Im s) [+] (Im (cc_IR r) [*] (c!(cc_IR r))). *) apply eq_transitive_unfolded with (Im s[+]Im (cc_IR r[*]c ! (cc_IR r))). - apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. apply H0. -(* Step_final (Im s[+] (cc_IR r) [*] (c!(cc_IR r))). *) - apply eq_transitive_unfolded with (Im (s[+]cc_IR r[*]c ! (cc_IR r))). - apply eq_reflexive_unfolded. + apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. apply H0. + (* Step_final (Im s[+] (cc_IR r) [*] (c!(cc_IR r))). *) + apply eq_transitive_unfolded with (Im (s[+]cc_IR r[*]c ! (cc_IR r))). + apply eq_reflexive_unfolded. apply eq_reflexive_unfolded. -(* astepl r0[*] (Im c0) [+]Zero. *) - apply eq_transitive_unfolded with (r0[*]Im c0[+]Zero). + (* astepl r0[*] (Im c0) [+]Zero. *) + apply eq_transitive_unfolded with (r0[*]Im c0[+]Zero). apply eq_symmetric_unfolded. apply cm_rht_unit_unfolded. -(* astepl r0[*] (Im c0) [+]Zero[*] (Re c0). *) + (* astepl r0[*] (Im c0) [+]Zero[*] (Re c0). *) apply eq_transitive_unfolded with (r0[*]Im c0[+]Zero[*]Re c0). apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. apply cring_mult_zero_op. -(* astepl (Im (r0[+I*]Zero) [*] ((Re c0) [+I*] (Im c0))). *) + apply eq_symmetric_unfolded. apply cring_mult_zero_op. + (* astepl (Im (r0[+I*]Zero) [*] ((Re c0) [+I*] (Im c0))). *) apply eq_transitive_unfolded with (Im ((r0[+I*]Zero) [*] (Re c0[+I*]Im c0))). apply eq_reflexive_unfolded. -(* Step_final (Im (cc_IR r0) [*] ((Re c0) [+I*] (Im c0))). *) - apply eq_transitive_unfolded with (Im (cc_IR r0[*] (Re c0[+I*]Im c0))). - apply eq_reflexive_unfolded. + (* Step_final (Im (cc_IR r0) [*] ((Re c0) [+I*] (Im c0))). *) + apply eq_transitive_unfolded with (Im (cc_IR r0[*] (Re c0[+I*]Im c0))). apply eq_reflexive_unfolded. + apply eq_reflexive_unfolded. Qed. Lemma nrCC3_a2 : forall p n, nth_coeff n (Im_poly p) [=] Im (nth_coeff n p). -intro. -elim p; intros. -unfold Im_poly in |- *. -(* astepl (Zero::IR). *) +Proof. + intro. + elim p; intros. + unfold Im_poly in |- *. + (* astepl (Zero::IR). *) apply eq_transitive_unfolded with ZeroR. - apply eq_reflexive_unfolded. -(* Step_final (Im (Zero::CC)). *) + apply eq_reflexive_unfolded. + (* Step_final (Im (Zero::CC)). *) apply eq_transitive_unfolded with (Im (Zero:CC)). + apply eq_reflexive_unfolded. apply eq_reflexive_unfolded. - apply eq_reflexive_unfolded. -elim n; intros. -(* Step_final (Im s). *) + elim n; intros. + (* Step_final (Im s). *) apply eq_transitive_unfolded with (Im s). + apply eq_reflexive_unfolded. apply eq_reflexive_unfolded. + (* astepl (nth_coeff ? n0 (Im_poly c)). *) + apply eq_transitive_unfolded with (nth_coeff n0 (Im_poly c)). apply eq_reflexive_unfolded. -(* astepl (nth_coeff ? n0 (Im_poly c)). *) - apply eq_transitive_unfolded with (nth_coeff n0 (Im_poly c)). - apply eq_reflexive_unfolded. -(* Step_final (Im (nth_coeff CC n0 c)). *) - apply eq_transitive_unfolded with (Im (nth_coeff (R:=CC) n0 c)). + (* Step_final (Im (nth_coeff CC n0 c)). *) + apply eq_transitive_unfolded with (Im (nth_coeff (R:=CC) n0 c)). apply H. - apply eq_reflexive_unfolded. + apply eq_reflexive_unfolded. Qed. (** @@ -723,192 +738,184 @@ Variable n : nat. Definition nrCC3_poly'' := (_X_[+]_C_ II) [^]n. Lemma nrCC3_a3 : forall r : IR, nrCC3_poly'' ! (cc_IR r) [=] (r[+I*]One) [^]n. -intros. -unfold nrCC3_poly'' in |- *. -(* astepl ((_X_[+] (_C_ II))!(cc_IR r)) [^]n. *) - apply eq_transitive_unfolded with ((_X_[+]_C_ II) ! (cc_IR r) [^]n). +Proof. + intros. + unfold nrCC3_poly'' in |- *. + (* astepl ((_X_[+] (_C_ II))!(cc_IR r)) [^]n. *) + apply eq_transitive_unfolded with ((_X_[+]_C_ II) ! (cc_IR r) [^]n). apply nexp_apply. -(* astepl ((_X_!(cc_IR r)) [+] ((_C_) II)!(cc_IR r)) [^]n. *) - apply - eq_transitive_unfolded with ((_X_ ! (cc_IR r) [+] (_C_ II) ! (cc_IR r)) [^]n). + (* astepl ((_X_!(cc_IR r)) [+] ((_C_) II)!(cc_IR r)) [^]n. *) + apply eq_transitive_unfolded with ((_X_ ! (cc_IR r) [+] (_C_ II) ! (cc_IR r)) [^]n). apply un_op_wd_unfolded. apply plus_apply. -cut (forall c x : CC, _X_ ! x[+] (_C_ c) ! x [=] x[+]c); intros. -(* astepl ((cc_IR r) [+]II) [^]n. *) + cut (forall c x : CC, _X_ ! x[+] (_C_ c) ! x [=] x[+]c); intros. + (* astepl ((cc_IR r) [+]II) [^]n. *) apply eq_transitive_unfolded with ((cc_IR r[+]II) [^]n). - apply un_op_wd_unfolded. apply H. -(* astepl ((r[+I*]Zero) [+] (Zero[+I*]One)) [^]n. *) - apply eq_transitive_unfolded with ((r[+I*]Zero[+]Zero[+I*]One) [^]n). - apply eq_reflexive_unfolded. -(* Step_final ((r[+]Zero) [+I*] (Zero[+]One)) [^]n. *) + apply un_op_wd_unfolded. apply H. + (* astepl ((r[+I*]Zero) [+] (Zero[+I*]One)) [^]n. *) + apply eq_transitive_unfolded with ((r[+I*]Zero[+]Zero[+I*]One) [^]n). + apply eq_reflexive_unfolded. + (* Step_final ((r[+]Zero) [+I*] (Zero[+]One)) [^]n. *) apply eq_transitive_unfolded with (((r[+]Zero) [+I*] (Zero[+]One)) [^]n). - apply eq_reflexive_unfolded. + apply eq_reflexive_unfolded. apply un_op_wd_unfolded. apply I_wd. apply cm_rht_unit_unfolded. - apply cm_lft_unit_unfolded. -(* algebra. *) - apply bin_op_wd_unfolded. apply x_apply. apply c_apply. + apply cm_lft_unit_unfolded. + (* algebra. *) + apply bin_op_wd_unfolded. apply x_apply. apply c_apply. Qed. Lemma nrCC3_a4 : degree_le 1 (_X_[+]_C_ II). -apply degree_imp_degree_le. -cut (degree 1 (_C_ II[+]_X_)); intros. -apply (degree_wd _ (_C_ II[+]_X_)). -(* algebra. *) - apply cag_commutes_unfolded. -(* algebra. *) - rename X into H. exact H. -apply (degree_plus_rht _ (_C_ II) _X_ 0 1). -apply degree_le_c_. -apply degree_x_. -auto with arith. +Proof. + apply degree_imp_degree_le. + cut (degree 1 (_C_ II[+]_X_)); intros. + apply (degree_wd _ (_C_ II[+]_X_)). + (* algebra. *) + apply cag_commutes_unfolded. + (* algebra. *) + rename X into H. exact H. + apply (degree_plus_rht _ (_C_ II) _X_ 0 1). + apply degree_le_c_. + apply degree_x_. + auto with arith. Qed. Lemma nrCC3_a5 : degree_le n nrCC3_poly''. -replace n with (1 * n). -unfold nrCC3_poly'' in |- *. -apply degree_le_nexp. -exact nrCC3_a4. -unfold mult in |- *. -auto with arith. +Proof. + replace n with (1 * n). + unfold nrCC3_poly'' in |- *. + apply degree_le_nexp. + exact nrCC3_a4. + unfold mult in |- *. + auto with arith. Qed. Lemma nrCC3_a6 : nth_coeff n nrCC3_poly'' [=] One. -cut (monic n nrCC3_poly''); intros. -unfold monic in H. -elim H; intros; assumption. -replace n with (1 * n). -unfold nrCC3_poly'' in |- *. -apply monic_nexp. -unfold monic in |- *; split. -(* algebra. *) - apply eq_reflexive_unfolded. -exact nrCC3_a4. -unfold mult in |- *. -auto with arith. +Proof. + cut (monic n nrCC3_poly''); intros. + unfold monic in H. + elim H; intros; assumption. + replace n with (1 * n). + unfold nrCC3_poly'' in |- *. + apply monic_nexp. + unfold monic in |- *; split. + (* algebra. *) + apply eq_reflexive_unfolded. + exact nrCC3_a4. + unfold mult in |- *. + auto with arith. Qed. Definition nrCC3_poly' := nrCC3_poly''[*]_C_ (a[+I*][--]b). Lemma nrCC3_a7 : forall r : IR, nrCC3_poly' ! (cc_IR r) [=] (r[+I*]One) [^]n[*] (a[+I*][--]b). -intros. -unfold nrCC3_poly' in |- *. -(* astepl (nrCC3_poly''!(cc_IR r)) [*] ((_C_ a[+I*][--]b)!(cc_IR r)). *) - apply - eq_transitive_unfolded - with (nrCC3_poly'' ! (cc_IR r) [*] (_C_ (a[+I*][--]b)) ! (cc_IR r)). +Proof. + intros. + unfold nrCC3_poly' in |- *. + (* astepl (nrCC3_poly''!(cc_IR r)) [*] ((_C_ a[+I*][--]b)!(cc_IR r)). *) + apply eq_transitive_unfolded with (nrCC3_poly'' ! (cc_IR r) [*] (_C_ (a[+I*][--]b)) ! (cc_IR r)). apply mult_apply. -Hint Resolve nrCC3_a3: algebra. -(* Step_final (nrCC3_poly''!(cc_IR r)) [*] (a[+I*][--]b). *) - apply - eq_transitive_unfolded with (nrCC3_poly'' ! (cc_IR r) [*] (a[+I*][--]b)). + Hint Resolve nrCC3_a3: algebra. + (* Step_final (nrCC3_poly''!(cc_IR r)) [*] (a[+I*][--]b). *) + apply eq_transitive_unfolded with (nrCC3_poly'' ! (cc_IR r) [*] (a[+I*][--]b)). apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. apply c_apply. - apply bin_op_wd_unfolded. apply nrCC3_a3. apply eq_reflexive_unfolded. + apply bin_op_wd_unfolded. apply nrCC3_a3. apply eq_reflexive_unfolded. Qed. Lemma nrCC3_a8 : degree_le n nrCC3_poly'. -replace n with (n + 0). -unfold nrCC3_poly' in |- *. -apply degree_le_mult. -exact nrCC3_a5. -apply degree_le_c_. -auto with arith. +Proof. + replace n with (n + 0). + unfold nrCC3_poly' in |- *. + apply degree_le_mult. + exact nrCC3_a5. + apply degree_le_c_. + auto with arith. Qed. Lemma nrCC3_a9 : nth_coeff n nrCC3_poly' [=] a[+I*][--]b. -unfold nrCC3_poly' in |- *. -Hint Resolve nth_coeff_p_mult_c_: algebra. -(* astepl (nth_coeff n nrCC3_poly'') [*] (a[+I*][--]b). *) - apply - eq_transitive_unfolded with (nth_coeff n nrCC3_poly''[*] (a[+I*][--]b)). +Proof. + unfold nrCC3_poly' in |- *. + Hint Resolve nth_coeff_p_mult_c_: algebra. + (* astepl (nth_coeff n nrCC3_poly'') [*] (a[+I*][--]b). *) + apply eq_transitive_unfolded with (nth_coeff n nrCC3_poly''[*] (a[+I*][--]b)). apply nth_coeff_p_mult_c_. -Hint Resolve nrCC3_a6: algebra. -(* Step_final One[*] (a[+I*][--]b). *) - apply eq_transitive_unfolded with (One[*] (a[+I*][--]b)). + Hint Resolve nrCC3_a6: algebra. + (* Step_final One[*] (a[+I*][--]b). *) + apply eq_transitive_unfolded with (One[*] (a[+I*][--]b)). apply bin_op_wd_unfolded. exact nrCC3_a6. apply eq_reflexive_unfolded. - apply one_mult. + apply one_mult. Qed. Definition nrootCC_3_poly := Im_poly nrCC3_poly'. Lemma nrootCC_3_ : forall r : IR, nrootCC_3_poly ! r [=] Im ((r[+I*]One) [^]n[*] (a[+I*][--]b)). -intros. -unfold nrootCC_3_poly in |- *. -Hint Resolve nrCC3_a1 nrCC3_a7: algebra. -(* Step_final (Im (nrCC3_poly'!(cc_IR r))). *) - apply eq_transitive_unfolded with (Im nrCC3_poly' ! (cc_IR r)). +Proof. + intros. + unfold nrootCC_3_poly in |- *. + Hint Resolve nrCC3_a1 nrCC3_a7: algebra. + (* Step_final (Im (nrCC3_poly'!(cc_IR r))). *) + apply eq_transitive_unfolded with (Im nrCC3_poly' ! (cc_IR r)). apply nrCC3_a1. - apply Im_wd. apply nrCC3_a7. + apply Im_wd. apply nrCC3_a7. Qed. Lemma nrootCC_3 : forall r : IR, cc_IR nrootCC_3_poly ! r[*] (Two[*]II) [=] (r[+I*]One) [^]n[*] (a[+I*][--]b) [-] (r[+I*][--]One) [^]n[*] (a[+I*]b). -intros. -cut - (CC_conj ((r[+I*]One) [^]n[*] (a[+I*][--]b)) [=] (r[+I*][--]One) [^]n[*] (a[+I*]b)); +Proof. intros. -Hint Resolve nrootCC_3_: algebra. -(* astepl (cc_IR (Im (r[+I*]One) [^]n[*] (a[+I*][--]b))) [*] (Two[*]II). *) - apply - eq_transitive_unfolded - with (cc_IR (Im ((r[+I*]One) [^]n[*] (a[+I*][--]b))) [*] (Two[*]II)). - apply bin_op_wd_unfolded. apply cc_IR_wd. apply nrootCC_3_. + cut (CC_conj ((r[+I*]One) [^]n[*] (a[+I*][--]b)) [=] (r[+I*][--]One) [^]n[*] (a[+I*]b)); intros. + Hint Resolve nrootCC_3_: algebra. + (* astepl (cc_IR (Im (r[+I*]One) [^]n[*] (a[+I*][--]b))) [*] (Two[*]II). *) + apply eq_transitive_unfolded with (cc_IR (Im ((r[+I*]One) [^]n[*] (a[+I*][--]b))) [*] (Two[*]II)). + apply bin_op_wd_unfolded. apply cc_IR_wd. apply nrootCC_3_. apply eq_reflexive_unfolded. -Hint Resolve calculate_Im: algebra. -(* Step_final - (r[+I*]One) [^]n[*] (a[+I*][--]b) [-] (CC_conj (r[+I*]One) [^]n[*] (a[+I*][--]b)). - *) - apply - eq_transitive_unfolded - with - ((r[+I*]One) [^]n[*] (a[+I*][--]b) [-] - CC_conj ((r[+I*]One) [^]n[*] (a[+I*][--]b))). - apply calculate_Im. + Hint Resolve calculate_Im: algebra. + (* Step_final (r[+I*]One) [^]n[*] (a[+I*][--]b) [-] (CC_conj (r[+I*]One) [^]n[*] (a[+I*][--]b)). + *) + apply eq_transitive_unfolded with ((r[+I*]One) [^]n[*] (a[+I*][--]b) [-] + CC_conj ((r[+I*]One) [^]n[*] (a[+I*][--]b))). + apply calculate_Im. apply cg_minus_wd. apply eq_reflexive_unfolded. exact H. -(* astepl (CC_conj (r[+I*]One) [^]n) [*] (CC_conj a[+I*][--]b). *) - apply - eq_transitive_unfolded - with (CC_conj ((r[+I*]One) [^]n) [*]CC_conj (a[+I*][--]b)). + (* astepl (CC_conj (r[+I*]One) [^]n) [*] (CC_conj a[+I*][--]b). *) + apply eq_transitive_unfolded with (CC_conj ((r[+I*]One) [^]n) [*]CC_conj (a[+I*][--]b)). apply CC_conj_mult. -(* Step_final (CC_conj r[+I*]One) [^]n[*]a[+I*][--][--]b. *) - apply - eq_transitive_unfolded with (CC_conj (r[+I*]One) [^]n[*] (a[+I*][--][--]b)). + (* Step_final (CC_conj r[+I*]One) [^]n[*]a[+I*][--][--]b. *) + apply eq_transitive_unfolded with (CC_conj (r[+I*]One) [^]n[*] (a[+I*][--][--]b)). apply bin_op_wd_unfolded. apply CC_conj_nexp. apply eq_reflexive_unfolded. - apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. apply I_wd. - apply eq_reflexive_unfolded. apply cg_inv_inv. + apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. apply I_wd. + apply eq_reflexive_unfolded. apply cg_inv_inv. Qed. Lemma nrootCC_3_degree : degree n nrootCC_3_poly. -unfold degree in |- *. -split. -cut (nth_coeff n nrootCC_3_poly [=] [--]b); intros. -(* astepl [--]b. *) - apply ap_wdl_unfolded with ( [--]b). - apply zero_minus_apart. apply minus_ap_zero. apply inv_resp_ap_zero. +Proof. + unfold degree in |- *. + split. + cut (nth_coeff n nrootCC_3_poly [=] [--]b); intros. + (* astepl [--]b. *) + apply ap_wdl_unfolded with ( [--]b). + apply zero_minus_apart. apply minus_ap_zero. apply inv_resp_ap_zero. exact b_. - apply eq_symmetric_unfolded. exact H. -unfold nrootCC_3_poly in |- *. -Hint Resolve nrCC3_a2: algebra. -(* astepl (Im (nth_coeff n nrCC3_poly')). *) + apply eq_symmetric_unfolded. exact H. + unfold nrootCC_3_poly in |- *. + Hint Resolve nrCC3_a2: algebra. + (* astepl (Im (nth_coeff n nrCC3_poly')). *) apply eq_transitive_unfolded with (Im (nth_coeff n nrCC3_poly')). - apply nrCC3_a2. -Hint Resolve nrCC3_a9: algebra. -(* Step_final (Im a[+I*][--]b). *) + apply nrCC3_a2. + Hint Resolve nrCC3_a9: algebra. + (* Step_final (Im a[+I*][--]b). *) apply eq_transitive_unfolded with (Im (a[+I*][--]b)). - apply Im_wd. exact nrCC3_a9. - apply eq_reflexive_unfolded. -cut - (forall (p : cpoly CC) (n : nat), degree_le n p -> degree_le n (Im_poly p)); + apply Im_wd. exact nrCC3_a9. + apply eq_reflexive_unfolded. + cut (forall (p : cpoly CC) (n : nat), degree_le n p -> degree_le n (Im_poly p)); intros. + unfold nrootCC_3_poly in |- *. + apply H. + exact nrCC3_a8. + unfold degree_le in |- *. + unfold degree_le in H. intros. -unfold nrootCC_3_poly in |- *. -apply H. -exact nrCC3_a8. -unfold degree_le in |- *. -unfold degree_le in H. -intros. -(* astepl (Im (nth_coeff m p)). *) - apply eq_transitive_unfolded with (Im (nth_coeff m p)). + (* astepl (Im (nth_coeff m p)). *) + apply eq_transitive_unfolded with (Im (nth_coeff m p)). apply nrCC3_a2. -(* Step_final (Im (Zero::CC)). *) - apply eq_transitive_unfolded with (Im (Zero:CC)). + (* Step_final (Im (Zero::CC)). *) + apply eq_transitive_unfolded with (Im (Zero:CC)). apply Im_wd. apply H. exact H0. apply eq_reflexive_unfolded. Qed. @@ -929,31 +936,33 @@ Hypothesis n_ : 0 < n. Definition nrootCC_3'_poly := _X_[^]n[-]_C_ c. Lemma nrootCC_3' : forall x : IR, nrootCC_3'_poly ! x [=] x[^]n[-]c. -intros. -unfold nrootCC_3'_poly in |- *. -cut ((_X_[^]n) ! x [=] x[^]n). intros. -(* Step_final (_X_[^]n)!x[-] (_C_ c)!x. *) +Proof. + intros. + unfold nrootCC_3'_poly in |- *. + cut ((_X_[^]n) ! x [=] x[^]n). intros. + (* Step_final (_X_[^]n)!x[-] (_C_ c)!x. *) apply eq_transitive_unfolded with ((_X_[^]n) ! x[-] (_C_ c) ! x). - apply minus_apply. + apply minus_apply. apply cg_minus_wd. exact H. apply c_apply. -(* Step_final (_X_!x) [^]n. *) - apply eq_transitive_unfolded with (_X_ ! x[^]n). + (* Step_final (_X_!x) [^]n. *) + apply eq_transitive_unfolded with (_X_ ! x[^]n). apply nexp_apply. - apply un_op_wd_unfolded. apply x_apply. + apply un_op_wd_unfolded. apply x_apply. Qed. Lemma nrootCC_3'_degree : degree n nrootCC_3'_poly. -unfold nrootCC_3'_poly in |- *. -apply (degree_minus_lft _ (_C_ c) (_X_[^]n) 0 n). -apply degree_le_c_. -(* Replace (degree IR n) with (degree IR (mult (1) n)). *) -pattern n at 1 in |- *; replace n with (1 * n). -apply degree_nexp. -apply degree_x_. -replace (1 * n) with n; auto. -unfold mult in |- *. -auto with arith. -assumption. +Proof. + unfold nrootCC_3'_poly in |- *. + apply (degree_minus_lft _ (_C_ c) (_X_[^]n) 0 n). + apply degree_le_c_. + (* Replace (degree IR n) with (degree IR (mult (1) n)). *) + pattern n at 1 in |- *; replace n with (1 * n). + apply degree_nexp. + apply degree_x_. + replace (1 * n) with n; auto. + unfold mult in |- *. + auto with arith. + assumption. Qed. End NRootCC_3'. @@ -980,32 +989,30 @@ Let c := a[+I*]b. Section NRootCC_4_solutions. Lemma nrCC4_a1 : {r : IR | (r[+I*]One) [^]n[*]CC_conj c[-] (r[+I*][--]One) [^]n[*]c [=] Zero}. -elim (realpolyn_oddhaszero (nrootCC_3_poly a b n)). -intro r. intro H. -exists r. -(* astepl (r[+I*]One) [^]n[*] (a[+I*][--]b) [-] (r[+I*][--]One) [^]n[*] (a[+I*]b). *) - apply - eq_transitive_unfolded +Proof. + elim (realpolyn_oddhaszero (nrootCC_3_poly a b n)). + intro r. intro H. + exists r. + (* astepl (r[+I*]One) [^]n[*] (a[+I*][--]b) [-] (r[+I*][--]One) [^]n[*] (a[+I*]b). *) + apply eq_transitive_unfolded with ((r[+I*]One) [^]n[*] (a[+I*][--]b) [-] (r[+I*][--]One) [^]n[*] (a[+I*]b)). - apply eq_reflexive_unfolded. -Hint Resolve nrootCC_3: algebra. -(* astepl (cc_IR ((nrootCC_3_poly a b n)!r)) [*] (Two[*]II). *) - apply - eq_transitive_unfolded - with (cc_IR (nrootCC_3_poly a b n) ! r[*] (Two[*]II)). - apply eq_symmetric_unfolded. apply nrootCC_3. -(* astepl (cc_IR Zero) [*] (Two[*]II). *) - apply eq_transitive_unfolded with (cc_IR Zero[*] (Two[*]II)). - apply bin_op_wd_unfolded. apply cc_IR_wd. exact H. apply eq_reflexive_unfolded. -(* Step_final Zero[*] (Two[*]II). *) - apply eq_transitive_unfolded with (Zero[*] (Two[*]II)). - apply eq_reflexive_unfolded. + apply eq_reflexive_unfolded. + Hint Resolve nrootCC_3: algebra. + (* astepl (cc_IR ((nrootCC_3_poly a b n)!r)) [*] (Two[*]II). *) + apply eq_transitive_unfolded with (cc_IR (nrootCC_3_poly a b n) ! r[*] (Two[*]II)). + apply eq_symmetric_unfolded. apply nrootCC_3. + (* astepl (cc_IR Zero) [*] (Two[*]II). *) + apply eq_transitive_unfolded with (cc_IR Zero[*] (Two[*]II)). + apply bin_op_wd_unfolded. apply cc_IR_wd. exact H. apply eq_reflexive_unfolded. + (* Step_final Zero[*] (Two[*]II). *) + apply eq_transitive_unfolded with (Zero[*] (Two[*]II)). + apply eq_reflexive_unfolded. apply cring_mult_zero_op. -unfold odd_cpoly in |- *. -exists n. -apply to_Codd. -assumption. -apply (nrootCC_3_degree a b b_ n). + unfold odd_cpoly in |- *. + exists n. + apply to_Codd. + assumption. + apply (nrootCC_3_degree a b b_ n). Qed. (** @@ -1017,41 +1024,42 @@ Variables r2' c2 : IR. Hypothesis r2'_ : r2' [#] Zero. Lemma nrCC4_a1' : {y2 : IR | (y2[*]r2') [^]n [=] c2}. -elim (realpolyn_oddhaszero (nrootCC_3'_poly c2 n)). -intro y2r2'. intros. -exists (y2r2'[/] r2'[//]r2'_). -(* astepl y2r2'[^]n. *) +Proof. + elim (realpolyn_oddhaszero (nrootCC_3'_poly c2 n)). + intro y2r2'. intros. + exists (y2r2'[/] r2'[//]r2'_). + (* astepl y2r2'[^]n. *) apply eq_transitive_unfolded with (y2r2'[^]n). - apply un_op_wd_unfolded. apply div_1. -(* astepl y2r2'[^]n[+]Zero. *) - apply eq_transitive_unfolded with (y2r2'[^]n[+]Zero). - apply eq_symmetric_unfolded. apply cm_rht_unit_unfolded. -(* astepl y2r2'[^]n[+] ( [--]c2[+]c2). *) - apply eq_transitive_unfolded with (y2r2'[^]n[+] ( [--]c2[+]c2)). - apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. + apply un_op_wd_unfolded. apply div_1. + (* astepl y2r2'[^]n[+]Zero. *) + apply eq_transitive_unfolded with (y2r2'[^]n[+]Zero). + apply eq_symmetric_unfolded. apply cm_rht_unit_unfolded. + (* astepl y2r2'[^]n[+] ( [--]c2[+]c2). *) + apply eq_transitive_unfolded with (y2r2'[^]n[+] ( [--]c2[+]c2)). + apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. apply eq_symmetric_unfolded. apply cg_lft_inv_unfolded. -(* astepl (y2r2'[^]n[+][--]c2) [+]c2. *) - apply eq_transitive_unfolded with (y2r2'[^]n[+][--]c2[+]c2). - apply plus_assoc_unfolded. -(* astepl (y2r2'[^]n[-]c2) [+]c2. *) + (* astepl (y2r2'[^]n[+][--]c2) [+]c2. *) + apply eq_transitive_unfolded with (y2r2'[^]n[+][--]c2[+]c2). + apply plus_assoc_unfolded. + (* astepl (y2r2'[^]n[-]c2) [+]c2. *) apply eq_transitive_unfolded with (y2r2'[^]n[-]c2[+]c2). - apply eq_reflexive_unfolded. -Hint Resolve nrootCC_3': algebra. -(* astepl (nrootCC_3'_poly c2 n)!y2r2'[+]c2. *) + apply eq_reflexive_unfolded. + Hint Resolve nrootCC_3': algebra. + (* astepl (nrootCC_3'_poly c2 n)!y2r2'[+]c2. *) apply eq_transitive_unfolded with ((nrootCC_3'_poly c2 n) ! y2r2'[+]c2). - apply bin_op_wd_unfolded. apply eq_symmetric_unfolded. apply nrootCC_3'. + apply bin_op_wd_unfolded. apply eq_symmetric_unfolded. apply nrootCC_3'. apply eq_reflexive_unfolded. -(* Step_final Zero[+]c2. *) + (* Step_final Zero[+]c2. *) apply eq_transitive_unfolded with (Zero[+]c2). - apply bin_op_wd_unfolded. assumption. apply eq_reflexive_unfolded. - apply cm_lft_unit_unfolded. -unfold odd_cpoly in |- *. -exists n. -apply to_Codd. -assumption. -apply nrootCC_3'_degree. -rewrite (odd_double n). auto with arith. -assumption. + apply bin_op_wd_unfolded. assumption. apply eq_reflexive_unfolded. + apply cm_lft_unit_unfolded. + unfold odd_cpoly in |- *. + exists n. + apply to_Codd. + assumption. + apply nrootCC_3'_degree. + rewrite (odd_double n). auto with arith. + assumption. Qed. End NRootCC_4_solutions. @@ -1071,25 +1079,28 @@ Variable y2 : IR. Hypothesis y2_property : (y2[*] (r[^]2[+]One)) [^]n [=] a[^]2[+]b[^]2. Lemma nrCC4_a2 : Zero [<] a[^]2[+]b[^]2. -apply plus_resp_nonneg_pos. -apply sqr_nonneg. -apply pos_square. -assumption. +Proof. + apply plus_resp_nonneg_pos. + apply sqr_nonneg. + apply pos_square. + assumption. Qed. Lemma nrCC4_a3 : Zero [<] r[^]2[+]One. -apply plus_resp_nonneg_pos. -apply sqr_nonneg. -apply pos_one. +Proof. + apply plus_resp_nonneg_pos. + apply sqr_nonneg. + apply pos_one. Qed. Lemma nrCC4_a4 : Zero [<] y2. -apply mult_cancel_pos_lft with (r[^]2[+]One). -apply odd_power_cancel_pos with n. -assumption. -apply (pos_wd _ _ _ y2_property). -apply nrCC4_a2. -apply less_leEq; apply nrCC4_a3. +Proof. + apply mult_cancel_pos_lft with (r[^]2[+]One). + apply odd_power_cancel_pos with n. + assumption. + apply (pos_wd _ _ _ y2_property). + apply nrCC4_a2. + apply less_leEq; apply nrCC4_a3. Qed. Definition nrCC4_y := sqrt y2 (less_leEq _ _ _ nrCC4_a4). @@ -1101,30 +1112,32 @@ Definition nrCC4_x := y[*]r. Let x := nrCC4_x. Lemma nrCC4_a5 : x [=] y[*]r. -unfold x in |- *. unfold nrCC4_x in |- *. -(* algebra. *) - apply eq_reflexive_unfolded. +Proof. + unfold x in |- *. unfold nrCC4_x in |- *. + (* algebra. *) + apply eq_reflexive_unfolded. Qed. Lemma nrCC4_a6 : (x[^]2[+]y[^]2) [^]n [=] a[^]2[+]b[^]2. -unfold x in |- *. unfold nrCC4_x in |- *. -cut ((y[*]r) [^]2[+]y[^]2 [=] y[^]2[*] (r[^]2[+]One)). intro. -(* astepl (y[^] (2) [*] (r[^] (2) [+]One)) [^]n. *) +Proof. + unfold x in |- *. unfold nrCC4_x in |- *. + cut ((y[*]r) [^]2[+]y[^]2 [=] y[^]2[*] (r[^]2[+]One)). intro. + (* astepl (y[^] (2) [*] (r[^] (2) [+]One)) [^]n. *) apply eq_transitive_unfolded with ((y[^]2[*] (r[^]2[+]One)) [^]n). - apply un_op_wd_unfolded. exact H. -cut (y[^]2 [=] y2). intro. -(* Step_final (y2[*] (r[^] (2) [+]One)) [^]n. *) - apply eq_transitive_unfolded with ((y2[*] (r[^]2[+]One)) [^]n). - apply un_op_wd_unfolded. apply bin_op_wd_unfolded. exact H0. + apply un_op_wd_unfolded. exact H. + cut (y[^]2 [=] y2). intro. + (* Step_final (y2[*] (r[^] (2) [+]One)) [^]n. *) + apply eq_transitive_unfolded with ((y2[*] (r[^]2[+]One)) [^]n). + apply un_op_wd_unfolded. apply bin_op_wd_unfolded. exact H0. apply eq_reflexive_unfolded. - exact y2_property. -unfold y in |- *. unfold nrCC4_y in |- *. -apply sqrt_sqr. -(* Step_final y[^] (2) [*]r[^] (2) [+]y[^] (2) [*]One. *) - apply eq_transitive_unfolded with (y[^]2[*]r[^]2[+]y[^]2[*]One). + exact y2_property. + unfold y in |- *. unfold nrCC4_y in |- *. + apply sqrt_sqr. + (* Step_final y[^] (2) [*]r[^] (2) [+]y[^] (2) [*]One. *) + apply eq_transitive_unfolded with (y[^]2[*]r[^]2[+]y[^]2[*]One). apply bin_op_wd_unfolded. apply mult_nexp. apply eq_symmetric_unfolded. - apply mult_one. - apply eq_symmetric_unfolded. apply ring_dist_unfolded. + apply mult_one. + apply eq_symmetric_unfolded. apply ring_dist_unfolded. Qed. Definition nrCC4_z := x[+I*]y. @@ -1132,126 +1145,121 @@ Definition nrCC4_z := x[+I*]y. Let z := nrCC4_z. Lemma nrCC4_a7 : z[^]n[*]CC_conj c[-]CC_conj z[^]n[*]c [=] Zero. -unfold z in |- *. unfold nrCC4_z in |- *. -(* astepl (x[+I*]y) [^]n[*] (CC_conj c) [-] (x[+I*][--]y) [^]n[*]c. *) - apply - eq_transitive_unfolded - with ((x[+I*]y) [^]n[*]CC_conj c[-] (x[+I*][--]y) [^]n[*]c). +Proof. + unfold z in |- *. unfold nrCC4_z in |- *. + (* astepl (x[+I*]y) [^]n[*] (CC_conj c) [-] (x[+I*][--]y) [^]n[*]c. *) + apply eq_transitive_unfolded with ((x[+I*]y) [^]n[*]CC_conj c[-] (x[+I*][--]y) [^]n[*]c). apply eq_reflexive_unfolded. -unfold x in |- *. unfold nrCC4_x in |- *. -cut - ((y[*]r[+I*]y) [^]n[*]CC_conj c [=] cc_IR y[^]n[*] ((r[+I*]One) [^]n[*]CC_conj c)). intro. -cut ((y[*]r[+I*][--]y) [^]n[*]c [=] cc_IR y[^]n[*] ((r[+I*][--]One) [^]n[*]c)). intro. -(* astepl (cc_IR y) [^]n[*] ((r[+I*]One) [^]n[*] (CC_conj c)) [-] - (cc_IR y) [^]n[*] ((r[+I*][--]One) [^]n[*]c). *) - apply - eq_transitive_unfolded - with - (cc_IR y[^]n[*] ((r[+I*]One) [^]n[*]CC_conj c) [-] - cc_IR y[^]n[*] ((r[+I*][--]One) [^]n[*]c)). - apply cg_minus_wd. exact H. exact H0. -(* astepl (cc_IR y) [^]n[*] - (((r[+I*]One) [^]n[*] (CC_conj c)) [-] ((r[+I*][--]One) [^]n[*]c)). *) - apply - eq_transitive_unfolded - with - (cc_IR y[^]n[*] ((r[+I*]One) [^]n[*]CC_conj c[-] (r[+I*][--]One) [^]n[*]c)). - apply eq_symmetric_unfolded. apply dist_2a. -(* Step_final (cc_IR y) [^]n[*]Zero. *) - apply eq_transitive_unfolded with (cc_IR y[^]n[*]Zero). - apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. exact r_property. - apply cring_mult_zero. -cut ((y[*]r[+I*][--]y) [^]n [=] cc_IR y[^]n[*] (r[+I*][--]One) [^]n). intro. -(* Step_final ((cc_IR y) [^]n[*] (r[+I*][--]One) [^]n) [*]c. *) - apply eq_transitive_unfolded with (cc_IR y[^]n[*] (r[+I*][--]One) [^]n[*]c). - apply bin_op_wd_unfolded. exact H0. apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. apply mult_assoc_unfolded. -cut (y[*]r[+I*][--]y [=] cc_IR y[*] (r[+I*][--]One)). intro. -(* Step_final ((cc_IR y) [*] (r[+I*][--]One)) [^]n. *) - apply eq_transitive_unfolded with ((cc_IR y[*] (r[+I*][--]One)) [^]n). - apply un_op_wd_unfolded. exact H0. - apply mult_nexp. -cut ( [--]y [=] y[*][--]One). intro. -(* Step_final (y[*]r) [+I*] (y[*][--]One). *) - apply eq_transitive_unfolded with (y[*]r[+I*]y[*][--]One). - apply I_wd. apply eq_reflexive_unfolded. exact H0. - apply eq_symmetric_unfolded. apply cc_IR_mult_rht. -(* Step_final [--] (y[*]One). *) - apply eq_transitive_unfolded with ( [--] (y[*]One)). - apply un_op_wd_unfolded. apply eq_symmetric_unfolded. apply mult_one. - apply eq_symmetric_unfolded. apply cring_inv_mult_lft. -cut ((y[*]r[+I*]y) [^]n [=] cc_IR y[^]n[*] (r[+I*]One) [^]n). intro. -(* Step_final ((cc_IR y) [^]n[*] (r[+I*]One) [^]n) [*] (CC_conj c). *) - apply - eq_transitive_unfolded with (cc_IR y[^]n[*] (r[+I*]One) [^]n[*]CC_conj c). - apply bin_op_wd_unfolded. exact H. apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. apply mult_assoc_unfolded. -cut (y[*]r[+I*]y [=] cc_IR y[*] (r[+I*]One)). intro. -(* Step_final ((cc_IR y) [*] (r[+I*]One)) [^]n. *) + unfold x in |- *. unfold nrCC4_x in |- *. + cut ((y[*]r[+I*]y) [^]n[*]CC_conj c [=] cc_IR y[^]n[*] ((r[+I*]One) [^]n[*]CC_conj c)). intro. + cut ((y[*]r[+I*][--]y) [^]n[*]c [=] cc_IR y[^]n[*] ((r[+I*][--]One) [^]n[*]c)). intro. + (* astepl (cc_IR y) [^]n[*] ((r[+I*]One) [^]n[*] (CC_conj c)) [-] + (cc_IR y) [^]n[*] ((r[+I*][--]One) [^]n[*]c). *) + apply eq_transitive_unfolded with (cc_IR y[^]n[*] ((r[+I*]One) [^]n[*]CC_conj c) [-] + cc_IR y[^]n[*] ((r[+I*][--]One) [^]n[*]c)). + apply cg_minus_wd. exact H. exact H0. + (* astepl (cc_IR y) [^]n[*] (((r[+I*]One) [^]n[*] (CC_conj c)) [-] ((r[+I*][--]One) [^]n[*]c)). *) + apply eq_transitive_unfolded with + (cc_IR y[^]n[*] ((r[+I*]One) [^]n[*]CC_conj c[-] (r[+I*][--]One) [^]n[*]c)). + apply eq_symmetric_unfolded. apply dist_2a. + (* Step_final (cc_IR y) [^]n[*]Zero. *) + apply eq_transitive_unfolded with (cc_IR y[^]n[*]Zero). + apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. exact r_property. + apply cring_mult_zero. + cut ((y[*]r[+I*][--]y) [^]n [=] cc_IR y[^]n[*] (r[+I*][--]One) [^]n). intro. + (* Step_final ((cc_IR y) [^]n[*] (r[+I*][--]One) [^]n) [*]c. *) + apply eq_transitive_unfolded with (cc_IR y[^]n[*] (r[+I*][--]One) [^]n[*]c). + apply bin_op_wd_unfolded. exact H0. apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded. apply mult_assoc_unfolded. + cut (y[*]r[+I*][--]y [=] cc_IR y[*] (r[+I*][--]One)). intro. + (* Step_final ((cc_IR y) [*] (r[+I*][--]One)) [^]n. *) + apply eq_transitive_unfolded with ((cc_IR y[*] (r[+I*][--]One)) [^]n). + apply un_op_wd_unfolded. exact H0. + apply mult_nexp. + cut ( [--]y [=] y[*][--]One). intro. + (* Step_final (y[*]r) [+I*] (y[*][--]One). *) + apply eq_transitive_unfolded with (y[*]r[+I*]y[*][--]One). + apply I_wd. apply eq_reflexive_unfolded. exact H0. + apply eq_symmetric_unfolded. apply cc_IR_mult_rht. + (* Step_final [--] (y[*]One). *) + apply eq_transitive_unfolded with ( [--] (y[*]One)). + apply un_op_wd_unfolded. apply eq_symmetric_unfolded. apply mult_one. + apply eq_symmetric_unfolded. apply cring_inv_mult_lft. + cut ((y[*]r[+I*]y) [^]n [=] cc_IR y[^]n[*] (r[+I*]One) [^]n). intro. + (* Step_final ((cc_IR y) [^]n[*] (r[+I*]One) [^]n) [*] (CC_conj c). *) + apply eq_transitive_unfolded with (cc_IR y[^]n[*] (r[+I*]One) [^]n[*]CC_conj c). + apply bin_op_wd_unfolded. exact H. apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded. apply mult_assoc_unfolded. + cut (y[*]r[+I*]y [=] cc_IR y[*] (r[+I*]One)). intro. + (* Step_final ((cc_IR y) [*] (r[+I*]One)) [^]n. *) apply eq_transitive_unfolded with ((cc_IR y[*] (r[+I*]One)) [^]n). - apply un_op_wd_unfolded. exact H. - apply mult_nexp. -(* Step_final (y[*]r) [+I*] (y[*]One). *) - apply eq_transitive_unfolded with (y[*]r[+I*]y[*]One). + apply un_op_wd_unfolded. exact H. + apply mult_nexp. + (* Step_final (y[*]r) [+I*] (y[*]One). *) + apply eq_transitive_unfolded with (y[*]r[+I*]y[*]One). apply I_wd. apply eq_reflexive_unfolded. apply eq_symmetric_unfolded. - apply mult_one. - apply eq_symmetric_unfolded. apply cc_IR_mult_rht. + apply mult_one. + apply eq_symmetric_unfolded. apply cc_IR_mult_rht. Qed. Lemma nrCC4_a8 : (z[*]CC_conj z) [^]n [=] c[*]CC_conj c. -unfold z in |- *. -unfold nrCC4_z in |- *. -unfold c in |- *. -(* astepl (cc_IR x[^] (2) [+]y[^] (2)) [^]n. *) - apply eq_transitive_unfolded with (cc_IR (x[^]2[+]y[^]2) [^]n). +Proof. + unfold z in |- *. + unfold nrCC4_z in |- *. + unfold c in |- *. + (* astepl (cc_IR x[^] (2) [+]y[^] (2)) [^]n. *) + apply eq_transitive_unfolded with (cc_IR (x[^]2[+]y[^]2) [^]n). apply un_op_wd_unfolded. apply calculate_norm. -(* astepl (cc_IR (x[^] (2) [+]y[^] (2)) [^]n). *) + (* astepl (cc_IR (x[^] (2) [+]y[^] (2)) [^]n). *) apply eq_transitive_unfolded with (cc_IR ((x[^]2[+]y[^]2) [^]n)). apply cc_IR_nexp. -Hint Resolve nrCC4_a6: algebra. -(* Step_final (cc_IR (a[^] (2) [+]b[^] (2))). *) - apply eq_transitive_unfolded with (cc_IR (a[^]2[+]b[^]2)). + Hint Resolve nrCC4_a6: algebra. + (* Step_final (cc_IR (a[^] (2) [+]b[^] (2))). *) + apply eq_transitive_unfolded with (cc_IR (a[^]2[+]b[^]2)). apply cc_IR_wd. exact nrCC4_a6. apply eq_symmetric_unfolded. apply calculate_norm. Qed. Lemma nrCC4_a9 : z[^]n [=] c or z[^]n [=] [--]c. -apply nrootCC_2. -right. -(* astepl b. *) - apply ap_wdl_unfolded with b. - exact b_. - apply eq_reflexive_unfolded. -apply nrCC4_a8. -apply nrCC4_a7. +Proof. + apply nrootCC_2. + right. + (* astepl b. *) + apply ap_wdl_unfolded with b. + exact b_. + apply eq_reflexive_unfolded. + apply nrCC4_a8. + apply nrCC4_a7. Qed. End NRootCC_4_equations. Lemma nrCC4_a10 : forall c, {z : CC | z[^]n [=] c or z[^]n [=] [--]c} -> {z : CC | z[^]n [=] c}. -intros c0 H. -elim H. intros x H0. -elim H0; intro H1. -exists x. assumption. -exists ( [--]x). -(* astepl [--] (x[^]n). *) - apply eq_transitive_unfolded with ( [--] (x[^]n)). +Proof. + intros c0 H. + elim H. intros x H0. + elim H0; intro H1. + exists x. assumption. + exists ( [--]x). + (* astepl [--] (x[^]n). *) + apply eq_transitive_unfolded with ( [--] (x[^]n)). apply inv_nexp_odd. assumption. -(* Step_final [--][--]c0. *) + (* Step_final [--][--]c0. *) apply eq_transitive_unfolded with ( [--][--]c0). apply un_op_wd_unfolded. exact H1. apply cg_inv_inv. Qed. Lemma nrootCC_4_ap_real : {z : CC | z[^]n [=] c}. -apply nrCC4_a10. -elim nrCC4_a1. intro r. intro H. -elim (nrCC4_a1' (r[^]2[+]One) (a[^]2[+]b[^]2)). intro y2. intro H0. -exists (nrCC4_z r y2 H0). -apply nrCC4_a9. assumption. -change (r[^]2[+]One [#] Zero) in |- *. -apply pos_ap_zero. -apply nrCC4_a3. +Proof. + apply nrCC4_a10. + elim nrCC4_a1. intro r. intro H. + elim (nrCC4_a1' (r[^]2[+]One) (a[^]2[+]b[^]2)). intro y2. intro H0. + exists (nrCC4_z r y2 H0). + apply nrCC4_a9. assumption. + change (r[^]2[+]One [#] Zero) in |- *. + apply pos_ap_zero. + apply nrCC4_a3. Qed. End NRootCC_4_ap_real. @@ -1275,46 +1283,49 @@ Let b' := Im c'. (* end hide *) Lemma nrootCC_4_ap_real' : {z' : CC | z'[^]n [=] a'[+I*]b'}. -apply nrootCC_4_ap_real; try assumption. -apply (imag_to_real a b a' b'). -(* algebra. *) +Proof. + apply nrootCC_4_ap_real; try assumption. + apply (imag_to_real a b a' b'). + (* algebra. *) apply eq_reflexive_unfolded. -(* algebra. *) - exact a_. + (* algebra. *) + exact a_. Qed. Lemma nrootCC_4_ap_imag : {z : CC | z[^]n [=] a[+I*]b}. -elim nrootCC_4_ap_real'. -intro z'. -intro H. -exists (z'[*]nroot_minus_I n n_). -(* astepl z'[^]n[*] (nroot_minus_I n on) [^]n. *) - apply eq_transitive_unfolded with (z'[^]n[*]nroot_minus_I n n_[^]n). +Proof. + elim nrootCC_4_ap_real'. + intro z'. + intro H. + exists (z'[*]nroot_minus_I n n_). + (* astepl z'[^]n[*] (nroot_minus_I n on) [^]n. *) + apply eq_transitive_unfolded with (z'[^]n[*]nroot_minus_I n n_[^]n). apply mult_nexp. -Hint Resolve nroot_minus_I_nexp: algebra. -(* astepl (a'[+I*]b') [*][--]II. *) - apply eq_transitive_unfolded with ((a'[+I*]b') [*][--]II). + Hint Resolve nroot_minus_I_nexp: algebra. + (* astepl (a'[+I*]b') [*][--]II. *) + apply eq_transitive_unfolded with ((a'[+I*]b') [*][--]II). apply bin_op_wd_unfolded. exact H. apply nroot_minus_I_nexp. -(* astepl ((a[+I*]b) [*]II) [*][--]II. *) - apply eq_transitive_unfolded with ((a[+I*]b) [*]II[*][--]II). + (* astepl ((a[+I*]b) [*]II) [*][--]II. *) + apply eq_transitive_unfolded with ((a[+I*]b) [*]II[*][--]II). apply eq_reflexive_unfolded. -(* astepl (a[+I*]b) [*] (II[*][--]II). *) - apply eq_transitive_unfolded with ((a[+I*]b) [*] (II[*][--]II)). + (* astepl (a[+I*]b) [*] (II[*][--]II). *) + apply eq_transitive_unfolded with ((a[+I*]b) [*] (II[*][--]II)). apply eq_symmetric_unfolded. apply mult_assoc_unfolded. -(* Step_final (a[+I*]b) [*]One. *) + (* Step_final (a[+I*]b) [*]One. *) apply eq_transitive_unfolded with ((a[+I*]b) [*]One). apply bin_op_wd_unfolded. apply eq_reflexive_unfolded. exact I_recip_rht. - apply mult_one. + apply mult_one. Qed. End NRootCC_4_ap_imag. Lemma nrootCC_4 : forall c, c [#] Zero -> forall n, odd n -> {z : CC | z[^]n [=] c}. -intros. -pattern c in |- *. -apply C_cc_ap_zero; try assumption; intros. -apply nrootCC_4_ap_imag; try assumption. -apply nrootCC_4_ap_real; try assumption. +Proof. + intros. + pattern c in |- *. + apply C_cc_ap_zero; try assumption; intros. + apply nrootCC_4_ap_imag; try assumption. + apply nrootCC_4_ap_real; try assumption. Qed. End NRootCC_4. @@ -1324,20 +1335,22 @@ End NRootCC_4. Section NRootCC_5. Lemma nrCC_5a2 : forall n : nat, double n = 2 * n. -intros. -unfold double in |- *. -unfold mult in |- *. -auto with arith. +Proof. + intros. + unfold double in |- *. + unfold mult in |- *. + auto with arith. Qed. Lemma nrCC_5a3 : forall (n : nat) (z : CC), (z[^]2) [^]n [=] z[^]double n. -intros. -(* astepl z[^] (mult (2) n). *) - apply eq_transitive_unfolded with (z[^] (2 * n)). +Proof. + intros. + (* astepl z[^] (mult (2) n). *) + apply eq_transitive_unfolded with (z[^] (2 * n)). apply nexp_mult. -rewrite <- nrCC_5a2. -(* algebra. *) - apply eq_reflexive_unfolded. + rewrite <- nrCC_5a2. + (* algebra. *) + apply eq_reflexive_unfolded. Qed. Hint Resolve nrCC_5a3: algebra. @@ -1349,34 +1362,36 @@ Variable c : CC. Hypothesis c_ : c [#] Zero. Lemma nrCC_5a4 : forall n, 0 < n -> {z : CC | z[^]n [=] c} -> {z : CC | z[^]double n [=] c}. -intros n H H0. -elim H0. intros x H1. -elim (nrootCC_1 x). intros x0 H2. -exists x0. -(* astepl (x0[^] (2)) [^]n. *) +Proof. + intros n H H0. + elim H0. intros x H1. + elim (nrootCC_1 x). intros x0 H2. + exists x0. + (* astepl (x0[^] (2)) [^]n. *) apply eq_transitive_unfolded with ((x0[^]2) [^]n). - apply eq_symmetric_unfolded. apply nrCC_5a3. -(* Step_final x[^]n. *) - apply eq_transitive_unfolded with (x[^]n). - apply un_op_wd_unfolded. exact H2. - exact H1. -apply (cs_un_op_strext _ (nexp_op (R:=CC) n)). -(* astepl c. *) - apply ap_wdl_unfolded with c. + apply eq_symmetric_unfolded. apply nrCC_5a3. + (* Step_final x[^]n. *) + apply eq_transitive_unfolded with (x[^]n). + apply un_op_wd_unfolded. exact H2. + exact H1. + apply (cs_un_op_strext _ (nexp_op (R:=CC) n)). + (* astepl c. *) + apply ap_wdl_unfolded with c. 2: apply eq_symmetric_unfolded. 2: exact H1. -(* astepr (Zero::CC). *) + (* astepr (Zero::CC). *) apply ap_wdr_unfolded with (Zero:CC). exact c_. - apply eq_symmetric_unfolded. apply zero_nexp. exact H. + apply eq_symmetric_unfolded. apply zero_nexp. exact H. Qed. Lemma nrootCC_5 : forall n : nat, 0 < n -> {z : CC | z[^]n [=] c}. -intros. -pattern n in |- *. -apply odd_double_ind. -exact (nrootCC_4 c c_). -exact nrCC_5a4. -assumption. +Proof. + intros. + pattern n in |- *. + apply odd_double_ind. + exact (nrootCC_4 c c_). + exact nrCC_5a4. + assumption. Qed. End NRootCC_5. diff --git a/coq_reals/Rreals.v b/coq_reals/Rreals.v index 8bb7b4748..ff998d99c 100644 --- a/coq_reals/Rreals.v +++ b/coq_reals/Rreals.v @@ -39,7 +39,7 @@ Require Import Fourier. module will give you classical logic, the axioms of Coq's real number structure, plus all the logical consquences of these axioms. To avoid these consequences, use CoRN's real number structure [IR] instead. - + Here we show that the real numbers from the Coq standard library form a real number structure. This is done in the usual way by building up the algebraic heirarchy. *) @@ -47,39 +47,40 @@ Require Import Fourier. (** ** Coq real numbers form a setoid *) Lemma R_is_CSetoid: is_CSetoid R (@eq R) (fun x y : R => x <> y). -constructor. -unfold irreflexive. -intros x H. -apply H; reflexivity. -unfold Csymmetric. -intros x y H. -auto. -unfold cotransitive. -intros x y H z. -elim (total_order_T x z); intro H1. -elim H1; intro H2. -left. -apply Rlt_not_eq; assumption. -right. -rewrite <- H2. -assumption. -left. -apply Rgt_not_eq; assumption. -unfold tight_apart. -intros x y. -constructor. -intro xy. -elim (total_order_T x y); intro H1. -elim H1; clear H1; intro H2. -elimtype False. -apply xy. -apply Rlt_not_eq; assumption. -assumption. -elimtype False. -apply xy. -apply Rgt_not_eq; assumption. -intros H H0. -apply H0; assumption. +Proof. + constructor. + unfold irreflexive. + intros x H. + apply H; reflexivity. + unfold Csymmetric. + intros x y H. + auto. + unfold cotransitive. + intros x y H z. + elim (total_order_T x z); intro H1. + elim H1; intro H2. + left. + apply Rlt_not_eq; assumption. + right. + rewrite <- H2. + assumption. + left. + apply Rgt_not_eq; assumption. + unfold tight_apart. + intros x y. + constructor. + intro xy. + elim (total_order_T x y); intro H1. + elim H1; clear H1; intro H2. + elimtype False. + apply xy. + apply Rlt_not_eq; assumption. + assumption. + elimtype False. + apply xy. + apply Rgt_not_eq; assumption. + intros H H0. + apply H0; assumption. Qed. Definition RCSetoid : CSetoid := Build_CSetoid R (@eq R) (fun x y => x <> y) R_is_CSetoid. @@ -91,30 +92,32 @@ Canonical Structure RSetoid := cs_crr RCSetoid. (** addition *) Lemma RPlus_is_setoid_bin_fun: bin_fun_strext RCSetoid RCSetoid RCSetoid Rplus. -unfold bin_fun_strext. -intros x1 x2 y1 y2 H. -elim (total_order_T x1 x2); intro H1. -elim H1; clear H1; intro H2. -left. -apply: Rlt_not_eq; assumption. -right. -intro H0. -apply H. -rewrite H2. -rewrite H0. -reflexivity. -left. -apply: Rgt_not_eq; assumption. +Proof. + unfold bin_fun_strext. + intros x1 x2 y1 y2 H. + elim (total_order_T x1 x2); intro H1. + elim H1; clear H1; intro H2. + left. + apply: Rlt_not_eq; assumption. + right. + intro H0. + apply H. + rewrite H2. + rewrite H0. + reflexivity. + left. + apply: Rgt_not_eq; assumption. Qed. Definition RPlus_sbinfun : CSetoid_bin_op RCSetoid := Build_CSetoid_bin_op RCSetoid Rplus RPlus_is_setoid_bin_fun. Lemma R_is_CSemiGroup : is_CSemiGroup RCSetoid RPlus_sbinfun. -unfold is_CSemiGroup. -unfold associative. -intros x y z. -apply eq_symmetric. -apply Rplus_assoc. +Proof. + unfold is_CSemiGroup. + unfold associative. + intros x y z. + apply eq_symmetric. + apply Rplus_assoc. Qed. Definition RSemiGroup : CSemiGroup := Build_CSemiGroup RCSetoid RPlus_sbinfun R_is_CSemiGroup. @@ -123,12 +126,13 @@ Canonical Structure RSemiGroup. (** ** Coq real numbers form a monoid *) Lemma R_is_CMonoid : is_CMonoid RSemiGroup (0%R). -constructor. -unfold is_rht_unit. -intro x. -apply Rplus_0_r. -unfold is_lft_unit. -apply Rplus_0_l. +Proof. + constructor. + unfold is_rht_unit. + intro x. + apply Rplus_0_r. + unfold is_lft_unit. + apply Rplus_0_l. Qed. Definition RMonoid : CMonoid := Build_CMonoid _ _ R_is_CMonoid. @@ -139,22 +143,24 @@ Canonical Structure RMonoid. (** negation *) Lemma RNeg_sunop : fun_strext (S1:=RCSetoid) (S2:=RCSetoid) Ropp. -unfold fun_strext. -intros x y H H0. -apply H. -rewrite H0. -reflexivity. +Proof. + unfold fun_strext. + intros x y H H0. + apply H. + rewrite H0. + reflexivity. Qed. Definition RNeg_op : CSetoid_un_op RMonoid := Build_CSetoid_un_op RCSetoid Ropp RNeg_sunop. Lemma R_is_Group : is_CGroup RMonoid RNeg_op. -unfold is_CGroup. -intro x. -unfold is_inverse. -split. -apply Rplus_opp_r. -apply Rplus_opp_l. +Proof. + unfold is_CGroup. + intro x. + unfold is_inverse. + split. + apply Rplus_opp_r. + apply Rplus_opp_l. Qed. Definition RGroup := Build_CGroup _ _ R_is_Group. @@ -163,10 +169,11 @@ Canonical Structure RGroup. (** ** Coq real numbers form an abelian group *) Lemma R_is_AbGroup : is_CAbGroup RGroup. -unfold is_CAbGroup. -unfold commutes. -intros x y. -apply Rplus_comm. +Proof. + unfold is_CAbGroup. + unfold commutes. + intros x y. + apply Rplus_comm. Qed. Definition RAbGroup := Build_CAbGroup _ R_is_AbGroup. @@ -177,44 +184,47 @@ Canonical Structure RAbGroup. (** multiplication *) Lemma RMul_is_csbinop : bin_fun_strext RCSetoid RCSetoid RCSetoid Rmult. -unfold bin_fun_strext. -intros x1 x2 y1 y2 H. -elim (total_order_T x1 x2); intro H1. -elim H1; clear H1; intro H2. -left. -apply: Rlt_not_eq; assumption. -right. -Focus 2. -left. -apply: Rgt_not_eq; assumption. -intro H0. -apply H. -rewrite H0. -rewrite H2. -reflexivity. +Proof. + unfold bin_fun_strext. + intros x1 x2 y1 y2 H. + elim (total_order_T x1 x2); intro H1. + elim H1; clear H1; intro H2. + left. + apply: Rlt_not_eq; assumption. + right. + Focus 2. + left. + apply: Rgt_not_eq; assumption. + intro H0. + apply H. + rewrite H0. + rewrite H2. + reflexivity. Qed. Definition RMul_op : CSetoid_bin_op RMonoid := Build_CSetoid_bin_op RCSetoid Rmult RMul_is_csbinop. Lemma RMul_assoc : associative (S:=RAbGroup) RMul_op. -unfold associative. -intros x y z. -apply eq_symmetric. -apply Rmult_assoc. +Proof. + unfold associative. + intros x y z. + apply eq_symmetric. + apply Rmult_assoc. Qed. Lemma R_is_Ring : is_CRing RAbGroup (1%R) RMul_op. -exists RMul_assoc. -constructor. -unfold is_rht_unit; intro x. -apply Rmult_1_r. -unfold is_lft_unit; intro x. -apply Rmult_1_l. -unfold commutes. -apply Rmult_comm. -unfold distributive; intros x y z. -apply Rmult_plus_distr_l. -apply R1_neq_R0. +Proof. + exists RMul_assoc. + constructor. + unfold is_rht_unit; intro x. + apply Rmult_1_r. + unfold is_lft_unit; intro x. + apply Rmult_1_l. + unfold commutes. + apply Rmult_comm. + unfold distributive; intros x y z. + apply Rmult_plus_distr_l. + apply R1_neq_R0. Qed. Definition RRing := Build_CRing _ _ _ R_is_Ring. @@ -227,22 +237,24 @@ Canonical Structure RRing. Definition Rrecip : forall x : RRing, x [#] Zero -> RRing := fun x _ => Rinv x. Lemma R_is_Field : is_CField RRing Rrecip. -constructor. -apply Rinv_r. -assumption. -apply Rinv_l. -assumption. +Proof. + constructor. + apply Rinv_r. + assumption. + apply Rinv_l. + assumption. Qed. Lemma R_is_Field2: forall (x y : RRing) (x_ : x[#]Zero) (y_ : y[#]Zero), Rrecip x x_[#]Rrecip y y_ -> x[#]y. -intros x y x1 y1 H. -intro. -apply H. -clear H. -unfold Rrecip. -rewrite H0. -trivial. +Proof. + intros x y x1 y1 H. + intro. + apply H. + clear H. + unfold Rrecip. + rewrite H0. + trivial. Qed. Definition RField : CField := Build_CField _ _ R_is_Field R_is_Field2. @@ -253,32 +265,33 @@ Canonical Structure RField. (** less-than *) Lemma Rlt_strext : Crel_strext RField Rlt. -unfold Crel_strext. -intros x1 x2 y1 y2 H. -elim (total_order_T x2 y2); intro H1. -elim H1; clear H1; intro H2. -left; assumption. -right. -elim (total_order_T x1 x2); intro H1. -elim H1; clear H1; intro H3. -left. -apply: Rlt_not_eq; assumption. -right. -rewrite <- H2. -rewrite <- H3. -apply: Rgt_not_eq; assumption. -left. -apply: Rgt_not_eq; assumption. -right. -elim (total_order_T x1 x2); intro H2. -elim H2; clear H2; intro H3. -left; apply: Rlt_not_eq; assumption. -right. -apply: Rgt_not_eq. -apply Rgt_trans with x1. -assumption. -rewrite H3; assumption. -left; apply: Rgt_not_eq; assumption. +Proof. + unfold Crel_strext. + intros x1 x2 y1 y2 H. + elim (total_order_T x2 y2); intro H1. + elim H1; clear H1; intro H2. + left; assumption. + right. + elim (total_order_T x1 x2); intro H1. + elim H1; clear H1; intro H3. + left. + apply: Rlt_not_eq; assumption. + right. + rewrite <- H2. + rewrite <- H3. + apply: Rgt_not_eq; assumption. + left. + apply: Rgt_not_eq; assumption. + right. + elim (total_order_T x1 x2); intro H2. + elim H2; clear H2; intro H3. + left; apply: Rlt_not_eq; assumption. + right. + apply: Rgt_not_eq. + apply Rgt_trans with x1. + assumption. + rewrite H3; assumption. + left; apply: Rgt_not_eq; assumption. Qed. Definition Rless_rel : CCSetoid_relation RField := Build_CCSetoid_relation RField Rlt Rlt_strext. @@ -286,45 +299,47 @@ Definition Rless_rel : CCSetoid_relation RField := Build_CCSetoid_relation RFiel (** greater-than *) Lemma Rgt_strext : Crel_strext RField Rgt. -intros x1 x2 y1 y2. -pose (G := Rlt_strext y1 y2 x1 x2). -tauto. +Proof. + intros x1 x2 y1 y2. + pose (G := Rlt_strext y1 y2 x1 x2). + tauto. Qed. Definition Rgt_rel : CCSetoid_relation RField := Build_CCSetoid_relation RField Rgt Rgt_strext. Lemma R_is_OrdField : is_COrdField RField Rless_rel Rle Rgt_rel Rge. -constructor. -constructor. -unfold Ctransitive. -apply Rlt_trans. -unfold CSetoids.antisymmetric. -apply Rlt_asym. -intros x y xy z. -apply Rplus_lt_compat_r. -assumption. -intros x y x0 y0. -apply Rmult_gt_0_compat; assumption. -intros x y. -constructor. -intro xy. -elim (total_order_T x y); intro H2. -elim H2; clear H2; intro H3. -left; assumption. -elimtype False; apply xy; assumption. -right; assumption. -intro H; destruct H. -apply: Rlt_not_eq; assumption. -apply: Rgt_not_eq; assumption. -intros x y. -simpl in *. -unfold Not; split. -intros; fourier. -intro. -apply Rnot_lt_le. -assumption. -auto with *. -auto with *. +Proof. + constructor. + constructor. + unfold Ctransitive. + apply Rlt_trans. + unfold CSetoids.antisymmetric. + apply Rlt_asym. + intros x y xy z. + apply Rplus_lt_compat_r. + assumption. + intros x y x0 y0. + apply Rmult_gt_0_compat; assumption. + intros x y. + constructor. + intro xy. + elim (total_order_T x y); intro H2. + elim H2; clear H2; intro H3. + left; assumption. + elimtype False; apply xy; assumption. + right; assumption. + intro H; destruct H. + apply: Rlt_not_eq; assumption. + apply: Rgt_not_eq; assumption. + intros x y. + simpl in *. + unfold Not; split. + intros; fourier. + intro. + apply Rnot_lt_le. + assumption. + auto with *. + auto with *. Qed. Definition ROrdField : COrdField := Build_COrdField _ _ _ _ _ R_is_OrdField. @@ -334,123 +349,126 @@ Canonical Structure ROrdField. Lemma cauchy_prop_cauchy_crit : (CauchySeq ROrdField) -> forall s : (nat -> ROrdField), (Cauchy_prop (R:=ROrdField) s) -> (Rseries.Cauchy_crit s). -intros x seq cprop. -unfold Cauchy_prop in cprop. -unfold Rseries.Cauchy_crit. -intros eps epsgt. -elim (cprop ((eps / 2 / 2)%R) (eps2_Rgt_R0 _ (eps2_Rgt_R0 _ epsgt))). -intros N NProp. -exists N. -intros n m ngt mgt. -assert (AbsSmall (eps / 2) ((seq n) - (seq m)) )%R. -stepr ((seq n - seq N) + (seq N - seq m))%R by (simpl; ring). -stepl (eps / 2 / 2 + eps / 2 / 2)%R by (simpl; field). -apply AbsSmall_plus. -apply NProp; assumption. -apply (AbsSmall_minus). -apply NProp; assumption. -destruct H. -unfold Rfunctions.R_dist. -apply Rabs_def1. -clear - H0 epsgt. -simpl in *. -fourier. -clear - H epsgt. -simpl in *. -fourier. +Proof. + intros x seq cprop. + unfold Cauchy_prop in cprop. + unfold Rseries.Cauchy_crit. + intros eps epsgt. + elim (cprop ((eps / 2 / 2)%R) (eps2_Rgt_R0 _ (eps2_Rgt_R0 _ epsgt))). + intros N NProp. + exists N. + intros n m ngt mgt. + assert (AbsSmall (eps / 2) ((seq n) - (seq m)) )%R. + stepr ((seq n - seq N) + (seq N - seq m))%R by (simpl; ring). + stepl (eps / 2 / 2 + eps / 2 / 2)%R by (simpl; field). + apply AbsSmall_plus. + apply NProp; assumption. + apply (AbsSmall_minus). + apply NProp; assumption. + destruct H. + unfold Rfunctions.R_dist. + apply Rabs_def1. + clear - H0 epsgt. + simpl in *. + fourier. + clear - H epsgt. + simpl in *. + fourier. Qed. (** limit *) Definition RLim : CauchySeq ROrdField -> ROrdField. -intro x. -elim x. -intros seq cprop. -cut (Rseries.Cauchy_crit seq). -intro crit. -elim (R_complete seq crit). -intros lim uncv. -exact lim. -apply (cauchy_prop_cauchy_crit x). -exact cprop. +Proof. + intro x. + elim x. + intros seq cprop. + cut (Rseries.Cauchy_crit seq). + intro crit. + elim (R_complete seq crit). + intros lim uncv. + exact lim. + apply (cauchy_prop_cauchy_crit x). + exact cprop. Defined. (** INR is isomorphic to nring *) Lemma R_INR_as_IR : forall n : nat, INR n = nring (R:=RRing) n. -induction n. -simpl; trivial. -induction n. -simpl; auto with *. -simpl in *. -rewrite IHn. -trivial. +Proof. + induction n. + simpl; trivial. + induction n. + simpl; auto with *. + simpl in *. + rewrite IHn. + trivial. Qed. Hint Rewrite R_INR_as_IR : RtoIR. Lemma RisReals : is_CReals ROrdField RLim. -constructor. -intros [s hs]. -unfold SeqLimit. -unfold RLim. -intros e e0. -simpl. -destruct (R_complete s ((cauchy_prop_cauchy_crit (Build_CauchySeq ROrdField s hs) s hs))). -unfold Rseries.Un_cv in u. -simpl in *. -destruct (hs (e/4)) as [N HN]. - simpl. - fourier. -exists N. -intros m Hm. -destruct (u (e/2)). - fourier. -set (z:=max x0 m). -rstepr (((s m[-]s N)[+](s N[-]s z))[+](s z[-]x)). - apply AbsSmall_eps_div_two. +Proof. + constructor. + intros [s hs]. + unfold SeqLimit. + unfold RLim. + intros e e0. + simpl. + destruct (R_complete s ((cauchy_prop_cauchy_crit (Build_CauchySeq ROrdField s hs) s hs))). + unfold Rseries.Un_cv in u. + simpl in *. + destruct (hs (e/4)) as [N HN]. + simpl. + fourier. + exists N. + intros m Hm. + destruct (u (e/2)). + fourier. + set (z:=max x0 m). + rstepr (((s m[-]s N)[+](s N[-]s z))[+](s z[-]x)). apply AbsSmall_eps_div_two. - stepl (e/4). - apply HN; auto. - change (e / 4 = e * / (0 + 1 + 1) * / (0 + 1 + 1)). + apply AbsSmall_eps_div_two. + stepl (e/4). + apply HN; auto. + change (e / 4 = e * / (0 + 1 + 1) * / (0 + 1 + 1)). + field. + apply AbsSmall_minus. + stepl (e/4). + unfold z. + apply HN; eauto with *. + change (e / 4 = e * / (0 + 1 + 1) * / (0 + 1 + 1)). + field. + assert (Hz:(z >= x0)%nat). + unfold z; eauto with *. + destruct (Rabs_def2 _ _ (H _ Hz)) as [A0 A1]. + stepl (e/2). + split; unfold cg_minus; simpl; auto with *. + change (e / 2 = e * / (0 + 1 + 1)). field. - apply AbsSmall_minus. - stepl (e/4). - unfold z. - apply HN; eauto with *. - change (e / 4 = e * / (0 + 1 + 1) * / (0 + 1 + 1)). - field. - assert (Hz:(z >= x0)%nat). - unfold z; eauto with *. - destruct (Rabs_def2 _ _ (H _ Hz)) as [A0 A1]. - stepl (e/2). - split; unfold cg_minus; simpl; auto with *. - change (e / 2 = e * / (0 + 1 + 1)). - field. - -intro x. -exists (Zabs_nat (up x)). -unfold Zabs_nat. -elim (archimed x). -destruct (up x); simpl. -intros; fourier. -unfold nat_of_P. -intros H _. -apply Rlt_le. -rewrite <- R_INR_as_IR. -auto. -intros I _. -cut (x < 0%R). -intro H; clear I. -rewrite <- R_INR_as_IR. -cut (0 <= INR (nat_of_P p)). -intro. -fourier. -apply pos_INR. -cut (0 <= INR (nat_of_P p)). -intro. -fourier. -apply pos_INR. + intro x. + exists (Zabs_nat (up x)). + unfold Zabs_nat. + elim (archimed x). + destruct (up x); simpl. + intros; fourier. + unfold nat_of_P. + intros H _. + apply Rlt_le. + rewrite <- R_INR_as_IR. + auto. + intros I _. + cut (x < 0%R). + intro H; clear I. + rewrite <- R_INR_as_IR. + cut (0 <= INR (nat_of_P p)). + intro. + fourier. + apply pos_INR. + cut (0 <= INR (nat_of_P p)). + intro. + fourier. + apply pos_INR. Qed. Definition RReals : CReals := Build_CReals ROrdField RLim RisReals. diff --git a/coq_reals/Rreals_iso.v b/coq_reals/Rreals_iso.v index 2b98b249b..d9118ae36 100644 --- a/coq_reals/Rreals_iso.v +++ b/coq_reals/Rreals_iso.v @@ -47,7 +47,7 @@ Require Import Exponential. these consequences, use CoRN's real number structure [IR] instead. All real number structures are isomorphic. This module uses this - isomorphis to create a rewrite database [RtoIR] for converting many + isomorphis to create a rewrite database [RtoIR] for converting many problems over [R] into problems over [IR] where constructive methods may be employed. *) @@ -55,130 +55,147 @@ Require Import Exponential. (** ** The isomorphism *) Lemma RIR_iso : Isomorphism RReals IR. -exact (Canonic_Isomorphism_between_CReals RReals IR). +Proof. + exact (Canonic_Isomorphism_between_CReals RReals IR). Qed. Definition RasIR : R -> IR := iso_map_lft _ _ RIR_iso. Definition IRasR : IR -> R := iso_map_rht _ _ RIR_iso. Lemma RasIRasR_id : forall (x:R), (IRasR (RasIR x)=x). -apply (inversity_rht _ _ RIR_iso). +Proof. + apply (inversity_rht _ _ RIR_iso). Qed. Lemma IRasRasIR_id : forall (x:IR), (RasIR (IRasR x)[=]x). -apply (inversity_lft _ _ RIR_iso). +Proof. + apply (inversity_lft _ _ RIR_iso). Qed. (** equality *) Lemma R_eq_as_IR : forall x y, (x = y -> RasIR x [=] RasIR y). -apply: map_wd_unfolded. +Proof. + apply: map_wd_unfolded. Qed. (** apartness *) Lemma R_eq_as_IR_back : forall x y, (RasIR x [=] RasIR y -> x = y). -intros x y H. -replace x with (IRasR (RasIR x)) by apply RasIRasR_id. -replace y with (IRasR (RasIR y)) by apply RasIRasR_id. -apply: map_wd_unfolded; assumption. +Proof. + intros x y H. + replace x with (IRasR (RasIR x)) by apply RasIRasR_id. + replace y with (IRasR (RasIR y)) by apply RasIRasR_id. + apply: map_wd_unfolded; assumption. Qed. Lemma R_ap_as_IR : forall x y, (RasIR x [#] RasIR y -> x <> y). -intros x y H. -replace x with (IRasR (RasIR x)) by apply RasIRasR_id. -replace y with (IRasR (RasIR y)) by apply RasIRasR_id. -change (IRasR (RasIR x) [#] IRasR (RasIR y)). -apply: map_pres_apartness; assumption. +Proof. + intros x y H. + replace x with (IRasR (RasIR x)) by apply RasIRasR_id. + replace y with (IRasR (RasIR y)) by apply RasIRasR_id. + change (IRasR (RasIR x) [#] IRasR (RasIR y)). + apply: map_pres_apartness; assumption. Qed. Lemma R_ap_as_IR_back : forall x y, (x <> y -> RasIR x [#] RasIR y). -intros x y H. -apply map_pres_apartness. -assumption. +Proof. + intros x y H. + apply map_pres_apartness. + assumption. Qed. Lemma IR_ap_as_R : forall x y, (x <> y -> RasIR x [#] RasIR y). -intro. -apply: map_pres_apartness. +Proof. + intro. + apply: map_pres_apartness. Qed. (** less-than *) Lemma R_lt_as_IR : forall x y, (RasIR x [<] RasIR y -> x < y). -intros x y H. -replace x with (IRasR (RasIR x)) by apply RasIRasR_id. -replace y with (IRasR (RasIR y)) by apply RasIRasR_id. -change (IRasR (RasIR x) [<] IRasR (RasIR y)). -apply: map_pres_less; assumption. +Proof. + intros x y H. + replace x with (IRasR (RasIR x)) by apply RasIRasR_id. + replace y with (IRasR (RasIR y)) by apply RasIRasR_id. + change (IRasR (RasIR x) [<] IRasR (RasIR y)). + apply: map_pres_less; assumption. Qed. Lemma R_lt_as_IR_back : forall x y, (x [<] y -> IRasR x < IRasR y). -intros x y H. -change (IRasR x [<] IRasR y). -apply: map_pres_less. -assumption. +Proof. + intros x y H. + change (IRasR x [<] IRasR y). + apply: map_pres_less. + assumption. Qed. Lemma IR_lt_as_R : forall x y, (x < y -> RasIR x [<] RasIR y). -intro. -apply: map_pres_less. +Proof. + intro. + apply: map_pres_less. Qed. Lemma IR_lt_as_R_back : forall x y, (IRasR x < IRasR y -> x [<] y). -intros. -stepl (RasIR (IRasR x)) by apply IRasRasIR_id. -stepr (RasIR (IRasR y)) by apply IRasRasIR_id. -apply map_pres_less. -assumption. +Proof. + intros. + stepl (RasIR (IRasR x)) by apply IRasRasIR_id. + stepr (RasIR (IRasR y)) by apply IRasRasIR_id. + apply map_pres_less. + assumption. Qed. (** le *) Lemma R_le_as_IR : forall x y, (RasIR x [<=] RasIR y -> x <= y). -intros x y H. -cut (~ (y < x)). -apply Rnot_lt_le. -intro xy. -move:H. rewrite leEq_def. apply. -apply IR_lt_as_R. -assumption. +Proof. + intros x y H. + cut (~ (y < x)). + apply Rnot_lt_le. + intro xy. + move:H. rewrite leEq_def. apply. + apply IR_lt_as_R. + assumption. Qed. Lemma IR_le_as_R : forall x y, (x <= y -> RasIR x [<=] RasIR y). -intros x y H. -rewrite leEq_def. -intro xy. -assert (~ (y < x)). -apply RIneq.Rle_not_lt; assumption . -apply H0. -apply R_lt_as_IR. -assumption. +Proof. + intros x y H. + rewrite leEq_def. + intro xy. + assert (~ (y < x)). + apply RIneq.Rle_not_lt; assumption . + apply H0. + apply R_lt_as_IR. + assumption. Qed. Lemma IR_le_as_R_back : forall x y, (IRasR x <= IRasR y -> x [<=] y). -intros. -rewrite leEq_def. -intro xy. -cut (~ (IRasR y < IRasR x)); intro. -apply H0. -apply R_lt_as_IR. -stepl y by rewrite IRasRasIR_id; reflexivity. -stepr x by rewrite IRasRasIR_id; reflexivity. -assumption . -apply (RIneq.Rle_not_lt (IRasR y) (IRasR x)). -assumption. -assumption. +Proof. + intros. + rewrite leEq_def. + intro xy. + cut (~ (IRasR y < IRasR x)); intro. + apply H0. + apply R_lt_as_IR. + stepl y by rewrite IRasRasIR_id; reflexivity. + stepr x by rewrite IRasRasIR_id; reflexivity. + assumption . + apply (RIneq.Rle_not_lt (IRasR y) (IRasR x)). + assumption. + assumption. Qed. (** zero *) Lemma R_Zero_as_IR : (RasIR R0 [=] Zero). -apply map_pres_zero_unfolded. +Proof. + apply map_pres_zero_unfolded. Qed. Lemma IR_Zero_as_R : (IRasR Zero = 0). -apply: map_pres_zero_unfolded. +Proof. + apply: map_pres_zero_unfolded. Qed. Hint Rewrite R_Zero_as_IR : RtoIR. @@ -186,31 +203,36 @@ Hint Rewrite R_Zero_as_IR : RtoIR. (** one *) Lemma R_One_as_IR : (RasIR R1 [=] One). -apply map_pres_one_unfolded. +Proof. + apply map_pres_one_unfolded. Qed. Hint Rewrite R_One_as_IR : RtoIR. Lemma IR_One_as_R : (IRasR One = R1). -apply: map_pres_one_unfolded. +Proof. + apply: map_pres_one_unfolded. Qed. (** addition *) Lemma R_plus_as_IR : forall x y, (RasIR (x+y) [=] RasIR x [+] RasIR y). -apply: map_pres_plus. +Proof. + apply: map_pres_plus. Qed. Hint Rewrite R_plus_as_IR : RtoIR. Lemma IR_plus_as_R : forall x y, (IRasR (x[+]y) [=] IRasR x + IRasR y). -apply: map_pres_plus_unfolded. +Proof. + apply: map_pres_plus_unfolded. Qed. (** negation *) Lemma R_opp_as_IR : forall x, (RasIR (- x) [=] ([--] (RasIR x))). -apply: map_pres_minus. +Proof. + apply: map_pres_minus. Qed. Hint Rewrite R_opp_as_IR : RtoIR. @@ -218,11 +240,12 @@ Hint Rewrite R_opp_as_IR : RtoIR. (** subtraction *) Lemma R_minus_as_IR : forall x y, (RasIR (x-y) [=] RasIR x [-] RasIR y). -intros x y. -unfold cg_minus. -rewrite <- R_opp_as_IR. -rewrite <- R_plus_as_IR. -reflexivity. +Proof. + intros x y. + unfold cg_minus. + rewrite <- R_opp_as_IR. + rewrite <- R_plus_as_IR. + reflexivity. Qed. Hint Rewrite R_minus_as_IR : RtoIR. @@ -230,25 +253,27 @@ Hint Rewrite R_minus_as_IR : RtoIR. (** multiplication *) Lemma R_mult_as_IR : forall x y, (RasIR (x*y) [=] RasIR x [*] RasIR y). -apply: map_pres_mult. +Proof. + apply: map_pres_mult. Qed. Hint Rewrite R_mult_as_IR : RtoIR. (** reciprocal *) Lemma R_recip_as_IR : forall y Hy, (RasIR (1 / y) [=] (One [/] RasIR y [//] Hy)). -intros y Hy. -simpl in Hy. -assert (y [#] 0)%R. -apply: R_ap_as_IR. -stepr (Zero:IR). assumption. -symmetry. -apply R_Zero_as_IR. -change (1/y) with (One [/] y [//] X). -eapply eq_transitive. -unfold RasIR. -apply (map_pres_inv_unfolded RReals IR). -apply div_wd; reflexivity. +Proof. + intros y Hy. + simpl in Hy. + assert (y [#] 0)%R. + apply: R_ap_as_IR. + stepr (Zero:IR). assumption. + symmetry. + apply R_Zero_as_IR. + change (1/y) with (One [/] y [//] X). + eapply eq_transitive. + unfold RasIR. + apply (map_pres_inv_unfolded RReals IR). + apply div_wd; reflexivity. Qed. Hint Rewrite R_recip_as_IR : RtoIR. @@ -256,37 +281,39 @@ Hint Rewrite R_recip_as_IR : RtoIR. (** division *) Lemma R_div_as_IR : forall x y Hy, (RasIR (x/y) [=] (RasIR x [/] RasIR y [//] Hy)). -intros x y Hy. -unfold Rdiv. -rewrite R_mult_as_IR. -rstepr ((RasIR x) [*] (One [/]RasIR y[//]Hy)). -replace (/ y) with (1 / y). -rewrite <- R_recip_as_IR; reflexivity. -unfold Rdiv. -ring. +Proof. + intros x y Hy. + unfold Rdiv. + rewrite R_mult_as_IR. + rstepr ((RasIR x) [*] (One [/]RasIR y[//]Hy)). + replace (/ y) with (1 / y). + rewrite <- R_recip_as_IR; reflexivity. + unfold Rdiv. + ring. Qed. (** absolute value *) Lemma R_abs_as_IR : forall x, RasIR (Rabs x) [=] AbsIR (RasIR x). -intro x. -unfold Rabs. -destruct (Rcase_abs x) as [Hx | Hx]. -cut (RasIR x[<=]Zero). -intro Hxn. -rewrite (AbsIR_eq_inv_x (RasIR x) Hxn). -autorewrite with RtoIR; reflexivity. -stepr (RasIR 0) by apply R_Zero_as_IR. -apply less_leEq. -apply IR_lt_as_R. -assumption. -cut (Zero [<=] RasIR x). -intro Hxn. -rewrite (AbsIR_eq_x _ Hxn). -reflexivity. -stepl (RasIR 0) by apply R_Zero_as_IR. -apply IR_le_as_R. -fourier. +Proof. + intro x. + unfold Rabs. + destruct (Rcase_abs x) as [Hx | Hx]. + cut (RasIR x[<=]Zero). + intro Hxn. + rewrite (AbsIR_eq_inv_x (RasIR x) Hxn). + autorewrite with RtoIR; reflexivity. + stepr (RasIR 0) by apply R_Zero_as_IR. + apply less_leEq. + apply IR_lt_as_R. + assumption. + cut (Zero [<=] RasIR x). + intro Hxn. + rewrite (AbsIR_eq_x _ Hxn). + reflexivity. + stepl (RasIR 0) by apply R_Zero_as_IR. + apply IR_le_as_R. + fourier. Qed. Hint Rewrite R_abs_as_IR : RtoIR. @@ -294,150 +321,151 @@ Hint Rewrite R_abs_as_IR : RtoIR. Lemma R_sum_as_IR : forall a m, RasIR (sum_f_R0 a m) [=] (seq_part_sum (fun i : nat => RasIR (a i)) (S m)). -intros a m. -induction m. -simpl. -rational. -simpl. -autorewrite with RtoIR. -rewrite IHm. -simpl. -reflexivity. +Proof. + intros a m. + induction m. + simpl. + rational. + simpl. + autorewrite with RtoIR. + rewrite IHm. + simpl. + reflexivity. Qed. (** infinite sum *) Lemma R_infsum_as_IR_convergent : forall (y: R) a, infinit_sum a y -> convergent (fun i : nat => RasIR (a i)). -unfold infinit_sum. -unfold convergent. -intros y a conv. -assert (cauchy := CV_Cauchy _ (exist _ y conv)). -clear conv. -unfold Cauchy_crit in cauchy. -unfold Cauchy_prop. -intros e e0. -pose (new_e0 := R_lt_as_IR_back _ _ e0). -rewrite -> IR_Zero_as_R in new_e0. -assert (sig (fun N => - forall n m : nat, - (n >= N)%nat -> - (m >= N)%nat -> R_dist (sum_f_R0 a n) (sum_f_R0 a m) < IRasR e -)). -apply constructive_indefinite_description_nat. -intros N. -apply forall_dec. -intros n0. -apply forall_dec. -intros n1. -apply imp_dec. -unfold ge. -destruct (le_gt_dec N n0). -left; auto with *. -right; auto with *. -apply imp_dec. -destruct (le_gt_dec N n1). -left; auto with *. -right; auto with *. -apply Rlt_dec. -apply cauchy. -auto with *. -destruct H as [N HN]. -exists (S N). -intros m Hm. -assert (N <= pred m)%nat. -auto with *. -assert (HH := HN (pred m) N H (le_refl N)). -clear - HH Hm. -destruct m. -elimtype False. -auto with *. -rewrite <- R_sum_as_IR. -rewrite <- R_sum_as_IR. -rewrite <- R_minus_as_IR. -apply AbsIR_imp_AbsSmall. -stepl (RasIR (Rabs(sum_f_R0 a m - sum_f_R0 a N))) by apply R_abs_as_IR. -apply less_leEq. -unfold R_dist in HH. -stepr (RasIR (IRasR e)) by apply IRasRasIR_id. -apply IR_lt_as_R. -assumption. +Proof. + unfold infinit_sum. + unfold convergent. + intros y a conv. + assert (cauchy := CV_Cauchy _ (exist _ y conv)). + clear conv. + unfold Cauchy_crit in cauchy. + unfold Cauchy_prop. + intros e e0. + pose (new_e0 := R_lt_as_IR_back _ _ e0). + rewrite -> IR_Zero_as_R in new_e0. + assert (sig (fun N => forall n m : nat, (n >= N)%nat -> + (m >= N)%nat -> R_dist (sum_f_R0 a n) (sum_f_R0 a m) < IRasR e )). + apply constructive_indefinite_description_nat. + intros N. + apply forall_dec. + intros n0. + apply forall_dec. + intros n1. + apply imp_dec. + unfold ge. + destruct (le_gt_dec N n0). + left; auto with *. + right; auto with *. + apply imp_dec. + destruct (le_gt_dec N n1). + left; auto with *. + right; auto with *. + apply Rlt_dec. + apply cauchy. + auto with *. + destruct H as [N HN]. + exists (S N). + intros m Hm. + assert (N <= pred m)%nat. + auto with *. + assert (HH := HN (pred m) N H (le_refl N)). + clear - HH Hm. + destruct m. + elimtype False. + auto with *. + rewrite <- R_sum_as_IR. + rewrite <- R_sum_as_IR. + rewrite <- R_minus_as_IR. + apply AbsIR_imp_AbsSmall. + stepl (RasIR (Rabs(sum_f_R0 a m - sum_f_R0 a N))) by apply R_abs_as_IR. + apply less_leEq. + unfold R_dist in HH. + stepr (RasIR (IRasR e)) by apply IRasRasIR_id. + apply IR_lt_as_R. + assumption. Qed. Lemma R_infsum_as_IR : forall (y: R) a, Rfunctions.infinit_sum a y -> forall prf, RasIR y [=] series_sum (fun i : nat => RasIR (a i)) prf. -intros y a Hay prf. -unfold series_sum. -unfold infinit_sum in *. -apply Limits_unique. -unfold Cauchy_Lim_prop2. -simpl. -clear prf. -intros e He. -assert (sig (fun N => - forall n : nat, (n >= N)%nat -> R_dist (sum_f_R0 a n) y < IRasR e -)). -apply constructive_indefinite_description_nat. -intros N. -apply forall_dec. -intros n0. -apply imp_dec. -unfold ge. -destruct (le_gt_dec N n0). -left; auto with *. -right; auto with *. -apply Rlt_dec. -apply (Hay). -unfold Rgt. -apply R_lt_as_IR. -stepl (Zero:IR) by symmetry;apply R_Zero_as_IR. -stepr (e) by symmetry; apply IRasRasIR_id. -assumption. -destruct H as [N HN]. -exists (S N). -intros m Hm. -assert (N <= pred m)%nat. -auto with *. -assert (HH := HN (pred m) H). -clear - HH Hm. -destruct m. -elimtype False. -auto with *. -rewrite <- R_sum_as_IR. -rewrite <- R_minus_as_IR. -apply AbsIR_imp_AbsSmall. -unfold R_dist in HH. -simpl in HH. -apply less_leEq. -stepl (RasIR (Rabs(sum_f_R0 a m - y))) by apply R_abs_as_IR. -stepr (RasIR (IRasR e)) by apply IRasRasIR_id. -apply IR_lt_as_R. -assumption. +Proof. + intros y a Hay prf. + unfold series_sum. + unfold infinit_sum in *. + apply Limits_unique. + unfold Cauchy_Lim_prop2. + simpl. + clear prf. + intros e He. + assert (sig (fun N => forall n : nat, (n >= N)%nat -> R_dist (sum_f_R0 a n) y < IRasR e )). + apply constructive_indefinite_description_nat. + intros N. + apply forall_dec. + intros n0. + apply imp_dec. + unfold ge. + destruct (le_gt_dec N n0). + left; auto with *. + right; auto with *. + apply Rlt_dec. + apply (Hay). + unfold Rgt. + apply R_lt_as_IR. + stepl (Zero:IR) by symmetry;apply R_Zero_as_IR. + stepr (e) by symmetry; apply IRasRasIR_id. + assumption. + destruct H as [N HN]. + exists (S N). + intros m Hm. + assert (N <= pred m)%nat. + auto with *. + assert (HH := HN (pred m) H). + clear - HH Hm. + destruct m. + elimtype False. + auto with *. + rewrite <- R_sum_as_IR. + rewrite <- R_minus_as_IR. + apply AbsIR_imp_AbsSmall. + unfold R_dist in HH. + simpl in HH. + apply less_leEq. + stepl (RasIR (Rabs(sum_f_R0 a m - y))) by apply R_abs_as_IR. + stepr (RasIR (IRasR e)) by apply IRasRasIR_id. + apply IR_lt_as_R. + assumption. Qed. Lemma R_infsum_f_as_IR : forall (x y: R) f, Rfunctions.infinit_sum (f x) y -> forall prf, RasIR y [=] series_sum (fun i : nat => RasIR (f x i)) prf. -intros x y f cprf rprf. -apply R_infsum_as_IR. -assumption. +Proof. + intros x y f cprf rprf. + apply R_infsum_as_IR. + assumption. Qed. (** factorial *) Lemma fac_fact : forall i, fac i = fact i. -reflexivity. +Proof. + reflexivity. Qed. Lemma R_nring_as_IR : forall i, RasIR (nring i) [=] nring i. -induction i. -simpl. -apply R_Zero_as_IR. -simpl. -autorewrite with RtoIR. -rewrite IHi. -reflexivity. +Proof. + induction i. + simpl. + apply R_Zero_as_IR. + simpl. + autorewrite with RtoIR. + rewrite IHi. + reflexivity. Qed. Hint Rewrite R_nring_as_IR : RtoIR. @@ -445,48 +473,48 @@ Hint Rewrite R_nring_as_IR : RtoIR. Lemma R_pow_as_IR : forall x i, RasIR (Rpow_def.pow x i)[=] nexp _ i (RasIR x). -intros x i. -induction i. -simpl. -apply R_One_as_IR. -simpl. -autorewrite with RtoIR. -rewrite IHi. -auto with *. +Proof. + intros x i. + induction i. + simpl. + apply R_One_as_IR. + simpl. + autorewrite with RtoIR. + rewrite IHi. + auto with *. Qed. Hint Rewrite R_pow_as_IR : RtoIR. Lemma R_exp_as_IR : forall x, RasIR (exp x) [=] Exp (RasIR x). -unfold exp. -unfold projT1. -intro x; case (exist_exp x). -unfold exp_in. -intros y rsums. -rewrite ( - R_infsum_f_as_IR x y ((fun x i => / INR (fact i) * Rpow_def.pow x i)) rsums - (R_infsum_as_IR_convergent _ _ rsums) -). -simpl. -apply series_sum_wd. -intro i. -autorewrite with RtoIR. -rewrite <- fac_fact. -replace (/ nring (fac i)) with (1 / nring (fac i)). -2: field; apply (nring_fac_ap_zero RReals i). -cut (Dom (f_rcpcl' IR) (RasIR (nring (R:=RRing) (fac i)))). -intro Hy. -rewrite (R_recip_as_IR (nring (fac i)) Hy). -clear. -rewrite (cg_inv_zero IR (RasIR x)). -apply mult_wdl. -apply div_wd. -reflexivity. -apply (R_nring_as_IR (fac i)). -simpl. -stepl (nring (R:=IR) (fac i)). -apply (nring_fac_ap_zero IR i). -symmetry. -apply (R_nring_as_IR). +Proof. + unfold exp. + unfold projT1. + intro x; case (exist_exp x). + unfold exp_in. + intros y rsums. + rewrite ( R_infsum_f_as_IR x y ((fun x i => / INR (fact i) * Rpow_def.pow x i)) rsums + (R_infsum_as_IR_convergent _ _ rsums) ). + simpl. + apply series_sum_wd. + intro i. + autorewrite with RtoIR. + rewrite <- fac_fact. + replace (/ nring (fac i)) with (1 / nring (fac i)). + 2: field; apply (nring_fac_ap_zero RReals i). + cut (Dom (f_rcpcl' IR) (RasIR (nring (R:=RRing) (fac i)))). + intro Hy. + rewrite (R_recip_as_IR (nring (fac i)) Hy). + clear. + rewrite (cg_inv_zero IR (RasIR x)). + apply mult_wdl. + apply div_wd. + reflexivity. + apply (R_nring_as_IR (fac i)). + simpl. + stepl (nring (R:=IR) (fac i)). + apply (nring_fac_ap_zero IR i). + symmetry. + apply (R_nring_as_IR). Qed. Hint Rewrite R_exp_as_IR : RtoIR. @@ -494,294 +522,283 @@ Hint Rewrite R_exp_as_IR : RtoIR. (** trigonometry *) Lemma R_cos_as_IR : forall x, RasIR (cos x) [=] Cos (RasIR x). -unfold cos. -intro x. -case (exist_cos (Rsqr x)). -unfold cos_in. -intros y rsums. -rewrite (R_infsum_f_as_IR x y (fun x i => cos_n i * Rsqr x ^ i) rsums - (R_infsum_as_IR_convergent _ _ rsums) -). -simpl. -unfold series_sum. -apply Lim_seq_eq_Lim_subseq with (fun n => 2*n)%nat. - intros; omega. - intros n; exists (S n); omega. -induction n. -reflexivity. -simpl in *. -rewrite IHn. -rewrite (plus_comm n (S (n + 0))). -simpl. -rstepr ( - seq_part_sum - (fun n0 : nat => - (cos_seq n0[/]nring (R:=IR) (fac n0)[//]nring_fac_ap_zero IR n0)[*] +Proof. + unfold cos. + intro x. + case (exist_cos (Rsqr x)). + unfold cos_in. + intros y rsums. + rewrite (R_infsum_f_as_IR x y (fun x i => cos_n i * Rsqr x ^ i) rsums + (R_infsum_as_IR_convergent _ _ rsums) ). + simpl. + unfold series_sum. + apply Lim_seq_eq_Lim_subseq with (fun n => 2*n)%nat. + intros; omega. + intros n; exists (S n); omega. + induction n. + reflexivity. + simpl in *. + rewrite IHn. + rewrite (plus_comm n (S (n + 0))). + simpl. + rstepr ( seq_part_sum (fun n0 : nat => + (cos_seq n0[/]nring (R:=IR) (fac n0)[//]nring_fac_ap_zero IR n0)[*] nexp IR n0 (RasIR x[-]Zero)) (n + 0 + n)[+] ( - (cos_seq (n + 0 + n)[/]nring (R:=IR) (fac (n + 0 + n))[//] - nring_fac_ap_zero IR (n + 0 + n))[*]nexp IR (n + 0 + n) (RasIR x[-]Zero)[+] - (cos_seq (S (n + 0 + n))[/] - nring (R:=IR) (fac (n + 0 + n) + (n + 0 + n) * fac (n + 0 + n))[//] - nring_fac_ap_zero IR (S (n + 0 + n)))[*] - (nexp IR (n + 0 + n) (RasIR x[-]Zero)[*](RasIR x[-]Zero))) -). -apply bin_op_wd_unfolded. -rewrite plus_comm. -reflexivity. -replace (n + 0 + n)%nat with (n + n)%nat by auto with *. -unfold Rsqr. -unfold cos_n. -simpl. -unfold cos_seq. -simpl. -destruct (even_or_odd_plus (n + n)). -destruct (even_or_odd_plus (S(n + n))). -simpl. -destruct s; [ | elimtype False; auto with *]. -destruct s0; simpl. -elimtype False; auto with *. -autorewrite with RtoIR. -stepr ( -(nexp IR x0 [--]One[/]nring (R:=IR) (fac (n + n))[//] - nring_fac_ap_zero IR (n + n))[*]nexp IR (n + n) (RasIR x[-]Zero) -). -apply bin_op_wd_unfolded. -replace (n + 0)%nat with n by auto with *. -assert (Dom (f_rcpcl' IR) (RasIR (nring (R:=RRing) (fact (n + n))))). -simpl. -stepr (RasIR 0) by apply R_Zero_as_IR. -apply R_ap_as_IR_back. -apply (nring_fac_ap_zero RReals (n + n)). -rewrite (R_div_as_IR ((-1)^n) (nring (R := RRing) (fact (n + n))) X). -apply div_wd. -autorewrite with RtoIR. -replace n with x0 by omega. -reflexivity. -autorewrite with RtoIR. -reflexivity. -clear. -induction n; simpl. -reflexivity. -rewrite IHn. -replace (n + S n)%nat with (S (n + n))%nat by auto with *. -simpl. -rstepr ( - nexp IR (n + n) (RasIR x[-]Zero)[*]((RasIR x[-]Zero)[*](RasIR x[-]Zero)) -). -apply bin_op_wd_unfolded. -reflexivity. -rational. -setoid_replace - ((Zero[/]nring (R:=IR) (fac (n + n) + (n + n) * fac (n + n))[//] - nring_fac_ap_zero IR (S (n + n)))[*] - (nexp IR (n + n) (RasIR x[-]Zero)[*](RasIR x[-]Zero))) - with (Zero:IR). -rational. -rational. + (cos_seq (n + 0 + n)[/]nring (R:=IR) (fac (n + 0 + n))[//] + nring_fac_ap_zero IR (n + 0 + n))[*]nexp IR (n + 0 + n) (RasIR x[-]Zero)[+] + (cos_seq (S (n + 0 + n))[/] + nring (R:=IR) (fac (n + 0 + n) + (n + 0 + n) * fac (n + 0 + n))[//] + nring_fac_ap_zero IR (S (n + 0 + n)))[*] + (nexp IR (n + 0 + n) (RasIR x[-]Zero)[*](RasIR x[-]Zero))) ). + apply bin_op_wd_unfolded. + rewrite plus_comm. + reflexivity. + replace (n + 0 + n)%nat with (n + n)%nat by auto with *. + unfold Rsqr. + unfold cos_n. + simpl. + unfold cos_seq. + simpl. + destruct (even_or_odd_plus (n + n)). + destruct (even_or_odd_plus (S(n + n))). + simpl. + destruct s; [ | elimtype False; auto with *]. + destruct s0; simpl. + elimtype False; auto with *. + autorewrite with RtoIR. + stepr ( (nexp IR x0 [--]One[/]nring (R:=IR) (fac (n + n))[//] + nring_fac_ap_zero IR (n + n))[*]nexp IR (n + n) (RasIR x[-]Zero) ). + apply bin_op_wd_unfolded. + replace (n + 0)%nat with n by auto with *. + assert (Dom (f_rcpcl' IR) (RasIR (nring (R:=RRing) (fact (n + n))))). + simpl. + stepr (RasIR 0) by apply R_Zero_as_IR. + apply R_ap_as_IR_back. + apply (nring_fac_ap_zero RReals (n + n)). + rewrite (R_div_as_IR ((-1)^n) (nring (R := RRing) (fact (n + n))) X). + apply div_wd. + autorewrite with RtoIR. + replace n with x0 by omega. + reflexivity. + autorewrite with RtoIR. + reflexivity. + clear. + induction n; simpl. + reflexivity. + rewrite IHn. + replace (n + S n)%nat with (S (n + n))%nat by auto with *. + simpl. + rstepr ( nexp IR (n + n) (RasIR x[-]Zero)[*]((RasIR x[-]Zero)[*](RasIR x[-]Zero)) ). + apply bin_op_wd_unfolded. + reflexivity. + rational. + setoid_replace ((Zero[/]nring (R:=IR) (fac (n + n) + (n + n) * fac (n + n))[//] + nring_fac_ap_zero IR (S (n + n)))[*] (nexp IR (n + n) (RasIR x[-]Zero)[*](RasIR x[-]Zero))) + with (Zero:IR). + rational. + rational. Qed. Hint Rewrite R_cos_as_IR : RtoIR. Lemma R_sin_as_IR : forall x, RasIR (sin x) [=] Sin (RasIR x). -unfold sin. -intro x. -case (exist_sin (Rsqr x)). -unfold sin_in. -intros y rsums. -rewrite R_mult_as_IR. -rewrite (R_infsum_f_as_IR x y (fun x i => sin_n i * Rsqr x ^ i) rsums - (R_infsum_as_IR_convergent _ _ rsums) -). -assert (convergent - (fun n : nat => - RasIR x[*](fun i : nat => RasIR (sin_n i * Rsqr x ^ i)) n)). -apply conv_series_mult_scal. -apply (R_infsum_as_IR_convergent _ _ rsums). -rewrite <- (series_sum_mult_scal (fun i : nat => RasIR (sin_n i * Rsqr x ^ i)) - (R_infsum_as_IR_convergent _ _ rsums) (RasIR x) X). -simpl. -unfold series_sum. -apply Lim_seq_eq_Lim_subseq with (fun n => 2*n)%nat. - intros; omega. - intros n; exists (S n); omega. -induction n. -reflexivity. -simpl in *. -rewrite IHn. -rewrite (plus_comm n (S (n + 0))). -simpl. -replace (n + 0 + n)%nat with (n + n)%nat by auto with *. -unfold sin_n. -simpl. -replace (n + 0)%nat with (n)%nat by auto with *. -unfold sin_seq at 3. -unfold sin_seq at 3. -simpl. -destruct (even_or_odd_plus (n + n)). -destruct (even_or_odd_plus (S(n + n))). -destruct s; [ | elimtype False; auto with *]. -destruct s0; simpl. -elimtype False; auto with *. - -rstepr ( -seq_part_sum - (fun n0 : nat => +Proof. + unfold sin. + intro x. + case (exist_sin (Rsqr x)). + unfold sin_in. + intros y rsums. + rewrite R_mult_as_IR. + rewrite (R_infsum_f_as_IR x y (fun x i => sin_n i * Rsqr x ^ i) rsums + (R_infsum_as_IR_convergent _ _ rsums) ). + assert (convergent (fun n : nat => RasIR x[*](fun i : nat => RasIR (sin_n i * Rsqr x ^ i)) n)). + apply conv_series_mult_scal. + apply (R_infsum_as_IR_convergent _ _ rsums). + rewrite <- (series_sum_mult_scal (fun i : nat => RasIR (sin_n i * Rsqr x ^ i)) + (R_infsum_as_IR_convergent _ _ rsums) (RasIR x) X). + simpl. + unfold series_sum. + apply Lim_seq_eq_Lim_subseq with (fun n => 2*n)%nat. + intros; omega. + intros n; exists (S n); omega. + induction n. + reflexivity. + simpl in *. + rewrite IHn. + rewrite (plus_comm n (S (n + 0))). + simpl. + replace (n + 0 + n)%nat with (n + n)%nat by auto with *. + unfold sin_n. + simpl. + replace (n + 0)%nat with (n)%nat by auto with *. + unfold sin_seq at 3. + unfold sin_seq at 3. + simpl. + destruct (even_or_odd_plus (n + n)). + destruct (even_or_odd_plus (S(n + n))). + destruct s; [ | elimtype False; auto with *]. + destruct s0; simpl. + elimtype False; auto with *. + rstepr ( seq_part_sum (fun n0 : nat => (sin_seq n0[/]nring (R:=IR) (fac n0)[//]nring_fac_ap_zero IR n0)[*] - nexp IR n0 (RasIR x[-]Zero)) (n + n)[+]( -(Zero[/]nring (R:=IR) (fac (n + n))[//]nring_fac_ap_zero IR (n + n))[*] -nexp IR (n + n) (RasIR x[-]Zero)[+] -(nexp IR x1 [--]One[/]nring (R:=IR) (fac (n + n) + (n + n) * fac (n + n))[//] - nring_fac_ap_zero IR (S (n + n)))[*] -(nexp IR (n + n) (RasIR x[-]Zero)[*](RasIR x[-]Zero))) -). -apply bin_op_wd_unfolded. -reflexivity. -setoid_replace (RasIR x [-] Zero) with (RasIR x);[|rational]. -replace x1 with n by omega. -clear. - -setoid_replace ((Zero[/]nring (R:=IR) (fac (n + n))[//]nring_fac_ap_zero IR (n + n))[*] -nexp IR (n + n) (RasIR x)) with (Zero:IR);[|rational]. -rstepr ( -RasIR x [*] ( -(nexp IR n [--]One[/]nring (R:=IR) (fac (n + n) + (n + n) * fac (n + n))[//] - nring_fac_ap_zero IR (S (n + n)))[*](nexp IR (n + n) (RasIR x))) -). -apply bin_op_wd_unfolded. -reflexivity. -autorewrite with RtoIR. -unfold Rsqr. -apply bin_op_wd_unfolded. -cut (Dom (f_rcpcl' IR) (RasIR (nring (R:=RRing) (fact (n + n + 1))))). -intro X. -rewrite (R_div_as_IR ((-1)^n) (nring (R:=RRing) (fact (n + n + 1))) X). -apply div_wd. -autorewrite with RtoIR; reflexivity. -autorewrite with RtoIR. -apply nring_wd. -rewrite <- fac_fact. -replace (n + n + 1)%nat with (S (n + n)) by omega. -simpl. -reflexivity. -simpl. -stepr (RasIR 0) by apply R_Zero_as_IR. -apply R_ap_as_IR_back. -apply (nring_fac_ap_zero RReals (n + n + 1)). -induction n; simpl. -reflexivity. -replace (n + S n)%nat with (S(n + n)) by omega. -simpl. -rewrite IHn. -autorewrite with RtoIR. -rational. + nexp IR n0 (RasIR x[-]Zero)) (n + n)[+]( + (Zero[/]nring (R:=IR) (fac (n + n))[//]nring_fac_ap_zero IR (n + n))[*] + nexp IR (n + n) (RasIR x[-]Zero)[+] + (nexp IR x1 [--]One[/]nring (R:=IR) (fac (n + n) + (n + n) * fac (n + n))[//] + nring_fac_ap_zero IR (S (n + n)))[*] + (nexp IR (n + n) (RasIR x[-]Zero)[*](RasIR x[-]Zero))) ). + apply bin_op_wd_unfolded. + reflexivity. + setoid_replace (RasIR x [-] Zero) with (RasIR x);[|rational]. + replace x1 with n by omega. + clear. + setoid_replace ((Zero[/]nring (R:=IR) (fac (n + n))[//]nring_fac_ap_zero IR (n + n))[*] + nexp IR (n + n) (RasIR x)) with (Zero:IR);[|rational]. + rstepr ( RasIR x [*] ( (nexp IR n [--]One[/]nring (R:=IR) (fac (n + n) + (n + n) * fac (n + n))[//] + nring_fac_ap_zero IR (S (n + n)))[*](nexp IR (n + n) (RasIR x))) ). + apply bin_op_wd_unfolded. + reflexivity. + autorewrite with RtoIR. + unfold Rsqr. + apply bin_op_wd_unfolded. + cut (Dom (f_rcpcl' IR) (RasIR (nring (R:=RRing) (fact (n + n + 1))))). + intro X. + rewrite (R_div_as_IR ((-1)^n) (nring (R:=RRing) (fact (n + n + 1))) X). + apply div_wd. + autorewrite with RtoIR; reflexivity. + autorewrite with RtoIR. + apply nring_wd. + rewrite <- fac_fact. + replace (n + n + 1)%nat with (S (n + n)) by omega. + simpl. + reflexivity. + simpl. + stepr (RasIR 0) by apply R_Zero_as_IR. + apply R_ap_as_IR_back. + apply (nring_fac_ap_zero RReals (n + n + 1)). + induction n; simpl. + reflexivity. + replace (n + S n)%nat with (S(n + n)) by omega. + simpl. + rewrite IHn. + autorewrite with RtoIR. + rational. Qed. Hint Rewrite R_sin_as_IR : RtoIR. Lemma R_tan_as_IR : forall x dom, RasIR (tan x) [=] Tan (RasIR x) dom. -intros x dom. -unfold tan. -cut (Dom (f_rcpcl' IR) (RasIR (cos x))). -intro Hdiv. -rewrite (R_div_as_IR (sin x) (cos x) Hdiv). -cut (Dom (f_rcpcl' IR) (Cos (RasIR x))). -intro ndom. -stepl (Sin(RasIR x) [/] Cos(RasIR x) [//] ndom). -unfold Tan. -unfold Tang. -apply: div_wd. -apply: pfwdef. -reflexivity. -apply: pfwdef. -reflexivity. -apply div_wd. -symmetry; apply R_sin_as_IR. -symmetry; apply R_cos_as_IR. -unfold pfdom,f_rcpcl' in *. -stepl (RasIR (cos x)) by apply R_cos_as_IR. -assumption. -unfold pfdom,f_rcpcl', Tang,Fdiv in *. -destruct dom. -destruct e. -stepl (Cos (RasIR x)) by symmetry; apply R_cos_as_IR. -apply: c. +Proof. + intros x dom. + unfold tan. + cut (Dom (f_rcpcl' IR) (RasIR (cos x))). + intro Hdiv. + rewrite (R_div_as_IR (sin x) (cos x) Hdiv). + cut (Dom (f_rcpcl' IR) (Cos (RasIR x))). + intro ndom. + stepl (Sin(RasIR x) [/] Cos(RasIR x) [//] ndom). + unfold Tan. + unfold Tang. + apply: div_wd. + apply: pfwdef. + reflexivity. + apply: pfwdef. + reflexivity. + apply div_wd. + symmetry; apply R_sin_as_IR. + symmetry; apply R_cos_as_IR. + unfold pfdom,f_rcpcl' in *. + stepl (RasIR (cos x)) by apply R_cos_as_IR. + assumption. + unfold pfdom,f_rcpcl', Tang,Fdiv in *. + destruct dom. + destruct e. + stepl (Cos (RasIR x)) by symmetry; apply R_cos_as_IR. + apply: c. Qed. Add Morphism RasIR with signature (@cs_eq _) ==> (@cs_eq _) as R_as_IR_wd. -intros. -rewrite H. -reflexivity. +Proof. + intros. + rewrite H. + reflexivity. Qed. (** logarithm *) Lemma R_ln_as_IR : forall x prf, RasIR (ln x) [=] Log (RasIR x) prf. -intros x prf. -apply Exp_cancel. -rewrite Exp_Log. -rewrite <- R_exp_as_IR. -apply R_as_IR_wd. -apply exp_ln. -apply R_lt_as_IR. -stepl (Zero:IR) by symmetry; apply R_Zero_as_IR. -assumption. +Proof. + intros x prf. + apply Exp_cancel. + rewrite Exp_Log. + rewrite <- R_exp_as_IR. + apply R_as_IR_wd. + apply exp_ln. + apply R_lt_as_IR. + stepl (Zero:IR) by symmetry; apply R_Zero_as_IR. + assumption. Qed. (** integers *) Lemma R_pring_as_IR : forall x, RasIR (pring _ x) [=] pring _ x. -intro x. -(*rewrite pring_convert.*) -stepr (nring (R := IR) (nat_of_P x)). -stepl (RasIR (nring (R := RReals) (nat_of_P x))). -apply R_nring_as_IR. -apply R_as_IR_wd. -symmetry. -apply (pring_convert RReals x). -symmetry. -apply (pring_convert IR x). +Proof. + intro x. + (*rewrite pring_convert.*) + stepr (nring (R := IR) (nat_of_P x)). + stepl (RasIR (nring (R := RReals) (nat_of_P x))). + apply R_nring_as_IR. + apply R_as_IR_wd. + symmetry. + apply (pring_convert RReals x). + symmetry. + apply (pring_convert IR x). Qed. Lemma R_zring_as_IR : forall x, RasIR (zring x) [=] zring x. -induction x; simpl. -apply R_Zero_as_IR. -apply R_pring_as_IR. -rewrite R_opp_as_IR. -rewrite R_pring_as_IR. -reflexivity. +Proof. + induction x; simpl. + apply R_Zero_as_IR. + apply R_pring_as_IR. + rewrite R_opp_as_IR. + rewrite R_pring_as_IR. + reflexivity. Qed. Lemma INR_as_nring : forall x, INR x = nring (R:=RRing) x. -induction x. -reflexivity. -simpl nring. -rewrite <- IHx. -apply S_INR. +Proof. + induction x. + reflexivity. + simpl nring. + rewrite <- IHx. + apply S_INR. Qed. Lemma IZR_as_zring : forall x, IZR x = zring (R:=RRing) x. -induction x; simpl. -reflexivity. -rewrite INR_as_nring. -(* rewrite pring_convert *) -symmetry. -apply (pring_convert RRing p). -rewrite INR_as_nring. -apply Ropp_eq_compat. -symmetry. -apply (pring_convert RRing p). +Proof. + induction x; simpl. + reflexivity. + rewrite INR_as_nring. + (* rewrite pring_convert *) + symmetry. + apply (pring_convert RRing p). + rewrite INR_as_nring. + apply Ropp_eq_compat. + symmetry. + apply (pring_convert RRing p). Qed. Lemma R_IZR_as_IR : forall x, RasIR (IZR x) [=] zring x. -induction x; simpl. -apply R_Zero_as_IR. -rewrite R_INR_as_IR. -rewrite R_nring_as_IR. -auto with *. -rewrite R_opp_as_IR. -rewrite R_INR_as_IR. -rewrite R_nring_as_IR. -auto with *. +Proof. + induction x; simpl. + apply R_Zero_as_IR. + rewrite R_INR_as_IR. + rewrite R_nring_as_IR. + auto with *. + rewrite R_opp_as_IR. + rewrite R_INR_as_IR. + rewrite R_nring_as_IR. + auto with *. Qed. Hint Rewrite R_IZR_as_IR : RtoIR. @@ -789,135 +806,135 @@ Hint Rewrite R_IZR_as_IR : RtoIR. (** pi *) Lemma R_pi_as_IR : RasIR (PI) [=] Pi. -assert (Sin (RasIR PI) [=] Zero). -rewrite <- R_sin_as_IR. -rewrite sin_PI. -apply R_Zero_as_IR. -assert (Not (forall z : Z, RasIR PI[#]zring (R:=IR) z[*]Pi)). -unfold Not. -intro X. -apply ((eq_imp_not_ap _ _ _ H) (Sin_ap_Zero (RasIR (PI)) X)). -clear H. -apply (not_ap_imp_eq). -intro PiNot. -elim H0. -intro z. -elim z. -simpl. -rstepr (Zero:IR). -stepr (RasIR 0) by apply R_Zero_as_IR. -apply R_ap_as_IR_back. -apply PI_neq0. -intro p. -rewrite <- convert_is_POS. -stepr (nring (R := IR) (nat_of_P p) [*] Pi) by - apply mult_wdl; symmetry; apply (zring_plus_nat IR). -case (nat_of_P p). -simpl. -rstepr (Zero:IR). -stepr (RasIR 0) by apply R_Zero_as_IR. -apply R_ap_as_IR_back. -apply PI_neq0. -intro n. -case n. -simpl. -rstepr (Pi). -assumption. -intro n0. -apply less_imp_ap. -apply leEq_less_trans with Four. -rstepr ((One [+] One) [*] (One [+] One):IR). -rewrite <- R_One_as_IR. -rewrite <- R_plus_as_IR. -rewrite <- R_mult_as_IR. -apply IR_le_as_R. -apply PI_4. -apply less_leEq_trans with (Two [*] Pi). -rstepl (Two [*] Two:IR). -apply mult_resp_less_lft. -apply Pi_gt_2. -rstepr ((Zero [+] One) [+] One : IR). -apply plus_one_ext_less. -apply zero_lt_posplus1. -apply eq_imp_leEq. -reflexivity. -apply mult_resp_leEq_rht. -simpl. -apply (plus_resp_leEq). -apply (plus_resp_leEq). -stepl (nring (R := IR) 0) by auto with *. -apply nring_leEq; auto with *. -apply less_leEq. -apply pos_Pi. -intro p. -apply Greater_imp_ap. -simpl. -apply leEq_less_trans with (Zero:IR). -rewrite pring_convert. -apply less_leEq. -apply inv_cancel_less. -rstepl (Zero[*]Zero:IR). -rstepr ((nring (R:=IR) (nat_of_P p))[*]Pi). -apply mult_resp_less_both. -apply eq_imp_leEq. -reflexivity. -rstepl (nring (R := IR) 0) . -apply nring_less. -auto with *. -apply eq_imp_leEq. -reflexivity. -auto with *. -stepl (RasIR 0) by apply R_Zero_as_IR. -apply IR_lt_as_R. -apply PI_RGT_0. +Proof. + assert (Sin (RasIR PI) [=] Zero). + rewrite <- R_sin_as_IR. + rewrite sin_PI. + apply R_Zero_as_IR. + assert (Not (forall z : Z, RasIR PI[#]zring (R:=IR) z[*]Pi)). + unfold Not. + intro X. + apply ((eq_imp_not_ap _ _ _ H) (Sin_ap_Zero (RasIR (PI)) X)). + clear H. + apply (not_ap_imp_eq). + intro PiNot. + elim H0. + intro z. + elim z. + simpl. + rstepr (Zero:IR). + stepr (RasIR 0) by apply R_Zero_as_IR. + apply R_ap_as_IR_back. + apply PI_neq0. + intro p. + rewrite <- convert_is_POS. + stepr (nring (R := IR) (nat_of_P p) [*] Pi) by apply mult_wdl; symmetry; apply (zring_plus_nat IR). + case (nat_of_P p). + simpl. + rstepr (Zero:IR). + stepr (RasIR 0) by apply R_Zero_as_IR. + apply R_ap_as_IR_back. + apply PI_neq0. + intro n. + case n. + simpl. + rstepr (Pi). + assumption. + intro n0. + apply less_imp_ap. + apply leEq_less_trans with Four. + rstepr ((One [+] One) [*] (One [+] One):IR). + rewrite <- R_One_as_IR. + rewrite <- R_plus_as_IR. + rewrite <- R_mult_as_IR. + apply IR_le_as_R. + apply PI_4. + apply less_leEq_trans with (Two [*] Pi). + rstepl (Two [*] Two:IR). + apply mult_resp_less_lft. + apply Pi_gt_2. + rstepr ((Zero [+] One) [+] One : IR). + apply plus_one_ext_less. + apply zero_lt_posplus1. + apply eq_imp_leEq. + reflexivity. + apply mult_resp_leEq_rht. + simpl. + apply (plus_resp_leEq). + apply (plus_resp_leEq). + stepl (nring (R := IR) 0) by auto with *. + apply nring_leEq; auto with *. + apply less_leEq. + apply pos_Pi. + intro p. + apply Greater_imp_ap. + simpl. + apply leEq_less_trans with (Zero:IR). + rewrite pring_convert. + apply less_leEq. + apply inv_cancel_less. + rstepl (Zero[*]Zero:IR). + rstepr ((nring (R:=IR) (nat_of_P p))[*]Pi). + apply mult_resp_less_both. + apply eq_imp_leEq. + reflexivity. + rstepl (nring (R := IR) 0) . + apply nring_less. + auto with *. + apply eq_imp_leEq. + reflexivity. + auto with *. + stepl (RasIR 0) by apply R_Zero_as_IR. + apply IR_lt_as_R. + apply PI_RGT_0. Qed. Lemma R_pi_alt_as_IR : RasIR (PI) [=] pi. -unfold PI. -unfold pi. -destruct (exist_PI) as [x prf]. -unfold pi_series. -unfold tg_alt in prf. -unfold PI_tg in prf. -rewrite R_mult_as_IR. -apply mult_wd. -rewrite R_mult_as_IR. -rewrite R_plus_as_IR. -rewrite R_One_as_IR. -rational. -rewrite (R_infsum_as_IR x ( -(fun i : nat => (-1) ^ i * / INR (2 * i + 1)) -) prf (R_infsum_as_IR_convergent _ _ prf) ). -apply series_sum_wd. -intro n. -autorewrite with RtoIR. -apply mult_wd. -simpl; reflexivity. -stepr (RasIR (1 / nring (R:=RRing) (2 * n + 1))). -apply R_as_IR_wd. -unfold Rdiv. -simpl; auto with *. -cut (n + (n + 0) + 1 = S (n + n))%nat. -intro DF. -cut (Dom (f_rcpcl' IR) (RasIR (nring (R:=RReals) (2 * n + 1)))). -intro H. -rewrite (R_recip_as_IR (nring (R:=RReals) (2 * n + 1)) H). -apply div_wd. -reflexivity. -rewrite R_nring_as_IR. -apply nring_wd. -rewrite <- DF. -simpl. -auto. -simpl. -stepr (RasIR 0) by apply R_Zero_as_IR. -apply R_ap_as_IR_back. -apply Rgt_not_eq. -rewrite DF. -unfold Rgt. -change (Zero [<] nring (R:=RRing) (S (n + n))). -apply pos_nring_S. -auto with *. +Proof. + unfold PI. + unfold pi. + destruct (exist_PI) as [x prf]. + unfold pi_series. + unfold tg_alt in prf. + unfold PI_tg in prf. + rewrite R_mult_as_IR. + apply mult_wd. + rewrite R_mult_as_IR. + rewrite R_plus_as_IR. + rewrite R_One_as_IR. + rational. + rewrite (R_infsum_as_IR x ( (fun i : nat => (-1) ^ i * / INR (2 * i + 1)) + ) prf (R_infsum_as_IR_convergent _ _ prf) ). + apply series_sum_wd. + intro n. + autorewrite with RtoIR. + apply mult_wd. + simpl; reflexivity. + stepr (RasIR (1 / nring (R:=RRing) (2 * n + 1))). + apply R_as_IR_wd. + unfold Rdiv. + simpl; auto with *. + cut (n + (n + 0) + 1 = S (n + n))%nat. + intro DF. + cut (Dom (f_rcpcl' IR) (RasIR (nring (R:=RReals) (2 * n + 1)))). + intro H. + rewrite (R_recip_as_IR (nring (R:=RReals) (2 * n + 1)) H). + apply div_wd. + reflexivity. + rewrite R_nring_as_IR. + apply nring_wd. + rewrite <- DF. + simpl. + auto. + simpl. + stepr (RasIR 0) by apply R_Zero_as_IR. + apply R_ap_as_IR_back. + apply Rgt_not_eq. + rewrite DF. + unfold Rgt. + change (Zero [<] nring (R:=RRing) (S (n + n))). + apply pos_nring_S. + auto with *. Qed. Hint Rewrite R_pi_as_IR : RtoIR. @@ -925,35 +942,36 @@ Hint Rewrite R_pi_as_IR : RtoIR. (** rationals *) Lemma R_Q2R_as_IR : forall q, RasIR (Q2R q) [=] inj_Q IR q. -intro q. -destruct q. -unfold Q2R. -simpl. -cut (Dom (f_rcpcl' IR) (RasIR (nring (R:=RRing) (nat_of_P Qden)))). -intro Hy. -stepr (RasIR (zring (R:=RRing) Qnum)[/]RasIR (nring (R:=RRing) (nat_of_P Qden))[//]Hy). -stepl (RasIR (zring (R:=RRing) Qnum / nring (R:=RRing) (nat_of_P Qden))). -apply (R_div_as_IR (zring Qnum) (nring (nat_of_P Qden))). -apply R_as_IR_wd. -unfold Rdiv. -replace (nring (R:=RRing) (nat_of_P Qden)) with (INR (nat_of_P Qden)). -replace (zring (R:=RRing) Qnum) with (IZR Qnum). -simpl; reflexivity. -apply IZR_as_zring. -apply INR_as_nring. -apply div_wd. -apply R_zring_as_IR. -apply R_nring_as_IR. -simpl. -stepr (RasIR 0) by apply R_Zero_as_IR. -apply IR_ap_as_R. -apply Rgt_not_eq. -unfold Rgt. -replace 0%R with (nring (R:=RRing) 0). -change ((nring (R:=RRing) 0 [<] nring (R:=RRing) (nat_of_P Qden))). -apply nring_less. -auto with *. -auto with *. +Proof. + intro q. + destruct q. + unfold Q2R. + simpl. + cut (Dom (f_rcpcl' IR) (RasIR (nring (R:=RRing) (nat_of_P Qden)))). + intro Hy. + stepr (RasIR (zring (R:=RRing) Qnum)[/]RasIR (nring (R:=RRing) (nat_of_P Qden))[//]Hy). + stepl (RasIR (zring (R:=RRing) Qnum / nring (R:=RRing) (nat_of_P Qden))). + apply (R_div_as_IR (zring Qnum) (nring (nat_of_P Qden))). + apply R_as_IR_wd. + unfold Rdiv. + replace (nring (R:=RRing) (nat_of_P Qden)) with (INR (nat_of_P Qden)). + replace (zring (R:=RRing) Qnum) with (IZR Qnum). + simpl; reflexivity. + apply IZR_as_zring. + apply INR_as_nring. + apply div_wd. + apply R_zring_as_IR. + apply R_nring_as_IR. + simpl. + stepr (RasIR 0) by apply R_Zero_as_IR. + apply IR_ap_as_R. + apply Rgt_not_eq. + unfold Rgt. + replace 0%R with (nring (R:=RRing) 0). + change ((nring (R:=RRing) 0 [<] nring (R:=RRing) (nat_of_P Qden))). + apply nring_less. + auto with *. + auto with *. Qed. Hint Rewrite R_Q2R_as_IR : RtoIR. diff --git a/coq_reals/Rsign.v b/coq_reals/Rsign.v index 63a054c43..e4e415701 100644 --- a/coq_reals/Rsign.v +++ b/coq_reals/Rsign.v @@ -1,10 +1,10 @@ Require Import Rreals_iso. Require Import CRsign. -Ltac R_dec_precompute := +Ltac R_dec_precompute := try apply Rlt_le; apply R_lt_as_IR; - match goal with + match goal with | |- (Ccsr_rel ?A ?B ?X ?Y) => let X0 := fresh "R_dec" in pose (X0:=X); diff --git a/fta/CC_Props.v b/fta/CC_Props.v index 01de930df..13199d327 100644 --- a/fta/CC_Props.v +++ b/fta/CC_Props.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export AbsCC. @@ -43,27 +43,29 @@ Require Export AbsCC. Hint Resolve AbsIR_sqrt_sqr: algebra. Lemma absCC_absIR_re : forall x : CC, AbsIR (Re x) [<=] AbsCC x. -intros. -astepl (sqrt (Re x[^]2) (sqr_nonneg _ (Re x))). -unfold AbsCC in |- *. -apply power_cancel_leEq with 2. auto. apply sqrt_nonneg. -astepl (Re x[^]2). -astepr (Re x[^]2[+]Im x[^]2). -astepl (Re x[^]2[+]Zero). -apply plus_resp_leEq_lft. -apply sqr_nonneg. +Proof. + intros. + astepl (sqrt (Re x[^]2) (sqr_nonneg _ (Re x))). + unfold AbsCC in |- *. + apply power_cancel_leEq with 2. auto. apply sqrt_nonneg. + astepl (Re x[^]2). + astepr (Re x[^]2[+]Im x[^]2). + astepl (Re x[^]2[+]Zero). + apply plus_resp_leEq_lft. + apply sqr_nonneg. Qed. Lemma absCC_absIR_im : forall x : CC, AbsIR (Im x) [<=] AbsCC x. -intros. -astepl (sqrt (Im x[^]2) (sqr_nonneg _ (Im x))). -unfold AbsCC in |- *. -apply power_cancel_leEq with 2. auto. apply sqrt_nonneg. -astepl (Im x[^]2). -astepr (Re x[^]2[+]Im x[^]2). -astepl (Zero[+]Im x[^]2). -apply plus_resp_leEq. -apply sqr_nonneg. +Proof. + intros. + astepl (sqrt (Im x[^]2) (sqr_nonneg _ (Im x))). + unfold AbsCC in |- *. + apply power_cancel_leEq with 2. auto. apply sqrt_nonneg. + astepl (Im x[^]2). + astepr (Re x[^]2[+]Im x[^]2). + astepl (Zero[+]Im x[^]2). + apply plus_resp_leEq. + apply sqr_nonneg. Qed. Definition seq_re (s : nat -> CC) (n : nat) := Re (s n). @@ -72,18 +74,18 @@ Definition seq_im (s : nat -> CC) (n : nat) := Im (s n). Definition CC_Cauchy_prop (s : nat -> CC) : CProp := Cauchy_prop (seq_re s) and Cauchy_prop (seq_im s). -Record CC_CauchySeq : Type := +Record CC_CauchySeq : Type := {CC_seq :> nat -> CC; CC_proof : CC_Cauchy_prop CC_seq}. Lemma re_is_Cauchy : forall s : CC_CauchySeq, Cauchy_prop (seq_re s). Proof. -intro s; elim (CC_proof s); auto. + intro s; elim (CC_proof s); auto. Qed. Lemma im_is_Cauchy : forall s : CC_CauchySeq, Cauchy_prop (seq_im s). Proof. -intro s; elim (CC_proof s); auto. + intro s; elim (CC_proof s); auto. Qed. Definition CC_Cauchy2re s := Build_CauchySeq _ _ (re_is_Cauchy s). @@ -96,97 +98,94 @@ Definition CC_SeqLimit (seq : nat -> CC) (lim : CC) : CProp := forall e, Zero [<] e -> {N : nat | forall m, N <= m -> AbsCC (seq m[-]lim) [<=] e}. Lemma AbsSmall_sqr : forall x e : IR, AbsSmall e x -> x[^]2 [<=] e[^]2. -unfold AbsSmall in |- *. intros. elim H. clear H. intros. -astepl (Zero[+]x[^]2). -apply shift_plus_leEq. -astepr ((e[-]x) [*] (e[+]x)). -apply mult_resp_nonneg. -apply shift_leEq_minus. astepl x. auto. -rstepr (x[-][--]e). -apply shift_leEq_minus. astepl ( [--]e). auto. +Proof. + unfold AbsSmall in |- *. intros. elim H. clear H. intros. + astepl (Zero[+]x[^]2). + apply shift_plus_leEq. + astepr ((e[-]x) [*] (e[+]x)). + apply mult_resp_nonneg. + apply shift_leEq_minus. astepl x. auto. + rstepr (x[-][--]e). + apply shift_leEq_minus. astepl ( [--]e). auto. Qed. Lemma AbsSmall_AbsCC : forall (z : CC) (e : IR), Zero [<] e -> AbsSmall (e [/]TwoNZ) (Re z) -> AbsSmall (e [/]TwoNZ) (Im z) -> AbsCC z [<=] e. -intros. unfold AbsCC in |- *. -apply power_cancel_leEq with 2. auto. -apply less_leEq. auto. -astepl (Re z[^]2[+]Im z[^]2). -rstepr ((e [/]TwoNZ) [^]2[+] (e [/]TwoNZ) [^]2[+] (e[^]2) [/]TwoNZ). -astepl (Re z[^]2[+]Im z[^]2[+]Zero). -apply plus_resp_leEq_both. -apply plus_resp_leEq_both. -apply AbsSmall_sqr. auto. -apply AbsSmall_sqr. auto. -apply less_leEq. -apply div_resp_pos. apply pos_two. -apply nexp_resp_pos. auto. +Proof. + intros. unfold AbsCC in |- *. + apply power_cancel_leEq with 2. auto. + apply less_leEq. auto. + astepl (Re z[^]2[+]Im z[^]2). + rstepr ((e [/]TwoNZ) [^]2[+] (e [/]TwoNZ) [^]2[+] (e[^]2) [/]TwoNZ). + astepl (Re z[^]2[+]Im z[^]2[+]Zero). + apply plus_resp_leEq_both. + apply plus_resp_leEq_both. + apply AbsSmall_sqr. auto. + apply AbsSmall_sqr. auto. + apply less_leEq. + apply div_resp_pos. apply pos_two. + apply nexp_resp_pos. auto. Qed. Lemma LimCC_is_lim : forall s : CC_CauchySeq, CC_SeqLimit s (LimCC s). -unfold CC_SeqLimit in |- *. unfold LimCC in |- *. intros s e H. -cut (SeqLimit (seq_re s) (Lim (CC_Cauchy2re s))). -unfold SeqLimit in |- *. intro H0. -cut (SeqLimit (seq_im s) (Lim (CC_Cauchy2im s))). -unfold SeqLimit in |- *. intro H1. -cut (Zero [<] e [/]TwoNZ). intro H2. -elim (H0 (e [/]TwoNZ) H2). unfold seq_re in |- *. intro N. intros H3. -elim (H1 (e [/]TwoNZ) H2). unfold seq_im in |- *. intro N'. intros H4. -cut {M : nat | N <= M | N' <= M}. intros H5. -elim H5. clear H5. intro M. intros. -exists M. intros. -apply AbsSmall_AbsCC. auto. -astepr (Re (CC_seq s m) [-]Lim (CC_Cauchy2re s)). -apply H3. omega. -astepr (Im (CC_seq s m) [-]Lim (CC_Cauchy2im s)). -apply H4. omega. -elim (le_lt_dec N N'); intros. -exists N'; auto. -exists N; auto with arith. -apply div_resp_pos. apply pos_two. auto. -apply - Lim_Cauchy - with - (s := Build_CauchySeq IR (fun n : nat => Im (CC_seq s n)) - (im_is_Cauchy s)). -apply - Lim_Cauchy - with - (s := Build_CauchySeq IR (fun n : nat => Re (CC_seq s n)) - (re_is_Cauchy s)). +Proof. + unfold CC_SeqLimit in |- *. unfold LimCC in |- *. intros s e H. + cut (SeqLimit (seq_re s) (Lim (CC_Cauchy2re s))). + unfold SeqLimit in |- *. intro H0. + cut (SeqLimit (seq_im s) (Lim (CC_Cauchy2im s))). + unfold SeqLimit in |- *. intro H1. + cut (Zero [<] e [/]TwoNZ). intro H2. + elim (H0 (e [/]TwoNZ) H2). unfold seq_re in |- *. intro N. intros H3. + elim (H1 (e [/]TwoNZ) H2). unfold seq_im in |- *. intro N'. intros H4. + cut {M : nat | N <= M | N' <= M}. intros H5. + elim H5. clear H5. intro M. intros. + exists M. intros. + apply AbsSmall_AbsCC. auto. + astepr (Re (CC_seq s m) [-]Lim (CC_Cauchy2re s)). + apply H3. omega. + astepr (Im (CC_seq s m) [-]Lim (CC_Cauchy2im s)). + apply H4. omega. + elim (le_lt_dec N N'); intros. + exists N'; auto. + exists N; auto with arith. + apply div_resp_pos. apply pos_two. auto. + apply Lim_Cauchy with (s := Build_CauchySeq IR (fun n : nat => Im (CC_seq s n)) (im_is_Cauchy s)). + apply Lim_Cauchy with (s := Build_CauchySeq IR (fun n : nat => Re (CC_seq s n)) (re_is_Cauchy s)). Qed. Lemma CC_SeqLimit_uniq : forall (s : nat -> CC) (l l' : CC), CC_SeqLimit s l -> CC_SeqLimit s l' -> l [=] l'. -unfold CC_SeqLimit in |- *. do 3 intro. intros H H0. -apply cg_inv_unique_2. -apply AbsCC_small_imp_eq. intros e H1. -cut (Zero [<] e [/]ThreeNZ). intro H2. -elim (H (e [/]ThreeNZ)). intro N. intros H3. -elim (H0 (e [/]ThreeNZ)). intro N'. intros H4. -cut {M : nat | N <= M | N' <= M}. intros H5. -elim H5. clear H5. intro M. intros. -apply leEq_less_trans with (AbsCC (s M[-]l) [+]AbsCC (s M[-]l')). -apply leEq_wdl with (AbsCC ( [--] (s M[-]l) [+] (s M[-]l'))). -apply leEq_wdr with (AbsCC [--] (s M[-]l) [+]AbsCC (s M[-]l')). -apply triangle. -algebra. -apply AbsCC_wd. rational. -rstepr (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ). astepl (Zero[+]AbsCC (s M[-]l) [+]AbsCC (s M[-]l')). -apply plus_resp_less_leEq. -apply plus_resp_less_leEq. -auto. -apply H3. auto. -apply H4. auto. -exists (max N N'); auto with arith. -auto. auto. -apply pos_div_three. auto. +Proof. + unfold CC_SeqLimit in |- *. do 3 intro. intros H H0. + apply cg_inv_unique_2. + apply AbsCC_small_imp_eq. intros e H1. + cut (Zero [<] e [/]ThreeNZ). intro H2. + elim (H (e [/]ThreeNZ)). intro N. intros H3. + elim (H0 (e [/]ThreeNZ)). intro N'. intros H4. + cut {M : nat | N <= M | N' <= M}. intros H5. + elim H5. clear H5. intro M. intros. + apply leEq_less_trans with (AbsCC (s M[-]l) [+]AbsCC (s M[-]l')). + apply leEq_wdl with (AbsCC ( [--] (s M[-]l) [+] (s M[-]l'))). + apply leEq_wdr with (AbsCC [--] (s M[-]l) [+]AbsCC (s M[-]l')). + apply triangle. + algebra. + apply AbsCC_wd. rational. + rstepr (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ). astepl (Zero[+]AbsCC (s M[-]l) [+]AbsCC (s M[-]l')). + apply plus_resp_less_leEq. + apply plus_resp_less_leEq. + auto. + apply H3. auto. + apply H4. auto. + exists (max N N'); auto with arith. + auto. auto. + apply pos_div_three. auto. Qed. Lemma CC_SeqLimit_unq : forall (s : CC_CauchySeq) l, CC_SeqLimit s l -> l [=] LimCC s. -intros. -apply CC_SeqLimit_uniq with (CC_seq s). auto. -apply LimCC_is_lim. +Proof. + intros. + apply CC_SeqLimit_uniq with (CC_seq s). auto. + apply LimCC_is_lim. Qed. (** @@ -212,17 +211,17 @@ Definition CCcontin : CProp := forall x : CC, CCcontinAt x. Lemma CCfunLim_SeqLimit : forall p l pn, CCfunLim p l -> CC_SeqLimit pn p -> CC_SeqLimit (fun n => f (pn n)) l. Proof. -intros p l pn fl sl; unfold CC_SeqLimit in |- *. -intros eps epos. -elim (fl _ epos); intros del H H0. -elim (sl _ H); intros N Nh. -exists N. intros m leNm. -apply leEq_wdl with (AbsCC (l[-]f (pn m))). -apply H0. -apply leEq_wdl with (AbsCC (pn m[-]p)). -apply (Nh _ leNm). -apply cc_minus_abs. -apply cc_minus_abs. + intros p l pn fl sl; unfold CC_SeqLimit in |- *. + intros eps epos. + elim (fl _ epos); intros del H H0. + elim (sl _ H); intros N Nh. + exists N. intros m leNm. + apply leEq_wdl with (AbsCC (l[-]f (pn m))). + apply H0. + apply leEq_wdl with (AbsCC (pn m[-]p)). + apply (Nh _ leNm). + apply cc_minus_abs. + apply cc_minus_abs. Qed. Definition f_seq (s : nat -> CC) (n : nat) : CC := f (s n). @@ -230,13 +229,13 @@ Definition f_seq (s : nat -> CC) (n : nat) : CC := f (s n). Lemma poly_pres_lim : CCcontin -> forall s : CC_CauchySeq, CC_SeqLimit (fun n => f (s n)) (f (LimCC s)). Proof. -intros cp s. -apply (CCfunLim_SeqLimit (LimCC s) (f (LimCC s))). -unfold CCfunLim in |- *. -intros e zlte. -elim (cp (LimCC s) e zlte). -intros d; exists d; auto. -exact (LimCC_is_lim s). + intros cp s. + apply (CCfunLim_SeqLimit (LimCC s) (f (LimCC s))). + unfold CCfunLim in |- *. + intros e zlte. + elim (cp (LimCC s) e zlte). + intros d; exists d; auto. + exact (LimCC_is_lim s). Qed. End Continuity_for_CC. @@ -244,29 +243,29 @@ End Continuity_for_CC. Lemma seq_yields_zero : forall q : IR, Zero [<=] q -> q [<] One -> forall c : IR, Zero [<] c -> forall s, (forall i, AbsCC (s i) [<=] q[^]i[*]c) -> CC_SeqLimit s Zero. Proof. -intros q zltq qlt1 c zltc s H. -unfold CC_SeqLimit in |- *. -intros e zlte. -generalize (qi_lim_zero q zltq qlt1). -intro Hqi. -unfold SeqLimit in Hqi. -elim (Hqi (e[/] c[//]pos_ap_zero _ c zltc)). -intros N HN. -exists N. -intros m leNm. -apply leEq_transitive with (q[^]m[*]c). -astepl (AbsCC (s m)). -apply H. -generalize (HN m leNm). -intro H0. -unfold AbsSmall in H0. -inversion_clear H0. -rstepr ((e[/] c[//]pos_ap_zero IR c zltc) [*]c). -apply mult_resp_leEq_rht. -rstepl (q[^]m[-]Zero). -assumption. -apply less_leEq. assumption. -apply shift_less_div. -assumption. -rstepl ZeroR; assumption. + intros q zltq qlt1 c zltc s H. + unfold CC_SeqLimit in |- *. + intros e zlte. + generalize (qi_lim_zero q zltq qlt1). + intro Hqi. + unfold SeqLimit in Hqi. + elim (Hqi (e[/] c[//]pos_ap_zero _ c zltc)). + intros N HN. + exists N. + intros m leNm. + apply leEq_transitive with (q[^]m[*]c). + astepl (AbsCC (s m)). + apply H. + generalize (HN m leNm). + intro H0. + unfold AbsSmall in H0. + inversion_clear H0. + rstepr ((e[/] c[//]pos_ap_zero IR c zltc) [*]c). + apply mult_resp_leEq_rht. + rstepl (q[^]m[-]Zero). + assumption. + apply less_leEq. assumption. + apply shift_less_div. + assumption. + rstepl ZeroR; assumption. Qed. diff --git a/fta/CPoly_Contin1.v b/fta/CPoly_Contin1.v index 225bb43a4..b7eb4493b 100644 --- a/fta/CPoly_Contin1.v +++ b/fta/CPoly_Contin1.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CC_Props. @@ -44,66 +44,66 @@ Section Mult_CC_Continuous. Lemma mult_absCC : forall (x y : CC) (X Y : IR), AbsCC x [<=] X -> AbsCC y [<=] Y -> AbsCC (x[*]y) [<=] X[*]Y. -intros. -astepl (AbsCC x[*]AbsCC y). -apply mult_resp_leEq_both. -apply AbsCC_nonneg. apply AbsCC_nonneg. auto. auto. +Proof. + intros. + astepl (AbsCC x[*]AbsCC y). + apply mult_resp_leEq_both. + apply AbsCC_nonneg. apply AbsCC_nonneg. auto. auto. Qed. Lemma estimate_absCC : forall x : CC, {X : IR | Zero [<] X | AbsCC x [<=] X}. -intros. -exists (AbsCC x[+]One). -astepl (Zero[+]ZeroR). -apply plus_resp_leEq_less. apply AbsCC_nonneg. apply pos_one. -astepl (AbsCC x[+]Zero). -apply less_leEq. -apply plus_resp_less_lft. apply pos_one. +Proof. + intros. + exists (AbsCC x[+]One). + astepl (Zero[+]ZeroR). + apply plus_resp_leEq_less. apply AbsCC_nonneg. apply pos_one. + astepl (AbsCC x[+]Zero). + apply less_leEq. + apply plus_resp_less_lft. apply pos_one. Qed. Lemma mult_CC_contin : forall (x y : CC) (e : IR), Zero [<] e -> {c : IR | Zero [<] c | {d : IR | Zero [<] d | forall x' y', AbsCC (x[-]x') [<=] c -> AbsCC (y[-]y') [<=] d -> AbsCC (x[*]y[-]x'[*]y') [<=] e}}. -do 3 intro. intro H. -cut (Zero [<] e [/]TwoNZ). intro H0. -elim (estimate_absCC x). intro X. intros H1 H2. -elim (estimate_absCC y). intro Y. intros H3 H4. -cut (Y[#]Zero). intro H5. -exists (e [/]TwoNZ[/] Y[//]H5). -apply div_resp_pos. auto. auto. -cut (Zero [<] X[+](e [/]TwoNZ[/] Y[//]H5)). intro. -cut (X[+](e [/]TwoNZ[/] Y[//]H5)[#]Zero). intro H7. -exists (e [/]TwoNZ[/] X[+](e [/]TwoNZ[/] Y[//]H5)[//]H7). -apply div_resp_pos. auto. auto. -intros. -apply leEq_wdl with (AbsCC ((x[-]x')[*]y[+]x'[*](y[-]y'))). -apply leEq_transitive with (AbsCC ((x[-]x')[*]y)[+]AbsCC (x'[*](y[-]y'))). -apply triangle. -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -apply plus_resp_leEq_both. -apply leEq_wdr with ((e [/]TwoNZ[/] Y[//]H5)[*]Y). -apply mult_absCC; auto. -rational. -apply - leEq_wdr - with - ((X[+](e [/]TwoNZ[/] Y[//]H5))[*] - (e [/]TwoNZ[/] X[+](e [/]TwoNZ[/] Y[//]H5)[//]H7)). -apply mult_absCC; auto. -apply leEq_wdl with (AbsCC (x[+](x'[-]x))). -apply leEq_transitive with (AbsCC x[+]AbsCC (x'[-]x)). -apply triangle. -apply plus_resp_leEq_both. auto. -astepl (AbsCC [--](x'[-]x)). -apply leEq_wdl with (AbsCC (x[-]x')). auto. -apply AbsCC_wd. rational. -apply AbsCC_wd. rational. -rational. -apply AbsCC_wd. rational. -apply Greater_imp_ap. auto. -apply plus_resp_pos; auto. -apply div_resp_pos; auto. -apply Greater_imp_ap. auto. -apply pos_div_two. auto. +Proof. + do 3 intro. intro H. + cut (Zero [<] e [/]TwoNZ). intro H0. + elim (estimate_absCC x). intro X. intros H1 H2. + elim (estimate_absCC y). intro Y. intros H3 H4. + cut (Y[#]Zero). intro H5. + exists (e [/]TwoNZ[/] Y[//]H5). + apply div_resp_pos. auto. auto. + cut (Zero [<] X[+](e [/]TwoNZ[/] Y[//]H5)). intro. + cut (X[+](e [/]TwoNZ[/] Y[//]H5)[#]Zero). intro H7. + exists (e [/]TwoNZ[/] X[+](e [/]TwoNZ[/] Y[//]H5)[//]H7). + apply div_resp_pos. auto. auto. + intros. + apply leEq_wdl with (AbsCC ((x[-]x')[*]y[+]x'[*](y[-]y'))). + apply leEq_transitive with (AbsCC ((x[-]x')[*]y)[+]AbsCC (x'[*](y[-]y'))). + apply triangle. + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + apply plus_resp_leEq_both. + apply leEq_wdr with ((e [/]TwoNZ[/] Y[//]H5)[*]Y). + apply mult_absCC; auto. + rational. + apply leEq_wdr with ((X[+](e [/]TwoNZ[/] Y[//]H5))[*] + (e [/]TwoNZ[/] X[+](e [/]TwoNZ[/] Y[//]H5)[//]H7)). + apply mult_absCC; auto. + apply leEq_wdl with (AbsCC (x[+](x'[-]x))). + apply leEq_transitive with (AbsCC x[+]AbsCC (x'[-]x)). + apply triangle. + apply plus_resp_leEq_both. auto. + astepl (AbsCC [--](x'[-]x)). + apply leEq_wdl with (AbsCC (x[-]x')). auto. + apply AbsCC_wd. rational. + apply AbsCC_wd. rational. + rational. + apply AbsCC_wd. rational. + apply Greater_imp_ap. auto. + apply plus_resp_pos; auto. + apply div_resp_pos; auto. + apply Greater_imp_ap. auto. + apply pos_div_two. auto. Qed. End Mult_CC_Continuous. @@ -120,35 +120,37 @@ Variable g : CCX. Lemma cpoly_CC_contin : forall (x : CC) (e : IR), Zero [<] e -> {d : IR | Zero [<] d | forall x', AbsCC (x[-]x') [<=] d -> AbsCC (g ! x[-]g ! x') [<=] e}. -elim g. -intros. -exists OneR. intros. apply pos_one. intros. -apply leEq_wdl with ZeroR. apply less_leEq. auto. -cut (Zero [=] AbsCC (Zero[-]Zero)). auto. -Step_final (AbsCC Zero). -intros a f. intro H. do 2 intro. intro H0. -elim (mult_CC_contin x f ! x e H0). intro d1. intros H1 H2. -elim H2. clear H2. intro c. intros H2 H3. -elim (H x c H2). clear H. intro d2. intros H H4. -exists (Min d1 d2). apply less_Min; auto. intros. -simpl in |- *. -cut (AbsCC (a[+]x[*]f ! x[-](a[+]x'[*]f ! x')) [<=] e). auto. -apply leEq_wdl with (AbsCC (x[*]f ! x[-]x'[*]f ! x')). -apply H3. clear H3. -apply leEq_transitive with (Min d1 d2); auto. apply Min_leEq_lft. -apply H4. clear H4. -apply leEq_transitive with (Min d1 d2); auto. apply Min_leEq_rht. -apply AbsCC_wd. -rational. +Proof. + elim g. + intros. + exists OneR. intros. apply pos_one. intros. + apply leEq_wdl with ZeroR. apply less_leEq. auto. + cut (Zero [=] AbsCC (Zero[-]Zero)). auto. + Step_final (AbsCC Zero). + intros a f. intro H. do 2 intro. intro H0. + elim (mult_CC_contin x f ! x e H0). intro d1. intros H1 H2. + elim H2. clear H2. intro c. intros H2 H3. + elim (H x c H2). clear H. intro d2. intros H H4. + exists (Min d1 d2). apply less_Min; auto. intros. + simpl in |- *. + cut (AbsCC (a[+]x[*]f ! x[-](a[+]x'[*]f ! x')) [<=] e). auto. + apply leEq_wdl with (AbsCC (x[*]f ! x[-]x'[*]f ! x')). + apply H3. clear H3. + apply leEq_transitive with (Min d1 d2); auto. apply Min_leEq_lft. + apply H4. clear H4. + apply leEq_transitive with (Min d1 d2); auto. apply Min_leEq_rht. + apply AbsCC_wd. + rational. Qed. Lemma contin_polyCC : CCcontin (fun x => g ! x). -unfold CCcontin in |- *. unfold CCcontinAt in |- *. unfold CCfunLim in |- *. -intros. -elim (cpoly_CC_contin x e); auto. -intro d. intros H0 H1. -exists d. auto. intros. -apply H1; auto. +Proof. + unfold CCcontin in |- *. unfold CCcontinAt in |- *. unfold CCfunLim in |- *. + intros. + elim (cpoly_CC_contin x e); auto. + intro d. intros H0 H1. + exists d. auto. intros. + apply H1; auto. Qed. End CPoly_CC_Continuous. diff --git a/fta/CPoly_Rev.v b/fta/CPoly_Rev.v index c94affad4..1edcead6c 100644 --- a/fta/CPoly_Rev.v +++ b/fta/CPoly_Rev.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CPoly_Degree. @@ -60,97 +60,100 @@ Fixpoint monom (a : R) (n : nat) {struct n} : cpoly_cring R := end. Lemma monom_coeff : forall (c : R) n, nth_coeff n (monom c n) [=] c. -intros. induction n as [| n Hrecn]; intros. -simpl in |- *. algebra. -simpl in |- *. algebra. +Proof. + intros. induction n as [| n Hrecn]; intros. + simpl in |- *. algebra. + simpl in |- *. algebra. Qed. Lemma monom_coeff' : forall (c : R) m n, m <> n -> nth_coeff n (monom c m) [=] Zero. -intros c m. -induction m as [| m Hrecm]; intros. -elim (O_or_S n); intro y. elim y. clear y. intros x y. rewrite <- y. -simpl in |- *. algebra. -elim (H y). -elim (O_or_S n); intro y. elim y. clear y. intros x y. rewrite <- y. -simpl in |- *. apply Hrecm. omega. -rewrite <- y. -simpl in |- *. algebra. +Proof. + intros c m. + induction m as [| m Hrecm]; intros. + elim (O_or_S n); intro y. elim y. clear y. intros x y. rewrite <- y. + simpl in |- *. algebra. + elim (H y). + elim (O_or_S n); intro y. elim y. clear y. intros x y. rewrite <- y. + simpl in |- *. apply Hrecm. omega. + rewrite <- y. + simpl in |- *. algebra. Qed. Hint Resolve monom_coeff monom_coeff': algebra. Lemma monom_degree : forall (a : R) n, degree_le n (monom a n). -unfold degree_le in |- *. intros. -cut (n <> m). intro. algebra. omega. +Proof. + unfold degree_le in |- *. intros. + cut (n <> m). intro. algebra. omega. Qed. Lemma monom_S : forall (a : R) n, monom a (S n) [=] _X_[*]monom a n. -intros. -apply eq_transitive_unfolded with (cpoly_linear _ Zero (monom a n)). -simpl in |- *. split. algebra. cut (monom a n [=] monom a n). auto. algebra. -astepl (_X_[*]monom a n[+]_C_ Zero). -Step_final (_X_[*]monom a n[+]Zero). +Proof. + intros. + apply eq_transitive_unfolded with (cpoly_linear _ Zero (monom a n)). + simpl in |- *. split. algebra. cut (monom a n [=] monom a n). auto. algebra. + astepl (_X_[*]monom a n[+]_C_ Zero). + Step_final (_X_[*]monom a n[+]Zero). Qed. Hint Resolve monom_S: algebra. Lemma monom_wd_lft : forall (a b : R) n, a [=] b -> monom a n [=] monom b n. -intros. -induction n as [| n Hrecn]. -simpl in |- *. split; auto. -astepl (_X_[*]monom a n). -Step_final (_X_[*]monom b n). +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *. split; auto. + astepl (_X_[*]monom a n). + Step_final (_X_[*]monom b n). Qed. Hint Resolve monom_wd_lft: algebra_c. Lemma monom_mult' : forall (a b : R) n, _C_ a[*]monom b n [=] monom (a[*]b) n. -intros. -induction n as [| n Hrecn]. -simpl in |- *. split; algebra. -astepl (_C_ a[*] (_X_[*]monom b n)). -astepl (_C_ a[*]_X_[*]monom b n). -astepl (_X_[*]_C_ a[*]monom b n). -astepl (_X_[*] (_C_ a[*]monom b n)). -Step_final (_X_[*]monom (a[*]b) n). +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *. split; algebra. + astepl (_C_ a[*] (_X_[*]monom b n)). + astepl (_C_ a[*]_X_[*]monom b n). + astepl (_X_[*]_C_ a[*]monom b n). + astepl (_X_[*] (_C_ a[*]monom b n)). + Step_final (_X_[*]monom (a[*]b) n). Qed. Hint Resolve monom_mult': algebra. Lemma monom_mult : forall (a b : R) m n, monom a m[*]monom b n [=] monom (a[*]b) (m + n). -intros. induction m as [| m Hrecm]; intros. -replace (monom a 0) with (_C_ a). algebra. algebra. -astepl (_X_[*]monom a m[*]monom b n). -astepl (_X_[*] (monom a m[*]monom b n)). -replace (S m + n) with (S (m + n)). -Step_final (_X_[*]monom (a[*]b) (m + n)). -auto. +Proof. + intros. induction m as [| m Hrecm]; intros. + replace (monom a 0) with (_C_ a). algebra. algebra. + astepl (_X_[*]monom a m[*]monom b n). + astepl (_X_[*] (monom a m[*]monom b n)). + replace (S m + n) with (S (m + n)). + Step_final (_X_[*]monom (a[*]b) (m + n)). + auto. Qed. Lemma monom_sum : forall (p : RX) n, degree_le n p -> p [=] Sum 0 n (fun i => monom (nth_coeff i p) i). -intros. -unfold RX in |- *; apply all_nth_coeff_eq_imp. intros. -apply eq_symmetric_unfolded. -apply - eq_transitive_unfolded - with (Sum 0 n (fun i0 : nat => nth_coeff i (monom (nth_coeff i0 p) i0))). -apply nth_coeff_sum with (p_ := fun i0 : nat => monom (nth_coeff i0 p) i0). -elim (le_lt_dec i n); intros. -apply eq_transitive_unfolded with (nth_coeff i (monom (nth_coeff i p) i)). -apply - Sum_term - with - (f := fun i0 : nat => nth_coeff i (monom (nth_coeff i0 p) i0)) - (i := i). -auto with arith. auto. -intros. algebra. -algebra. -apply eq_transitive_unfolded with (Zero:R). -apply Sum_zero. auto with arith. -intros. cut (i0 <> i). intro. algebra. omega. -algebra. +Proof. + intros. + unfold RX in |- *; apply all_nth_coeff_eq_imp. intros. + apply eq_symmetric_unfolded. + apply eq_transitive_unfolded + with (Sum 0 n (fun i0 : nat => nth_coeff i (monom (nth_coeff i0 p) i0))). + apply nth_coeff_sum with (p_ := fun i0 : nat => monom (nth_coeff i0 p) i0). + elim (le_lt_dec i n); intros. + apply eq_transitive_unfolded with (nth_coeff i (monom (nth_coeff i p) i)). + apply Sum_term with (f := fun i0 : nat => nth_coeff i (monom (nth_coeff i0 p) i0)) (i := i). + auto with arith. auto. + intros. algebra. + algebra. + apply eq_transitive_unfolded with (Zero:R). + apply Sum_zero. auto with arith. + intros. cut (i0 <> i). intro. algebra. omega. + algebra. Qed. End Monomials. @@ -170,304 +173,231 @@ Definition Rev (n : nat) (p : RX) := Sum 0 n (fun i => monom (nth_coeff i p) (n - i)). Lemma Rev_coeff : forall n p i, i <= n -> nth_coeff i (Rev n p) [=] nth_coeff (n - i) p. -intros. -unfold Rev in |- *. -apply - eq_transitive_unfolded - with - (Sum 0 n (fun i0 : nat => nth_coeff i (monom (nth_coeff i0 p) (n - i0)))). -apply - nth_coeff_sum with (p_ := fun i0 : nat => monom (nth_coeff i0 p) (n - i0)). -apply - eq_transitive_unfolded - with (nth_coeff i (monom (nth_coeff (n - i) p) (n - (n - i)))). -apply - Sum_term - with - (i := n - i) +Proof. + intros. + unfold Rev in |- *. + apply eq_transitive_unfolded with + (Sum 0 n (fun i0 : nat => nth_coeff i (monom (nth_coeff i0 p) (n - i0)))). + apply nth_coeff_sum with (p_ := fun i0 : nat => monom (nth_coeff i0 p) (n - i0)). + apply eq_transitive_unfolded with (nth_coeff i (monom (nth_coeff (n - i) p) (n - (n - i)))). + apply Sum_term with (i := n - i) (f := fun i0 : nat => nth_coeff i (monom (nth_coeff i0 p) (n - i0))). -auto with arith. omega. -intros. -cut (n - j <> i). intro. algebra. omega. -replace (n - (n - i)) with i. algebra. omega. + auto with arith. omega. + intros. + cut (n - j <> i). intro. algebra. omega. + replace (n - (n - i)) with i. algebra. omega. Qed. Lemma Rev_coeff' : forall n p i, n < i -> nth_coeff i (Rev n p) [=] Zero. -intros. -unfold Rev in |- *. -apply - eq_transitive_unfolded - with - (Sum 0 n (fun i0 : nat => nth_coeff i (monom (nth_coeff i0 p) (n - i0)))). -apply - nth_coeff_sum - with (p_ := fun i0 : nat => monom (nth_coeff (R:=R) i0 p) (n - i0)). -apply Sum_zero. auto with arith. -intros. -cut (n - i0 <> i). intro. algebra. omega. +Proof. + intros. + unfold Rev in |- *. + apply eq_transitive_unfolded with + (Sum 0 n (fun i0 : nat => nth_coeff i (monom (nth_coeff i0 p) (n - i0)))). + apply nth_coeff_sum with (p_ := fun i0 : nat => monom (nth_coeff (R:=R) i0 p) (n - i0)). + apply Sum_zero. auto with arith. + intros. + cut (n - i0 <> i). intro. algebra. omega. Qed. Hint Resolve Rev_coeff Rev_coeff': algebra. Lemma Rev_wd : forall n p p', degree_le n p -> p [=] p' -> Rev n p [=] Rev n p'. -unfold RX in |- *. intros. -apply all_nth_coeff_eq_imp. intros. -elim (le_lt_dec i n); intros. -astepl (nth_coeff (n - i) p). -Step_final (nth_coeff (n - i) p'). -Step_final (Zero:R). +Proof. + unfold RX in |- *. intros. + apply all_nth_coeff_eq_imp. intros. + elim (le_lt_dec i n); intros. + astepl (nth_coeff (n - i) p). + Step_final (nth_coeff (n - i) p'). + Step_final (Zero:R). Qed. Hint Resolve Rev_wd: algebra_c. Lemma Rev_rev : forall n p, degree_le n p -> Rev n (Rev n p) [=] p. -unfold RX in |- *. intros. -apply all_nth_coeff_eq_imp. intros. -elim (le_lt_dec i n); intros. -astepl (nth_coeff (n - i) (Rev n p)). -pattern i at 2 in |- *. replace i with (n - (n - i)). -apply Rev_coeff. -omega. -omega. -unfold degree_le in H. -Step_final (Zero:R). +Proof. + unfold RX in |- *. intros. + apply all_nth_coeff_eq_imp. intros. + elim (le_lt_dec i n); intros. + astepl (nth_coeff (n - i) (Rev n p)). + pattern i at 2 in |- *. replace i with (n - (n - i)). + apply Rev_coeff. + omega. + omega. + unfold degree_le in H. + Step_final (Zero:R). Qed. Hint Resolve Rev_rev: algebra. Lemma Rev_degree_le : forall n p, degree_le n (Rev n p). -unfold degree_le in |- *. algebra. +Proof. + unfold degree_le in |- *. algebra. Qed. Lemma Rev_degree : forall n p, p ! Zero [#] Zero -> degree n (Rev n p). -unfold degree_le in |- *. unfold degree in |- *. intros. split. -astepl (nth_coeff (n - n) p). -replace (n - n) with 0. -astepl p ! Zero. auto. -auto with arith. -apply Rev_degree_le. +Proof. + unfold degree_le in |- *. unfold degree in |- *. intros. split. + astepl (nth_coeff (n - n) p). + replace (n - n) with 0. + astepl p ! Zero. auto. + auto with arith. + apply Rev_degree_le. Qed. Lemma Rev_monom : forall (c : R) m n, m <= n -> Rev n (monom c m) [=] monom c (n - m). -intros. -apply all_nth_coeff_eq_imp. intros. -elim (le_lt_dec i n); intro y. -astepl (nth_coeff (n - i) (monom c m)). -elim (eq_nat_dec m (n - i)); intro H0. -cut (i = n - m). intro y0. -rewrite <- y0. rewrite H0. Step_final c. -omega. -cut (n - m <> i). intro. -Step_final (Zero:R). -omega. -cut (n - m <> i). intro. -Step_final (Zero:R). -omega. +Proof. + intros. + apply all_nth_coeff_eq_imp. intros. + elim (le_lt_dec i n); intro y. + astepl (nth_coeff (n - i) (monom c m)). + elim (eq_nat_dec m (n - i)); intro H0. + cut (i = n - m). intro y0. + rewrite <- y0. rewrite H0. Step_final c. + omega. + cut (n - m <> i). intro. + Step_final (Zero:R). + omega. + cut (n - m <> i). intro. + Step_final (Zero:R). + omega. Qed. Hint Resolve Rev_monom: algebra. Lemma Rev_zero : forall n, Rev n Zero [=] (Zero:RX). -intros. -apply all_nth_coeff_eq_imp. intros. -elim (le_lt_dec i n); intros. -astepl (nth_coeff (n - i) Zero:R). -Step_final (Zero:R). -Step_final (Zero:R). +Proof. + intros. + apply all_nth_coeff_eq_imp. intros. + elim (le_lt_dec i n); intros. + astepl (nth_coeff (n - i) Zero:R). + Step_final (Zero:R). + Step_final (Zero:R). Qed. Hint Resolve Rev_zero: algebra. Lemma Rev_plus : forall p1 p2 n, Rev n (p1[+]p2) [=] Rev n p1[+]Rev n p2. -intros. -apply all_nth_coeff_eq_imp. intros. -elim (le_lt_dec i n); intros. -astepl (nth_coeff (n - i) (p1[+]p2)). -unfold RX in |- *. -astepl (nth_coeff (n - i) p1[+]nth_coeff (n - i) p2). -Step_final (nth_coeff i (Rev n p1) [+]nth_coeff i (Rev n p2)). -astepl (Zero:R). -astepl (Zero[+] (Zero:R)). -Step_final (nth_coeff i (Rev n p1) [+]nth_coeff i (Rev n p2)). +Proof. + intros. + apply all_nth_coeff_eq_imp. intros. + elim (le_lt_dec i n); intros. + astepl (nth_coeff (n - i) (p1[+]p2)). + unfold RX in |- *. + astepl (nth_coeff (n - i) p1[+]nth_coeff (n - i) p2). + Step_final (nth_coeff i (Rev n p1) [+]nth_coeff i (Rev n p2)). + astepl (Zero:R). + astepl (Zero[+] (Zero:R)). + Step_final (nth_coeff i (Rev n p1) [+]nth_coeff i (Rev n p2)). Qed. Hint Resolve Rev_plus: algebra. Lemma Rev_minus : forall p1 p2 n, Rev n (p1[-]p2) [=] Rev n p1[-]Rev n p2. -intros. -apply all_nth_coeff_eq_imp. intros. -elim (le_lt_dec i n); intros. -astepl (nth_coeff (n - i) (p1[-]p2)). -unfold RX in |- *. -astepl (nth_coeff (n - i) p1[-]nth_coeff (n - i) p2). -Step_final (nth_coeff i (Rev n p1) [-]nth_coeff i (Rev n p2)). -astepl (Zero:R). -astepl (Zero[-] (Zero:R)). -Step_final (nth_coeff i (Rev n p1) [-]nth_coeff i (Rev n p2)). +Proof. + intros. + apply all_nth_coeff_eq_imp. intros. + elim (le_lt_dec i n); intros. + astepl (nth_coeff (n - i) (p1[-]p2)). + unfold RX in |- *. + astepl (nth_coeff (n - i) p1[-]nth_coeff (n - i) p2). + Step_final (nth_coeff i (Rev n p1) [-]nth_coeff i (Rev n p2)). + astepl (Zero:R). + astepl (Zero[-] (Zero:R)). + Step_final (nth_coeff i (Rev n p1) [-]nth_coeff i (Rev n p2)). Qed. Hint Resolve Rev_minus: algebra. Lemma Rev_sum0 : forall a_ l n, Rev n (Sum0 l a_) [=] Sum0 l (fun i => Rev n (a_ i)). -intros. -induction l as [| l Hrecl]. -replace (Sum0 0 a_) with (Zero:RX). -replace (Sum0 0 (fun i : nat => Rev n (a_ i))) with (Zero:RX). -algebra. auto. auto. -replace (Sum0 (S l) a_) with (Sum0 l a_[+]a_ l). -replace (Sum0 (S l) (fun i : nat => Rev n (a_ i))) with - (Sum0 l (fun i : nat => Rev n (a_ i)) [+]Rev n (a_ l)). -astepl (Rev n (Sum0 l a_) [+]Rev n (a_ l)). -apply bin_op_wd_unfolded. auto. algebra. -auto. auto. +Proof. + intros. + induction l as [| l Hrecl]. + replace (Sum0 0 a_) with (Zero:RX). + replace (Sum0 0 (fun i : nat => Rev n (a_ i))) with (Zero:RX). + algebra. auto. auto. + replace (Sum0 (S l) a_) with (Sum0 l a_[+]a_ l). + replace (Sum0 (S l) (fun i : nat => Rev n (a_ i))) with + (Sum0 l (fun i : nat => Rev n (a_ i)) [+]Rev n (a_ l)). + astepl (Rev n (Sum0 l a_) [+]Rev n (a_ l)). + apply bin_op_wd_unfolded. auto. algebra. + auto. auto. Qed. Hint Resolve Rev_sum0: algebra. Lemma Rev_sum : forall a_ k l n, Rev n (Sum k l a_) [=] Sum k l (fun i => Rev n (a_ i)). -intros. -unfold Sum in |- *. unfold Sum1 in |- *. -astepl (Rev n (Sum0 (S l) a_) [-]Rev n (Sum0 k a_)). -apply cg_minus_wd; apply Rev_sum0. +Proof. + intros. + unfold Sum in |- *. unfold Sum1 in |- *. + astepl (Rev n (Sum0 (S l) a_) [-]Rev n (Sum0 k a_)). + apply cg_minus_wd; apply Rev_sum0. Qed. Lemma Rev_mult : forall n1 n2 p1 p2, degree_le n1 p1 -> degree_le n2 p2 -> Rev (n1 + n2) (p1[*]p2) [=] Rev n1 p1[*]Rev n2 p2. -intros. -cut (degree_le (n1 + n2) (p1[*]p2)). intro. -cut - (p1[*]p2 [=] - Sum 0 n2 - (fun i2 : nat => - Sum 0 n1 - (fun i1 : nat => monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2)))). intro. -cut - (Rev (n1 + n2) (p1[*]p2) [=] - Sum 0 n2 - (fun i2 : nat => - Sum 0 n1 - (fun i1 : nat => +Proof. + intros. + cut (degree_le (n1 + n2) (p1[*]p2)). intro. + cut (p1[*]p2 [=] Sum 0 n2 (fun i2 : nat => Sum 0 n1 + (fun i1 : nat => monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2)))). intro. + cut (Rev (n1 + n2) (p1[*]p2) [=] Sum 0 n2 (fun i2 : nat => Sum 0 n1 (fun i1 : nat => + monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (n1 + n2 - (i1 + i2))))). intro. + cut (Rev n1 p1 [=] Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) (n1 - i1))). intro. + cut (Rev n2 p2 [=] Sum 0 n2 (fun i2 : nat => monom (nth_coeff i2 p2) (n2 - i2))). intro. + cut (Rev n1 p1[*]Rev n2 p2 [=] Sum 0 n2 (fun i2 : nat => Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (n1 + n2 - (i1 + i2))))). intro. -cut - (Rev n1 p1 [=] Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) (n1 - i1))). intro. -cut - (Rev n2 p2 [=] Sum 0 n2 (fun i2 : nat => monom (nth_coeff i2 p2) (n2 - i2))). intro. -cut - (Rev n1 p1[*]Rev n2 p2 [=] - Sum 0 n2 - (fun i2 : nat => - Sum 0 n1 - (fun i1 : nat => - monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (n1 + n2 - (i1 + i2))))). intro. -Step_final - (Sum 0 n2 - (fun i2 : nat => - Sum 0 n1 - (fun i1 : nat => - monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (n1 + n2 - (i1 + i2))))). -astepl - (Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) (n1 - i1)) [*] - Sum 0 n2 (fun i2 : nat => monom (nth_coeff i2 p2) (n2 - i2))). -apply - eq_transitive_unfolded - with - (Sum 0 n2 - (fun i2 : nat => + Step_final (Sum 0 n2 (fun i2 : nat => Sum 0 n1 (fun i1 : nat => + monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (n1 + n2 - (i1 + i2))))). + astepl (Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) (n1 - i1)) [*] + Sum 0 n2 (fun i2 : nat => monom (nth_coeff i2 p2) (n2 - i2))). + apply eq_transitive_unfolded with (Sum 0 n2 (fun i2 : nat => Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) (n1 - i1)) [*] - monom (nth_coeff i2 p2) (n2 - i2))). -apply eq_symmetric_unfolded. -apply - mult_distr_sum_lft - with (f := fun i2 : nat => monom (nth_coeff i2 p2) (n2 - i2)). -apply Sum_wd'. auto with arith. intro i2. intros. -astepl - (monom (nth_coeff i2 p2) (n2 - i2) [*] - Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) (n1 - i1))). -apply - eq_transitive_unfolded - with - (Sum 0 n1 - (fun i1 : nat => + monom (nth_coeff i2 p2) (n2 - i2))). + apply eq_symmetric_unfolded. + apply mult_distr_sum_lft with (f := fun i2 : nat => monom (nth_coeff i2 p2) (n2 - i2)). + apply Sum_wd'. auto with arith. intro i2. intros. + astepl (monom (nth_coeff i2 p2) (n2 - i2) [*] + Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) (n1 - i1))). + apply eq_transitive_unfolded with (Sum 0 n1 (fun i1 : nat => monom (nth_coeff i2 p2) (n2 - i2) [*]monom (nth_coeff i1 p1) (n1 - i1))). -apply eq_symmetric_unfolded. -apply - mult_distr_sum_lft - with (f := fun i1 : nat => monom (nth_coeff i1 p1) (n1 - i1)). -apply Sum_wd'. auto with arith. intro i1. intros. -astepl - (monom (nth_coeff i1 p1) (n1 - i1) [*]monom (nth_coeff i2 p2) (n2 - i2)). -astepl (monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (n1 - i1 + (n2 - i2))). -replace (n1 - i1 + (n2 - i2)) with (n1 + n2 - (i1 + i2)). -algebra. -omega. -unfold Rev in |- *. algebra. -unfold Rev in |- *. algebra. -astepl - (Rev (n1 + n2) - (Sum 0 n2 - (fun i2 : nat => - Sum 0 n1 - (fun i1 : nat => - monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2))))). -apply - eq_transitive_unfolded - with - (Sum 0 n2 - (fun i2 : nat => - Rev (n1 + n2) - (Sum 0 n1 - (fun i1 : nat => - monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2))))). -apply - Rev_sum - with - (a_ := fun i2 : nat => - Sum 0 n1 - (fun i1 : nat => - monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2))). -apply Sum_wd'. auto with arith. intro i2. intros. -apply - eq_transitive_unfolded - with - (Sum 0 n1 - (fun i1 : nat => - Rev (n1 + n2) (monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2)))). -apply - Rev_sum - with - (a_ := fun i1 : nat => - monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2)). -apply Sum_wd'. auto with arith. intro i1. intros. -apply Rev_monom. omega. -astepl - (Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) i1) [*] - Sum 0 n2 (fun i2 : nat => monom (nth_coeff i2 p2) i2)). -apply - eq_transitive_unfolded - with - (Sum 0 n2 - (fun i2 : nat => - Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) i1) [*] - monom (nth_coeff i2 p2) i2)). -apply eq_symmetric_unfolded. -apply - mult_distr_sum_lft with (f := fun i2 : nat => monom (nth_coeff i2 p2) i2). -apply Sum_wd'. auto with arith. intro i2. intros. -astepl - (monom (nth_coeff i2 p2) i2[*] - Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) i1)). -apply - eq_transitive_unfolded - with - (Sum 0 n1 - (fun i1 : nat => - monom (nth_coeff i2 p2) i2[*]monom (nth_coeff i1 p1) i1)). -apply eq_symmetric_unfolded. -apply - mult_distr_sum_lft with (f := fun i1 : nat => monom (nth_coeff i1 p1) i1). -apply Sum_wd'. auto with arith. intro i1. intros. -Step_final (monom (nth_coeff i1 p1) i1[*]monom (nth_coeff i2 p2) i2). -unfold RX in |- *. apply degree_le_mult; auto. + apply eq_symmetric_unfolded. + apply mult_distr_sum_lft with (f := fun i1 : nat => monom (nth_coeff i1 p1) (n1 - i1)). + apply Sum_wd'. auto with arith. intro i1. intros. + astepl (monom (nth_coeff i1 p1) (n1 - i1) [*]monom (nth_coeff i2 p2) (n2 - i2)). + astepl (monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (n1 - i1 + (n2 - i2))). + replace (n1 - i1 + (n2 - i2)) with (n1 + n2 - (i1 + i2)). + algebra. + omega. + unfold Rev in |- *. algebra. + unfold Rev in |- *. algebra. + astepl (Rev (n1 + n2) (Sum 0 n2 (fun i2 : nat => Sum 0 n1 (fun i1 : nat => + monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2))))). + apply eq_transitive_unfolded with (Sum 0 n2 (fun i2 : nat => Rev (n1 + n2) (Sum 0 n1 (fun i1 : nat => + monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2))))). + apply Rev_sum with (a_ := fun i2 : nat => Sum 0 n1 (fun i1 : nat => + monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2))). + apply Sum_wd'. auto with arith. intro i2. intros. + apply eq_transitive_unfolded with (Sum 0 n1 (fun i1 : nat => + Rev (n1 + n2) (monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2)))). + apply Rev_sum with (a_ := fun i1 : nat => monom (nth_coeff i1 p1[*]nth_coeff i2 p2) (i1 + i2)). + apply Sum_wd'. auto with arith. intro i1. intros. + apply Rev_monom. omega. + astepl (Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) i1) [*] + Sum 0 n2 (fun i2 : nat => monom (nth_coeff i2 p2) i2)). + apply eq_transitive_unfolded with (Sum 0 n2 (fun i2 : nat => + Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) i1) [*] monom (nth_coeff i2 p2) i2)). + apply eq_symmetric_unfolded. + apply mult_distr_sum_lft with (f := fun i2 : nat => monom (nth_coeff i2 p2) i2). + apply Sum_wd'. auto with arith. intro i2. intros. + astepl (monom (nth_coeff i2 p2) i2[*] Sum 0 n1 (fun i1 : nat => monom (nth_coeff i1 p1) i1)). + apply eq_transitive_unfolded with (Sum 0 n1 (fun i1 : nat => + monom (nth_coeff i2 p2) i2[*]monom (nth_coeff i1 p1) i1)). + apply eq_symmetric_unfolded. + apply mult_distr_sum_lft with (f := fun i1 : nat => monom (nth_coeff i1 p1) i1). + apply Sum_wd'. auto with arith. intro i1. intros. + Step_final (monom (nth_coeff i1 p1) i1[*]monom (nth_coeff i2 p2) i2). + unfold RX in |- *. apply degree_le_mult; auto. Qed. End Poly_Reverse. diff --git a/fta/CPoly_Shift.v b/fta/CPoly_Shift.v index 9282f570e..d2e617a75 100644 --- a/fta/CPoly_Shift.v +++ b/fta/CPoly_Shift.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CComplex. @@ -49,148 +49,132 @@ Definition Shift (a : CC) (p : CCX) := Sum 0 (lth_of_poly p) (fun i => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i). Lemma Shift_apply : forall a p (x : CC), (Shift a p) ! x [=] p ! (x[+]a). -intros. -unfold Shift in |- *. -apply - eq_transitive_unfolded - with - (Sum 0 (lth_of_poly p) - (fun i : nat => (_C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) ! x)). -apply - Sum_cpoly_ap - with (f := fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i). -apply eq_symmetric_unfolded. -astepl - (Sum 0 (lth_of_poly p) (fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i)) - ! (x[+]a). -apply - eq_transitive_unfolded - with - (Sum 0 (lth_of_poly p) - (fun i : nat => (_C_ (nth_coeff i p) [*]_X_[^]i) ! (x[+]a))). -apply Sum_cpoly_ap with (f := fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i). -apply Sum_wd. intros. -astepl ((_C_ (nth_coeff i p)) ! (x[+]a) [*] (_X_[^]i) ! (x[+]a)). -astepl (nth_coeff i p[*]_X_ ! (x[+]a) [^]i). -astepl (nth_coeff i p[*] (x[+]a) [^]i). -astepl (nth_coeff i p[*] (_X_ ! x[+] (_C_ a) ! x) [^]i). -astepl (nth_coeff i p[*] (_X_[+]_C_ a) ! x[^]i). -Step_final ((_C_ (nth_coeff i p)) ! x[*] ((_X_[+]_C_ a) [^]i) ! x). +Proof. + intros. + unfold Shift in |- *. + apply eq_transitive_unfolded with (Sum 0 (lth_of_poly p) + (fun i : nat => (_C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) ! x)). + apply Sum_cpoly_ap with (f := fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i). + apply eq_symmetric_unfolded. + astepl (Sum 0 (lth_of_poly p) (fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i)) ! (x[+]a). + apply eq_transitive_unfolded with (Sum 0 (lth_of_poly p) + (fun i : nat => (_C_ (nth_coeff i p) [*]_X_[^]i) ! (x[+]a))). + apply Sum_cpoly_ap with (f := fun i : nat => _C_ (nth_coeff i p) [*]_X_[^]i). + apply Sum_wd. intros. + astepl ((_C_ (nth_coeff i p)) ! (x[+]a) [*] (_X_[^]i) ! (x[+]a)). + astepl (nth_coeff i p[*]_X_ ! (x[+]a) [^]i). + astepl (nth_coeff i p[*] (x[+]a) [^]i). + astepl (nth_coeff i p[*] (_X_ ! x[+] (_C_ a) ! x) [^]i). + astepl (nth_coeff i p[*] (_X_[+]_C_ a) ! x[^]i). + Step_final ((_C_ (nth_coeff i p)) ! x[*] ((_X_[+]_C_ a) [^]i) ! x). Qed. Hint Resolve Shift_apply: algebra. Lemma Shift_wdr : forall a p p', p [=] p' -> Shift a p [=] Shift a p'. -intros. apply poly_CC_extensional. intros. -astepl p ! (x[+]a). Step_final p' ! (x[+]a). +Proof. + intros. apply poly_CC_extensional. intros. + astepl p ! (x[+]a). Step_final p' ! (x[+]a). Qed. Lemma Shift_shift : forall a p, Shift [--]a (Shift a p) [=] p. -intros. apply poly_CC_extensional. intros. -astepl (Shift a p) ! (x[+][--]a). -astepl p ! (x[+][--]a[+]a). -apply apply_wd. algebra. rational. +Proof. + intros. apply poly_CC_extensional. intros. + astepl (Shift a p) ! (x[+][--]a). + astepl p ! (x[+][--]a[+]a). + apply apply_wd. algebra. rational. Qed. Lemma Shift_mult : forall a p1 p2, Shift a (p1[*]p2) [=] Shift a p1[*]Shift a p2. -intros. apply poly_CC_extensional. intros. -astepl (p1[*]p2) ! (x[+]a). -astepl (p1 ! (x[+]a) [*]p2 ! (x[+]a)). -Step_final ((Shift a p1) ! x[*] (Shift a p2) ! x). +Proof. + intros. apply poly_CC_extensional. intros. + astepl (p1[*]p2) ! (x[+]a). + astepl (p1 ! (x[+]a) [*]p2 ! (x[+]a)). + Step_final ((Shift a p1) ! x[*] (Shift a p2) ! x). Qed. Lemma Shift_degree_le : forall a p n, degree_le n p -> degree_le n (Shift a p). -intros. -unfold Shift in |- *. -apply Sum_degree_le. auto with arith. intros. -elim (le_lt_dec i n); intros. -replace n with (0 + n). -apply degree_le_mult. apply degree_le_c_. -apply degree_le_mon with (1 * i). -omega. -apply degree_le_nexp. apply degree_imp_degree_le. -apply degree_wd with (_C_ a[+]_X_). algebra. -apply degree_plus_rht with 0. apply degree_le_c_. apply degree_x_. -auto. auto. -unfold degree_le in H. -apply degree_le_wd with (_C_ (Zero:CC)). -astepl (Zero:cpoly_cring CC). -astepl (Zero[*] (_X_[+]_C_ a) [^]i). -apply bin_op_wd_unfolded. -Step_final (_C_ (Zero:CC)). -algebra. -apply degree_le_mon with 0. -auto with arith. -apply degree_le_c_. +Proof. + intros. + unfold Shift in |- *. + apply Sum_degree_le. auto with arith. intros. + elim (le_lt_dec i n); intros. + replace n with (0 + n). + apply degree_le_mult. apply degree_le_c_. + apply degree_le_mon with (1 * i). + omega. + apply degree_le_nexp. apply degree_imp_degree_le. + apply degree_wd with (_C_ a[+]_X_). algebra. + apply degree_plus_rht with 0. apply degree_le_c_. apply degree_x_. + auto. auto. + unfold degree_le in H. + apply degree_le_wd with (_C_ (Zero:CC)). + astepl (Zero:cpoly_cring CC). + astepl (Zero[*] (_X_[+]_C_ a) [^]i). + apply bin_op_wd_unfolded. + Step_final (_C_ (Zero:CC)). + algebra. + apply degree_le_mon with 0. + auto with arith. + apply degree_le_c_. Qed. Lemma Shift_monic : forall a p n, monic n p -> monic n (Shift a p). -intros. -unfold monic in H. elim H. clear H. intros H H0. unfold degree_le in H0. -apply - monic_wd - with (Sum 0 n (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i)). -astepl - (Sum 0 n (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) [+]Zero). -apply - eq_transitive_unfolded - with - (Sum 0 n (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) [+] - Sum (S n) (lth_of_poly p) - (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i)). -apply bin_op_wd_unfolded. algebra. -apply eq_symmetric_unfolded. -apply Sum_zero. -cut (n < lth_of_poly p). intro. auto with arith. -apply lt_i_lth_of_poly. astepl (One:CC). algebra. -intros. cut (n < i). intro. -astepl (_C_ Zero[*] (_X_[+]_C_ a) [^]i). -Step_final (Zero[*] (_X_[+]_C_ a) [^]i). -auto with arith. -unfold Shift in |- *. -apply Sum_Sum. -elim (O_or_S n); intro y. elim y. clear y. intros x y. -rewrite <- y in H. rewrite <- y in H0. rewrite <- y. -apply - monic_wd - with - (Sum 0 x (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) [+] - (_X_[+]_C_ a) [^]S x). -apply - eq_transitive_unfolded - with - (Sum 0 x (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) [+] - _C_ (nth_coeff (S x) p) [*] (_X_[+]_C_ a) [^]S x). -apply bin_op_wd_unfolded. algebra. -astepl (One[*] (_X_[+]_C_ a) [^]S x). -apply bin_op_wd_unfolded. -Step_final (_C_ (One:CC)). algebra. -apply eq_symmetric_unfolded. -apply - Sum_last with (f := fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i). -apply monic_plus with x. -apply Sum_degree_le. auto with arith. intros. -replace x with (0 + x). -apply degree_le_mult. apply degree_le_c_. -apply degree_le_mon with (1 * i). -omega. -apply degree_le_nexp. apply degree_imp_degree_le. -apply degree_wd with (_C_ a[+]_X_). algebra. -apply degree_plus_rht with 0. apply degree_le_c_. apply degree_x_. -auto. auto. -pattern (S x) at 1 in |- *. replace (S x) with (1 * S x). -apply monic_nexp. -apply monic_wd with (_C_ a[+]_X_). algebra. -apply monic_plus with 0. apply degree_le_c_. -apply monic_x_. -auto. auto with arith. auto. -rewrite <- y in H. rewrite <- y in H0. rewrite <- y. -apply monic_wd with (One:CCX). -unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. split. -cut (One [=] nth_coeff 0 p[*]One[+]Zero). auto. -astepl (nth_coeff 0 p). rational. auto. -apply monic_wd with (_C_ (One:CC)). algebra. -apply monic_c_one. +Proof. + intros. + unfold monic in H. elim H. clear H. intros H H0. unfold degree_le in H0. + apply monic_wd with (Sum 0 n (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i)). + astepl (Sum 0 n (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) [+]Zero). + apply eq_transitive_unfolded with + (Sum 0 n (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) [+] Sum (S n) (lth_of_poly p) + (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i)). + apply bin_op_wd_unfolded. algebra. + apply eq_symmetric_unfolded. + apply Sum_zero. + cut (n < lth_of_poly p). intro. auto with arith. + apply lt_i_lth_of_poly. astepl (One:CC). algebra. + intros. cut (n < i). intro. + astepl (_C_ Zero[*] (_X_[+]_C_ a) [^]i). + Step_final (Zero[*] (_X_[+]_C_ a) [^]i). + auto with arith. + unfold Shift in |- *. + apply Sum_Sum. + elim (O_or_S n); intro y. elim y. clear y. intros x y. + rewrite <- y in H. rewrite <- y in H0. rewrite <- y. + apply monic_wd with (Sum 0 x (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) [+] + (_X_[+]_C_ a) [^]S x). + apply eq_transitive_unfolded with + (Sum 0 x (fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i) [+] + _C_ (nth_coeff (S x) p) [*] (_X_[+]_C_ a) [^]S x). + apply bin_op_wd_unfolded. algebra. + astepl (One[*] (_X_[+]_C_ a) [^]S x). + apply bin_op_wd_unfolded. + Step_final (_C_ (One:CC)). algebra. + apply eq_symmetric_unfolded. + apply Sum_last with (f := fun i : nat => _C_ (nth_coeff i p) [*] (_X_[+]_C_ a) [^]i). + apply monic_plus with x. + apply Sum_degree_le. auto with arith. intros. + replace x with (0 + x). + apply degree_le_mult. apply degree_le_c_. + apply degree_le_mon with (1 * i). + omega. + apply degree_le_nexp. apply degree_imp_degree_le. + apply degree_wd with (_C_ a[+]_X_). algebra. + apply degree_plus_rht with 0. apply degree_le_c_. apply degree_x_. + auto. auto. + pattern (S x) at 1 in |- *. replace (S x) with (1 * S x). + apply monic_nexp. + apply monic_wd with (_C_ a[+]_X_). algebra. + apply monic_plus with 0. apply degree_le_c_. + apply monic_x_. + auto. auto with arith. auto. + rewrite <- y in H. rewrite <- y in H0. rewrite <- y. + apply monic_wd with (One:CCX). + unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. split. + cut (One [=] nth_coeff 0 p[*]One[+]Zero). auto. + astepl (nth_coeff 0 p). rational. auto. + apply monic_wd with (_C_ (One:CC)). algebra. + apply monic_c_one. Qed. End Poly_Shifted. diff --git a/fta/FTA.v b/fta/FTA.v index c52ed5810..2dd1abc2f 100644 --- a/fta/FTA.v +++ b/fta/FTA.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CPoly_Rev. Require Export FTAreg. @@ -51,17 +51,18 @@ Variable n : nat. Hypothesis f_degree : degree (S n) f. Lemma FTA_reg' : {f1 : CCX | degree 1 f1 | {f2 : CCX | degree n f2 | f [=] f1[*]f2}}. -elim (FTA_reg f (S n)). intro c. intro H. -cut (degree 1 (_X_[-]_C_ c)). intro. -exists (_X_[-]_C_ c). auto. -elim (poly_linear_factor _ _ _ H). -intro f2. intros. -exists f2. -apply degree_mult_imp with (_X_[-]_C_ c) 1. auto. -apply degree_wd with f; auto. auto. -apply degree_minus_lft with 0. apply degree_le_c_. apply degree_x_. auto. -auto with arith. -auto. +Proof. + elim (FTA_reg f (S n)). intro c. intro H. + cut (degree 1 (_X_[-]_C_ c)). intro. + exists (_X_[-]_C_ c). auto. + elim (poly_linear_factor _ _ _ H). + intro f2. intros. + exists f2. + apply degree_mult_imp with (_X_[-]_C_ c) 1. auto. + apply degree_wd with f; auto. auto. + apply degree_minus_lft with 0. apply degree_le_c_. apply degree_x_. auto. + auto with arith. + auto. Qed. End FTA_reg'. @@ -82,57 +83,60 @@ Variable c : CC. Hypothesis f_c : f ! c [#] Zero. Lemma FTA_1a : degree_le (S n) (Shift c f). -apply Shift_degree_le. -auto. +Proof. + apply Shift_degree_le. + auto. Qed. Let g := Rev (S n) (Shift c f). Lemma FTA_1b : degree (S n) g. -unfold g in |- *. -apply Rev_degree. -astepl f ! c. auto. - -Step_final f ! (Zero[+]c). +Proof. + unfold g in |- *. + apply Rev_degree. + astepl f ! c. auto. + Step_final f ! (Zero[+]c). Qed. Lemma FTA_1 : {f1 : CCX | {f2 : CCX | degree_le 1 f1 /\ degree_le n f2 /\ f [=] f1[*]f2}}. -elim (FTA_reg' g n FTA_1b). intro g1. intros H H0. -elim H0. clear H0. intro g2. intros H0 H1. -cut (degree_le 1 g1). intro. -cut (degree_le n g2). intro. -exists (Shift [--]c (Rev 1 g1)). -exists (Shift [--]c (Rev n g2)). -split. -apply Shift_degree_le. -apply Rev_degree_le. -split. -apply Shift_degree_le. -apply Rev_degree_le. -cut (degree_le (1 + n) (g1[*]g2)). intro. -cut (degree_le (1 + n) g). intro. -cut (degree_le (1 + n) (Shift c f)). intro. -astepl (Shift [--]c (Shift c f)). -astepl (Shift [--]c (Rev (1 + n) (Rev (S n) (Shift c f)))). -astepl (Shift [--]c (Rev (1 + n) g)). -astepl (Shift [--]c (Rev (1 + n) (g1[*]g2))). -Step_final (Shift [--]c (Rev 1 g1[*]Rev n g2)). -exact FTA_1a. -apply degree_le_wd with (g1[*]g2); algebra. -apply degree_le_mult; auto. -apply degree_imp_degree_le; auto. -apply degree_imp_degree_le; auto. +Proof. + elim (FTA_reg' g n FTA_1b). intro g1. intros H H0. + elim H0. clear H0. intro g2. intros H0 H1. + cut (degree_le 1 g1). intro. + cut (degree_le n g2). intro. + exists (Shift [--]c (Rev 1 g1)). + exists (Shift [--]c (Rev n g2)). + split. + apply Shift_degree_le. + apply Rev_degree_le. + split. + apply Shift_degree_le. + apply Rev_degree_le. + cut (degree_le (1 + n) (g1[*]g2)). intro. + cut (degree_le (1 + n) g). intro. + cut (degree_le (1 + n) (Shift c f)). intro. + astepl (Shift [--]c (Shift c f)). + astepl (Shift [--]c (Rev (1 + n) (Rev (S n) (Shift c f)))). + astepl (Shift [--]c (Rev (1 + n) g)). + astepl (Shift [--]c (Rev (1 + n) (g1[*]g2))). + Step_final (Shift [--]c (Rev 1 g1[*]Rev n g2)). + exact FTA_1a. + apply degree_le_wd with (g1[*]g2); algebra. + apply degree_le_mult; auto. + apply degree_imp_degree_le; auto. + apply degree_imp_degree_le; auto. Qed. Lemma FTA_1' : {a : CC | {b : CC | {g : CCX | degree_le n g | f [=] (_C_ a[*]_X_[+]_C_ b) [*]g}}}. -elim FTA_1. intro f1. intros H. -elim H. clear H. intros f2 H0. -elim H0. clear H0. intro H. intros H0. -elim H0. clear H0. intros H0 H1. -elim (degree_le_1_imp _ f1); auto. intro a. intros H2. exists a. -elim H2. clear H2. intro b. intros. exists b. -exists f2. auto. -Step_final (f1[*]f2). +Proof. + elim FTA_1. intro f1. intros H. + elim H. clear H. intros f2 H0. + elim H0. clear H0. intro H. intros H0. + elim H0. clear H0. intros H0 H1. + elim (degree_le_1_imp _ f1); auto. intro a. intros H2. exists a. + elim H2. clear H2. intro b. intros. exists b. + exists f2. auto. + Step_final (f1[*]f2). Qed. End FTA_1. @@ -140,121 +144,109 @@ End FTA_1. Section Fund_Thm_Alg. Lemma FTA' : forall n (f : CCX), degree_le n f -> nonConst _ f -> {z : CC | f ! z [=] Zero}. -intro n. induction n as [| n Hrecn]. -unfold nonConst in |- *. unfold degree_le in |- *. intros f H H0. -elim H0. clear H0. intro n. intros H0 H1. -elim (eq_imp_not_ap _ _ _ (H _ H0) H1). -unfold nonConst in |- *. intros f H H0. -elim H0. clear H0. intro m'. intros H0 H1. -elim (poly_apzero_CC f). intro c. intros H2. -elim (FTA_1' f n H c H2). intro a. intros H3. -elim H3. clear H3. intro b. intros H3. -elim H3. clear H3. intro g. intros H3 H4. -elim (O_or_S m'); intro y. -elim y. clear y. intro m. intro y. rewrite <- y in H0. rewrite <- y in H1. -cut (a[*]nth_coeff m g [#] Zero or b[*]nth_coeff (S m) g [#] Zero). -intro H5. -elim H5; clear H5; intros H5. -cut (a [#] Zero). intro H6. -exists ( [--]b[/] a[//]H6). -astepl ((_C_ a[*]_X_[+]_C_ b) [*]g) ! ( [--]b[/] a[//]H6). -astepl ((_C_ a[*]_X_[+]_C_ b) ! ( [--]b[/] a[//]H6) [*]g ! ( [--]b[/] a[//]H6)). -astepl - (((_C_ a[*]_X_) ! ( [--]b[/] a[//]H6) [+] (_C_ b) ! ( [--]b[/] a[//]H6)) [*] - g ! ( [--]b[/] a[//]H6)). -astepl - (((_C_ a) ! ( [--]b[/] a[//]H6) [*]_X_ ! ( [--]b[/] a[//]H6) [+]b) [*] - g ! ( [--]b[/] a[//]H6)). -astepl ((a[*] ( [--]b[/] a[//]H6) [+]b) [*]g ! ( [--]b[/] a[//]H6)). -rational. -apply cring_mult_ap_zero with (nth_coeff m g). auto. -elim (Hrecn g); auto. intro z. intros. exists z. -astepl ((_C_ a[*]_X_[+]_C_ b) [*]g) ! z. -astepl ((_C_ a[*]_X_[+]_C_ b) ! z[*]g ! z). -Step_final ((_C_ a[*]_X_[+]_C_ b) ! z[*]Zero). -unfold nonConst in |- *. exists (S m). auto. -apply cring_mult_ap_zero_op with b. auto. -apply cg_add_ap_zero. -astepl (nth_coeff (S m) f). auto. -Step_final (nth_coeff (S m) ((_C_ a[*]_X_[+]_C_ b) [*]g)). -rewrite <- y in H0. elim (lt_irrefl 0 H0). -apply nth_coeff_ap_zero_imp with m'. auto. +Proof. + intro n. induction n as [| n Hrecn]. + unfold nonConst in |- *. unfold degree_le in |- *. intros f H H0. + elim H0. clear H0. intro n. intros H0 H1. + elim (eq_imp_not_ap _ _ _ (H _ H0) H1). + unfold nonConst in |- *. intros f H H0. + elim H0. clear H0. intro m'. intros H0 H1. + elim (poly_apzero_CC f). intro c. intros H2. + elim (FTA_1' f n H c H2). intro a. intros H3. + elim H3. clear H3. intro b. intros H3. + elim H3. clear H3. intro g. intros H3 H4. + elim (O_or_S m'); intro y. + elim y. clear y. intro m. intro y. rewrite <- y in H0. rewrite <- y in H1. + cut (a[*]nth_coeff m g [#] Zero or b[*]nth_coeff (S m) g [#] Zero). + intro H5. + elim H5; clear H5; intros H5. + cut (a [#] Zero). intro H6. + exists ( [--]b[/] a[//]H6). + astepl ((_C_ a[*]_X_[+]_C_ b) [*]g) ! ( [--]b[/] a[//]H6). + astepl ((_C_ a[*]_X_[+]_C_ b) ! ( [--]b[/] a[//]H6) [*]g ! ( [--]b[/] a[//]H6)). + astepl (((_C_ a[*]_X_) ! ( [--]b[/] a[//]H6) [+] (_C_ b) ! ( [--]b[/] a[//]H6)) [*] + g ! ( [--]b[/] a[//]H6)). + astepl (((_C_ a) ! ( [--]b[/] a[//]H6) [*]_X_ ! ( [--]b[/] a[//]H6) [+]b) [*] + g ! ( [--]b[/] a[//]H6)). + astepl ((a[*] ( [--]b[/] a[//]H6) [+]b) [*]g ! ( [--]b[/] a[//]H6)). + rational. + apply cring_mult_ap_zero with (nth_coeff m g). auto. + elim (Hrecn g); auto. intro z. intros. exists z. + astepl ((_C_ a[*]_X_[+]_C_ b) [*]g) ! z. + astepl ((_C_ a[*]_X_[+]_C_ b) ! z[*]g ! z). + Step_final ((_C_ a[*]_X_[+]_C_ b) ! z[*]Zero). + unfold nonConst in |- *. exists (S m). auto. + apply cring_mult_ap_zero_op with b. auto. + apply cg_add_ap_zero. + astepl (nth_coeff (S m) f). auto. + Step_final (nth_coeff (S m) ((_C_ a[*]_X_[+]_C_ b) [*]g)). + rewrite <- y in H0. elim (lt_irrefl 0 H0). + apply nth_coeff_ap_zero_imp with m'. auto. Qed. Lemma FTA : forall f : CCX, nonConst _ f -> {z : CC | f ! z [=] Zero}. -intros. -elim (Cpoly_ex_degree _ f). intro n. intros. (* Set_ not necessary *) -apply FTA' with n; auto. +Proof. + intros. + elim (Cpoly_ex_degree _ f). intro n. intros. (* Set_ not necessary *) + apply FTA' with n; auto. Qed. Lemma FTA_a_la_Henk : forall f : CCX, {x : CC | {y : CC | AbsCC (f ! x[-]f ! y) [>]Zero}} -> {z : CC | f ! z [=] Zero}. -intros f H. -elim H. -intros x H0. -elim H0. -intros y H1. -pose (H1':=(CAnd_proj1 _ _ (greater_def _ _ _) H1)). -clearbody H1'. -clear H1. -rename H1' into H1. -generalize (less_imp_ap _ _ _ H1); intro H2. -generalize (AbsCC_ap_zero _ H2); intro H3. - -cut - (Sum 0 (lth_of_poly f) (fun i : nat => nth_coeff i f[*] (x[^]i[-]y[^]i)) [#] - Zero). -intro H4. -cut (0 <= lth_of_poly f); try auto with arith. -intro H5. -generalize (Sum_apzero _ _ _ _ H5 H4); intro H6. -elim H6; intros i H8 H9. -elim H8; intros H10 H11. -apply FTA. -unfold nonConst in |- *. -generalize (cring_mult_ap_zero _ _ _ H9); intro H12. -exists i. -elim (zerop i). -intro H13. -elimtype False. -elim (ap_irreflexive_unfolded _ (Zero:CC)). -rstepl (nth_coeff i f[*] (x[^]0[-]y[^]0)). -rewrite <- H13. -assumption. -auto. -assumption. -apply - ap_wdl_unfolded - with - (Sum 0 (lth_of_poly f) - (fun i : nat => nth_coeff i f[*]x[^]i[-]nth_coeff i f[*]y[^]i)). -2: apply Sum_wd. -2: intro. -2: algebra. -apply - ap_wdl_unfolded - with - (Sum 0 (lth_of_poly f) (fun i : nat => nth_coeff i f[*]x[^]i) [-] - Sum 0 (lth_of_poly f) (fun i : nat => nth_coeff i f[*]y[^]i)). -2: apply eq_symmetric_unfolded. -2: change - (Sum 0 (lth_of_poly f) - (fun j : nat => - (fun i : nat => nth_coeff i f[*]x[^]i) j[-] - (fun i : nat => nth_coeff i f[*]y[^]i) j) [=] +Proof. + intros f H. + elim H. + intros x H0. + elim H0. + intros y H1. + pose (H1':=(CAnd_proj1 _ _ (greater_def _ _ _) H1)). + clearbody H1'. + clear H1. + rename H1' into H1. + generalize (less_imp_ap _ _ _ H1); intro H2. + generalize (AbsCC_ap_zero _ H2); intro H3. + cut (Sum 0 (lth_of_poly f) (fun i : nat => nth_coeff i f[*] (x[^]i[-]y[^]i)) [#] Zero). + intro H4. + cut (0 <= lth_of_poly f); try auto with arith. + intro H5. + generalize (Sum_apzero _ _ _ _ H5 H4); intro H6. + elim H6; intros i H8 H9. + elim H8; intros H10 H11. + apply FTA. + unfold nonConst in |- *. + generalize (cring_mult_ap_zero _ _ _ H9); intro H12. + exists i. + elim (zerop i). + intro H13. + elimtype False. + elim (ap_irreflexive_unfolded _ (Zero:CC)). + rstepl (nth_coeff i f[*] (x[^]0[-]y[^]0)). + rewrite <- H13. + assumption. + auto. + assumption. + apply ap_wdl_unfolded with (Sum 0 (lth_of_poly f) + (fun i : nat => nth_coeff i f[*]x[^]i[-]nth_coeff i f[*]y[^]i)). + 2: apply Sum_wd. + 2: intro. + 2: algebra. + apply ap_wdl_unfolded with (Sum 0 (lth_of_poly f) (fun i : nat => nth_coeff i f[*]x[^]i) [-] + Sum 0 (lth_of_poly f) (fun i : nat => nth_coeff i f[*]y[^]i)). + 2: apply eq_symmetric_unfolded. + 2: change (Sum 0 (lth_of_poly f) (fun j : nat => (fun i : nat => nth_coeff i f[*]x[^]i) j[-] + (fun i : nat => nth_coeff i f[*]y[^]i) j) [=] Sum 0 (lth_of_poly f) (fun i : nat => nth_coeff i f[*]x[^]i) [-] - Sum 0 (lth_of_poly f) (fun i : nat => nth_coeff i f[*]y[^]i)) - in |- *. -2: apply Sum_minus_Sum. -apply ap_wdl_unfolded with (f ! x[-]f ! y). -2: unfold cg_minus in |- *. -2: apply csbf_wd_unfolded. -2: apply poly_as_sum. -2: apply poly_degree_lth. -2: apply csf_wd_unfolded. -2: apply poly_as_sum. -2: apply poly_degree_lth. -assumption. + Sum 0 (lth_of_poly f) (fun i : nat => nth_coeff i f[*]y[^]i)) in |- *. + 2: apply Sum_minus_Sum. + apply ap_wdl_unfolded with (f ! x[-]f ! y). + 2: unfold cg_minus in |- *. + 2: apply csbf_wd_unfolded. + 2: apply poly_as_sum. + 2: apply poly_degree_lth. + 2: apply csf_wd_unfolded. + 2: apply poly_as_sum. + 2: apply poly_degree_lth. + assumption. Qed. End Fund_Thm_Alg. diff --git a/fta/FTAreg.v b/fta/FTAreg.v index e60f54f2a..62aa025ed 100644 --- a/fta/FTAreg.v +++ b/fta/FTAreg.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export KneserLemma. Require Export CPoly_Shift. @@ -55,7 +55,7 @@ Hypothesis lt0n : 0 < n. forall (p : CCX), (monic n p) -> forall (c : IR), ((AbsCC (p!Zero)) [<] c) -> {z:CC | ((AbsCC z) [^]n [<] c) | ((AbsCC (p!z)) [<] qK[*]c)}. ]] -Let [p] be a monic polynomial over the complex numbers with degree +Let [p] be a monic polynomial over the complex numbers with degree [n], and let [c0] be such that [(AbsCC (p!Zero)) [<] c0]. %\end{convention}% *) @@ -73,50 +73,49 @@ Hypothesis mp : monic n p. Variable c0 : IR. Hypothesis p0ltc0 : AbsCC p ! Zero [<] c0. -Record Knes_tup : Type := +Record Knes_tup : Type := {z_el :> CC; c_el : IR; Kt_prop : AbsCC p ! z_el [<] c_el}. -Record Knes_tupp (tup : Knes_tup) : Type := +Record Knes_tupp (tup : Knes_tup) : Type := {Kntup :> Knes_tup; Ktp_prop : c_el Kntup [=] qK[*]c_el tup; Ktpp_prop : AbsCC (Kntup[-]tup) [^]n [<=] c_el tup}. Definition Knes_fun : forall tup : Knes_tup, Knes_tupp tup. -intro tup. -elim tup. -intros z c pzltc. -cut (AbsCC (Shift z p) ! Zero [<] c). -intro Hsh. -generalize (q_prop (Shift z p) (Shift_monic z p n mp) c Hsh). -intro Hex. -elim Hex. -intros z'; intros. -cut (AbsCC p ! (z'[+]z) [<] qK[*]c). -intro HH. -apply - (Build_Knes_tupp (Build_Knes_tup z c pzltc) - (Build_Knes_tup (z'[+]z) (qK[*]c) HH)). -simpl in |- *; algebra. -simpl in |- *; apply leEq_wdl with (AbsCC z'[^]n). -assumption. -apply (nexp_wd IR (AbsCC z') (AbsCC (z'[+]z[-]z)) n). -apply AbsCC_wd. -rational. -apply less_wdl with (AbsCC (Shift z p) ! z'). -assumption. -apply AbsCC_wd. -apply Shift_apply. -apply less_wdl with (AbsCC p ! z). -assumption. -generalize (Shift_apply z p Zero). -intro H3. -apply eq_symmetric_unfolded. -apply AbsCC_wd. -apply eq_transitive_unfolded with p ! (Zero[+]z). -assumption. -algebra. +Proof. + intro tup. + elim tup. + intros z c pzltc. + cut (AbsCC (Shift z p) ! Zero [<] c). + intro Hsh. + generalize (q_prop (Shift z p) (Shift_monic z p n mp) c Hsh). + intro Hex. + elim Hex. + intros z'; intros. + cut (AbsCC p ! (z'[+]z) [<] qK[*]c). + intro HH. + apply (Build_Knes_tupp (Build_Knes_tup z c pzltc) (Build_Knes_tup (z'[+]z) (qK[*]c) HH)). + simpl in |- *; algebra. + simpl in |- *; apply leEq_wdl with (AbsCC z'[^]n). + assumption. + apply (nexp_wd IR (AbsCC z') (AbsCC (z'[+]z[-]z)) n). + apply AbsCC_wd. + rational. + apply less_wdl with (AbsCC (Shift z p) ! z'). + assumption. + apply AbsCC_wd. + apply Shift_apply. + apply less_wdl with (AbsCC p ! z). + assumption. + generalize (Shift_apply z p Zero). + intro H3. + apply eq_symmetric_unfolded. + apply AbsCC_wd. + apply eq_transitive_unfolded with p ! (Zero[+]z). + assumption. + algebra. Defined. Fixpoint Knes_fun_it (i : nat) : Knes_tup := @@ -129,67 +128,68 @@ Definition sK := Knes_fun_it:nat -> CC. Lemma sK_c : forall tup : Knes_tup, c_el (Knes_fun tup) [=] qK[*]c_el tup. Proof. -intro tup. -generalize (Ktp_prop tup (Knes_fun tup)). -auto. + intro tup. + generalize (Ktp_prop tup (Knes_fun tup)). + auto. Qed. Lemma sK_c0 : forall i : nat, c_el (Knes_fun_it i) [=] qK[^]i[*]c0. Proof. -simple induction i. -simpl in |- *. -rational. -intros. -simpl in |- *. -generalize (sK_c (Knes_fun_it n0)). -intro H1. -apply eq_transitive_unfolded with (qK[*]c_el (Knes_fun_it n0)). -assumption. -rstepr (qK[*] (nexp IR n0 qK[*]c0)). -apply mult_wdr. -exact H. + simple induction i. + simpl in |- *. + rational. + intros. + simpl in |- *. + generalize (sK_c (Knes_fun_it n0)). + intro H1. + apply eq_transitive_unfolded with (qK[*]c_el (Knes_fun_it n0)). + assumption. + rstepr (qK[*] (nexp IR n0 qK[*]c0)). + apply mult_wdr. + exact H. Qed. Lemma sK_prop1 : forall i : nat, AbsCC p ! (sK i) [<=] qK[^]i[*]c0. -unfold sK in |- *. -simple induction i. -simpl in |- *. -rstepr c0. -apply less_leEq; exact p0ltc0. -intros. -simpl in |- *. -generalize (Kt_prop (Knes_fun (Knes_fun_it n0))). -intro H2. -apply leEq_wdr with (c_el (Knes_fun (Knes_fun_it n0))). -apply less_leEq; assumption. -generalize (sK_c (Knes_fun_it n0)). -intro H3. -eapply eq_transitive_unfolded. -apply H3. -generalize (sK_c0 n0). -intro H4. -rstepr (qK[*] (nexp IR n0 qK[*]c0)). -apply mult_wdr. -exact H4. +Proof. + unfold sK in |- *. + simple induction i. + simpl in |- *. + rstepr c0. + apply less_leEq; exact p0ltc0. + intros. + simpl in |- *. + generalize (Kt_prop (Knes_fun (Knes_fun_it n0))). + intro H2. + apply leEq_wdr with (c_el (Knes_fun (Knes_fun_it n0))). + apply less_leEq; assumption. + generalize (sK_c (Knes_fun_it n0)). + intro H3. + eapply eq_transitive_unfolded. + apply H3. + generalize (sK_c0 n0). + intro H4. + rstepr (qK[*] (nexp IR n0 qK[*]c0)). + apply mult_wdr. + exact H4. Qed. Lemma sK_it : forall tup : Knes_tup, AbsCC (Knes_fun tup[-]tup) [^]n [<=] c_el tup. Proof. -intro tup. -generalize (Ktpp_prop tup (Knes_fun tup)). -auto. + intro tup. + generalize (Ktpp_prop tup (Knes_fun tup)). + auto. Qed. Lemma sK_prop2 : forall i : nat, AbsCC (sK (S i) [-]sK i) [^]n [<=] qK[^]i[*]c0. Proof. -unfold sK in |- *. -simpl in |- *. -intro i. -generalize (sK_it (Knes_fun_it i)). -intro H0. -eapply leEq_wdr. -apply H0. -exact (sK_c0 i). + unfold sK in |- *. + simpl in |- *. + intro i. + generalize (sK_it (Knes_fun_it i)). + intro H0. + eapply leEq_wdr. + apply H0. + exact (sK_c0 i). Qed. End Kneser_Sequence. @@ -203,20 +203,19 @@ Section Seq_Exists_Main. Lemma seq_exists : {q : IR | Zero [<=] q | q [<] One and (forall p : cpoly CC, monic n p -> forall c : IR, AbsCC p ! Zero [<] c -> {s : nat -> CC | forall i, AbsCC p ! (s i) [<=] q[^]i[*]c /\ AbsCC (s (S i) [-]s i) [^]n [<=] q[^]i[*]c})}. - Proof. -elim (Kneser n lt0n). -intros q; intros H H0. -exists q. -assumption. -inversion_clear H0. -rename X0 into H2. -split. assumption. -intros p mp c pzltc. -exists (sK q H2 p mp c pzltc). -split. -exact (sK_prop1 q H2 p mp c pzltc i). -exact (sK_prop2 q H2 p mp c pzltc i). + elim (Kneser n lt0n). + intros q; intros H H0. + exists q. + assumption. + inversion_clear H0. + rename X0 into H2. + split. assumption. + intros p mp c pzltc. + exists (sK q H2 p mp c pzltc). + split. + exact (sK_prop1 q H2 p mp c pzltc i). + exact (sK_prop2 q H2 p mp c pzltc i). Qed. End Seq_Exists_Main. @@ -240,44 +239,44 @@ Variable zlte : Zero [<] e. Lemma N_exists : {N : nat | forall m, N <= m -> (q[^]m[-]q[^]N[/] q[-]One[//]q_) [*]c [<=] e}. Proof. -cut (Zero [<] One[-]q). -intro H0. -cut (One[-]q [#] Zero). -intro H3. -cut (c [#] Zero). -intro H1. -cut (Zero [<] (One[-]q) [*] (e[/] c[//]H1)). -intro H2. -elim (qi_yields_zero q zleq qlt1 ((One[-]q) [*] (e[/] c[//]H1)) H2). -intros N HN. -exists N. -intros m leNm. -rstepl ((q[^]N[-]q[^]m[/] One[-]q[//]H3) [*]c). -apply shift_mult_leEq with H1. -assumption. -apply shift_div_leEq'. -assumption. -apply leEq_transitive with (q[^]N). -rstepl (Zero[+] (q[^]N[-]q[^]m)). -apply shift_plus_leEq. -rstepr (q[^]m). -apply nexp_resp_nonneg. -assumption. -assumption. -apply mult_resp_pos. -assumption. -apply div_resp_pos. -assumption. -assumption. -apply ap_symmetric_unfolded. -apply less_imp_ap. -assumption. -apply ap_symmetric_unfolded. -apply less_imp_ap. -assumption. -apply shift_less_minus. -rstepl q. -assumption. + cut (Zero [<] One[-]q). + intro H0. + cut (One[-]q [#] Zero). + intro H3. + cut (c [#] Zero). + intro H1. + cut (Zero [<] (One[-]q) [*] (e[/] c[//]H1)). + intro H2. + elim (qi_yields_zero q zleq qlt1 ((One[-]q) [*] (e[/] c[//]H1)) H2). + intros N HN. + exists N. + intros m leNm. + rstepl ((q[^]N[-]q[^]m[/] One[-]q[//]H3) [*]c). + apply shift_mult_leEq with H1. + assumption. + apply shift_div_leEq'. + assumption. + apply leEq_transitive with (q[^]N). + rstepl (Zero[+] (q[^]N[-]q[^]m)). + apply shift_plus_leEq. + rstepr (q[^]m). + apply nexp_resp_nonneg. + assumption. + assumption. + apply mult_resp_pos. + assumption. + apply div_resp_pos. + assumption. + assumption. + apply ap_symmetric_unfolded. + apply less_imp_ap. + assumption. + apply ap_symmetric_unfolded. + apply less_imp_ap. + assumption. + apply shift_less_minus. + rstepl q. + assumption. Qed. End N_Exists. @@ -313,270 +312,256 @@ Let nrtq_ : nrtq[-]One [#] Zero := qltone IR nrtq nrtqlt1. (* end hide *) Lemma zlt_nrtq : Zero [<=] nrtq. -unfold nrtq; apply NRoot_nonneg. +Proof. + unfold nrtq; apply NRoot_nonneg. Qed. Lemma zlt_nrtc : Zero [<] nrtc. -unfold nrtc; apply NRoot_pos; auto. +Proof. + unfold nrtc; apply NRoot_pos; auto. Qed. Lemma nrt_pow : forall i (H : Zero [<=] q[^]i[*]c), NRoot H lt0n [=] nrtq[^]i[*]nrtc. -intros. -apply root_unique with n. -apply NRoot_nonneg. -apply mult_resp_nonneg. -apply nexp_resp_nonneg. exact zlt_nrtq. -apply less_leEq. exact zlt_nrtc. -auto. -astepl (q[^]i[*]c). -astepr ((nrtq[^]i) [^]n[*]nrtc[^]n). -astepr (nrtq[^] (i * n) [*]nrtc[^]n). -rewrite mult_comm. -astepr ((nrtq[^]n) [^]i[*]nrtc[^]n). -unfold nrtq in |- *. unfold nrtc in |- *. -apply bin_op_wd_unfolded. -apply un_op_wd_unfolded. -algebra. -algebra. +Proof. + intros. + apply root_unique with n. + apply NRoot_nonneg. + apply mult_resp_nonneg. + apply nexp_resp_nonneg. exact zlt_nrtq. + apply less_leEq. exact zlt_nrtc. + auto. + astepl (q[^]i[*]c). + astepr ((nrtq[^]i) [^]n[*]nrtc[^]n). + astepr (nrtq[^] (i * n) [*]nrtc[^]n). + rewrite mult_comm. + astepr ((nrtq[^]n) [^]i[*]nrtc[^]n). + unfold nrtq in |- *. unfold nrtc in |- *. + apply bin_op_wd_unfolded. + apply un_op_wd_unfolded. + algebra. + algebra. Qed. Lemma abs_pow_ltRe : forall s, (forall i, AbsCC (s (S i) [-]s i) [^]n [<=] q[^]i[*]c) -> forall i, AbsIR (Re (s (S i)) [-]Re (s i)) [<=] nrtq[^]i[*]nrtc. Proof. -intros s H i. -apply leEq_wdl with (AbsIR (Re (s (S i) [-]s i))). -apply leEq_transitive with (AbsCC (s (S i) [-]s i)). -apply absCC_absIR_re. -generalize (H i). -intro Hi. -cut (Zero [<=] q[^]i[*]c). -intro H0. -cut (AbsCC (s (S i) [-]s i) [<=] NRoot H0 lt0n). -intro H1. -apply leEq_wdr with (NRoot H0 lt0n). -assumption. -apply nrt_pow. -apply power_cancel_leEq with n. -auto with arith. -apply NRoot_nonneg. -apply leEq_wdr with (q[^]i[*]c). -exact (H i). -algebra. -apply mult_resp_nonneg. -apply nexp_resp_nonneg. -assumption. -apply less_leEq; assumption. -apply ABSIR_wd. -apply Re_resp_inv. + intros s H i. + apply leEq_wdl with (AbsIR (Re (s (S i) [-]s i))). + apply leEq_transitive with (AbsCC (s (S i) [-]s i)). + apply absCC_absIR_re. + generalize (H i). + intro Hi. + cut (Zero [<=] q[^]i[*]c). + intro H0. + cut (AbsCC (s (S i) [-]s i) [<=] NRoot H0 lt0n). + intro H1. + apply leEq_wdr with (NRoot H0 lt0n). + assumption. + apply nrt_pow. + apply power_cancel_leEq with n. + auto with arith. + apply NRoot_nonneg. + apply leEq_wdr with (q[^]i[*]c). + exact (H i). + algebra. + apply mult_resp_nonneg. + apply nexp_resp_nonneg. + assumption. + apply less_leEq; assumption. + apply ABSIR_wd. + apply Re_resp_inv. Qed. Lemma abs_pow_ltIm : forall s, (forall i, AbsCC (s (S i) [-]s i) [^]n [<=] q[^]i[*]c) -> forall i, AbsIR (Im (s (S i)) [-]Im (s i)) [<=] nrtq[^]i[*]nrtc. Proof. -intros s H i. -apply leEq_wdl with (AbsIR (Im (s (S i) [-]s i))). -apply leEq_transitive with (AbsCC (s (S i) [-]s i)). -apply absCC_absIR_im. -generalize (H i). -intro Hi. -cut (Zero [<=] q[^]i[*]c). -intro H0. -cut (AbsCC (s (S i) [-]s i) [<=] NRoot H0 lt0n). -intro H1. -apply leEq_wdr with (NRoot H0 lt0n). -assumption. -apply nrt_pow. -apply power_cancel_leEq with n. -auto with arith. -apply NRoot_nonneg. -apply leEq_wdr with (q[^]i[*]c). -exact (H i). -algebra. -apply mult_resp_nonneg. -apply nexp_resp_nonneg. -assumption. -apply less_leEq; assumption. -apply ABSIR_wd. -apply Im_resp_inv. + intros s H i. + apply leEq_wdl with (AbsIR (Im (s (S i) [-]s i))). + apply leEq_transitive with (AbsCC (s (S i) [-]s i)). + apply absCC_absIR_im. + generalize (H i). + intro Hi. + cut (Zero [<=] q[^]i[*]c). + intro H0. + cut (AbsCC (s (S i) [-]s i) [<=] NRoot H0 lt0n). + intro H1. + apply leEq_wdr with (NRoot H0 lt0n). + assumption. + apply nrt_pow. + apply power_cancel_leEq with n. + auto with arith. + apply NRoot_nonneg. + apply leEq_wdr with (q[^]i[*]c). + exact (H i). + algebra. + apply mult_resp_nonneg. + apply nexp_resp_nonneg. + assumption. + apply less_leEq; assumption. + apply ABSIR_wd. + apply Im_resp_inv. Qed. Lemma SublemmaRe : forall s, (forall i, AbsCC (s (S i) [-]s i) [^]n [<=] q[^]i[*]c) -> forall N m, N <= m -> AbsIR (Re (s m) [-]Re (s N)) [<=] (nrtq[^]m[-]nrtq[^]N[/] nrtq[-]One[//]nrtq_) [*]nrtc. Proof. -intros s Hi N m leNm. -elim (le_lt_eq_dec N m leNm). -intro ltNm. -generalize (diff_is_sum (fun j : nat => Re (s j)) N m ltNm). -intro Hsum. -generalize (ABSIR_wd _ _ Hsum). (* Use AbsIR_wd *) -intro Habseq. -apply - leEq_wdl - with (ABSIR (Sum N (pred m) (fun i : nat => Re (s (S i)) [-]Re (s i)))). -2: apply eq_symmetric_unfolded; apply Habseq. -cut (N <= S (pred m)). intro leNm'. -(* FIXME was 2:Omega *) 2: clear nrtq_ nrtqlt1 nrtc nrtq; omega. -generalize - (triangle_SumIR N (pred m) (fun i : nat => Re (s (S i)) [-]Re (s i)) leNm'). -intro Htri. -apply - leEq_transitive - with - (Sum N (pred m) - (fun i : nat => csf_fun IR IR AbsIR (Re (s (S i)) [-]Re (s i)))). -exact Htri. -generalize - (Sum_pres_leEq (fun i : nat => AbsIR (Re (s (S i)) [-]Re (s i))) - (fun i : nat => nrtq[^]i[*]nrtc) (abs_pow_ltRe s Hi) N ( - pred m)). -intro Hlt. -apply leEq_transitive with (Sum N (pred m) (fun i : nat => nrtq[^]i[*]nrtc)). -cut (N <= pred m). -intro leNpm. -exact (Hlt leNpm). -generalize (S_pred m N ltNm). -intro Heq. -apply lt_n_Sm_le. -rewrite <- Heq. -assumption. -generalize (Sum_c_exp nrtq nrtq_ N (pred m)). -intro Hs. -generalize (Sum_comm_scal (fun i : nat => nrtq[^]i) nrtc N (pred m)). -intro Hs2. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply Hs2. -apply mult_resp_leEq_rht. -generalize (Sum_c_exp nrtq nrtq_ N (pred m)). -intro Hs3. -cut (S (pred m) = m). -intro Heq. -rewrite Heq in Hs3. -apply eq_imp_leEq; assumption. -generalize (S_pred m N ltNm). -auto. -exact (less_leEq _ _ _ zlt_nrtc). - -intro HNm. -rewrite HNm. -apply leEq_wdl with (AbsIR Zero). -apply leEq_wdl with ZeroR. -apply leEq_wdr with ZeroR. -exact (leEq_reflexive _ _). -rational. -apply eq_symmetric_unfolded; exact AbsIRz_isz. -apply ABSIR_wd. -rational. + intros s Hi N m leNm. + elim (le_lt_eq_dec N m leNm). + intro ltNm. + generalize (diff_is_sum (fun j : nat => Re (s j)) N m ltNm). + intro Hsum. + generalize (ABSIR_wd _ _ Hsum). (* Use AbsIR_wd *) + intro Habseq. + apply leEq_wdl with (ABSIR (Sum N (pred m) (fun i : nat => Re (s (S i)) [-]Re (s i)))). + 2: apply eq_symmetric_unfolded; apply Habseq. + cut (N <= S (pred m)). intro leNm'. + (* FIXME was 2:Omega *) 2: clear nrtq_ nrtqlt1 nrtc nrtq; omega. + generalize (triangle_SumIR N (pred m) (fun i : nat => Re (s (S i)) [-]Re (s i)) leNm'). + intro Htri. + apply leEq_transitive with (Sum N (pred m) + (fun i : nat => csf_fun IR IR AbsIR (Re (s (S i)) [-]Re (s i)))). + exact Htri. + generalize (Sum_pres_leEq (fun i : nat => AbsIR (Re (s (S i)) [-]Re (s i))) + (fun i : nat => nrtq[^]i[*]nrtc) (abs_pow_ltRe s Hi) N ( pred m)). + intro Hlt. + apply leEq_transitive with (Sum N (pred m) (fun i : nat => nrtq[^]i[*]nrtc)). + cut (N <= pred m). + intro leNpm. + exact (Hlt leNpm). + generalize (S_pred m N ltNm). + intro Heq. + apply lt_n_Sm_le. + rewrite <- Heq. + assumption. + generalize (Sum_c_exp nrtq nrtq_ N (pred m)). + intro Hs. + generalize (Sum_comm_scal (fun i : nat => nrtq[^]i) nrtc N (pred m)). + intro Hs2. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Hs2. + apply mult_resp_leEq_rht. + generalize (Sum_c_exp nrtq nrtq_ N (pred m)). + intro Hs3. + cut (S (pred m) = m). + intro Heq. + rewrite Heq in Hs3. + apply eq_imp_leEq; assumption. + generalize (S_pred m N ltNm). + auto. + exact (less_leEq _ _ _ zlt_nrtc). + intro HNm. + rewrite HNm. + apply leEq_wdl with (AbsIR Zero). + apply leEq_wdl with ZeroR. + apply leEq_wdr with ZeroR. + exact (leEq_reflexive _ _). + rational. + apply eq_symmetric_unfolded; exact AbsIRz_isz. + apply ABSIR_wd. + rational. Qed. Lemma SublemmaIm : forall s, (forall i, AbsCC (s (S i) [-]s i) [^]n [<=] q[^]i[*]c) -> forall N m, N <= m -> AbsIR (Im (s m) [-]Im (s N)) [<=] (nrtq[^]m[-]nrtq[^]N[/] nrtq[-]One[//]nrtq_) [*]nrtc. Proof. -intros s Hi N m leNm. -elim (le_lt_eq_dec N m leNm). -intro ltNm. -generalize (diff_is_sum (fun j : nat => Im (s j)) N m ltNm). -intro HSum. -generalize (ABSIR_wd _ _ HSum). (* Use AbsIR_wd *) -intro Habseq. -apply - leEq_wdl - with (ABSIR (Sum N (pred m) (fun i : nat => Im (s (S i)) [-]Im (s i)))). -2: apply eq_symmetric_unfolded; apply Habseq. -cut (N <= S (pred m)). intro leNm'. -(* FIXME was 2:Omega *) 2: clear nrtq_ nrtqlt1 nrtc nrtq; omega. -generalize - (triangle_SumIR N (pred m) (fun i : nat => Im (s (S i)) [-]Im (s i)) leNm'). -intro Htri. -apply - leEq_transitive - with - (Sum N (pred m) - (fun i : nat => csf_fun IR IR AbsIR (Im (s (S i)) [-]Im (s i)))). -exact Htri. -generalize - (Sum_pres_leEq (fun i : nat => AbsIR (Im (s (S i)) [-]Im (s i))) - (fun i : nat => nrtq[^]i[*]nrtc) (abs_pow_ltIm s Hi) N ( - pred m)). -intro Hlt. -apply leEq_transitive with (Sum N (pred m) (fun i : nat => nrtq[^]i[*]nrtc)). -cut (N <= pred m). -intro leNpm. -exact (Hlt leNpm). -generalize (S_pred m N ltNm). -intro Heq. -apply lt_n_Sm_le. -simpl in |- *. -rewrite <- Heq. -assumption. -generalize (Sum_c_exp nrtq nrtq_ N (pred m)). -intro Hs. -generalize (Sum_comm_scal (fun i : nat => nrtq[^]i) nrtc N (pred m)). -intro Hs2. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply Hs2. -apply mult_resp_leEq_rht. -generalize (Sum_c_exp nrtq nrtq_ N (pred m)). -intro Hs3. -cut (S (pred m) = m). -intro Heq. -rewrite Heq in Hs3. -apply eq_imp_leEq; assumption. -generalize (S_pred m N ltNm). -auto. -exact (less_leEq _ _ _ zlt_nrtc). -intro HNm. -rewrite HNm. -apply leEq_wdl with (AbsIR Zero). -apply leEq_wdl with ZeroR. -apply leEq_wdr with ZeroR. -exact (leEq_reflexive _ _). -rational. -apply eq_symmetric_unfolded; exact AbsIRz_isz. -apply ABSIR_wd. -rational. + intros s Hi N m leNm. + elim (le_lt_eq_dec N m leNm). + intro ltNm. + generalize (diff_is_sum (fun j : nat => Im (s j)) N m ltNm). + intro HSum. + generalize (ABSIR_wd _ _ HSum). (* Use AbsIR_wd *) + intro Habseq. + apply leEq_wdl with (ABSIR (Sum N (pred m) (fun i : nat => Im (s (S i)) [-]Im (s i)))). + 2: apply eq_symmetric_unfolded; apply Habseq. + cut (N <= S (pred m)). intro leNm'. + (* FIXME was 2:Omega *) 2: clear nrtq_ nrtqlt1 nrtc nrtq; omega. + generalize (triangle_SumIR N (pred m) (fun i : nat => Im (s (S i)) [-]Im (s i)) leNm'). + intro Htri. + apply leEq_transitive with (Sum N (pred m) + (fun i : nat => csf_fun IR IR AbsIR (Im (s (S i)) [-]Im (s i)))). + exact Htri. + generalize (Sum_pres_leEq (fun i : nat => AbsIR (Im (s (S i)) [-]Im (s i))) + (fun i : nat => nrtq[^]i[*]nrtc) (abs_pow_ltIm s Hi) N ( pred m)). + intro Hlt. + apply leEq_transitive with (Sum N (pred m) (fun i : nat => nrtq[^]i[*]nrtc)). + cut (N <= pred m). + intro leNpm. + exact (Hlt leNpm). + generalize (S_pred m N ltNm). + intro Heq. + apply lt_n_Sm_le. + simpl in |- *. + rewrite <- Heq. + assumption. + generalize (Sum_c_exp nrtq nrtq_ N (pred m)). + intro Hs. + generalize (Sum_comm_scal (fun i : nat => nrtq[^]i) nrtc N (pred m)). + intro Hs2. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Hs2. + apply mult_resp_leEq_rht. + generalize (Sum_c_exp nrtq nrtq_ N (pred m)). + intro Hs3. + cut (S (pred m) = m). + intro Heq. + rewrite Heq in Hs3. + apply eq_imp_leEq; assumption. + generalize (S_pred m N ltNm). + auto. + exact (less_leEq _ _ _ zlt_nrtc). + intro HNm. + rewrite HNm. + apply leEq_wdl with (AbsIR Zero). + apply leEq_wdl with ZeroR. + apply leEq_wdr with ZeroR. + exact (leEq_reflexive _ _). + rational. + apply eq_symmetric_unfolded; exact AbsIRz_isz. + apply ABSIR_wd. + rational. Qed. Lemma seq_is_CC_Cauchy : forall s, (forall i, AbsCC (s (S i) [-]s i) [^]n [<=] q[^]i[*]c) -> CC_Cauchy_prop s. Proof. -unfold CC_Cauchy_prop in |- *. -split. -(* Prove (Cauchy_prop (seq_re s)) *) -unfold Cauchy_prop in |- *. -intros e zlte. -generalize (N_exists (*n lt0n*) nrtq zlt_nrtq nrtqlt1 nrtc zlt_nrtc e zlte). -intro Hex. -elim Hex. -intros N HN. -exists N. -intros m leNm. -apply AbsIR_imp_AbsSmall. -generalize (SublemmaRe s H N m leNm). -intro H2. -generalize (HN m leNm). -intro H3. -eapply leEq_transitive. -2: apply H3. -rstepr ((nrtq[^]m[-]nrtq[^]N[/] nrtq[-]One[//]nrtq_) [*]nrtc). -exact H2. -(* Prove (Cauchy_prop (seq_im s)) *) -unfold Cauchy_prop in |- *. -intros e zlte. -generalize (N_exists (*n lt0n*) nrtq zlt_nrtq nrtqlt1 nrtc zlt_nrtc e zlte). -intro Hex. -elim Hex. -intros N HN. -exists N. -intros m leNm. -apply AbsIR_imp_AbsSmall. -generalize (SublemmaIm s H N m leNm). -intro H2. -generalize (HN m leNm). -intro H3. -eapply leEq_transitive. -2: apply H3. -rstepr ((nrtq[^]m[-]nrtq[^]N[/] nrtq[-]One[//]nrtq_) [*]nrtc). -exact H2. + unfold CC_Cauchy_prop in |- *. + split. + (* Prove (Cauchy_prop (seq_re s)) *) + unfold Cauchy_prop in |- *. + intros e zlte. + generalize (N_exists (*n lt0n*) nrtq zlt_nrtq nrtqlt1 nrtc zlt_nrtc e zlte). + intro Hex. + elim Hex. + intros N HN. + exists N. + intros m leNm. + apply AbsIR_imp_AbsSmall. + generalize (SublemmaRe s H N m leNm). + intro H2. + generalize (HN m leNm). + intro H3. + eapply leEq_transitive. + 2: apply H3. + rstepr ((nrtq[^]m[-]nrtq[^]N[/] nrtq[-]One[//]nrtq_) [*]nrtc). + exact H2. + (* Prove (Cauchy_prop (seq_im s)) *) + unfold Cauchy_prop in |- *. + intros e zlte. + generalize (N_exists (*n lt0n*) nrtq zlt_nrtq nrtqlt1 nrtc zlt_nrtc e zlte). + intro Hex. + elim Hex. + intros N HN. + exists N. + intros m leNm. + apply AbsIR_imp_AbsSmall. + generalize (SublemmaIm s H N m leNm). + intro H2. + generalize (HN m leNm). + intro H3. + eapply leEq_transitive. + 2: apply H3. + rstepr ((nrtq[^]m[-]nrtq[^]N[/] nrtq[-]One[//]nrtq_) [*]nrtc). + exact H2. Qed. End Seq_is_CC_CAuchy. @@ -584,48 +569,43 @@ End Seq_is_CC_CAuchy. Lemma FTA_monic : forall (p : cpoly CC) (n : nat), 0 < n -> monic n p -> {c : CC | p ! c [=] Zero}. Proof. -intros p n H0n mon. -generalize (seq_exists n H0n). -intro H. -elim H. -intros q qnonneg Hq1. -elim Hq1. -intros qlt10 Hq2. -generalize (Hq2 p mon). -intro Hq3. -cut (Zero [<] AbsCC p ! Zero[+]One). -intro Hp. -elim (Hq3 (AbsCC p ! Zero[+]One)). -intros s Hs. -cut - (forall i : nat, AbsCC (s (S i) [-]s i) [^]n [<=] q[^]i[*] (AbsCC p ! Zero[+]One)). -intro Hs2. -cut (CC_Cauchy_prop s). -intro Hs3. -exists (LimCC (Build_CC_CauchySeq s Hs3)). -apply CC_SeqLimit_uniq with (fun n : nat => p ! (s n)). -exact - (poly_pres_lim (fun x : CC => p ! x) (contin_polyCC p) - (Build_CC_CauchySeq s Hs3)). -generalize - (seq_yields_zero q qnonneg qlt10 (AbsCC p ! Zero[+]One) Hp - (fun n0 : nat => p ! (s n0))). -intro H0. apply H0. -intro i. generalize (Hs i). -intro H1; inversion_clear H1; assumption. -exact - (seq_is_CC_Cauchy n H0n q qnonneg qlt10 (AbsCC p ! Zero[+]One) Hp s Hs2). -intro i; generalize (Hs i); intro Ha; elim Ha; intros; assumption. -exact (less_plusOne _ (AbsCC p ! Zero)). -apply zero_lt_posplus1. -apply AbsCC_nonneg. + intros p n H0n mon. + generalize (seq_exists n H0n). + intro H. + elim H. + intros q qnonneg Hq1. + elim Hq1. + intros qlt10 Hq2. + generalize (Hq2 p mon). + intro Hq3. + cut (Zero [<] AbsCC p ! Zero[+]One). + intro Hp. + elim (Hq3 (AbsCC p ! Zero[+]One)). + intros s Hs. + cut (forall i : nat, AbsCC (s (S i) [-]s i) [^]n [<=] q[^]i[*] (AbsCC p ! Zero[+]One)). + intro Hs2. + cut (CC_Cauchy_prop s). + intro Hs3. + exists (LimCC (Build_CC_CauchySeq s Hs3)). + apply CC_SeqLimit_uniq with (fun n : nat => p ! (s n)). + exact (poly_pres_lim (fun x : CC => p ! x) (contin_polyCC p) (Build_CC_CauchySeq s Hs3)). + generalize (seq_yields_zero q qnonneg qlt10 (AbsCC p ! Zero[+]One) Hp (fun n0 : nat => p ! (s n0))). + intro H0. apply H0. + intro i. generalize (Hs i). + intro H1; inversion_clear H1; assumption. + exact (seq_is_CC_Cauchy n H0n q qnonneg qlt10 (AbsCC p ! Zero[+]One) Hp s Hs2). + intro i; generalize (Hs i); intro Ha; elim Ha; intros; assumption. + exact (less_plusOne _ (AbsCC p ! Zero)). + apply zero_lt_posplus1. + apply AbsCC_nonneg. Qed. Lemma FTA_reg : forall (p : cpoly CC) (n : nat), 0 < n -> degree n p -> {c : CC | p ! c [=] Zero}. -intros p n H H0. -elim (FTA_monic (poly_norm _ p n H0) n); auto. -intros. exists x. -apply poly_norm_apply with n H0; auto. -apply poly_norm_monic; auto. +Proof. + intros p n H H0. + elim (FTA_monic (poly_norm _ p n H0) n); auto. + intros. exists x. + apply poly_norm_apply with n H0; auto. + apply poly_norm_monic; auto. Qed. diff --git a/fta/KeyLemma.v b/fta/KeyLemma.v index 44373edb5..7a519ca7a 100644 --- a/fta/KeyLemma.v +++ b/fta/KeyLemma.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export ZArith. Require Export Compare. @@ -65,242 +65,246 @@ Variable a_0 : IR. Hypothesis eps_le_a_0 : eps [<=] a_0. Lemma a_0_eps_nonneg : Zero [<=] a_0[-]eps. -apply shift_leEq_minus. -astepl eps; auto. +Proof. + apply shift_leEq_minus. + astepl eps; auto. Qed. Lemma a_0_eps_fuzz : a_0[-]eps [<] a_0. -astepr (a_0[-]Zero). -apply minus_resp_less_rht. -apply eps_pos. +Proof. + astepr (a_0[-]Zero). + apply minus_resp_less_rht. + apply eps_pos. Qed. Lemma lem_1a : n - (n - 1) = 1. -cut (1 <= n). -omega. -auto with arith. +Proof. + cut (1 <= n). + omega. + auto with arith. Qed. Lemma lem_1b : forall n j : nat, n - S j <= n - j. -intros. -omega. +Proof. + intros. + omega. Qed. Lemma lem_1c : forall n j : nat, n - j <= n. -intros. -omega. +Proof. + intros. + omega. Qed. Lemma lem_1 : {t : IR | Zero [<=] t | {k : nat | 1 <= k /\ k <= n /\ a k[*]t[^]k [=] a_0[-]eps /\ (forall i, 1 <= i -> i <= n -> a i[*]t[^]i [<=] a_0)}}. Proof. -cut - (forall j : nat, - let l := n - j in - 1 <= l -> - l <= n -> - {t : IR | Zero [<=] t | - {k : nat | - l <= k /\ - k <= n /\ - a k[*]t[^]k [=] a_0[-]eps /\ - (forall i : nat, l <= i -> i <= n -> a i[*]t[^]i [<=] a_0)}}). -intro H. -rewrite <- lem_1a. -apply H; rewrite lem_1a; auto with arith. -intro j. induction j as [| j Hrecj]. + cut (forall j : nat, let l := n - j in 1 <= l -> l <= n -> {t : IR | Zero [<=] t | {k : nat | + l <= k /\ k <= n /\ a k[*]t[^]k [=] a_0[-]eps /\ + (forall i : nat, l <= i -> i <= n -> a i[*]t[^]i [<=] a_0)}}). + intro H. + rewrite <- lem_1a. + apply H; rewrite lem_1a; auto with arith. + intro j. induction j as [| j Hrecj]. replace (n - 0) with n. - 2: auto with arith. - intros l H H0. - exists (NRoot a_0_eps_nonneg gt_n_0). - apply NRoot_nonneg. - exists n. - split. auto. - split. auto. - split. + 2: auto with arith. + intros l H H0. + exists (NRoot a_0_eps_nonneg gt_n_0). + apply NRoot_nonneg. + exists n. + split. auto. + split. auto. + split. + astepl (One[*]NRoot a_0_eps_nonneg gt_n_0[^]n). + Step_final (NRoot a_0_eps_nonneg gt_n_0[^]n). + intros i H1 H2. + replace i with n. + 2: apply le_antisym; auto. astepl (One[*]NRoot a_0_eps_nonneg gt_n_0[^]n). - Step_final (NRoot a_0_eps_nonneg gt_n_0[^]n). - intros i H1 H2. - replace i with n. - 2: apply le_antisym; auto. - astepl (One[*]NRoot a_0_eps_nonneg gt_n_0[^]n). - astepl (NRoot a_0_eps_nonneg gt_n_0[^]n). - astepl (a_0[-]eps). - apply less_leEq; apply a_0_eps_fuzz. -intros l H H0. -cut (1 <= n - j). intro H1. - 2: apply le_trans with (n - S j); [ auto | apply lem_1b ]. -cut (n - j <= n). intro H2. - 2: apply lem_1c. -elim (Hrecj H1 H2). intros t' H4 H5. -elim H5. intros k' H6. -elim H6. intros H7 H8. elim H8. intros H9 H10. elim H10. intros H11 H12. -clear H10 H8 H6 H5. -elim - (less_cotransitive_unfolded _ _ _ a_0_eps_fuzz (a (n - S j) [*]t'[^] (n - S j))); - intro H14. - cut (Zero [<] a (n - S j)). intro H15. - cut (a (n - S j) [#] Zero). intro H16. - 2: apply pos_ap_zero; auto. - cut (Zero [<=] (a_0[-]eps[/] a (n - S j) [//]H16)). intro H17. - cut (0 < n - S j). intro H18. - 2: auto with arith. - exists (NRoot H17 H18). - apply NRoot_nonneg. - exists (n - S j). - split. auto. - split. auto. - split. - astepl (a (n - S j) [*] (a_0[-]eps[/] a (n - S j) [//]H16)). - rational. - intros i H19 H20. - elim (le_lt_eq_dec _ _ H19); intro H22. - apply leEq_transitive with (a i[*]t'[^]i). - apply mult_resp_leEq_lft. - apply power_resp_leEq. + astepl (NRoot a_0_eps_nonneg gt_n_0[^]n). + astepl (a_0[-]eps). + apply less_leEq; apply a_0_eps_fuzz. + intros l H H0. + cut (1 <= n - j). intro H1. + 2: apply le_trans with (n - S j); [ auto | apply lem_1b ]. + cut (n - j <= n). intro H2. + 2: apply lem_1c. + elim (Hrecj H1 H2). intros t' H4 H5. + elim H5. intros k' H6. + elim H6. intros H7 H8. elim H8. intros H9 H10. elim H10. intros H11 H12. + clear H10 H8 H6 H5. + elim (less_cotransitive_unfolded _ _ _ a_0_eps_fuzz (a (n - S j) [*]t'[^] (n - S j))); intro H14. + cut (Zero [<] a (n - S j)). intro H15. + cut (a (n - S j) [#] Zero). intro H16. + 2: apply pos_ap_zero; auto. + cut (Zero [<=] (a_0[-]eps[/] a (n - S j) [//]H16)). intro H17. + cut (0 < n - S j). intro H18. + 2: auto with arith. + exists (NRoot H17 H18). apply NRoot_nonneg. - apply power_cancel_leEq with (n - S j); auto. - astepl (a_0[-]eps[/] a (n - S j) [//]H16). - apply shift_div_leEq. + exists (n - S j). + split. auto. + split. auto. + split. + astepl (a (n - S j) [*] (a_0[-]eps[/] a (n - S j) [//]H16)). + rational. + intros i H19 H20. + elim (le_lt_eq_dec _ _ H19); intro H22. + apply leEq_transitive with (a i[*]t'[^]i). + apply mult_resp_leEq_lft. + apply power_resp_leEq. + apply NRoot_nonneg. + apply power_cancel_leEq with (n - S j); auto. + astepl (a_0[-]eps[/] a (n - S j) [//]H16). + apply shift_div_leEq. + auto. + astepr (a (n - S j) [*]t'[^] (n - S j)). + apply less_leEq; auto. + apply a_nonneg. + apply H12. + replace (n - j) with (S (n - S j)); auto with arith. + rewrite minus_Sn_m; auto with arith. auto. - astepr (a (n - S j) [*]t'[^] (n - S j)). - apply less_leEq; auto. + rewrite <- H22. + astepl (a (n - S j) [*] (a_0[-]eps[/] a (n - S j) [//]H16)). + astepl (a_0[-]eps). + apply less_leEq; apply a_0_eps_fuzz. + apply shift_leEq_div; auto. + astepl ZeroR; apply a_0_eps_nonneg. + cut (Zero [<] a (n - S j) [*]t'[^] (n - S j)). intro H15. + 2: apply leEq_less_trans with (a_0[-]eps); auto. + 2: apply a_0_eps_nonneg. + apply leEq_not_eq. apply a_nonneg. + apply ap_symmetric_unfolded. + exact (cring_mult_ap_zero _ _ _ (pos_ap_zero _ _ H15)). + exists t'. + auto. + exists k'. + split. + apply le_trans with (n - j). + unfold l in |- *; apply lem_1b. + auto. + split. auto. + split. auto. + intros i H15 H16. + elim (le_lt_eq_dec _ _ H15); intro H18. apply H12. replace (n - j) with (S (n - S j)); auto with arith. rewrite minus_Sn_m; auto with arith. auto. - rewrite <- H22. - astepl (a (n - S j) [*] (a_0[-]eps[/] a (n - S j) [//]H16)). - astepl (a_0[-]eps). - apply less_leEq; apply a_0_eps_fuzz. - - apply shift_leEq_div; auto. - astepl ZeroR; apply a_0_eps_nonneg. - - cut (Zero [<] a (n - S j) [*]t'[^] (n - S j)). intro H15. - 2: apply leEq_less_trans with (a_0[-]eps); auto. - 2: apply a_0_eps_nonneg. - apply leEq_not_eq. - apply a_nonneg. - apply ap_symmetric_unfolded. - exact (cring_mult_ap_zero _ _ _ (pos_ap_zero _ _ H15)). - -exists t'. -auto. -exists k'. -split. -apply le_trans with (n - j). - unfold l in |- *; apply lem_1b. - auto. -split. auto. -split. auto. -intros i H15 H16. -elim (le_lt_eq_dec _ _ H15); intro H18. - apply H12. - replace (n - j) with (S (n - S j)); auto with arith. - rewrite minus_Sn_m; auto with arith. - auto. -rewrite <- H18. -apply less_leEq; auto. + rewrite <- H18. + apply less_leEq; auto. Qed. Definition p3m (i : nat) := (One [/]ThreeNZ) [^]i:IR. Lemma p3m_pos : forall i : nat, Zero [<] p3m i. -intros. -unfold p3m in |- *. -apply nexp_resp_pos. -apply div_resp_pos. -apply pos_three. -apply pos_one. +Proof. + intros. + unfold p3m in |- *. + apply nexp_resp_pos. + apply div_resp_pos. + apply pos_three. + apply pos_one. Qed. Lemma p3m_S : forall i : nat, p3m (S i) [=] p3m i [/]ThreeNZ. -intros. -unfold p3m in |- *. -astepl ((One [/]ThreeNZ) [^]i[*] (One [/]ThreeNZ:IR)). -rational. +Proof. + intros. + unfold p3m in |- *. + astepl ((One [/]ThreeNZ) [^]i[*] (One [/]ThreeNZ:IR)). + rational. Qed. Hint Resolve p3m_S: algebra. Lemma p3m_P : forall i : nat, p3m i [=] p3m (S i) [*]Three. -intros. -Step_final (p3m i [/]ThreeNZ[*]Three). +Proof. + intros. + Step_final (p3m i [/]ThreeNZ[*]Three). Qed. Lemma p3m_aux : forall i j : nat, p3m (S i) [^]j [=] p3m j[*]p3m i[^]j. -intros. -unfold p3m in |- *. -astepl ((One [/]ThreeNZ) [^] (S i * j):IR). -replace (S i * j) with (j + i * j). -Step_final ((One [/]ThreeNZ) [^]j[*] (One [/]ThreeNZ) [^] (i * j):IR). -reflexivity. +Proof. + intros. + unfold p3m in |- *. + astepl ((One [/]ThreeNZ) [^] (S i * j):IR). + replace (S i * j) with (j + i * j). + Step_final ((One [/]ThreeNZ) [^]j[*] (One [/]ThreeNZ) [^] (i * j):IR). + reflexivity. Qed. Lemma p3m_pow : forall i j : nat, p3m i[^]j [=] p3m (i * j). -intros. -unfold p3m in |- *. -algebra. +Proof. + intros. + unfold p3m in |- *. + algebra. Qed. Hint Resolve p3m_aux: algebra. Lemma p3m_0 : p3m 0 [=] One. -unfold p3m in |- *. -simpl in |- *. -algebra. +Proof. + unfold p3m in |- *. + simpl in |- *. + algebra. Qed. Hint Resolve p3m_0: algebra. Lemma third_pos : ZeroR [<] One [/]ThreeNZ. -apply recip_resp_pos. -apply pos_three. +Proof. + apply recip_resp_pos. + apply pos_three. Qed. Hint Resolve third_pos: algebra. Lemma third_less_one : One [/]ThreeNZ [<] OneR. -apply pos_div_three'. -apply pos_one. +Proof. + apply pos_div_three'. + apply pos_one. Qed. Hint Resolve third_less_one: algebra. Lemma p3m_mon : forall i j : nat, i < j -> p3m j [<] p3m i. -intros. -unfold p3m in |- *. -apply small_nexp_resp_lt; algebra. +Proof. + intros. + unfold p3m in |- *. + apply small_nexp_resp_lt; algebra. Qed. Lemma p3m_mon' : forall i j : nat, i <= j -> p3m j [<=] p3m i. -intros. -unfold p3m in |- *. -apply small_nexp_resp_le; try apply less_leEq; algebra. +Proof. + intros. + unfold p3m in |- *. + apply small_nexp_resp_le; try apply less_leEq; algebra. Qed. Lemma p3m_small : forall i : nat, p3m i [<=] One. -intro. -astepr (p3m 0). -apply p3m_mon'. -auto with arith. +Proof. + intro. + astepr (p3m 0). + apply p3m_mon'. + auto with arith. Qed. Lemma p3m_smaller : forall i : nat, 0 < i -> p3m i [<=] Half. -intros. -apply leEq_transitive with (p3m 1). -apply p3m_mon'. -auto with arith. -unfold p3m in |- *. -astepl (One [/]ThreeNZ:IR). -unfold Half in |- *. -apply less_leEq. -apply recip_resp_less. -apply pos_two. -apply two_less_three. +Proof. + intros. + apply leEq_transitive with (p3m 1). + apply p3m_mon'. + auto with arith. + unfold p3m in |- *. + astepl (One [/]ThreeNZ:IR). + unfold Half in |- *. + apply less_leEq. + apply recip_resp_less. + apply pos_two. + apply two_less_three. Qed. Definition chfun (k : nat -> nat) (a j i : nat) : nat := @@ -310,132 +314,144 @@ Definition chfun (k : nat -> nat) (a j i : nat) : nat := end. Lemma chfun_1 : forall k a j i, i <= j -> k i = chfun k a j i. -intros. -unfold chfun in |- *. -elim (le_gt_dec i j). -auto. -intro y. -elim (le_not_gt _ _ H y). +Proof. + intros. + unfold chfun in |- *. + elim (le_gt_dec i j). + auto. + intro y. + elim (le_not_gt _ _ H y). Qed. Lemma chfun_2 : forall k j a i, j < i -> a = chfun k a j i. -intros. -unfold chfun in |- *. -elim (le_gt_dec i j). -intro y. -elim (le_not_gt _ _ y H). -auto. +Proof. + intros. + unfold chfun in |- *. + elim (le_gt_dec i j). + intro y. + elim (le_not_gt _ _ y H). + auto. Qed. Lemma chfun_3 : forall k j a, (forall i, 1 <= k i /\ k i <= n) -> 1 <= a -> a <= n -> forall i, 1 <= chfun k a j i /\ chfun k a j i <= n. -intros. -unfold chfun in |- *. -elim (le_gt_dec i j). -auto. -auto. +Proof. + intros. + unfold chfun in |- *. + elim (le_gt_dec i j). + auto. + auto. Qed. Lemma chfun_4 : forall k j a, (forall i, k (S i) <= k i) -> a <= k j -> forall i, chfun k a j (S i) <= chfun k a j i. -intros. -unfold chfun in |- *. -elim (le_gt_dec i j); elim (le_gt_dec (S i) j); intros; auto. -cut (i = j). intro. -rewrite H1. -auto. -omega. -omega. +Proof. + intros. + unfold chfun in |- *. + elim (le_gt_dec i j); elim (le_gt_dec (S i) j); intros; auto. + cut (i = j). intro. + rewrite H1. + auto. + omega. + omega. Qed. Definition Halfeps := Half[*]eps. Lemma Halfeps_pos : Zero [<] Halfeps. -unfold Halfeps in |- *. -apply mult_resp_pos. -apply pos_half. -apply eps_pos. +Proof. + unfold Halfeps in |- *. + apply mult_resp_pos. + apply pos_half. + apply eps_pos. Qed. Lemma Halfeps_Halfeps : forall x : IR, x[-]Halfeps[-]Halfeps [=] x[-]eps. -intros. -unfold Halfeps in |- *. -unfold Half in |- *. -rational. +Proof. + intros. + unfold Halfeps in |- *. + unfold Half in |- *. + rational. Qed. Hint Resolve Halfeps_Halfeps: algebra. Lemma Halfeps_eps : forall x y : IR, x[-]Halfeps [<=] y -> x[-]eps [<=] y. -intros. -astepl (x[-]Halfeps[-]Halfeps). -apply leEq_transitive with (x[-]Halfeps). -apply less_leEq. -apply shift_minus_less. -apply shift_less_plus'. -astepl ZeroR. -apply Halfeps_pos. -auto. +Proof. + intros. + astepl (x[-]Halfeps[-]Halfeps). + apply leEq_transitive with (x[-]Halfeps). + apply less_leEq. + apply shift_minus_less. + apply shift_less_plus'. + astepl ZeroR. + apply Halfeps_pos. + auto. Qed. Lemma Halfeps_trans : forall x y z : IR, x[-]Halfeps [<=] y -> y[-]Halfeps [<=] z -> x[-]eps [<=] z. -intros. -astepl (x[-]Halfeps[-]Halfeps). -apply leEq_transitive with (y[-]Halfeps). -apply minus_resp_leEq. -auto. -auto. +Proof. + intros. + astepl (x[-]Halfeps[-]Halfeps). + apply leEq_transitive with (y[-]Halfeps). + apply minus_resp_leEq. + auto. + auto. Qed. Lemma Key_1a : forall (i j : nat) (a t : IR), a[*] (t[*]p3m (S j)) [^]i [=] p3m i[*] (a[*] (t[*]p3m j) [^]i). -intros. -astepl (a0[*] (t[^]i[*]p3m (S j) [^]i)). -astepl (a0[*] (t[^]i[*] (p3m i[*]p3m j[^]i))). -astepr (p3m i[*] (a0[*] (t[^]i[*]p3m j[^]i))). -rational. +Proof. + intros. + astepl (a0[*] (t[^]i[*]p3m (S j) [^]i)). + astepl (a0[*] (t[^]i[*] (p3m i[*]p3m j[^]i))). + astepr (p3m i[*] (a0[*] (t[^]i[*]p3m j[^]i))). + rational. Qed. Hint Resolve Key_1a: algebra. Lemma Key_1b : forall k : nat, 1 <= k -> p3m k[*]eps [<=] Halfeps. -intros. -unfold Halfeps in |- *. -apply mult_resp_leEq_rht. -apply p3m_smaller. -auto. -apply less_leEq; apply eps_pos. +Proof. + intros. + unfold Halfeps in |- *. + apply mult_resp_leEq_rht. + apply p3m_smaller. + auto. + apply less_leEq; apply eps_pos. Qed. Lemma Key_1 : forall (i k j : nat) (ai ak t : IR), 1 <= k -> k < i -> Zero [<=] ai -> Zero [<=] t -> ai[*] (t[*]p3m j) [^]i[-]eps [<=] ak[*] (t[*]p3m j) [^]k -> ai[*] (t[*]p3m (S j)) [^]i[-]Halfeps [<=] ak[*] (t[*]p3m (S j)) [^]k. -intros i k j ai ak t H H0 H1 H2 H3. -apply leEq_transitive with (p3m k[*] (ai[*] (t[*]p3m j) [^]i) [-]p3m k[*]eps). - apply minus_resp_leEq_both. - astepl (p3m i[*] (ai[*] (t[*]p3m j) [^]i)). - apply mult_resp_leEq_rht. - apply less_leEq. - apply p3m_mon; auto. - astepl (ai[*]Zero). - apply mult_resp_leEq_lft; auto. - apply nexp_resp_nonneg. - apply mult_resp_nonneg; auto. - apply less_leEq; apply p3m_pos. - apply Key_1b; auto. -astepl (p3m k[*] (ai[*] (t[*]p3m j) [^]i[-]eps)). -astepr (p3m k[*] (ak[*] (t[*]p3m j) [^]k)). -apply mult_resp_leEq_lft; auto. -apply less_leEq; apply p3m_pos. +Proof. + intros i k j ai ak t H H0 H1 H2 H3. + apply leEq_transitive with (p3m k[*] (ai[*] (t[*]p3m j) [^]i) [-]p3m k[*]eps). + apply minus_resp_leEq_both. + astepl (p3m i[*] (ai[*] (t[*]p3m j) [^]i)). + apply mult_resp_leEq_rht. + apply less_leEq. + apply p3m_mon; auto. + astepl (ai[*]Zero). + apply mult_resp_leEq_lft; auto. + apply nexp_resp_nonneg. + apply mult_resp_nonneg; auto. + apply less_leEq; apply p3m_pos. + apply Key_1b; auto. + astepl (p3m k[*] (ai[*] (t[*]p3m j) [^]i[-]eps)). + astepr (p3m k[*] (ak[*] (t[*]p3m j) [^]k)). + apply mult_resp_leEq_lft; auto. + apply less_leEq; apply p3m_pos. Qed. Lemma Key_2 : forall (i k k' j : nat) (ai ak ak' t : IR), 1 <= k -> k < i -> Zero [<=] ai -> Zero [<=] t -> ak[*] (t[*]p3m (S j)) [^]k[-]Halfeps [<=] ak'[*] (t[*]p3m (S j)) [^]k' -> ai[*] (t[*]p3m j) [^]i[-]eps [<=] ak[*] (t[*]p3m j) [^]k -> ai[*] (t[*]p3m (S j)) [^]i[-]eps [<=] ak'[*] (t[*]p3m (S j)) [^]k'. -intros. -apply Halfeps_trans with (ak[*] (t[*]p3m (S j)) [^]k). -apply Key_1; auto. -auto. +Proof. + intros. + apply Halfeps_trans with (ak[*] (t[*]p3m (S j)) [^]k). + apply Key_1; auto. + auto. Qed. Lemma Key : {t : IR | Zero [<=] t | forall J, {k : nat -> nat | @@ -443,70 +459,69 @@ Lemma Key : {t : IR | Zero [<=] t | forall J, {k : nat -> nat | (let k_0 := k 0 in a k_0[*]t[^]k_0 [=] a_0[-]eps) /\ (forall j, j <= J -> let k_j := k j in let r := t[*]p3m j in forall i, 1 <= i -> i <= n -> a i[*]r[^]i[-]eps [<=] a k_j[*]r[^]k_j)}}. -(* begin hide *) -Proof. -elim lem_1. intro t. intros H0 H1. -elim H1. intros k_0 H2. -elim H2. intros H3 H4. -elim H4. intros H5 H6. -elim H6. intros H7 H8. -clear H6 H4 H2 H1. -exists t. -auto. -intro J. -induction J as [| J HrecJ]. - exists (fun j : nat => k_0). - split. auto. - split. auto. - split. auto. - intros j H9 k_j r i H10 H11. +Proof. + (* begin hide *) +Proof. + elim lem_1. intro t. intros H0 H1. + elim H1. intros k_0 H2. + elim H2. intros H3 H4. + elim H4. intros H5 H6. + elim H6. intros H7 H8. + clear H6 H4 H2 H1. + exists t. + auto. + intro J. + induction J as [| J HrecJ]. + exists (fun j : nat => k_0). + split. auto. + split. auto. + split. auto. + intros j H9 k_j r i H10 H11. + unfold k_j, r in |- *. + rewrite <- (le_n_O_eq _ H9). + replace (p3m 0) with OneR. + 2: auto. + astepr (a k_0[*] (t[^]k_0[*]One[^]k_0)). + astepr (a k_0[*] (t[^]k_0[*]One)). + astepr (a k_0[*]t[^]k_0). + astepr (a_0[-]eps). + apply minus_resp_leEq. + astepl (a i[*] (t[^]i[*]One[^]i)). + astepl (a i[*] (t[^]i[*]One)). + astepl (a i[*]t[^]i); auto. + elim HrecJ. intros k' H9. + elim H9. intros H10 H11. elim H11. intros H12 H13. elim H13. intros H14 H15. + clear H9 H11 H13. + cut (0 < k' J). intro H16. + 2: elim (H10 J); auto. + elim (maj_upto_eps IR (fun i : nat => a i[*] (t[*]p3m (S J)) [^]i) ( k' J) Halfeps H16 Halfeps_pos). + intros k_SJ H17. + elim H17. intros H18 H19. elim H19. intros H20 H21. + clear H17 H19. + exists (chfun k' k_SJ J). + split. intro i. + apply chfun_3. auto. auto. + apply le_trans with (k' J); auto. + elim (H10 J). auto. + split. + intro i. apply chfun_4; auto. + split. + replace (chfun k' k_SJ J 0) with (k' 0); auto. + intros j H22 k_j r i H23 H24. unfold k_j, r in |- *. - rewrite <- (le_n_O_eq _ H9). - replace (p3m 0) with OneR. - 2: auto. - astepr (a k_0[*] (t[^]k_0[*]One[^]k_0)). - astepr (a k_0[*] (t[^]k_0[*]One)). - astepr (a k_0[*]t[^]k_0). - astepr (a_0[-]eps). - apply minus_resp_leEq. - astepl (a i[*] (t[^]i[*]One[^]i)). - astepl (a i[*] (t[^]i[*]One)). - astepl (a i[*]t[^]i); auto. -elim HrecJ. intros k' H9. -elim H9. intros H10 H11. elim H11. intros H12 H13. elim H13. intros H14 H15. -clear H9 H11 H13. -cut (0 < k' J). intro H16. - 2: elim (H10 J); auto. -elim - (maj_upto_eps IR (fun i : nat => a i[*] (t[*]p3m (S J)) [^]i) ( - k' J) Halfeps H16 Halfeps_pos). -intros k_SJ H17. -elim H17. intros H18 H19. elim H19. intros H20 H21. -clear H17 H19. -exists (chfun k' k_SJ J). -split. intro i. - apply chfun_3. auto. auto. - apply le_trans with (k' J); auto. - elim (H10 J). auto. -split. - intro i. apply chfun_4; auto. -split. - replace (chfun k' k_SJ J 0) with (k' 0); auto. -intros j H22 k_j r i H23 H24. -unfold k_j, r in |- *. -elim (le_lt_eq_dec _ _ H22); intro H26. - replace (chfun k' k_SJ J j) with (k' j). - apply H15; auto with arith. - apply chfun_1; auto with arith. -replace (chfun k' k_SJ J j) with k_SJ. -rewrite H26. -elim (le_lt_dec i (k' J)); intro H28. - apply Halfeps_eps. + elim (le_lt_eq_dec _ _ H22); intro H26. + replace (chfun k' k_SJ J j) with (k' j). + apply H15; auto with arith. + apply chfun_1; auto with arith. + replace (chfun k' k_SJ J j) with k_SJ. + rewrite H26. + elim (le_lt_dec i (k' J)); intro H28. + apply Halfeps_eps. + auto. + apply Key_2 with (k' J) (a (k' J)); auto. + apply chfun_2. + rewrite H26. auto. -apply Key_2 with (k' J) (a (k' J)); auto. -apply chfun_2. -rewrite H26. -auto. Qed. (* end hide *) diff --git a/fta/KneserLemma.v b/fta/KneserLemma.v index e89ff57bc..6e90fc2b6 100644 --- a/fta/KneserLemma.v +++ b/fta/KneserLemma.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Smallest %\ensuremath{\frac13^{2n^2+n}}% *) (** printing eta_0 %\ensuremath{\eta_0}% #η0# *) @@ -64,7 +64,7 @@ Hypothesis b_n_1 : b_n [=] One. Variable c : IR. Hypothesis b_0_lt_c : AbsCC b_0 [<] c. -(** +(** %\begin{convention}% We define the following local abbreviations: - [two_n := 2 * n] - [Small := p3m n] @@ -85,117 +85,116 @@ Let q := One[-]Smallest. (* end hide *) Lemma b_0'_exists : forall eta : IR, Zero [<] eta -> {b_0' : CC | AbsCC (b_0'[-]b_0) [<=] eta | b_0' [#] Zero}. -intros. -exact (Cexis_AFS_CC Zero b_0 eta X). +Proof. + intros. + exact (Cexis_AFS_CC Zero b_0 eta X). Qed. Let eta_0 := ((c[-]AbsCC b_0) [/]FourNZ) [/]TwoNZ. Lemma eta_0_pos : Zero [<] eta_0. Proof. -unfold eta_0 in |- *. -apply pos_div_two. -apply pos_div_four. -apply shift_zero_less_minus. -assumption. + unfold eta_0 in |- *. + apply pos_div_two. + apply pos_div_four. + apply shift_zero_less_minus. + assumption. Qed. Lemma eta_exists : {eta : IR | Zero [<] eta | {b_0' : CC | AbsCC (b_0'[-]b_0) [<=] eta | b_0' [#] Zero and AbsCC b_0'[+]Three[*]eta [<] c}}. Proof. -exists eta_0. - exact eta_0_pos. -generalize (b_0'_exists eta_0 eta_0_pos). -intro H. -elim H. -intros b_0' H0 H1. -exists b_0'. -assumption. -split. assumption. -apply leEq_less_trans with ((AbsCC b_0[+]c) [/]TwoNZ). -2: apply Average_less_Greatest; auto. -apply shift_plus_leEq. -apply leEq_wdl with (AbsCC (b_0'[-]b_0[+]b_0)). - 2: apply AbsCC_wd; rational. -apply leEq_transitive with (AbsCC (b_0'[-]b_0) [+]AbsCC b_0). - apply triangle. -apply leEq_transitive with (eta_0[+]AbsCC b_0). - apply plus_resp_leEq; auto. -apply eq_imp_leEq. -unfold eta_0 in |- *; rational. + exists eta_0. + exact eta_0_pos. + generalize (b_0'_exists eta_0 eta_0_pos). + intro H. + elim H. + intros b_0' H0 H1. + exists b_0'. + assumption. + split. assumption. + apply leEq_less_trans with ((AbsCC b_0[+]c) [/]TwoNZ). + 2: apply Average_less_Greatest; auto. + apply shift_plus_leEq. + apply leEq_wdl with (AbsCC (b_0'[-]b_0[+]b_0)). + 2: apply AbsCC_wd; rational. + apply leEq_transitive with (AbsCC (b_0'[-]b_0) [+]AbsCC b_0). + apply triangle. + apply leEq_transitive with (eta_0[+]AbsCC b_0). + apply plus_resp_leEq; auto. + apply eq_imp_leEq. + unfold eta_0 in |- *; rational. Qed. Lemma eps_exists_1 : forall eps x y : IR, Zero [<] eps -> Zero [<] x -> Zero [<] y -> {eps' : IR | Zero [<] eps' | eps' [<=] eps /\ x[*]eps' [<=] y}. -intros eps x y Heps Hx Hy. -cut (Zero [<] Half[*]eps). intro H2. -cut (x [#] Zero). intro H3. -2: apply pos_ap_zero; auto. -elim (less_cotransitive_unfolded _ _ _ H2 ((y[/] x[//]H3) [-]Half[*]eps)); intro H5. - exists (Half[*]eps). - auto. - split. apply less_leEq; apply half_3. auto. - astepr (x[*] (y[/] x[//]H3)). - apply less_leEq. - apply mult_resp_less_lft; auto. - astepl (Zero[+]Half[*]eps). - apply shift_plus_less; auto. -cut (Zero [<] (y[/] x[//]H3)). intro H4. - 2: apply div_resp_pos; auto. -exists (Half[*] (y[/] x[//]H3)). -apply mult_resp_pos. apply pos_half. auto. -split. apply leEq_transitive with (y[/] x[//]H3). +Proof. + intros eps x y Heps Hx Hy. + cut (Zero [<] Half[*]eps). intro H2. + cut (x [#] Zero). intro H3. + 2: apply pos_ap_zero; auto. + elim (less_cotransitive_unfolded _ _ _ H2 ((y[/] x[//]H3) [-]Half[*]eps)); intro H5. + exists (Half[*]eps). + auto. + split. apply less_leEq; apply half_3. auto. + astepr (x[*] (y[/] x[//]H3)). + apply less_leEq. + apply mult_resp_less_lft; auto. + astepl (Zero[+]Half[*]eps). + apply shift_plus_less; auto. + cut (Zero [<] (y[/] x[//]H3)). intro H4. + 2: apply div_resp_pos; auto. + exists (Half[*] (y[/] x[//]H3)). + apply mult_resp_pos. apply pos_half. auto. + split. apply leEq_transitive with (y[/] x[//]H3). + apply less_leEq; apply half_3; auto. + apply less_leEq. + astepr (One[*]eps). + astepr ((Half[+]Half) [*]eps). + astepr (Half[*]eps[+]Half[*]eps). + apply shift_less_plus'; auto. + rstepl (Half[*]y). apply less_leEq; apply half_3; auto. - apply less_leEq. - astepr (One[*]eps). - astepr ((Half[+]Half) [*]eps). - astepr (Half[*]eps[+]Half[*]eps). - apply shift_less_plus'; auto. -rstepl (Half[*]y). -apply less_leEq; apply half_3; auto. -apply mult_resp_pos; auto. -apply pos_half. + apply mult_resp_pos; auto. + apply pos_half. Qed. -(* less_cotransitive_unfolded on - {Zero [<] y[/]x[//]H3[-]Half[*]eps} + +(* less_cotransitive_unfolded on + {Zero [<] y[/]x[//]H3[-]Half[*]eps} + {y[/]x[//]H3[-]Half[*]eps [<] Half[*]eps}. *) Lemma eps_exists : forall eta a_0 : IR, Zero [<] eta -> Zero [<] a_0 -> {eps : IR | Zero [<] eps | Two[*] (Three[^]n[+]One) [*]eps [<=] eta /\ Three[*]eps [<=] Smaller[*]a_0 /\ eps [<=] a_0}. -intros eta a_0 Heta Ha_0. -elim - (eps_exists_1 ((Smaller[*]a_0) [/]ThreeNZ) (Three[^]n[+]One) (eta [/]TwoNZ)). -intros eps H H0. -elim H0; intros H1 H2. -exists eps. -auto. -split. - astepl (Two[*] ((Three[^]n[+]One) [*]eps)). - apply shift_mult_leEq' with (two_ap_zero IR); auto. - apply pos_two. -split. - apply shift_mult_leEq' with (three_ap_zero IR); auto. - apply pos_three. -eapply leEq_transitive. - apply H1. -apply shift_div_leEq'. - apply pos_three. -apply mult_resp_leEq_rht. - unfold Smaller in |- *; apply leEq_transitive with OneR. apply p3m_small. - apply less_leEq; apply one_less_three. -apply less_leEq; auto. - -apply pos_div_three. -apply mult_resp_pos; auto. -unfold Smaller in |- *; apply p3m_pos. - -apply plus_resp_pos. - apply nexp_resp_pos. - apply pos_three. -apply pos_one. - -apply pos_div_two; auto. +Proof. + intros eta a_0 Heta Ha_0. + elim (eps_exists_1 ((Smaller[*]a_0) [/]ThreeNZ) (Three[^]n[+]One) (eta [/]TwoNZ)). + intros eps H H0. + elim H0; intros H1 H2. + exists eps. + auto. + split. + astepl (Two[*] ((Three[^]n[+]One) [*]eps)). + apply shift_mult_leEq' with (two_ap_zero IR); auto. + apply pos_two. + split. + apply shift_mult_leEq' with (three_ap_zero IR); auto. + apply pos_three. + eapply leEq_transitive. + apply H1. + apply shift_div_leEq'. + apply pos_three. + apply mult_resp_leEq_rht. + unfold Smaller in |- *; apply leEq_transitive with OneR. apply p3m_small. + apply less_leEq; apply one_less_three. + apply less_leEq; auto. + apply pos_div_three. + apply mult_resp_pos; auto. + unfold Smaller in |- *; apply p3m_pos. + apply plus_resp_pos. + apply nexp_resp_pos. + apply pos_three. + apply pos_one. + apply pos_div_two; auto. Qed. (* begin hide *) @@ -206,254 +205,217 @@ Lemma z_exists : forall (b_0' : CC) (k : nat) (r eta : IR), let a_0 := AbsCC b_0 Zero [<] a_0 -> Zero [<] a k -> 1 <= k -> k <= n -> Zero [<=] r -> Zero [<] eta -> AbsCC (b_0'[-]b_0) [<=] eta -> a k[*]r[^]k [<=] a_0 -> {z : CC | AbsCC z [=] r | AbsCC (b_0[+]b k[*]z[^]k) [<=] a_0[-]a k[*]r[^]k[+]eta}. -(* begin hide *) -intros b_0' k r eta a_0 H H0 H1 H2 H3 H4 H5 H6. -cut (AbsCC b_0' [#] Zero). intro H7. - 2: apply pos_ap_zero; auto. -cut (cc_IR (AbsCC b_0') [#] Zero). intro H8. - 2: astepr (cc_IR Zero); apply cc_IR_resp_ap; auto. -cut (a k [#] Zero). intro H9. - 2: apply pos_ap_zero; auto. -cut (b k [#] Zero). intro H10. - 2: apply AbsCC_ap_zero; apply ap_symmetric_unfolded; auto. -cut (0 < k). intro H11. - 2: auto with arith. -cut - ( [--] ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10)) [#] - Zero). intro H12. -elim - (CnrootCC - [--] ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10)) +Proof. + (* begin hide *) + intros b_0' k r eta a_0 H H0 H1 H2 H3 H4 H5 H6. + cut (AbsCC b_0' [#] Zero). intro H7. + 2: apply pos_ap_zero; auto. + cut (cc_IR (AbsCC b_0') [#] Zero). intro H8. + 2: astepr (cc_IR Zero); apply cc_IR_resp_ap; auto. + cut (a k [#] Zero). intro H9. + 2: apply pos_ap_zero; auto. + cut (b k [#] Zero). intro H10. + 2: apply AbsCC_ap_zero; apply ap_symmetric_unfolded; auto. + cut (0 < k). intro H11. + 2: auto with arith. + cut ( [--] ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10)) [#] + Zero). intro H12. + elim (CnrootCC [--] ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10)) H12 k H11). -intros w H13. -cut (AbsCC w [=] One). intro H14. -exists (cc_IR r[*]w). - astepl (AbsCC (cc_IR r) [*]AbsCC w). - astepl (r[*]AbsCC w). - Step_final (r[*]One). -apply - leEq_transitive - with (AbsCC (b_0'[+]b k[*] (cc_IR r[*]w) [^]k) [+]AbsCC (b_0[-]b_0')). - apply leEq_wdl with (AbsCC (b_0'[+]b k[*] (cc_IR r[*]w) [^]k[+] (b_0[-]b_0'))). - apply triangle. - apply AbsCC_wd; rational. -apply leEq_wdl with (AbsCC b_0'[-]a k[*]r[^]k[+]AbsCC (b_0[-]b_0')). - apply plus_resp_leEq_lft. - astepl (AbsCC [--] (b_0[-]b_0')). - apply leEq_wdl with (AbsCC (b_0'[-]b_0)); auto. - apply AbsCC_wd; rational. -apply bin_op_wd_unfolded. - 2: algebra. -apply - eq_transitive_unfolded - with - (AbsCC - ((b_0'[/] cc_IR (AbsCC b_0') [//]H8) [*] - (cc_IR (AbsCC b_0') [-]cc_IR (a k) [*]cc_IR r[^]k))). - astepl (One[*] (AbsCC b_0'[-]a k[*]r[^]k)). - astepr - (AbsCC (b_0'[/] cc_IR (AbsCC b_0') [//]H8) [*] - AbsCC (cc_IR (AbsCC b_0') [-]cc_IR (a k) [*]cc_IR r[^]k)). - apply bin_op_wd_unfolded. - astepl (AbsCC b_0'[/] AbsCC b_0'[//]H7). - apply eq_symmetric_unfolded. - apply cc_div_abs'. - apply AbsCC_nonneg. - apply - eq_transitive_unfolded - with (AbsCC (cc_IR (AbsCC b_0') [-]cc_IR (a k) [*]cc_IR (r[^]k))). - 2: apply AbsCC_wd; algebra. - astepr (AbsCC (cc_IR (AbsCC b_0') [-]cc_IR (a k[*]r[^]k))). - astepr (AbsCC (cc_IR (AbsCC b_0'[-]a k[*]r[^]k))). - cut (Zero [<=] AbsCC b_0'[-]a k[*]r[^]k). algebra. - apply shift_leEq_lft; auto. -apply AbsCC_wd. -rstepl - (b_0'[+] - b k[*] - (cc_IR r[^]k[*] - [--] ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10)))). -apply bin_op_wd_unfolded. algebra. -apply bin_op_wd_unfolded. algebra. -Step_final (cc_IR r[^]k[*]w[^]k). - -apply root_one with k; auto. - apply AbsCC_nonneg. -astepl (AbsCC (w[^]k)). -astepl - (AbsCC - [--] ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10))). -astepl - (AbsCC ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10))). -astepl - (AbsCC (cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] - AbsCC (b_0'[/] b k[//]H10)). -astepl - (AbsCC (cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] - AbsCC (b_0'[/] b k[//]H10)). -cut (Zero [<=] AbsCC b_0'). intro. 2: apply AbsCC_nonneg. -astepl - ((AbsCC (cc_IR (a k)) [/] AbsCC b_0'[//]H7) [*]AbsCC (b_0'[/] b k[//]H10)). -astepl - ((AbsCC (cc_IR (a k)) [/] AbsCC b_0'[//]H7) [*]AbsCC (b_0'[/] b k[//]H10)). -cut (Zero [<=] a k). intro. 2: apply less_leEq; auto. -astepl ((a k[/] AbsCC b_0'[//]H7) [*]AbsCC (b_0'[/] b k[//]H10)). -astepl ((a k[/] AbsCC b_0'[//]H7) [*] (AbsCC b_0'[/] AbsCC (b k) [//]H9)). -unfold a in |- *; rational. - -apply - ap_wdl_unfolded - with (cc_IR [--] (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10)). -apply mult_resp_ap_zero. -astepr (cc_IR Zero). -apply cc_IR_resp_ap. -apply inv_resp_ap_zero. -apply div_resp_ap_zero_rev; auto. -apply div_resp_ap_zero_rev. -apply AbsCC_ap_zero. -apply ap_symmetric_unfolded; auto. -apply - eq_transitive_unfolded - with ( [--] (cc_IR (a k[/] AbsCC b_0'[//]H7)) [*] (b_0'[/] b k[//]H10)). + intros w H13. + cut (AbsCC w [=] One). intro H14. + exists (cc_IR r[*]w). + astepl (AbsCC (cc_IR r) [*]AbsCC w). + astepl (r[*]AbsCC w). + Step_final (r[*]One). + apply leEq_transitive with (AbsCC (b_0'[+]b k[*] (cc_IR r[*]w) [^]k) [+]AbsCC (b_0[-]b_0')). + apply leEq_wdl with (AbsCC (b_0'[+]b k[*] (cc_IR r[*]w) [^]k[+] (b_0[-]b_0'))). + apply triangle. + apply AbsCC_wd; rational. + apply leEq_wdl with (AbsCC b_0'[-]a k[*]r[^]k[+]AbsCC (b_0[-]b_0')). + apply plus_resp_leEq_lft. + astepl (AbsCC [--] (b_0[-]b_0')). + apply leEq_wdl with (AbsCC (b_0'[-]b_0)); auto. + apply AbsCC_wd; rational. + apply bin_op_wd_unfolded. + 2: algebra. + apply eq_transitive_unfolded with (AbsCC ((b_0'[/] cc_IR (AbsCC b_0') [//]H8) [*] + (cc_IR (AbsCC b_0') [-]cc_IR (a k) [*]cc_IR r[^]k))). + astepl (One[*] (AbsCC b_0'[-]a k[*]r[^]k)). + astepr (AbsCC (b_0'[/] cc_IR (AbsCC b_0') [//]H8) [*] + AbsCC (cc_IR (AbsCC b_0') [-]cc_IR (a k) [*]cc_IR r[^]k)). + apply bin_op_wd_unfolded. + astepl (AbsCC b_0'[/] AbsCC b_0'[//]H7). + apply eq_symmetric_unfolded. + apply cc_div_abs'. + apply AbsCC_nonneg. + apply eq_transitive_unfolded with (AbsCC (cc_IR (AbsCC b_0') [-]cc_IR (a k) [*]cc_IR (r[^]k))). + 2: apply AbsCC_wd; algebra. + astepr (AbsCC (cc_IR (AbsCC b_0') [-]cc_IR (a k[*]r[^]k))). + astepr (AbsCC (cc_IR (AbsCC b_0'[-]a k[*]r[^]k))). + cut (Zero [<=] AbsCC b_0'[-]a k[*]r[^]k). algebra. + apply shift_leEq_lft; auto. + apply AbsCC_wd. + rstepl (b_0'[+] b k[*] (cc_IR r[^]k[*] + [--] ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10)))). + apply bin_op_wd_unfolded. algebra. + apply bin_op_wd_unfolded. algebra. + Step_final (cc_IR r[^]k[*]w[^]k). + apply root_one with k; auto. + apply AbsCC_nonneg. + astepl (AbsCC (w[^]k)). + astepl (AbsCC [--] ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10))). + astepl (AbsCC ((cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] (b_0'[/] b k[//]H10))). + astepl (AbsCC (cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] AbsCC (b_0'[/] b k[//]H10)). + astepl (AbsCC (cc_IR (a k) [/] cc_IR (AbsCC b_0') [//]H8) [*] AbsCC (b_0'[/] b k[//]H10)). + cut (Zero [<=] AbsCC b_0'). intro. 2: apply AbsCC_nonneg. + astepl ((AbsCC (cc_IR (a k)) [/] AbsCC b_0'[//]H7) [*]AbsCC (b_0'[/] b k[//]H10)). + astepl ((AbsCC (cc_IR (a k)) [/] AbsCC b_0'[//]H7) [*]AbsCC (b_0'[/] b k[//]H10)). + cut (Zero [<=] a k). intro. 2: apply less_leEq; auto. + astepl ((a k[/] AbsCC b_0'[//]H7) [*]AbsCC (b_0'[/] b k[//]H10)). + astepl ((a k[/] AbsCC b_0'[//]H7) [*] (AbsCC b_0'[/] AbsCC (b k) [//]H9)). + unfold a in |- *; rational. + apply ap_wdl_unfolded with (cc_IR [--] (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10)). + apply mult_resp_ap_zero. + astepr (cc_IR Zero). + apply cc_IR_resp_ap. + apply inv_resp_ap_zero. + apply div_resp_ap_zero_rev; auto. + apply div_resp_ap_zero_rev. + apply AbsCC_ap_zero. + apply ap_symmetric_unfolded; auto. + apply eq_transitive_unfolded with ( [--] (cc_IR (a k[/] AbsCC b_0'[//]H7)) [*] (b_0'[/] b k[//]H10)). + apply mult_wdl. + astepl (cc_IR (Zero[-] (a k[/] AbsCC b_0'[//]H7))). astepr (Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7)). + Step_final (cc_IR Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7)). + astepl ((Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7)) [*] (b_0'[/] b k[//]H10)). + astepl ((cc_IR Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7)) [*] (b_0'[/] b k[//]H10)). + astepl (cc_IR Zero[*] (b_0'[/] b k[//]H10) [-] + cc_IR (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10)). + astepl (Zero[*] (b_0'[/] b k[//]H10) [-] cc_IR (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10)). + astepl (Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10)). + astepl ( [--] (cc_IR (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10))). + apply un_op_wd_unfolded. apply mult_wdl. - astepl (cc_IR (Zero[-] (a k[/] AbsCC b_0'[//]H7))). astepr (Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7)). - Step_final (cc_IR Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7)). -astepl ((Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7)) [*] (b_0'[/] b k[//]H10)). -astepl - ((cc_IR Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7)) [*] (b_0'[/] b k[//]H10)). -astepl - (cc_IR Zero[*] (b_0'[/] b k[//]H10) [-] - cc_IR (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10)). -astepl - (Zero[*] (b_0'[/] b k[//]H10) [-] - cc_IR (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10)). -astepl (Zero[-]cc_IR (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10)). -astepl ( [--] (cc_IR (a k[/] AbsCC b_0'[//]H7) [*] (b_0'[/] b k[//]H10))). -apply un_op_wd_unfolded. -apply mult_wdl. -unfold cc_IR in |- *; simpl in |- *; split; simpl in |- *; rational. + unfold cc_IR in |- *; simpl in |- *; split; simpl in |- *; rational. Qed. (* end hide *) Lemma Kneser_1' : Half [<=] q. Proof. -unfold q in |- *. -apply shift_leEq_minus. -astepl (Smallest[+]Half). -apply shift_plus_leEq. -unfold Half in |- *. -rstepr (One [/]TwoNZ:IR). -unfold Smallest, Small, Smaller in |- *. -generalize (p3m_smaller n gt_n_0). -intro Hn. -generalize (p3m_smaller (two_n * n)). -intro H2nn. -apply leEq_transitive with (Half[*] (Half:IR)). - apply mult_resp_leEq_both; auto. + unfold q in |- *. + apply shift_leEq_minus. + astepl (Smallest[+]Half). + apply shift_plus_leEq. + unfold Half in |- *. + rstepr (One [/]TwoNZ:IR). + unfold Smallest, Small, Smaller in |- *. + generalize (p3m_smaller n gt_n_0). + intro Hn. + generalize (p3m_smaller (two_n * n)). + intro H2nn. + apply leEq_transitive with (Half[*] (Half:IR)). + apply mult_resp_leEq_both; auto. + apply less_leEq; apply p3m_pos. apply less_leEq; apply p3m_pos. - apply less_leEq; apply p3m_pos. - apply H2nn. - unfold two_n in |- *. - elim gt_n_0. auto with arith. - intros. simpl in |- *. auto with arith. -rstepr (One [/]TwoNZ[*]OneR). -apply less_leEq. -apply mult_resp_less_lft. - exact (half_lt1 _). -exact (pos_half _). + apply H2nn. + unfold two_n in |- *. + elim gt_n_0. auto with arith. + intros. simpl in |- *. auto with arith. + rstepr (One [/]TwoNZ[*]OneR). + apply less_leEq. + apply mult_resp_less_lft. + exact (half_lt1 _). + exact (pos_half _). Qed. Lemma Kneser_1'' : q [<] One. Proof. -unfold q in |- *. -apply shift_minus_less'. -rstepl (Zero[+]OneR). -apply plus_resp_less_rht. -unfold Smallest, Small, Smaller in |- *. -apply mult_resp_pos; apply p3m_pos. + unfold q in |- *. + apply shift_minus_less'. + rstepl (Zero[+]OneR). + apply plus_resp_less_rht. + unfold Smallest, Small, Smaller in |- *. + apply mult_resp_pos; apply p3m_pos. Qed. Lemma Kneser_1 : forall a_0 eta eps : IR, Zero [<] eta -> Zero [<] eps -> a_0[+]Three[*]eta [<] c -> Two[*] (Three[^]n[+]One) [*]eps [<=] eta -> q[*]a_0[+]Three[^]n[*]eps[+]eps[+]eta [<] q[*]c. Proof. -intros. -cut - (One [/]TwoNZ[*] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta) [<=] - q[*] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). -intro Hm. -apply - leEq_less_trans - with (q[*] (a_0[+]Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). - rstepr (q[*]a_0[+]q[*] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). - rstepl - (q[*]a_0[+]One [/]TwoNZ[*] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). - apply plus_resp_leEq_lft; auto. -apply mult_resp_less_lft. - apply leEq_less_trans with (a_0[+]Three[*]eta); auto. - rstepl (a_0[+] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). - apply plus_resp_leEq_lft. - rstepl (Two[*] (Three[^]n[+]One) [*]eps[+]Two[*]eta). - rstepr (eta[+]Two[*]eta). - apply plus_resp_leEq; auto. -apply less_leEq_trans with (Half:IR). -apply pos_half. exact Kneser_1'. - -apply mult_resp_leEq_rht. exact Kneser_1'. -apply less_leEq. -apply less_leEq_trans with (Zero[+]Two[*]eta). - rstepr (Two[*]eta). - apply mult_resp_pos; auto. - apply pos_two. -apply less_leEq. -apply plus_resp_less_rht. -apply less_transitive_unfolded with (Zero[+]Two[*]eps). - rstepr (Two[*]eps). - apply mult_resp_pos; auto. - apply pos_two. -apply plus_resp_less_rht. -repeat apply mult_resp_pos; auto. - apply pos_two. -apply nexp_resp_pos; apply pos_three. + intros. + cut (One [/]TwoNZ[*] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta) [<=] + q[*] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). + intro Hm. + apply leEq_less_trans with (q[*] (a_0[+]Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). + rstepr (q[*]a_0[+]q[*] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). + rstepl (q[*]a_0[+]One [/]TwoNZ[*] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). + apply plus_resp_leEq_lft; auto. + apply mult_resp_less_lft. + apply leEq_less_trans with (a_0[+]Three[*]eta); auto. + rstepl (a_0[+] (Two[*]Three[^]n[*]eps[+]Two[*]eps[+]Two[*]eta)). + apply plus_resp_leEq_lft. + rstepl (Two[*] (Three[^]n[+]One) [*]eps[+]Two[*]eta). + rstepr (eta[+]Two[*]eta). + apply plus_resp_leEq; auto. + apply less_leEq_trans with (Half:IR). + apply pos_half. exact Kneser_1'. + apply mult_resp_leEq_rht. exact Kneser_1'. + apply less_leEq. + apply less_leEq_trans with (Zero[+]Two[*]eta). + rstepr (Two[*]eta). + apply mult_resp_pos; auto. + apply pos_two. + apply less_leEq. + apply plus_resp_less_rht. + apply less_transitive_unfolded with (Zero[+]Two[*]eps). + rstepr (Two[*]eps). + apply mult_resp_pos; auto. + apply pos_two. + apply plus_resp_less_rht. + repeat apply mult_resp_pos; auto. + apply pos_two. + apply nexp_resp_pos; apply pos_three. Qed. Lemma Kneser_2a : forall (R : CRing) (m n i : nat) (f : nat -> R), 1 <= i -> Sum m n f [=] f m[+]f i[+] (Sum (S m) (pred i) f[+]Sum (S i) n f). -intros. -astepl (f m[+]Sum (S m) n0 f). -astepl (f m[+] (Sum (S m) i f[+]Sum (S i) n0 f)). -astepl (f m[+] (Sum (S m) (pred i) f[+]f i[+]Sum (S i) n0 f)). -rational. +Proof. + intros. + astepl (f m[+]Sum (S m) n0 f). + astepl (f m[+] (Sum (S m) i f[+]Sum (S i) n0 f)). + astepl (f m[+] (Sum (S m) (pred i) f[+]f i[+]Sum (S i) n0 f)). + rational. Qed. Lemma Kneser_2b : forall (k : nat) (z : CC), 1 <= k -> let p_ := fun i => b i[*]z[^]i in Sum 0 n (fun i => b i[*]z[^]i) [=] b_0[+]b k[*]z[^]k[+] (Sum 1 (pred k) p_[+]Sum (S k) n p_). -(* begin hide *) -intros. -unfold p_ in |- *. -unfold b_0 in |- *. -apply - eq_transitive_unfolded - with (b 0[*]z[^]0[+]b k[*]z[^]k[+] (Sum 1 (pred k) p_[+]Sum (S k) n p_)); +Proof. + (* begin hide *) + intros. unfold p_ in |- *. -apply Kneser_2a with (f := fun i : nat => b i[*]z[^]i). -auto. -rational. + unfold b_0 in |- *. + apply eq_transitive_unfolded + with (b 0[*]z[^]0[+]b k[*]z[^]k[+] (Sum 1 (pred k) p_[+]Sum (S k) n p_)); unfold p_ in |- *. + apply Kneser_2a with (f := fun i : nat => b i[*]z[^]i). + auto. + rational. Qed. (* end hide *) Lemma Kneser_2c : forall (m n : nat) (z : CC), m <= S n -> let r := AbsCC z in AbsCC (Sum m n (fun i => b i[*]z[^]i)) [<=] Sum m n (fun i => a i[*]r[^]i). -(* begin hide *) -intros. -unfold r in |- *. -apply leEq_wdr with (Sum m n0 (fun i : nat => AbsCC (b i[*]z[^]i))). -apply triangle_Sum with (z := fun i : nat => b i[*]z[^]i). auto. -apply Sum_wd. -intros. -unfold a in |- *. -Step_final (AbsCC (b i) [*]AbsCC (z[^]i)). +Proof. + (* begin hide *) + intros. + unfold r in |- *. + apply leEq_wdr with (Sum m n0 (fun i : nat => AbsCC (b i[*]z[^]i))). + apply triangle_Sum with (z := fun i : nat => b i[*]z[^]i). auto. + apply Sum_wd. + intros. + unfold a in |- *. + Step_final (AbsCC (b i) [*]AbsCC (z[^]i)). Qed. (* end hide *) @@ -461,124 +423,102 @@ Lemma Kneser_2 : forall (k : nat) (z : CC), 1 <= k -> k <= n -> let r := AbsCC z in let p_ := fun i => a i[*]r[^]i in AbsCC (Sum 0 n (fun i => b i[*]z[^]i)) [<=] AbsCC (b_0[+]b k[*]z[^]k) [+] (Sum 1 (pred k) p_[+]Sum (S k) n p_). -(* begin hide *) -intros. -unfold p_, r in |- *. -set (p_' := fun i : nat => b i[*]z[^]i) in *. -apply - leEq_wdl - with (AbsCC (b_0[+]b k[*]z[^]k[+] (Sum 1 (pred k) p_'[+]Sum (S k) n p_'))); - unfold p_' in |- *. -apply - leEq_transitive - with - (AbsCC (b_0[+]b k[*]z[^]k) [+]AbsCC (Sum 1 (pred k) p_'[+]Sum (S k) n p_')); - unfold p_' in |- *. -apply triangle. -apply plus_resp_leEq_lft. -apply - leEq_transitive with (AbsCC (Sum 1 (pred k) p_') [+]AbsCC (Sum (S k) n p_')); - unfold p_' in |- *. -apply triangle. -apply plus_resp_leEq_both. -apply Kneser_2c. auto with arith. -apply Kneser_2c. auto with arith. -apply AbsCC_wd. -apply eq_symmetric_unfolded. -apply Kneser_2b. -auto. +Proof. + (* begin hide *) + intros. + unfold p_, r in |- *. + set (p_' := fun i : nat => b i[*]z[^]i) in *. + apply leEq_wdl with (AbsCC (b_0[+]b k[*]z[^]k[+] (Sum 1 (pred k) p_'[+]Sum (S k) n p_'))); + unfold p_' in |- *. + apply leEq_transitive with + (AbsCC (b_0[+]b k[*]z[^]k) [+]AbsCC (Sum 1 (pred k) p_'[+]Sum (S k) n p_')); unfold p_' in |- *. + apply triangle. + apply plus_resp_leEq_lft. + apply leEq_transitive with (AbsCC (Sum 1 (pred k) p_') [+]AbsCC (Sum (S k) n p_')); + unfold p_' in |- *. + apply triangle. + apply plus_resp_leEq_both. + apply Kneser_2c. auto with arith. + apply Kneser_2c. auto with arith. + apply AbsCC_wd. + apply eq_symmetric_unfolded. + apply Kneser_2b. + auto. Qed. (* end hide *) Lemma Kneser_3 : {z : CC | AbsCC z[^]n [<=] c | AbsCC (Sum 0 n (fun i => b i[*]z[^]i)) [<] q[*]c}. Proof. -elim eta_exists. intros eta H0 H1. -elim H1. intros b_0' H3 H4. elim H4. intros H5 H6. -clear H1 H4. -cut (Zero [<] AbsCC b_0'). intro H7. - 2: apply AbsCC_pos; auto. -elim (eps_exists eta (AbsCC b_0') H0 H7). intros eps H9 H10. elim H10. intros H11 H12. elim H12. intros H13 H14. -clear H10 H12. -cut (forall k : nat, Zero [<=] a k). intro H15. - 2: intro; unfold a in |- *; apply AbsCC_nonneg. -cut (a n [=] One). intro H16. - 2: unfold a in |- *; Step_final (AbsCC One). -elim (Main a n gt_n_0 eps H9 H15 H16 (AbsCC b_0') H14). -intro r. intros H18 H19. -elim H19. intros k H20. -elim H20. intros H21 H22. elim H22. intros H23 H24. elim H24. intros H25 H26. -elim H26. intros H27 H28. elim H28. intros H29 H30. -clear H19 H20 H22 H24 H26 H28. -cut (Zero [<] a k). intro H31. -elim (z_exists b_0' k r eta H7 H31 H21 H23 H18 H0 H3 H30). intro z. intros H33 H34. -exists z. - astepl (r[^]n). - apply leEq_transitive with (AbsCC b_0'); auto. - apply leEq_transitive with (AbsCC b_0'[+]Three[*]eta). - 2: apply less_leEq; auto. - astepl (AbsCC b_0'[+]Zero). - apply plus_resp_leEq_lft. - apply less_leEq. - apply mult_resp_pos; auto. - apply pos_three. -set (r' := AbsCC z) in *. unfold r' in H33, H34. -set (p_' := fun i : nat => a i[*]r'[^]i) in *. -apply leEq_less_trans with (eps[+] (q[*]AbsCC b_0'[+]Three[^]n[*]eps[+]eta)). - 2: rstepl (q[*]AbsCC b_0'[+]Three[^]n[*]eps[+]eps[+]eta); apply Kneser_1; - auto. -apply - leEq_transitive - with (AbsCC (b_0[+]b k[*]z[^]k) [+] (Sum 1 (pred k) p_'[+]Sum (S k) n p_')); - unfold p_', r' in |- *. - apply Kneser_2; auto. -set (p_'' := fun i : nat => a i[*]r[^]i) in *. -apply - leEq_wdl - with (AbsCC (b_0[+]b k[*]z[^]k) [+] (Sum 1 (pred k) p_''[+]Sum (S k) n p_'')); - unfold p_'' in |- *. - 2: apply bin_op_wd_unfolded; - [ algebra | apply bin_op_wd_unfolded; apply Sum_wd; algebra ]. -apply - leEq_transitive - with - (AbsCC (b_0[+]b k[*]z[^]k) [+] - ((One[-]Small) [*] (a k[*]r[^]k) [+]Three[^]n[*]eps)). - apply plus_resp_leEq_lft; auto. -apply - leEq_transitive - with - (AbsCC b_0'[-]AbsCC (b k) [*]r[^]k[+]eta[+] - ((One[-]Small) [*] (a k[*]r[^]k) [+]Three[^]n[*]eps)). - apply plus_resp_leEq; auto. -unfold a in |- *. -rstepl (AbsCC b_0'[+]Three[^]n[*]eps[+]eta[-]Small[*] (AbsCC (b k) [*]r[^]k)). -apply - leEq_transitive - with - (AbsCC b_0'[+]Three[^]n[*]eps[+]eta[-] - Small[*] (Smaller[*]AbsCC b_0'[-]Two[*]eps)). - apply minus_resp_leEq_rht. - apply mult_resp_leEq_lft; auto. - unfold Small in |- *. - apply less_leEq; apply p3m_pos. -apply - leEq_wdl with (Small[*]Two[*]eps[+] (q[*]AbsCC b_0'[+]Three[^]n[*]eps[+]eta)). - 2: unfold q, Smallest in |- *; rational. -apply plus_resp_leEq. -astepr (One[*]eps). -apply mult_resp_leEq_rht. - 2: apply less_leEq; auto. -astepr (Half[*] (Two:IR)). -apply mult_resp_leEq_rht. - unfold Small in |- *; apply p3m_smaller; auto. -apply less_leEq; apply pos_two. - -apply mult_cancel_pos_lft with (r[^]k). - 2: apply nexp_resp_nonneg; auto. -apply less_leEq_trans with eps; auto. -eapply leEq_transitive. - 2: apply H29. -apply shift_leEq_minus. -rstepl (Three[*]eps). auto. + elim eta_exists. intros eta H0 H1. + elim H1. intros b_0' H3 H4. elim H4. intros H5 H6. + clear H1 H4. + cut (Zero [<] AbsCC b_0'). intro H7. + 2: apply AbsCC_pos; auto. + elim (eps_exists eta (AbsCC b_0') H0 H7). intros eps H9 H10. elim H10. intros H11 H12. elim H12. intros H13 H14. + clear H10 H12. + cut (forall k : nat, Zero [<=] a k). intro H15. + 2: intro; unfold a in |- *; apply AbsCC_nonneg. + cut (a n [=] One). intro H16. + 2: unfold a in |- *; Step_final (AbsCC One). + elim (Main a n gt_n_0 eps H9 H15 H16 (AbsCC b_0') H14). + intro r. intros H18 H19. + elim H19. intros k H20. + elim H20. intros H21 H22. elim H22. intros H23 H24. elim H24. intros H25 H26. + elim H26. intros H27 H28. elim H28. intros H29 H30. + clear H19 H20 H22 H24 H26 H28. + cut (Zero [<] a k). intro H31. + elim (z_exists b_0' k r eta H7 H31 H21 H23 H18 H0 H3 H30). intro z. intros H33 H34. + exists z. + astepl (r[^]n). + apply leEq_transitive with (AbsCC b_0'); auto. + apply leEq_transitive with (AbsCC b_0'[+]Three[*]eta). + 2: apply less_leEq; auto. + astepl (AbsCC b_0'[+]Zero). + apply plus_resp_leEq_lft. + apply less_leEq. + apply mult_resp_pos; auto. + apply pos_three. + set (r' := AbsCC z) in *. unfold r' in H33, H34. + set (p_' := fun i : nat => a i[*]r'[^]i) in *. + apply leEq_less_trans with (eps[+] (q[*]AbsCC b_0'[+]Three[^]n[*]eps[+]eta)). + 2: rstepl (q[*]AbsCC b_0'[+]Three[^]n[*]eps[+]eps[+]eta); apply Kneser_1; auto. + apply leEq_transitive with (AbsCC (b_0[+]b k[*]z[^]k) [+] (Sum 1 (pred k) p_'[+]Sum (S k) n p_')); + unfold p_', r' in |- *. + apply Kneser_2; auto. + set (p_'' := fun i : nat => a i[*]r[^]i) in *. + apply leEq_wdl with (AbsCC (b_0[+]b k[*]z[^]k) [+] (Sum 1 (pred k) p_''[+]Sum (S k) n p_'')); + unfold p_'' in |- *. + 2: apply bin_op_wd_unfolded; [ algebra | apply bin_op_wd_unfolded; apply Sum_wd; algebra ]. + apply leEq_transitive with (AbsCC (b_0[+]b k[*]z[^]k) [+] + ((One[-]Small) [*] (a k[*]r[^]k) [+]Three[^]n[*]eps)). + apply plus_resp_leEq_lft; auto. + apply leEq_transitive with (AbsCC b_0'[-]AbsCC (b k) [*]r[^]k[+]eta[+] + ((One[-]Small) [*] (a k[*]r[^]k) [+]Three[^]n[*]eps)). + apply plus_resp_leEq; auto. + unfold a in |- *. + rstepl (AbsCC b_0'[+]Three[^]n[*]eps[+]eta[-]Small[*] (AbsCC (b k) [*]r[^]k)). + apply leEq_transitive with (AbsCC b_0'[+]Three[^]n[*]eps[+]eta[-] + Small[*] (Smaller[*]AbsCC b_0'[-]Two[*]eps)). + apply minus_resp_leEq_rht. + apply mult_resp_leEq_lft; auto. + unfold Small in |- *. + apply less_leEq; apply p3m_pos. + apply leEq_wdl with (Small[*]Two[*]eps[+] (q[*]AbsCC b_0'[+]Three[^]n[*]eps[+]eta)). + 2: unfold q, Smallest in |- *; rational. + apply plus_resp_leEq. + astepr (One[*]eps). + apply mult_resp_leEq_rht. + 2: apply less_leEq; auto. + astepr (Half[*] (Two:IR)). + apply mult_resp_leEq_rht. + unfold Small in |- *; apply p3m_smaller; auto. + apply less_leEq; apply pos_two. + apply mult_cancel_pos_lft with (r[^]k). + 2: apply nexp_resp_nonneg; auto. + apply less_leEq_trans with eps; auto. + eapply leEq_transitive. + 2: apply H29. + apply shift_leEq_minus. + rstepl (Three[*]eps). auto. Qed. End Kneser_Lemma. @@ -586,20 +526,21 @@ End Kneser_Lemma. Lemma Kneser : forall n : nat, 0 < n -> {q : IR | Zero [<=] q | q [<] One and (forall p : cpoly CC, monic n p -> forall c : IR, AbsCC p ! Zero [<] c -> {z : CC | AbsCC z[^]n [<=] c | AbsCC p ! z [<] q[*]c})}. -intros n H. -exists (One[-]p3m n[*]p3m (2 * n * n)). - apply less_leEq. - apply less_leEq_trans with (Half:IR). - apply pos_half. - apply Kneser_1'; auto. -split. apply Kneser_1''. -intros p H0 c H1. -elim H0. intros H2 H3. -cut (nth_coeff n p [=] One). intro H4. - 2: auto. -elim (Kneser_3 (fun i : nat => nth_coeff i p) n H H4 c). intros z H6 H7. - 2: astepl (AbsCC p ! Zero); auto. -exists z. -auto. -astepl (AbsCC (Sum 0 n (fun i : nat => nth_coeff i p[*]z[^]i))); auto. +Proof. + intros n H. + exists (One[-]p3m n[*]p3m (2 * n * n)). + apply less_leEq. + apply less_leEq_trans with (Half:IR). + apply pos_half. + apply Kneser_1'; auto. + split. apply Kneser_1''. + intros p H0 c H1. + elim H0. intros H2 H3. + cut (nth_coeff n p [=] One). intro H4. + 2: auto. + elim (Kneser_3 (fun i : nat => nth_coeff i p) n H H4 c). intros z H6 H7. + 2: astepl (AbsCC p ! Zero); auto. + exists z. + auto. + astepl (AbsCC (Sum 0 n (fun i : nat => nth_coeff i p[*]z[^]i))); auto. Qed. diff --git a/fta/MainLemma.v b/fta/MainLemma.v index 2c7d810d7..26a5da9ae 100644 --- a/fta/MainLemma.v +++ b/fta/MainLemma.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing two_n %\ensuremath{2n}% #2n# *) (** printing Small %\ensuremath{\frac13^n}% *) @@ -67,10 +67,11 @@ Variable a_0 : IR. Hypothesis eps_le_a_0 : eps [<=] a_0. Lemma a_0_pos : Zero [<] a_0. -apply less_leEq_trans with eps; auto. +Proof. + apply less_leEq_trans with eps; auto. Qed. -(** +(** %\begin{convention}% We define the following local abbreviations: - [two_n := 2 * n] - [Small := p3m n] @@ -89,14 +90,14 @@ Lemma Main_1a' : forall (t : IR) (j k : nat), let r' := t[*]p3m (S (S j)) in let r := t[*]p3m (S j) in (forall i, 1 <= i -> i <= n -> a i[*]r'[^]i[-]eps [<=] a k[*]r'[^]k) -> forall i : nat, 1 <= i -> i <= n -> a i[*] (r [/]ThreeNZ) [^]i[-]eps [<=] a k[*] (r [/]ThreeNZ) [^]k. -(* begin hide *) -intros. -cut ((t[*]p3m (S j)) [/]ThreeNZ [=] t[*]p3m (S (S j))). intro. -astepl (a i[*] (t[*]p3m (S (S j))) [^]i[-]eps). -astepr (a k[*] (t[*]p3m (S (S j))) [^]k). -auto. - -Step_final (t[*]p3m (S j) [/]ThreeNZ). +Proof. + (* begin hide *) + intros. + cut ((t[*]p3m (S j)) [/]ThreeNZ [=] t[*]p3m (S (S j))). intro. + astepl (a i[*] (t[*]p3m (S (S j))) [^]i[-]eps). + astepr (a k[*] (t[*]p3m (S (S j))) [^]k). + auto. + Step_final (t[*]p3m (S j) [/]ThreeNZ). Qed. (* end hide *) @@ -104,14 +105,14 @@ Lemma Main_1b' : forall (t : IR) (j k : nat), let r' := t[*]p3m j in let r := t[*]p3m (S j) in (forall i, 1 <= i -> i <= n -> a i[*]r'[^]i[-]eps [<=] a k[*]r'[^]k) -> forall i, 1 <= i -> i <= n -> a i[*] (r[*]Three) [^]i[-]eps [<=] a k[*] (r[*]Three) [^]k. -(* begin hide *) -intros. -cut (t[*]p3m (S j) [*]Three [=] t[*]p3m j). intro. -astepl (a i[*] (t[*]p3m j) [^]i[-]eps). -astepr (a k[*] (t[*]p3m j) [^]k). -auto. - -Step_final (t[*] (p3m (S j) [*]Three)). +Proof. + (* begin hide *) + intros. + cut (t[*]p3m (S j) [*]Three [=] t[*]p3m j). intro. + astepl (a i[*] (t[*]p3m j) [^]i[-]eps). + astepr (a k[*] (t[*]p3m j) [^]k). + auto. + Step_final (t[*] (p3m (S j) [*]Three)). Qed. (* end hide *) @@ -119,118 +120,101 @@ Lemma Main_1a : forall (r : IR) (k : nat), Zero [<=] r -> 1 <= k -> k <= n -> (forall i, 1 <= i -> i <= n -> a i[*] (r [/]ThreeNZ) [^]i[-]eps [<=] a k[*] (r [/]ThreeNZ) [^]k) -> let p_ := fun i : nat => a i[*]r[^]i in let p_k := a k[*]r[^]k in Sum 1 (pred k) p_ [<=] Half[*] (One[-]Small) [*]p_k[+]Half[*]Three[^]n[*]eps. -(* begin hide *) -intros r k H H0 H1 H2 p_ p_k. -unfold p_, p_k in |- *. -apply - leEq_transitive - with - (Sum 1 (pred k) - (fun i : nat => Three[^]i[*] (a k[*] (r [/]ThreeNZ) [^]k[+]eps))). - apply Sum_resp_leEq. - auto with arith. - intros i H3 H4. - cut (Three[^]i [#] ZeroR). - intro H5. - apply shift_leEq_mult' with H5. - apply nexp_resp_pos. - apply pos_three. - astepl (a i[*] (r[^]i[/] Three[^]i[//]H5)). - astepl (a i[*] (r [/]ThreeNZ) [^]i). - astepr (eps[+]a k[*] (r [/]ThreeNZ) [^]k). - apply shift_leEq_plus'. - apply H2. - assumption. - omega. - - apply nexp_resp_ap_zero. - apply three_ap_zero. -apply - leEq_wdl - with - (Sum 1 (pred k) (fun i : nat => Three[^]i) [*] - (a k[*] (r [/]ThreeNZ) [^]k[+]eps)). - cut (Three[-]One [#] ZeroR). - intro H3. - astepl - ((Three[^]S (pred k) [-]Three[^]1[/] Three[-]One[//]H3) [*] - (a k[*] (r [/]ThreeNZ) [^]k[+]eps)). - rewrite <- (S_pred _ _ H0). - astepl - ((Three[^]k[-]Three[/] Three[-]One[//]H3) [*] - (a k[*] (r [/]ThreeNZ) [^]k[+]eps)). - rstepl - (One [/]TwoNZ[*] (Three[^]k[-]Three) [*] (a k[*] (r [/]ThreeNZ) [^]k) [+] - One [/]TwoNZ[*] (Three[^]k[-]Three) [*]eps). - apply - leEq_transitive - with - (Half[*] (One[-]Small) [*] (a k[*]r[^]k) [+] - One [/]TwoNZ[*] (Three[^]k[-]Three) [*]eps). - apply plus_resp_leEq. - cut (Three[^]k [#] ZeroR). - intro H4. - astepl - (One [/]TwoNZ[*] (Three[^]k[-]Three) [*] (a k[*] (r[^]k[/] Three[^]k[//]H4))). - rstepl (One [/]TwoNZ[*]a k[*]r[^]k[*] (One[-] (Three[/] Three[^]k[//]H4))). - rstepr (Half[*]a k[*]r[^]k[*] (One[-]Small)). - unfold Half in |- *. - apply mult_resp_leEq_lft. - apply minus_resp_leEq_both. - apply leEq_reflexive. - unfold Small in |- *. - unfold p3m in |- *. - cut (Three[^]pred k [#] ZeroR). +Proof. + (* begin hide *) + intros r k H H0 H1 H2 p_ p_k. + unfold p_, p_k in |- *. + apply leEq_transitive with (Sum 1 (pred k) + (fun i : nat => Three[^]i[*] (a k[*] (r [/]ThreeNZ) [^]k[+]eps))). + apply Sum_resp_leEq. + auto with arith. + intros i H3 H4. + cut (Three[^]i [#] ZeroR). intro H5. - apply leEq_wdr with (One[/] Three[^]pred k[//]H5). - cut (Three[^]n [#] ZeroR). - intro H6. - astepl (One[/] Three[^]n[//]H6). - apply recip_resp_leEq. - apply nexp_resp_pos. - apply pos_three. - apply great_nexp_resp_le. - apply less_leEq; apply one_less_three. - omega. - - apply nexp_resp_ap_zero. - apply three_ap_zero. - apply eq_div. - pattern k at 1 in |- *. - rewrite (S_pred _ _ H0). - astepl (One[*] (Three[*]Three[^]pred k):IR). - clear H3 H4 H5. - astepl ((Three[*]Three[^]pred k):IR). reflexivity. - apply nexp_resp_ap_zero. - apply three_ap_zero. - apply mult_resp_nonneg. - apply mult_resp_nonneg. - apply less_leEq. - astepr (Half:IR). - apply pos_half. - apply a_nonneg. - apply nexp_resp_nonneg; auto. - + apply shift_leEq_mult' with H5. + apply nexp_resp_pos. + apply pos_three. + astepl (a i[*] (r[^]i[/] Three[^]i[//]H5)). + astepl (a i[*] (r [/]ThreeNZ) [^]i). + astepr (eps[+]a k[*] (r [/]ThreeNZ) [^]k). + apply shift_leEq_plus'. + apply H2. + assumption. + omega. apply nexp_resp_ap_zero. apply three_ap_zero. - apply plus_resp_leEq_lft. - rstepl (One [/]TwoNZ[*]eps[*] (Three[^]k[-]Three)). - rstepr (Half[*]eps[*]Three[^]n). - unfold Half in |- *. - apply mult_resp_leEq_lft. - apply leEq_transitive with (Three[^]k:IR). - astepr (Three[^]k[-]ZeroR). - apply minus_resp_leEq_rht. - apply less_leEq; apply pos_three. - apply great_nexp_resp_le; auto. - apply less_leEq; apply one_less_three. - apply less_leEq; apply mult_resp_pos; auto. - astepr (Half:IR); apply pos_half. -rstepl (Two:IR). -apply two_ap_zero. - -apply eq_symmetric_unfolded. -apply mult_distr_sum_rht with (f := fun i : nat => (Three:IR) [^]i). + apply leEq_wdl with (Sum 1 (pred k) (fun i : nat => Three[^]i) [*] + (a k[*] (r [/]ThreeNZ) [^]k[+]eps)). + cut (Three[-]One [#] ZeroR). + intro H3. + astepl ((Three[^]S (pred k) [-]Three[^]1[/] Three[-]One[//]H3) [*] + (a k[*] (r [/]ThreeNZ) [^]k[+]eps)). + rewrite <- (S_pred _ _ H0). + astepl ((Three[^]k[-]Three[/] Three[-]One[//]H3) [*] (a k[*] (r [/]ThreeNZ) [^]k[+]eps)). + rstepl (One [/]TwoNZ[*] (Three[^]k[-]Three) [*] (a k[*] (r [/]ThreeNZ) [^]k) [+] + One [/]TwoNZ[*] (Three[^]k[-]Three) [*]eps). + apply leEq_transitive with (Half[*] (One[-]Small) [*] (a k[*]r[^]k) [+] + One [/]TwoNZ[*] (Three[^]k[-]Three) [*]eps). + apply plus_resp_leEq. + cut (Three[^]k [#] ZeroR). + intro H4. + astepl (One [/]TwoNZ[*] (Three[^]k[-]Three) [*] (a k[*] (r[^]k[/] Three[^]k[//]H4))). + rstepl (One [/]TwoNZ[*]a k[*]r[^]k[*] (One[-] (Three[/] Three[^]k[//]H4))). + rstepr (Half[*]a k[*]r[^]k[*] (One[-]Small)). + unfold Half in |- *. + apply mult_resp_leEq_lft. + apply minus_resp_leEq_both. + apply leEq_reflexive. + unfold Small in |- *. + unfold p3m in |- *. + cut (Three[^]pred k [#] ZeroR). + intro H5. + apply leEq_wdr with (One[/] Three[^]pred k[//]H5). + cut (Three[^]n [#] ZeroR). + intro H6. + astepl (One[/] Three[^]n[//]H6). + apply recip_resp_leEq. + apply nexp_resp_pos. + apply pos_three. + apply great_nexp_resp_le. + apply less_leEq; apply one_less_three. + omega. + apply nexp_resp_ap_zero. + apply three_ap_zero. + apply eq_div. + pattern k at 1 in |- *. + rewrite (S_pred _ _ H0). + astepl (One[*] (Three[*]Three[^]pred k):IR). + clear H3 H4 H5. + astepl ((Three[*]Three[^]pred k):IR). reflexivity. + apply nexp_resp_ap_zero. + apply three_ap_zero. + apply mult_resp_nonneg. + apply mult_resp_nonneg. + apply less_leEq. + astepr (Half:IR). + apply pos_half. + apply a_nonneg. + apply nexp_resp_nonneg; auto. + apply nexp_resp_ap_zero. + apply three_ap_zero. + apply plus_resp_leEq_lft. + rstepl (One [/]TwoNZ[*]eps[*] (Three[^]k[-]Three)). + rstepr (Half[*]eps[*]Three[^]n). + unfold Half in |- *. + apply mult_resp_leEq_lft. + apply leEq_transitive with (Three[^]k:IR). + astepr (Three[^]k[-]ZeroR). + apply minus_resp_leEq_rht. + apply less_leEq; apply pos_three. + apply great_nexp_resp_le; auto. + apply less_leEq; apply one_less_three. + apply less_leEq; apply mult_resp_pos; auto. + astepr (Half:IR); apply pos_half. + rstepl (Two:IR). + apply two_ap_zero. + apply eq_symmetric_unfolded. + apply mult_distr_sum_rht with (f := fun i : nat => (Three:IR) [^]i). Qed. (* end hide *) @@ -238,130 +222,105 @@ Lemma Main_1b : forall (r : IR) (k : nat), Zero [<=] r -> 1 <= k -> k <= n -> (forall i, 1 <= i -> i <= n -> a i[*] (r[*]Three) [^]i[-]eps [<=] a k[*] (r[*]Three) [^]k) -> let p_ := fun i => a i[*]r[^]i in let p_k := a k[*]r[^]k in Sum (S k) n p_ [<=] Half[*] (One[-]Small) [*]p_k[+]Half[*]Three[^]n[*]eps. -(* begin hide *) -intros r k H H0 H1 H2 p_ p_k. -unfold p_, p_k in |- *. -cut (forall i : nat, Three[^]i [#] ZeroR). -intro H3. - 2: intro i; apply pos_ap_zero. - 2: apply nexp_resp_pos. - 2: apply pos_three. -apply - leEq_transitive - with - (Sum (S k) n - (fun i : nat => a k[*] (r[*]Three) [^]k[+]eps[/] Three[^]i[//]H3 i)). - apply Sum_resp_leEq. - auto with arith. - intros i H4 H5. - apply shift_leEq_div. - apply nexp_resp_pos; apply pos_three. - rstepr (eps[+]a k[*] (r[*]Three) [^]k). - apply shift_leEq_plus'. - rstepl (a i[*] (r[^]i[*]Three[^]i) [-]eps). - astepl (a i[*] (r[*]Three) [^]i[-]eps). - apply H2; auto with arith. - apply le_trans with (S k); auto. -astepl - (Sum (S k) n - (fun i : nat => (a k[*] (r[*]Three) [^]k[+]eps) [*]One[/] Three[^]i[//]H3 i)). -astepl - (Sum (S k) n - (fun i : nat => - (a k[*] (r[*]Three) [^]k[+]eps) [*] (One[/] Three[^]i[//]H3 i))). -apply - leEq_wdl - with - ((a k[*] (r[*]Three) [^]k[+]eps) [*] - Sum (S k) n (fun i : nat => One[/] Three[^]i[//]H3 i)). - 2: apply eq_symmetric_unfolded. - 2: apply - mult_distr_sum_lft with (f := fun i : nat => One[/] Three[^]i[//]H3 i). -astepl - ((a k[*] (r[*]Three) [^]k[+]eps) [*] - Sum (S k) n (fun i : nat => (One [/]ThreeNZ) [^]i)). -cut (One[-]One [/]ThreeNZ [#] ZeroR). - 2: rstepl ((Two:IR) [/]ThreeNZ). - 2: apply div_resp_ap_zero_rev. - 2: apply two_ap_zero. -intro H4. -astepl - ((a k[*] (r[*]Three) [^]k[+]eps) [*] - ((One [/]ThreeNZ) [^]S k[-] (One [/]ThreeNZ) [^]S n[/] +Proof. + (* begin hide *) + intros r k H H0 H1 H2 p_ p_k. + unfold p_, p_k in |- *. + cut (forall i : nat, Three[^]i [#] ZeroR). + intro H3. + 2: intro i; apply pos_ap_zero. + 2: apply nexp_resp_pos. + 2: apply pos_three. + apply leEq_transitive with (Sum (S k) n + (fun i : nat => a k[*] (r[*]Three) [^]k[+]eps[/] Three[^]i[//]H3 i)). + apply Sum_resp_leEq. + auto with arith. + intros i H4 H5. + apply shift_leEq_div. + apply nexp_resp_pos; apply pos_three. + rstepr (eps[+]a k[*] (r[*]Three) [^]k). + apply shift_leEq_plus'. + rstepl (a i[*] (r[^]i[*]Three[^]i) [-]eps). + astepl (a i[*] (r[*]Three) [^]i[-]eps). + apply H2; auto with arith. + apply le_trans with (S k); auto. + astepl (Sum (S k) n (fun i : nat => (a k[*] (r[*]Three) [^]k[+]eps) [*]One[/] Three[^]i[//]H3 i)). + astepl (Sum (S k) n (fun i : nat => (a k[*] (r[*]Three) [^]k[+]eps) [*] (One[/] Three[^]i[//]H3 i))). + apply leEq_wdl with ((a k[*] (r[*]Three) [^]k[+]eps) [*] + Sum (S k) n (fun i : nat => One[/] Three[^]i[//]H3 i)). + 2: apply eq_symmetric_unfolded. + 2: apply mult_distr_sum_lft with (f := fun i : nat => One[/] Three[^]i[//]H3 i). + astepl ((a k[*] (r[*]Three) [^]k[+]eps) [*] Sum (S k) n (fun i : nat => (One [/]ThreeNZ) [^]i)). + cut (One[-]One [/]ThreeNZ [#] ZeroR). + 2: rstepl ((Two:IR) [/]ThreeNZ). + 2: apply div_resp_ap_zero_rev. + 2: apply two_ap_zero. + intro H4. + astepl ((a k[*] (r[*]Three) [^]k[+]eps) [*] ((One [/]ThreeNZ) [^]S k[-] (One [/]ThreeNZ) [^]S n[/] One[-]One [/]ThreeNZ[//]H4)). -astepl - ((a k[*] (r[*]Three) [^]k[+]eps) [*] - (One [/]ThreeNZ[*] (One [/]ThreeNZ) [^]k[-] + astepl ((a k[*] (r[*]Three) [^]k[+]eps) [*] (One [/]ThreeNZ[*] (One [/]ThreeNZ) [^]k[-] One [/]ThreeNZ[*] (One [/]ThreeNZ) [^]n[/] One[-]One [/]ThreeNZ[//]H4)). -rstepl - (One [/]TwoNZ[*] (a k[*] (r[*]Three) [^]k) [*] - ((One [/]ThreeNZ) [^]k[-] (One [/]ThreeNZ) [^]n) [+] - One [/]TwoNZ[*]eps[*] ((One [/]ThreeNZ) [^]k[-] (One [/]ThreeNZ) [^]n)). -apply - leEq_transitive - with - (Half[*] (One[-]Small) [*] (a k[*]r[^]k) [+] + rstepl (One [/]TwoNZ[*] (a k[*] (r[*]Three) [^]k) [*] + ((One [/]ThreeNZ) [^]k[-] (One [/]ThreeNZ) [^]n) [+] One [/]TwoNZ[*]eps[*] ((One [/]ThreeNZ) [^]k[-] (One [/]ThreeNZ) [^]n)). - apply plus_resp_leEq. - astepl - (One [/]TwoNZ[*] (a k[*] (r[^]k[*]Three[^]k)) [*] - ((One [/]ThreeNZ) [^]k[-] (One [/]ThreeNZ) [^]n)). - rstepl - (One [/]TwoNZ[*]a k[*]r[^]k[*] - (Three[^]k[*] (One [/]ThreeNZ) [^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n)). - unfold Half in |- *. - rstepr (One [/]TwoNZ[*]a k[*]r[^]k[*] (One[-]Small)). - apply mult_resp_leEq_lft. - astepl - (((Three:IR) [*]One [/]ThreeNZ) [^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). - astepl - ((((Three:IR) [*]One) [/]ThreeNZ) [^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). - astepl (((Three:IR) [/]ThreeNZ) [^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). - astepl (OneR[^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). - astepl (OneR[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). - apply less_leEq. - apply minus_resp_less_rht. - unfold Small in |- *. - unfold p3m in |- *. - rstepl (OneR[*] (One [/]ThreeNZ) [^]n). - apply mult_resp_less. - astepl (OneR[^]k). - apply nexp_resp_less; auto. - apply less_leEq; apply pos_one. - apply one_less_three. - apply nexp_resp_pos. - apply pos_div_three; apply pos_one. - apply mult_resp_nonneg. - apply mult_resp_nonneg. - apply less_leEq. - apply pos_div_two; apply pos_one. - apply a_nonneg. - apply nexp_resp_nonneg; assumption. -apply plus_resp_leEq_lft. -rstepr (Half[*]eps[*]Three[^]n). -unfold Half in |- *. -apply mult_resp_leEq_lft. - apply leEq_transitive with OneR. - apply leEq_transitive with ((OneR [/]ThreeNZ) [^]k). - astepr ((OneR [/]ThreeNZ) [^]k[-]Zero). + apply leEq_transitive with (Half[*] (One[-]Small) [*] (a k[*]r[^]k) [+] + One [/]TwoNZ[*]eps[*] ((One [/]ThreeNZ) [^]k[-] (One [/]ThreeNZ) [^]n)). + apply plus_resp_leEq. + astepl (One [/]TwoNZ[*] (a k[*] (r[^]k[*]Three[^]k)) [*] + ((One [/]ThreeNZ) [^]k[-] (One [/]ThreeNZ) [^]n)). + rstepl (One [/]TwoNZ[*]a k[*]r[^]k[*] + (Three[^]k[*] (One [/]ThreeNZ) [^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n)). + unfold Half in |- *. + rstepr (One [/]TwoNZ[*]a k[*]r[^]k[*] (One[-]Small)). + apply mult_resp_leEq_lft. + astepl (((Three:IR) [*]One [/]ThreeNZ) [^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). + astepl ((((Three:IR) [*]One) [/]ThreeNZ) [^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). + astepl (((Three:IR) [/]ThreeNZ) [^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). + astepl (OneR[^]k[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). + astepl (OneR[-]Three[^]k[*] (One [/]ThreeNZ) [^]n). apply less_leEq. apply minus_resp_less_rht. + unfold Small in |- *. + unfold p3m in |- *. + rstepl (OneR[*] (One [/]ThreeNZ) [^]n). + apply mult_resp_less. + astepl (OneR[^]k). + apply nexp_resp_less; auto. + apply less_leEq; apply pos_one. + apply one_less_three. apply nexp_resp_pos. apply pos_div_three; apply pos_one. - astepr (One[^]k:IR). - apply nexp_resp_leEq. - apply less_leEq; apply pos_div_three; apply pos_one. - astepr (OneR [/]OneNZ). - apply less_leEq; apply recip_resp_less. - apply pos_one. - apply one_less_three. + apply mult_resp_nonneg. + apply mult_resp_nonneg. + apply less_leEq. + apply pos_div_two; apply pos_one. + apply a_nonneg. + apply nexp_resp_nonneg; assumption. + apply plus_resp_leEq_lft. + rstepr (Half[*]eps[*]Three[^]n). + unfold Half in |- *. + apply mult_resp_leEq_lft. + apply leEq_transitive with OneR. + apply leEq_transitive with ((OneR [/]ThreeNZ) [^]k). + astepr ((OneR [/]ThreeNZ) [^]k[-]Zero). + apply less_leEq. + apply minus_resp_less_rht. + apply nexp_resp_pos. + apply pos_div_three; apply pos_one. + astepr (One[^]k:IR). + apply nexp_resp_leEq. + apply less_leEq; apply pos_div_three; apply pos_one. + astepr (OneR [/]OneNZ). + apply less_leEq; apply recip_resp_less. + apply pos_one. + apply one_less_three. astepl (OneR[^]n). apply nexp_resp_leEq; apply less_leEq. - apply pos_one. + apply pos_one. apply one_less_three. -apply less_leEq. -apply mult_resp_pos; auto. -apply pos_div_two; apply pos_one. + apply less_leEq. + apply mult_resp_pos; auto. + apply pos_div_two; apply pos_one. Qed. (* end hide *) @@ -370,94 +329,98 @@ Lemma Main_1 : forall (r : IR) (k : nat), Zero [<=] r -> 1 <= k -> k <= n -> (forall i, 1 <= i -> i <= n -> a i[*] (r[*]Three) [^]i[-]eps [<=] a k[*] (r[*]Three) [^]k) -> let p_ := fun i => a i[*]r[^]i in let p_k := a k[*]r[^]k in Sum 1 (pred k) p_[+]Sum (S k) n p_ [<=] (One[-]Small) [*]p_k[+]Three[^]n[*]eps. -(* begin hide *) -intros r k H H0 H1 H2 H3 p_ p_k. -unfold p_, p_k in |- *. -set (h := Half[*] (One[-]Small) [*]p_k[+]Half[*]Three[^]n[*]eps) in *. -apply leEq_wdr with (h[+]h); unfold h, p_k in |- *. - apply plus_resp_leEq_both. - apply Main_1a; auto. - apply Main_1b; auto. -unfold Half in |- *; rational. +Proof. + (* begin hide *) + intros r k H H0 H1 H2 H3 p_ p_k. + unfold p_, p_k in |- *. + set (h := Half[*] (One[-]Small) [*]p_k[+]Half[*]Three[^]n[*]eps) in *. + apply leEq_wdr with (h[+]h); unfold h, p_k in |- *. + apply plus_resp_leEq_both. + apply Main_1a; auto. + apply Main_1b; auto. + unfold Half in |- *; rational. Qed. (* end hide *) Lemma Main_2' : forall (t : IR) (i k : nat), a i[*] (t[*]p3m 0) [^]i[-]eps [<=] a k[*] (t[*]p3m 0) [^]k -> a i[*]t[^]i[-]eps [<=] a k[*]t[^]k. -intros. -cut (t[*]p3m 0 [=] t). intro. -astepl (a i[*] (t[*]p3m 0) [^]i[-]eps). -astepr (a k[*] (t[*]p3m 0) [^]k). -auto. - -Step_final (t[*]One). +Proof. + intros. + cut (t[*]p3m 0 [=] t). intro. + astepl (a i[*] (t[*]p3m 0) [^]i[-]eps). + astepr (a k[*] (t[*]p3m 0) [^]k). + auto. + Step_final (t[*]One). Qed. Lemma Main_2 : forall (t : IR) (j k : nat), let r := t[*]p3m j in Zero [<=] t -> a k[*]t[^]k [=] a_0[-]eps -> (forall i, 1 <= i -> i <= n -> a i[*]t[^]i[-]eps [<=] a k[*]t[^]k) -> forall i, 1 <= i -> i <= n -> a i[*]r[^]i [<=] a_0. -(* begin hide *) -intros. -unfold r in |- *. -apply leEq_transitive with (a i[*]t[^]i). - astepl (a i[*] (t[^]i[*]p3m j[^]i)). - rstepl (p3m j[^]i[*] (a i[*]t[^]i)). - astepr (One[*] (a i[*]t[^]i)). - apply mult_resp_leEq_rht. - astepr (One[^]i:IR). - apply nexp_resp_leEq. - apply less_leEq; apply p3m_pos. - apply p3m_small. - astepl (Zero[*]t[^]i). - apply mult_resp_leEq_rht; auto. - astepl (Zero[^]i:IR). - apply nexp_resp_leEq; auto. - apply leEq_reflexive. -apply leEq_wdr with (eps[+]a k[*]t[^]k). - apply shift_leEq_plus'; auto. -astepl (eps[+] (a_0[-]eps)); rational. +Proof. + (* begin hide *) + intros. + unfold r in |- *. + apply leEq_transitive with (a i[*]t[^]i). + astepl (a i[*] (t[^]i[*]p3m j[^]i)). + rstepl (p3m j[^]i[*] (a i[*]t[^]i)). + astepr (One[*] (a i[*]t[^]i)). + apply mult_resp_leEq_rht. + astepr (One[^]i:IR). + apply nexp_resp_leEq. + apply less_leEq; apply p3m_pos. + apply p3m_small. + astepl (Zero[*]t[^]i). + apply mult_resp_leEq_rht; auto. + astepl (Zero[^]i:IR). + apply nexp_resp_leEq; auto. + apply leEq_reflexive. + apply leEq_wdr with (eps[+]a k[*]t[^]k). + apply shift_leEq_plus'; auto. + astepl (eps[+] (a_0[-]eps)); rational. Qed. (* end hide *) Lemma Main_3a : forall (t : IR) (j k k_0 : nat), let r := t[*]p3m j in k_0 <= n -> a k_0[*]t[^]k_0 [=] a_0[-]eps -> a k_0[*]r[^]k_0[-]eps [<=] a k[*]r[^]k -> p3m (j * n) [*]a_0[-]Two[*]eps [<=] a k[*]r[^]k. -(* begin hide *) -intros. -unfold r in |- *. -rstepl (p3m (j * n) [*]a_0[-]eps[-]eps). -apply leEq_transitive with (a k_0[*] (t[*]p3m j) [^]k_0[-]eps); auto. -apply minus_resp_leEq. -astepr (a k_0[*] (t[^]k_0[*]p3m j[^]k_0)). -astepr (a k_0[*] (t[^]k_0[*]p3m (j * k_0))). -rstepr (p3m (j * k_0) [*] (a k_0[*]t[^]k_0)). -astepr (p3m (j * k_0) [*] (a_0[-]eps)). -astepr (p3m (j * k_0) [*]a_0[-]p3m (j * k_0) [*]eps). -apply minus_resp_leEq_both. +Proof. + (* begin hide *) + intros. + unfold r in |- *. + rstepl (p3m (j * n) [*]a_0[-]eps[-]eps). + apply leEq_transitive with (a k_0[*] (t[*]p3m j) [^]k_0[-]eps); auto. + apply minus_resp_leEq. + astepr (a k_0[*] (t[^]k_0[*]p3m j[^]k_0)). + astepr (a k_0[*] (t[^]k_0[*]p3m (j * k_0))). + rstepr (p3m (j * k_0) [*] (a k_0[*]t[^]k_0)). + astepr (p3m (j * k_0) [*] (a_0[-]eps)). + astepr (p3m (j * k_0) [*]a_0[-]p3m (j * k_0) [*]eps). + apply minus_resp_leEq_both. + apply mult_resp_leEq_rht. + apply p3m_mon'; auto with arith. + apply less_leEq; apply a_0_pos. + astepr (One[*]eps). apply mult_resp_leEq_rht. - apply p3m_mon'; auto with arith. - apply less_leEq; apply a_0_pos. -astepr (One[*]eps). -apply mult_resp_leEq_rht. - apply p3m_small. -apply less_leEq; auto. + apply p3m_small. + apply less_leEq; auto. Qed. (* end hide *) Lemma Main_3 : forall (t : IR) (j k k_0 : nat), let r := t[*]p3m j in j < two_n -> k_0 <= n -> a k_0[*]t[^]k_0 [=] a_0[-]eps -> a k_0[*]r[^]k_0[-]eps [<=] a k[*]r[^]k -> Smaller[*]a_0[-]Two[*]eps [<=] a k[*]r[^]k. -(* begin hide *) -intros t j k k_0 r H H0 H1 H2. -unfold r in |- *. -apply leEq_transitive with (p3m (j * n) [*]a_0[-]Two[*]eps). - apply minus_resp_leEq. - apply mult_resp_leEq_rht. - unfold Smaller in |- *. - apply p3m_mon'. - apply mult_le_compat_r; auto with arith. - apply less_leEq; apply a_0_pos. -apply Main_3a with k_0; auto. +Proof. + (* begin hide *) + intros t j k k_0 r H H0 H1 H2. + unfold r in |- *. + apply leEq_transitive with (p3m (j * n) [*]a_0[-]Two[*]eps). + apply minus_resp_leEq. + apply mult_resp_leEq_rht. + unfold Smaller in |- *. + apply p3m_mon'. + apply mult_le_compat_r; auto with arith. + apply less_leEq; apply a_0_pos. + apply Main_3a with k_0; auto. Qed. (* end hide *) @@ -465,54 +428,55 @@ Lemma Main : {r : IR | Zero [<=] r | {k : nat | 1 <= k /\ k <= n /\ (let p_ := fun i => a i[*]r[^]i in let p_k := a k[*]r[^]k in Sum 1 (pred k) p_[+]Sum (S k) n p_ [<=] (One[-]Small) [*]p_k[+]Three[^]n[*]eps /\ r[^]n [<=] a_0 /\ Smaller[*]a_0[-]Two[*]eps [<=] p_k /\ p_k [<=] a_0)}}. -(* begin hide *) Proof. -elim (Key a n gt_n_0 eps eps_pos a_nonneg a_n_1 a_0 eps_le_a_0). -intro t. intros H0 H1. -elim (H1 two_n). intro k. intros H2. -elim H2. intros H3 H4. -elim H4. intros H5 H6. -elim H6. intros H7 H8. -elim (kseq_prop k n H3 H5). intro j. intros H9. -elim H9. intros H10 H11. elim H11. intros H12 H13. -clear H9 H6 H4 H2 H1. -cut (Zero [<=] t[*]p3m (S j)). intro H14. -2: apply mult_resp_nonneg; auto. -2: apply less_leEq; apply p3m_pos. -exists (t[*]p3m (S j)). -auto. -exists (k (S j)). -elim (H3 (S j)); intros H3' H3''. -split. auto. -split. auto. -intros p_ p_k. (* patch *) -split; unfold p_, p_k in |- *. - apply Main_1; auto. + (* begin hide *) +Proof. + elim (Key a n gt_n_0 eps eps_pos a_nonneg a_n_1 a_0 eps_le_a_0). + intro t. intros H0 H1. + elim (H1 two_n). intro k. intros H2. + elim H2. intros H3 H4. + elim H4. intros H5 H6. + elim H6. intros H7 H8. + elim (kseq_prop k n H3 H5). intro j. intros H9. + elim H9. intros H10 H11. elim H11. intros H12 H13. + clear H9 H6 H4 H2 H1. + cut (Zero [<=] t[*]p3m (S j)). intro H14. + 2: apply mult_resp_nonneg; auto. + 2: apply less_leEq; apply p3m_pos. + exists (t[*]p3m (S j)). + auto. + exists (k (S j)). + elim (H3 (S j)); intros H3' H3''. + split. auto. + split. auto. + intros p_ p_k. (* patch *) + split; unfold p_, p_k in |- *. + apply Main_1; auto. + intros i H15 H16. + apply Main_1a'; auto. + intros i0 H17 H18. + rewrite H13. + apply H8; auto with arith. intros i H15 H16. - apply Main_1a'; auto. + apply Main_1b'; auto. intros i0 H17 H18. - rewrite H13. + rewrite <- H12. + apply H8; auto with arith. + apply le_trans with (S j); auto with arith. + split. + astepl (One[*] (t[*]p3m (S j)) [^]n). + astepl (a n[*] (t[*]p3m (S j)) [^]n). + apply Main_2 with (k 0); auto. + intros i H15 H16. + apply Main_2'. + apply H8; auto with arith. + elim (H3 0); intros H3''' H3''''. + split. + apply Main_3 with (k 0); auto. apply H8; auto with arith. - intros i H15 H16. - apply Main_1b'; auto. - intros i0 H17 H18. - rewrite <- H12. - apply H8; auto with arith. - apply le_trans with (S j); auto with arith. -split. - astepl (One[*] (t[*]p3m (S j)) [^]n). - astepl (a n[*] (t[*]p3m (S j)) [^]n). apply Main_2 with (k 0); auto. intros i H15 H16. - apply Main_2'. - apply H8; auto with arith. -elim (H3 0); intros H3''' H3''''. -split. - apply Main_3 with (k 0); auto. - apply H8; auto with arith. -apply Main_2 with (k 0); auto. -intros i H15 H16. -apply Main_2'; auto with arith. + apply Main_2'; auto with arith. Qed. (* end hide *) diff --git a/ftc/COrdLemmas.v b/ftc/COrdLemmas.v index 5fcab16ce..d3b432fce 100644 --- a/ftc/COrdLemmas.v +++ b/ftc/COrdLemmas.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export COrdCauchy. @@ -41,7 +41,7 @@ Section Lemmas. (** * Lemmas for Integration -Here we include several lemmas valid in any ordered field [F] which +Here we include several lemmas valid in any ordered field [F] which are useful for integration. ** Merging orders @@ -55,233 +55,235 @@ refinement). Variable F : COrdField. Lemma om_fun_lt : forall m n : nat, S m < S n -> m < n. -auto with zarith. +Proof. + auto with zarith. Qed. Definition om_fun n m (f : forall i, i < n -> F) (g : forall i, i < m -> F) (Hfg : forall i j Hi Hj, f i Hi [#] g j Hj) : forall i, i < m + n -> F. -intro n. induction n as [| n Hrecn]. +Proof. + intro n. induction n as [| n Hrecn]. intros. apply (g i). rewrite <- plus_n_O in H; auto. -intro m. induction m as [| m Hrecm]. + intro m. induction m as [| m Hrecm]. do 3 intro. apply f. -intros. -elim (ap_imp_less _ _ _ (Hfg n m (lt_n_Sn n) (lt_n_Sn m))); intro. - set (h := fun (i : nat) (Hi : i < m) => g i (lt_S _ _ Hi)) in *. + intros. + elim (ap_imp_less _ _ _ (Hfg n m (lt_n_Sn n) (lt_n_Sn m))); intro. + set (h := fun (i : nat) (Hi : i < m) => g i (lt_S _ _ Hi)) in *. + elim (le_lt_eq_dec _ _ H); intro. + apply Hrecm with (f := f) (g := h) (i := i); unfold h in |- *; auto. + apply om_fun_lt; auto. + apply (g m (lt_n_Sn m)). + clear Hrecm. + set (h := fun (i : nat) (Hi : i < n) => f i (lt_S _ _ Hi)) in *. elim (le_lt_eq_dec _ _ H); intro. - apply Hrecm with (f := f) (g := h) (i := i); unfold h in |- *; auto. - apply om_fun_lt; auto. - apply (g m (lt_n_Sn m)). -clear Hrecm. -set (h := fun (i : nat) (Hi : i < n) => f i (lt_S _ _ Hi)) in *. -elim (le_lt_eq_dec _ _ H); intro. - apply Hrecn with (f := h) (g := g) (i := i); unfold h in |- *; auto. - apply om_fun_lt. rewrite plus_n_Sm. auto. -apply (f n (lt_n_Sn n)). + apply Hrecn with (f := h) (g := g) (i := i); unfold h in |- *; auto. + apply om_fun_lt. rewrite plus_n_Sm. auto. + apply (f n (lt_n_Sn n)). Defined. Lemma om_fun_1 : forall n m f g Hfg, nat_less_n_fun f -> nat_less_n_fun g -> nat_less_n_fun (om_fun n m f g Hfg). -intro n. induction n as [| n Hrecn]. +Proof. + intro n. induction n as [| n Hrecn]. red in |- *; simpl in |- *; auto. -intro m; induction m as [| m Hrecm]. - red in |- *; simpl in |- *; auto. -red in |- *; intros. -simpl in |- *; elim ap_imp_less; simpl in |- *; intro; - repeat (elim le_lt_eq_dec; simpl in |- *; intro); - try (elimtype False; auto with zarith; fail); - try apply eq_reflexive_unfolded. -set (h := fun (i : nat) (Hi : i < m) => g i (lt_S _ _ Hi)) in *. -set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. -assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. -exact (Hrecm f h Hfh H Hh i j H1 (om_fun_lt _ _ a0) (om_fun_lt _ _ a1)). -apply Hrecn; try red in |- *; auto. + intro m; induction m as [| m Hrecm]. + red in |- *; simpl in |- *; auto. + red in |- *; intros. + simpl in |- *; elim ap_imp_less; simpl in |- *; intro; + repeat (elim le_lt_eq_dec; simpl in |- *; intro); try (elimtype False; auto with zarith; fail); + try apply eq_reflexive_unfolded. + set (h := fun (i : nat) (Hi : i < m) => g i (lt_S _ _ Hi)) in *. + set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. + assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. + exact (Hrecm f h Hfh H Hh i j H1 (om_fun_lt _ _ a0) (om_fun_lt _ _ a1)). + apply Hrecn; try red in |- *; auto. Qed. Lemma om_fun_2a : forall n m f g Hfg (x : F), (forall i Hi, f i Hi [<] x) -> (forall i Hi, g i Hi [<] x) -> forall i Hi, om_fun n m f g Hfg i Hi [<] x. -intro n. induction n as [| n Hrecn]. +Proof. + intro n. induction n as [| n Hrecn]. simpl in |- *; auto. -intro m; induction m as [| m Hrecm]. - simpl in |- *; auto. -intros. -simpl in |- *; elim ap_imp_less; simpl in |- *; intro; elim le_lt_eq_dec; - simpl in |- *; intro; auto. -set (h := fun (i : nat) (Hi : i < m) => g i (lt_S _ _ Hi)) in *. -set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. -set (Hh := fun i Hi => X0 i (lt_S _ _ Hi)) in *. -exact (Hrecm f h Hfh x X Hh i (om_fun_lt _ _ a0)). + intro m; induction m as [| m Hrecm]. + simpl in |- *; auto. + intros. + simpl in |- *; elim ap_imp_less; simpl in |- *; intro; elim le_lt_eq_dec; simpl in |- *; intro; auto. + set (h := fun (i : nat) (Hi : i < m) => g i (lt_S _ _ Hi)) in *. + set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. + set (Hh := fun i Hi => X0 i (lt_S _ _ Hi)) in *. + exact (Hrecm f h Hfh x X Hh i (om_fun_lt _ _ a0)). Qed. Lemma om_fun_2 : forall n m f g Hfg, nat_less_n_fun f -> nat_less_n_fun g -> (forall i i' Hi Hi', i < i' -> f i Hi [<] f i' Hi') -> (forall i i' Hi Hi', i < i' -> g i Hi [<] g i' Hi') -> forall i i' Hi Hi', i < i' -> om_fun n m f g Hfg i Hi [<] om_fun n m f g Hfg i' Hi'. -intro n. induction n as [| n Hrecn]. - simpl in |- *; auto. -intro m; induction m as [| m Hrecm]. +Proof. + intro n. induction n as [| n Hrecn]. simpl in |- *; auto. -intros. -simpl in |- *; elim ap_imp_less; simpl in |- *; intro; - repeat (elim le_lt_eq_dec; simpl in |- *; intro); - try (elimtype False; auto with zarith; fail). + intro m; induction m as [| m Hrecm]. + simpl in |- *; auto. + intros. + simpl in |- *; elim ap_imp_less; simpl in |- *; intro; + repeat (elim le_lt_eq_dec; simpl in |- *; intro); try (elimtype False; auto with zarith; fail). + set (h := fun (i : nat) (Hi : i < m) => g i (lt_S _ _ Hi)) in *. + set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. + assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. + set (inch := fun i i' Hi Hi' Hii' => X0 i i' (lt_S _ _ Hi) (lt_S _ _ Hi') Hii') in *. + exact (Hrecm f h Hfh H Hh X inch i i' (om_fun_lt _ _ a0) (om_fun_lt _ _ a1) H1). set (h := fun (i : nat) (Hi : i < m) => g i (lt_S _ _ Hi)) in *. set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. - set - (inch := - fun i i' Hi Hi' Hii' => X0 i i' (lt_S _ _ Hi) (lt_S _ _ Hi') Hii') - in *. - exact - (Hrecm f h Hfh H Hh X inch i i' (om_fun_lt _ _ a0) (om_fun_lt _ _ a1) H1). - set (h := fun (i : nat) (Hi : i < m) => g i (lt_S _ _ Hi)) in *. - set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. - assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. - refine (om_fun_2a _ _ f h Hfh (g m (lt_n_Sn m)) _ _ i (om_fun_lt _ _ a0)). - intros j Hj. elim (le_lt_eq_dec _ _ Hj); intro. + refine (om_fun_2a _ _ f h Hfh (g m (lt_n_Sn m)) _ _ i (om_fun_lt _ _ a0)). + intros j Hj. elim (le_lt_eq_dec _ _ Hj); intro. apply less_transitive_unfolded with (f n (lt_n_Sn n)); auto with arith. - apply less_wdl with (f n (lt_n_Sn n)); auto. - apply H; auto. inversion b0. auto. - unfold h in |- *; auto. - apply Hrecn; auto. red in |- *; auto. -apply om_fun_2a; auto. -intros j Hj. elim (le_lt_eq_dec _ _ Hj); intro. + apply less_wdl with (f n (lt_n_Sn n)); auto. + apply H; auto. inversion b0. auto. + unfold h in |- *; auto. + apply Hrecn; auto. red in |- *; auto. + apply om_fun_2a; auto. + intros j Hj. elim (le_lt_eq_dec _ _ Hj); intro. apply less_transitive_unfolded with (g m (lt_n_Sn m)); auto with arith. -apply less_wdl with (g m (lt_n_Sn m)); auto. -apply H0; auto. inversion b1. auto. + apply less_wdl with (g m (lt_n_Sn m)); auto. + apply H0; auto. inversion b1. auto. Qed. Lemma om_fun_3a : forall n m f g Hfg, nat_less_n_fun f -> nat_less_n_fun g -> forall i Hi, {j : nat | {Hj : j < m + n | f i Hi [=] om_fun n m f g Hfg j Hj}}. -intro n. induction n as [| n Hrecn]. +Proof. + intro n. induction n as [| n Hrecn]. simpl in |- *; intros. elimtype False; inversion Hi. -intro m; induction m as [| m Hrecm]. - simpl in |- *; intros. exists i. exists Hi. algebra. -intros. -simpl in |- *; elim ap_imp_less; simpl in |- *; intro. - set (h := fun i Hi => g i (lt_S _ _ Hi)) in *. - set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. - assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. - elim (Hrecm f h Hfh H Hh i Hi); intros j Hj. - elim Hj; clear Hj; intros Hj Hj'. - exists j; exists (lt_S _ _ Hj). - elim le_lt_eq_dec; simpl in |- *; intro. - astepl (om_fun _ _ f h Hfh _ Hj). - refine (om_fun_1 _ _ f h Hfh H Hh j j _ Hj (om_fun_lt _ _ a0)). auto. - elimtype False; auto with zarith. -elim (le_lt_eq_dec _ _ Hi); intro. - set (h := fun i Hi => f i (lt_S _ _ Hi)) in *. - set (Hfh := fun i j Hi Hj => Hfg i j (lt_S _ _ Hi) Hj) in *. - assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. - elim (Hrecn _ h g Hfh Hh H0 i (om_fun_lt _ _ a)); intros j Hj. - elim Hj; clear Hj; intros Hj Hj'. - cut (j < S (m + S n)). intro. 2: auto with zarith. - exists j; exists H1. - elim le_lt_eq_dec; simpl in |- *; intro. - eapply eq_transitive_unfolded. eapply eq_transitive_unfolded. 2: apply Hj'. - unfold h in |- *; apply H; auto. - apply om_fun_1; auto. - elimtype False; auto with zarith. -exists (m + S n). exists (lt_n_Sn (m + S n)). -elim le_lt_eq_dec; simpl in |- *; intro. - elimtype False; auto with zarith. -apply H. inversion b0. auto. -Qed. - -Lemma om_fun_3b : forall n m f g Hfg, nat_less_n_fun f -> nat_less_n_fun g -> - forall i Hi, {j : nat | {Hj : j < m + n | g i Hi [=] om_fun n m f g Hfg j Hj}}. -intro n. induction n as [| n Hrecn]. - simpl in |- *; intros. exists i. - assert (i < m + 0). rewrite <- plus_n_O. auto. - exists H1. algebra. -intro m; induction m as [| m Hrecm]. - simpl in |- *; intros. elimtype False; inversion Hi. -intros. -simpl in |- *; elim ap_imp_less; simpl in |- *; intro. - elim (le_lt_eq_dec _ _ Hi); intro. + intro m; induction m as [| m Hrecm]. + simpl in |- *; intros. exists i. exists Hi. algebra. + intros. + simpl in |- *; elim ap_imp_less; simpl in |- *; intro. set (h := fun i Hi => g i (lt_S _ _ Hi)) in *. set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. - elim (Hrecm f h Hfh H Hh i (om_fun_lt _ _ a0)); intros j Hj. + elim (Hrecm f h Hfh H Hh i Hi); intros j Hj. elim Hj; clear Hj; intros Hj Hj'. exists j; exists (lt_S _ _ Hj). + elim le_lt_eq_dec; simpl in |- *; intro. + astepl (om_fun _ _ f h Hfh _ Hj). + refine (om_fun_1 _ _ f h Hfh H Hh j j _ Hj (om_fun_lt _ _ a0)). auto. + elimtype False; auto with zarith. + elim (le_lt_eq_dec _ _ Hi); intro. + set (h := fun i Hi => f i (lt_S _ _ Hi)) in *. + set (Hfh := fun i j Hi Hj => Hfg i j (lt_S _ _ Hi) Hj) in *. + assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. + elim (Hrecn _ h g Hfh Hh H0 i (om_fun_lt _ _ a)); intros j Hj. + elim Hj; clear Hj; intros Hj Hj'. + cut (j < S (m + S n)). intro. 2: auto with zarith. + exists j; exists H1. elim le_lt_eq_dec; simpl in |- *; intro. eapply eq_transitive_unfolded. eapply eq_transitive_unfolded. 2: apply Hj'. - unfold h in |- *; apply H0; auto. - refine (om_fun_1 _ _ f h Hfh H Hh j j _ Hj (om_fun_lt _ _ a1)). auto. + unfold h in |- *; apply H; auto. + apply om_fun_1; auto. elimtype False; auto with zarith. exists (m + S n). exists (lt_n_Sn (m + S n)). elim le_lt_eq_dec; simpl in |- *; intro. elimtype False; auto with zarith. - apply H0. inversion b. auto. -set (h := fun i Hi => f i (lt_S _ _ Hi)) in *. -set (Hfh := fun i j Hi Hj => Hfg i j (lt_S _ _ Hi) Hj) in *. -assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. -elim (Hrecn _ h g Hfh Hh H0 i Hi); intros j Hj. -elim Hj; clear Hj; intros Hj Hj'. -cut (j < S (m + S n)). intro. 2: auto with zarith. -exists j; exists H1. -elim le_lt_eq_dec; simpl in |- *; intro. - eapply eq_transitive_unfolded. apply Hj'. apply om_fun_1; auto. -elimtype False; auto with zarith. + apply H. inversion b0. auto. +Qed. + +Lemma om_fun_3b : forall n m f g Hfg, nat_less_n_fun f -> nat_less_n_fun g -> + forall i Hi, {j : nat | {Hj : j < m + n | g i Hi [=] om_fun n m f g Hfg j Hj}}. +Proof. + intro n. induction n as [| n Hrecn]. + simpl in |- *; intros. exists i. + assert (i < m + 0). rewrite <- plus_n_O. auto. + exists H1. algebra. + intro m; induction m as [| m Hrecm]. + simpl in |- *; intros. elimtype False; inversion Hi. + intros. + simpl in |- *; elim ap_imp_less; simpl in |- *; intro. + elim (le_lt_eq_dec _ _ Hi); intro. + set (h := fun i Hi => g i (lt_S _ _ Hi)) in *. + set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. + assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. + elim (Hrecm f h Hfh H Hh i (om_fun_lt _ _ a0)); intros j Hj. + elim Hj; clear Hj; intros Hj Hj'. + exists j; exists (lt_S _ _ Hj). + elim le_lt_eq_dec; simpl in |- *; intro. + eapply eq_transitive_unfolded. eapply eq_transitive_unfolded. 2: apply Hj'. + unfold h in |- *; apply H0; auto. + refine (om_fun_1 _ _ f h Hfh H Hh j j _ Hj (om_fun_lt _ _ a1)). auto. + elimtype False; auto with zarith. + exists (m + S n). exists (lt_n_Sn (m + S n)). + elim le_lt_eq_dec; simpl in |- *; intro. + elimtype False; auto with zarith. + apply H0. inversion b. auto. + set (h := fun i Hi => f i (lt_S _ _ Hi)) in *. + set (Hfh := fun i j Hi Hj => Hfg i j (lt_S _ _ Hi) Hj) in *. + assert (Hh : nat_less_n_fun h). red in |- *; unfold h in |- *; auto. + elim (Hrecn _ h g Hfh Hh H0 i Hi); intros j Hj. + elim Hj; clear Hj; intros Hj Hj'. + cut (j < S (m + S n)). intro. 2: auto with zarith. + exists j; exists H1. + elim le_lt_eq_dec; simpl in |- *; intro. + eapply eq_transitive_unfolded. apply Hj'. apply om_fun_1; auto. + elimtype False; auto with zarith. Qed. Lemma om_fun_4a : forall n m f g Hfg (P : F -> CProp), pred_wd F P -> (forall i Hi, P (f i Hi)) -> (forall j Hj, P (g j Hj)) -> forall k Hk, P (om_fun n m f g Hfg k Hk). -intro n. induction n as [| n Hrecn]. +Proof. + intro n. induction n as [| n Hrecn]. simpl in |- *; auto. -intro m; induction m as [| m Hrecm]. - simpl in |- *; auto. -intros. -simpl in |- *; elim ap_imp_less; simpl in |- *; intro; elim le_lt_eq_dec; - simpl in |- *; intro; auto. - set (h := fun i Hi => g i (lt_S _ _ Hi)) in *. - set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. - set (Hh := fun i Hi => X1 i (lt_S _ _ Hi)) in *. - exact (Hrecm f h Hfh P X X0 Hh k (om_fun_lt _ _ a0)). -apply Hrecn; auto. + intro m; induction m as [| m Hrecm]. + simpl in |- *; auto. + intros. + simpl in |- *; elim ap_imp_less; simpl in |- *; intro; elim le_lt_eq_dec; simpl in |- *; intro; auto. + set (h := fun i Hi => g i (lt_S _ _ Hi)) in *. + set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. + set (Hh := fun i Hi => X1 i (lt_S _ _ Hi)) in *. + exact (Hrecm f h Hfh P X X0 Hh k (om_fun_lt _ _ a0)). + apply Hrecn; auto. Qed. Lemma om_fun_4b : forall n m f g Hfg (P : F -> Prop), pred_wd' F P -> (forall i Hi, P (f i Hi)) -> (forall j Hj, P (g j Hj)) -> forall k Hk, P (om_fun n m f g Hfg k Hk). -intro n. induction n as [| n Hrecn]. - simpl in |- *; auto. -intro m; induction m as [| m Hrecm]. +Proof. + intro n. induction n as [| n Hrecn]. simpl in |- *; auto. -intros. -simpl in |- *; elim ap_imp_less; simpl in |- *; intro; elim le_lt_eq_dec; - simpl in |- *; intro; auto. - set (h := fun i Hi => g i (lt_S _ _ Hi)) in *. - set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. - set (Hh := fun i Hi => H1 i (lt_S _ _ Hi)) in *. - exact (Hrecm f h Hfh P H H0 Hh k (om_fun_lt _ _ a0)). -apply Hrecn; auto. + intro m; induction m as [| m Hrecm]. + simpl in |- *; auto. + intros. + simpl in |- *; elim ap_imp_less; simpl in |- *; intro; elim le_lt_eq_dec; simpl in |- *; intro; auto. + set (h := fun i Hi => g i (lt_S _ _ Hi)) in *. + set (Hfh := fun i j Hi Hj => Hfg i j Hi (lt_S _ _ Hj)) in *. + set (Hh := fun i Hi => H1 i (lt_S _ _ Hi)) in *. + exact (Hrecm f h Hfh P H H0 Hh k (om_fun_lt _ _ a0)). + apply Hrecn; auto. Qed. Lemma om_fun_4c : forall n m f g Hfg (P : F -> CProp), pred_wd F P -> nat_less_n_fun f -> nat_less_n_fun g -> {i : nat | {Hi : i < n | P (f i Hi)}} or {j : nat | {Hj : j < m | P (g j Hj)}} -> {k : nat | {Hk : k < m + n | P (om_fun n m f g Hfg k Hk)}}. -intros n m f g Hfg P HP Hf Hg H. -elim H; intro H'; elim H'; intros i Hi; elim Hi; clear H H' Hi; intros Hi Hi'. - elim (om_fun_3a _ _ _ _ Hfg Hf Hg i Hi). intros j Hj. elim Hj; clear Hj. +Proof. + intros n m f g Hfg P HP Hf Hg H. + elim H; intro H'; elim H'; intros i Hi; elim Hi; clear H H' Hi; intros Hi Hi'. + elim (om_fun_3a _ _ _ _ Hfg Hf Hg i Hi). intros j Hj. elim Hj; clear Hj. + intros Hj Hj'. + exists j; exists Hj; apply HP with (x := f i Hi); auto. + elim (om_fun_3b _ _ _ _ Hfg Hf Hg i Hi). intros j Hj. elim Hj; clear Hj. intros Hj Hj'. - exists j; exists Hj; apply HP with (x := f i Hi); auto. -elim (om_fun_3b _ _ _ _ Hfg Hf Hg i Hi). intros j Hj. elim Hj; clear Hj. -intros Hj Hj'. -exists j; exists Hj; apply HP with (x := g i Hi); auto. + exists j; exists Hj; apply HP with (x := g i Hi); auto. Qed. Lemma om_fun_4d : forall n m f g Hfg (P : F -> Prop), pred_wd' F P -> nat_less_n_fun f -> nat_less_n_fun g -> {i : nat | {Hi : i < n | P (f i Hi)}} or {j : nat | {Hj : j < m | P (g j Hj)}} -> {k : nat | {Hk : k < m + n | P (om_fun n m f g Hfg k Hk)}}. -intros n m f g Hfg P HP Hf Hg H. -elim H; intro H'; elim H'; intros i Hi; elim Hi; clear H H' Hi; intros Hi Hi'. - elim (om_fun_3a _ _ _ _ Hfg Hf Hg i Hi). intros j Hj. elim Hj; clear Hj. +Proof. + intros n m f g Hfg P HP Hf Hg H. + elim H; intro H'; elim H'; intros i Hi; elim Hi; clear H H' Hi; intros Hi Hi'. + elim (om_fun_3a _ _ _ _ Hfg Hf Hg i Hi). intros j Hj. elim Hj; clear Hj. + intros Hj Hj'. + exists j; exists Hj; apply HP with (x := f i Hi); auto. + elim (om_fun_3b _ _ _ _ Hfg Hf Hg i Hi). intros j Hj. elim Hj; clear Hj. intros Hj Hj'. - exists j; exists Hj; apply HP with (x := f i Hi); auto. -elim (om_fun_3b _ _ _ _ Hfg Hf Hg i Hi). intros j Hj. elim Hj; clear Hj. -intros Hj Hj'. -exists j; exists Hj; apply HP with (x := g i Hi); auto. + exists j; exists Hj; apply HP with (x := g i Hi); auto. Qed. (* begin hide *) @@ -303,61 +305,58 @@ Lemma Sumx_Sum_Sum : forall n, Sumx (fun i (H : i < n) => Sum (f i) (pred (f (S i))) h) [=] Sumx (fun i (H : i < f n) => h i). -simple induction n. - rewrite f0; simpl in |- *; algebra. -clear n; intros. -elim (le_lt_dec n 0); intro. - cut (n = 0); [ clear a; intro | auto with arith ]. - rewrite H0 in H. rewrite H0. clear H0. - simpl in |- *. astepl (Sum (f 0) (pred (f 1)) h). rewrite f0. - apply eq_symmetric. eapply eq_transitive. - apply Sumx_to_Sum. - pattern 0 at 1 in |- *; rewrite <- f0; apply f_mon; apply lt_n_Sn. - intros i j H0 H1 H'; rewrite H0; algebra. - clear H; apply Sum_wd'; unfold part_tot_nat_fun in |- *; auto with arith. - intros. elim (le_lt_dec (f 1) i); intro; simpl in |- *. +Proof. + simple induction n. + rewrite f0; simpl in |- *; algebra. + clear n; intros. + elim (le_lt_dec n 0); intro. + cut (n = 0); [ clear a; intro | auto with arith ]. + rewrite H0 in H. rewrite H0. clear H0. + simpl in |- *. astepl (Sum (f 0) (pred (f 1)) h). rewrite f0. + apply eq_symmetric. eapply eq_transitive. + apply Sumx_to_Sum. + pattern 0 at 1 in |- *; rewrite <- f0; apply f_mon; apply lt_n_Sn. + intros i j H0 H1 H'; rewrite H0; algebra. + clear H; apply Sum_wd'; unfold part_tot_nat_fun in |- *; auto with arith. + intros. elim (le_lt_dec (f 1) i); intro; simpl in |- *. cut (0 < f 1). - intro; elimtype False; omega. - pattern 0 at 1 in |- *; rewrite <- f0; apply f_mon; apply lt_n_Sn. - algebra. -cut (0 < f n); [ intro | rewrite <- f0; apply f_mon; assumption ]. -simpl in |- *. -eapply eq_transitive_unfolded. - 2: apply eq_symmetric_unfolded; apply Sumx_to_Sum. - apply - eq_transitive_unfolded - with - (Sum 0 (pred (f n)) - (part_tot_nat_fun _ _ (fun (i : nat) (H : i < f n) => h i)) [+] - Sum (f n) (pred (f (S n))) h). - apply bin_op_wd_unfolded. - eapply eq_transitive_unfolded. - apply H. - apply Sumx_to_Sum; try assumption. - red in |- *; intros; rewrite H1; algebra. - algebra. - cut (f n = S (pred (f n))); [ intro | apply S_pred with 0; auto ]. - rewrite {4} H1. - eapply eq_transitive_unfolded. -2: apply Sum_Sum with (m := pred (f n)). - apply bin_op_wd_unfolded; apply Sum_wd'. - rewrite <- H1; apply lt_le_weak; assumption. - intros. - elim (le_lt_dec (f n) i); intro; simpl in |- *. - elimtype False; omega. - elim (le_lt_dec (f (S n)) i); intro; simpl in |- *. - cut (f n < f (S n)); [ intro | apply f_mon; apply lt_n_Sn ]. - elimtype False; apply (le_not_lt (f n) i); auto. - apply le_trans with (f (S n)); auto with arith. - intros; unfold part_tot_nat_fun in |- *; - elim (le_lt_dec (f (S n)) i);elim (le_lt_dec (f n) i);simpl;intros; try reflexivity;try elimtype False; try omega. - rewrite -H1; cut (0 < f (S n)); [ intro | rewrite <- f0; auto with arith ]; - cut (f (S n) = S (pred (f (S n)))); [ intro | apply S_pred with 0; auto ]; - rewrite <- H3; apply lt_le_weak; auto with arith. - intros; unfold part_tot_nat_fun in |- *;elim (le_lt_dec (f (S n)) i); - [intro; simpl in |- *; elimtype False; omega| reflexivity]. - apply lt_trans with (f n); auto with arith. -red in |- *; intros; rewrite -> H1; reflexivity. + intro; elimtype False; omega. + pattern 0 at 1 in |- *; rewrite <- f0; apply f_mon; apply lt_n_Sn. + algebra. + cut (0 < f n); [ intro | rewrite <- f0; apply f_mon; assumption ]. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply Sumx_to_Sum. + apply eq_transitive_unfolded with (Sum 0 (pred (f n)) + (part_tot_nat_fun _ _ (fun (i : nat) (H : i < f n) => h i)) [+] Sum (f n) (pred (f (S n))) h). + apply bin_op_wd_unfolded. + eapply eq_transitive_unfolded. + apply H. + apply Sumx_to_Sum; try assumption. + red in |- *; intros; rewrite H1; algebra. + algebra. + cut (f n = S (pred (f n))); [ intro | apply S_pred with 0; auto ]. + rewrite {4} H1. + eapply eq_transitive_unfolded. + 2: apply Sum_Sum with (m := pred (f n)). + apply bin_op_wd_unfolded; apply Sum_wd'. + rewrite <- H1; apply lt_le_weak; assumption. + intros. + elim (le_lt_dec (f n) i); intro; simpl in |- *. + elimtype False; omega. + elim (le_lt_dec (f (S n)) i); intro; simpl in |- *. + cut (f n < f (S n)); [ intro | apply f_mon; apply lt_n_Sn ]. + elimtype False; apply (le_not_lt (f n) i); auto. + apply le_trans with (f (S n)); auto with arith. + intros; unfold part_tot_nat_fun in |- *; + elim (le_lt_dec (f (S n)) i);elim (le_lt_dec (f n) i);simpl;intros; try reflexivity;try elimtype False; try omega. + rewrite -H1; cut (0 < f (S n)); [ intro | rewrite <- f0; auto with arith ]; + cut (f (S n) = S (pred (f (S n)))); [ intro | apply S_pred with 0; auto ]; + rewrite <- H3; apply lt_le_weak; auto with arith. + intros; unfold part_tot_nat_fun in |- *;elim (le_lt_dec (f (S n)) i); + [intro; simpl in |- *; elimtype False; omega| reflexivity]. + apply lt_trans with (f n); auto with arith. + red in |- *; intros; rewrite -> H1; reflexivity. Qed. Lemma str_Sumx_Sum_Sum : @@ -366,21 +365,22 @@ Lemma str_Sumx_Sum_Sum : forall m, m = f n -> Sumx (fun i (H : i < n) => Sum (f i) (pred (f (S i))) (g i H)) [=] Sumx (fun i (H : i < m) => h i). -intros. -rewrite H0. -eapply eq_transitive_unfolded. -2: apply Sumx_Sum_Sum. -apply Sumx_wd. -intros. -apply Sum_wd'. -cut (0 < f (S i)); [ intro | rewrite <- f0; auto with arith ]. -cut (f (S i) = S (pred (f (S i)))); [ intro | apply S_pred with 0; auto ]. -rewrite <- H3. -apply lt_le_weak; auto with arith. -intros; apply H. -assumption. -rewrite (S_pred (f (S i)) 0); auto with arith. -rewrite <- f0; auto with arith. +Proof. + intros. + rewrite H0. + eapply eq_transitive_unfolded. + 2: apply Sumx_Sum_Sum. + apply Sumx_wd. + intros. + apply Sum_wd'. + cut (0 < f (S i)); [ intro | rewrite <- f0; auto with arith ]. + cut (f (S i) = S (pred (f (S i)))); [ intro | apply S_pred with 0; auto ]. + rewrite <- H3. + apply lt_le_weak; auto with arith. + intros; apply H. + assumption. + rewrite (S_pred (f (S i)) 0); auto with arith. + rewrite <- f0; auto with arith. Qed. End Lemmas. @@ -388,10 +388,11 @@ End Lemmas. Section More_Lemmas. (* begin hide *) Let f' (m : nat) (f : forall i, i <= m -> nat) : nat -> nat. -intros m f i. -elim (le_lt_dec i m); intro. -apply (f i a). -apply (f m (le_n m) + i). +Proof. + intros m f i. + elim (le_lt_dec i m); intro. + apply (f i a). + apply (f m (le_n m) + i). Defined. (* end hide *) @@ -408,61 +409,55 @@ Lemma str_Sumx_Sum_Sum' : (forall H, n = f m H) -> Sumx (fun (i : nat) (H : i < m) => - Sum (f i (lt_le_weak _ _ H)) (pred (f (S i) H)) (g i H)) [=] + Sum (f i (lt_le_weak _ _ H)) (pred (f (S i) H)) (g i H)) [=] Sumx (fun (i : nat) (_ : i < n) => h i). -intros. -cut (forall (i : nat) (H : i <= m), f i H = f' m f i). -intros. -apply - eq_transitive_unfolded - with - (Sumx - (fun (i : nat) (H3 : i < m) => - Sum (f' m f i) (pred (f' m f (S i))) (g i H3))). -apply Sumx_wd; intros. -rewrite <- (H4 i (lt_le_weak _ _ H5)); rewrite <- (H4 (S i) H5); - apply Sum_wd'. -rewrite <- - (S_pred (f (S i) H5) (f i (lt_le_weak _ _ H5)) (H1 _ _ _ _ (lt_n_Sn i))) - . -apply lt_le_weak; apply H1; apply lt_n_Sn. -intros; algebra. -apply str_Sumx_Sum_Sum. -unfold f' in |- *; simpl in |- *. -elim (le_lt_dec 0 m); intro; simpl in |- *. -transitivity (f 0 (le_O_n m)). -apply H0; auto. -apply H. -elimtype False; inversion b. -intros; apply nat_local_mon_imp_mon. -clear H5 j i; intros. -unfold f' in |- *. -elim (le_lt_dec i m); elim (le_lt_dec (S i) m); intros; simpl in |- *. -apply H1; apply lt_n_Sn. -cut (i = m); [ intro | apply le_antisym; auto with arith ]. -generalize a; clear a; pattern i at 1 2 in |- *; rewrite H5; intro. -set (x := f m a) in *. -cut (x = f m (le_n m)). -2: unfold x in |- *; apply H0; auto. -intro. -rewrite <- H6. -rewrite <- plus_n_Sm; auto with arith. -elimtype False; apply (le_not_lt i m); auto with arith. -set (x := f m (le_n m)) in *; clearbody x; auto with arith. -assumption. -intros. -apply H2 with (Hi' := lt_le_weak _ _ Hi) (Hi'' := Hi). -rewrite H4; assumption. -rewrite H4; assumption. -unfold f' in |- *. -elim (le_lt_dec m m); intro; simpl in |- *. -apply H3. -elim (lt_irrefl _ b). -clear H3 H2 g n h; intros. -unfold f' in |- *. -elim (le_lt_dec i m); intro; simpl in |- *. -apply H0; auto. -elim (le_not_lt i m); auto. +Proof. + intros. + cut (forall (i : nat) (H : i <= m), f i H = f' m f i). + intros. + apply eq_transitive_unfolded with (Sumx (fun (i : nat) (H3 : i < m) => + Sum (f' m f i) (pred (f' m f (S i))) (g i H3))). + apply Sumx_wd; intros. + rewrite <- (H4 i (lt_le_weak _ _ H5)); rewrite <- (H4 (S i) H5); apply Sum_wd'. + rewrite <- (S_pred (f (S i) H5) (f i (lt_le_weak _ _ H5)) (H1 _ _ _ _ (lt_n_Sn i))) . + apply lt_le_weak; apply H1; apply lt_n_Sn. + intros; algebra. + apply str_Sumx_Sum_Sum. + unfold f' in |- *; simpl in |- *. + elim (le_lt_dec 0 m); intro; simpl in |- *. + transitivity (f 0 (le_O_n m)). + apply H0; auto. + apply H. + elimtype False; inversion b. + intros; apply nat_local_mon_imp_mon. + clear H5 j i; intros. + unfold f' in |- *. + elim (le_lt_dec i m); elim (le_lt_dec (S i) m); intros; simpl in |- *. + apply H1; apply lt_n_Sn. + cut (i = m); [ intro | apply le_antisym; auto with arith ]. + generalize a; clear a; pattern i at 1 2 in |- *; rewrite H5; intro. + set (x := f m a) in *. + cut (x = f m (le_n m)). + 2: unfold x in |- *; apply H0; auto. + intro. + rewrite <- H6. + rewrite <- plus_n_Sm; auto with arith. + elimtype False; apply (le_not_lt i m); auto with arith. + set (x := f m (le_n m)) in *; clearbody x; auto with arith. + assumption. + intros. + apply H2 with (Hi' := lt_le_weak _ _ Hi) (Hi'' := Hi). + rewrite H4; assumption. + rewrite H4; assumption. + unfold f' in |- *. + elim (le_lt_dec m m); intro; simpl in |- *. + apply H3. + elim (lt_irrefl _ b). + clear H3 H2 g n h; intros. + unfold f' in |- *. + elim (le_lt_dec i m); intro; simpl in |- *. + apply H0; auto. + elim (le_not_lt i m); auto. Qed. End More_Lemmas. diff --git a/ftc/CalculusTheorems.v b/ftc/CalculusTheorems.v index 04a474b41..b22556d87 100644 --- a/ftc/CalculusTheorems.v +++ b/ftc/CalculusTheorems.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Rolle. Require Export DiffTactics3. @@ -56,49 +56,50 @@ continuous function commutes with the limit of a numerical sequence Lemma Continuous_imp_comm_Lim : forall F x e, Zero [<] e -> Continuous (clcr (Lim x[-]e) (Lim x[+]e)) F -> forall Hx Hxn H, F (Lim x) Hx [=] Lim (Build_CauchySeq IR (fun n => F (x n) (Hxn n)) H). -intros F x e H H0 Hx Hxn H1. -set (a := Lim x) in *. -set (I := clcr (a[-]e) (a[+]e)) in *. -cut (compact_ I). intro H2. -2: simpl in |- *. -2: apply less_leEq; apply less_transitive_unfolded with a. -2: apply shift_minus_less; apply shift_less_plus'. -2: astepl ZeroR; auto. -2: apply shift_less_plus'. -2: astepl ZeroR; auto. -apply Limits_unique. -simpl in |- *. -intros eps H3. -set (H2' := H2) in *. -cut (Continuous_I (a:=Lend H2) (b:=Rend H2) H2' F). intro H4. -2: apply Int_Continuous; auto. -elim (contin_prop _ _ _ _ H4 _ H3); intros d H5 H6. -elim (Cauchy_complete x (Min d e)). -2: apply less_Min; auto. -intros N HN. -exists N; intros. -fold a in HN. -apply AbsIR_imp_AbsSmall. -elim (HN m H7); intros. -apply H6. -split; simpl in |- *. -unfold cg_minus in |- *; apply shift_plus_leEq'. -eapply leEq_transitive. -2: apply H8. -apply inv_resp_leEq; apply Min_leEq_rht. -apply shift_leEq_plus'. -eapply leEq_transitive. -apply H9. -apply Min_leEq_rht. -split; simpl in |- *. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; auto. -apply shift_leEq_plus'; astepl ZeroR. -apply less_leEq; auto. -apply AbsSmall_imp_AbsIR. -apply AbsSmall_leEq_trans with (Min d e). -apply Min_leEq_lft. -auto. +Proof. + intros F x e H H0 Hx Hxn H1. + set (a := Lim x) in *. + set (I := clcr (a[-]e) (a[+]e)) in *. + cut (compact_ I). intro H2. + 2: simpl in |- *. + 2: apply less_leEq; apply less_transitive_unfolded with a. + 2: apply shift_minus_less; apply shift_less_plus'. + 2: astepl ZeroR; auto. + 2: apply shift_less_plus'. + 2: astepl ZeroR; auto. + apply Limits_unique. + simpl in |- *. + intros eps H3. + set (H2' := H2) in *. + cut (Continuous_I (a:=Lend H2) (b:=Rend H2) H2' F). intro H4. + 2: apply Int_Continuous; auto. + elim (contin_prop _ _ _ _ H4 _ H3); intros d H5 H6. + elim (Cauchy_complete x (Min d e)). + 2: apply less_Min; auto. + intros N HN. + exists N; intros. + fold a in HN. + apply AbsIR_imp_AbsSmall. + elim (HN m H7); intros. + apply H6. + split; simpl in |- *. + unfold cg_minus in |- *; apply shift_plus_leEq'. + eapply leEq_transitive. + 2: apply H8. + apply inv_resp_leEq; apply Min_leEq_rht. + apply shift_leEq_plus'. + eapply leEq_transitive. + apply H9. + apply Min_leEq_rht. + split; simpl in |- *. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; auto. + apply shift_leEq_plus'; astepl ZeroR. + apply less_leEq; auto. + apply AbsSmall_imp_AbsIR. + apply AbsSmall_leEq_trans with (Min d e). + apply Min_leEq_lft. + auto. Qed. (** @@ -109,48 +110,48 @@ and [(b,c]], then it is positive in [[a,c]]. Lemma Continuous_imp_pos : forall a b c (Hac : a [<=] c), a [<=] b -> b [<] c -> forall F, Continuous_I Hac F -> (forall t, a [<=] t -> t [<=] b -> forall Ht, Zero [<] F t Ht) -> (forall t, b [<] t -> t [<=] c -> forall Ht, Zero [<] F t Ht) -> forall t, a [<=] t -> t [<=] c -> forall Ht, Zero [<] F t Ht. -intros a b c Hac H H0 F H1 H2 H3 t H4 H5 Ht. -elim H1; intros H6 H7; clear H1. -cut (Compact Hac b); [ intro H1 | split; auto ]. -2: apply less_leEq; auto. -set (e := F b (H6 _ H1) [/]TwoNZ) in *. -cut (Zero [<] e); intros. -2: unfold e in |- *; apply pos_div_two; apply H2; auto. -2: apply leEq_reflexive. -elim H7 with e; auto. -intros d H9 H10. -cut (b[-]d [<] b). -2: apply shift_minus_less; apply shift_less_plus'. -2: astepl ZeroR; auto. -intro H11. -elim (less_cotransitive_unfolded _ _ _ H11 t); intro. -clear H11. -elim (less_cotransitive_unfolded _ _ _ H9 (t[-]b)); intro. -apply H3. -astepl (Zero[+]b); apply shift_plus_less; auto. -auto. -apply cont_no_sign_change_pos with (Hab := Hac) (e := e) (Hx := H6 _ H1); - auto. -split; auto. -apply H10; auto. -split; auto. -apply AbsSmall_imp_AbsIR. -apply AbsIR_eq_AbsSmall. -rstepr ( [--] (t[-]b)); apply inv_resp_leEq. -apply less_leEq; auto. -apply less_leEq; apply shift_minus_less; apply shift_less_plus'; auto. -unfold e in |- *. -eapply less_leEq_trans. -apply pos_div_two'. -apply H2; auto. -apply leEq_reflexive. -apply leEq_AbsIR. -unfold e in |- *. -apply pos_div_two'. -apply H2; auto. -apply leEq_reflexive. -apply H2; auto. -apply less_leEq; auto. +Proof. + intros a b c Hac H H0 F H1 H2 H3 t H4 H5 Ht. + elim H1; intros H6 H7; clear H1. + cut (Compact Hac b); [ intro H1 | split; auto ]. + 2: apply less_leEq; auto. + set (e := F b (H6 _ H1) [/]TwoNZ) in *. + cut (Zero [<] e); intros. + 2: unfold e in |- *; apply pos_div_two; apply H2; auto. + 2: apply leEq_reflexive. + elim H7 with e; auto. + intros d H9 H10. + cut (b[-]d [<] b). + 2: apply shift_minus_less; apply shift_less_plus'. + 2: astepl ZeroR; auto. + intro H11. + elim (less_cotransitive_unfolded _ _ _ H11 t); intro. + clear H11. + elim (less_cotransitive_unfolded _ _ _ H9 (t[-]b)); intro. + apply H3. + astepl (Zero[+]b); apply shift_plus_less; auto. + auto. + apply cont_no_sign_change_pos with (Hab := Hac) (e := e) (Hx := H6 _ H1); auto. + split; auto. + apply H10; auto. + split; auto. + apply AbsSmall_imp_AbsIR. + apply AbsIR_eq_AbsSmall. + rstepr ( [--] (t[-]b)); apply inv_resp_leEq. + apply less_leEq; auto. + apply less_leEq; apply shift_minus_less; apply shift_less_plus'; auto. + unfold e in |- *. + eapply less_leEq_trans. + apply pos_div_two'. + apply H2; auto. + apply leEq_reflexive. + apply leEq_AbsIR. + unfold e in |- *. + apply pos_div_two'. + apply H2; auto. + apply leEq_reflexive. + apply H2; auto. + apply less_leEq; auto. Qed. (** @@ -162,273 +163,271 @@ Lemma strict_inc_glues : forall a b c F (Hab : a [<=] b) (Hbc : b [<=] c) (Hac : (forall x y, Compact Hab x -> Compact Hab y -> x [<] y -> forall Hx Hy, F x Hx [<] F y Hy) -> (forall x y, Compact Hbc x -> Compact Hbc y -> x [<] y -> forall Hx Hy, F x Hx [<] F y Hy) -> forall x y, Compact Hac x -> Compact Hac y -> x [<] y -> forall Hx Hy, F x Hx [<] F y Hy. -do 7 intro. intros H H0 H1 x y H2 H3 H4 Hx Hy. -cut (Dom F a); [ intro Ha | apply H; apply compact_inc_lft ]. -cut (Dom F b); [ intro Hb | apply H; split; auto ]. -cut (Dom F c); [ intro Hc | apply H; apply compact_inc_rht ]. -elim (less_cotransitive_unfolded _ _ _ H4 b); intro. -cut (Dom F (Min b y)); [ intro H5 | apply H; split ]. -2: apply leEq_Min; auto; elim H3; auto. -2: eapply leEq_transitive; [ apply Min_leEq_lft | auto ]. -apply less_leEq_trans with (F _ H5). -cut (Dom F (Min ((x[+]b) [/]TwoNZ) y)); [ intro Hxy | apply H; split ]. -3: elim H3; intros; eapply leEq_transitive; [ apply Min_leEq_rht | auto ]. -2: apply leEq_Min. -3: elim H3; auto. -2: apply shift_leEq_div; [ apply pos_two | rstepl (a[+]a) ]. -2: apply plus_resp_leEq_both; elim H2; auto. -apply less_leEq_trans with (F _ Hxy). -apply H0; try split. -elim H2; auto. -apply less_leEq; auto. -apply leEq_Min. -2: elim H3; auto. -apply shift_leEq_div; [ apply pos_two | rstepl (a[+]a) ]. -apply plus_resp_leEq_both; elim H2; auto. -eapply leEq_transitive. -apply Min_leEq_lft. -apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. -apply plus_resp_leEq; apply less_leEq; auto. -apply less_Min; auto. -apply shift_less_div; [ apply pos_two | rstepl (x[+]x) ]. -apply plus_resp_leEq_less; [ apply leEq_reflexive | auto ]. -apply part_mon_imp_mon' with (Compact Hab); auto. -intros x0 H6; apply H; inversion_clear H6; split; auto. -apply leEq_transitive with b; auto. -split. -apply leEq_Min. -apply shift_leEq_div; [ apply pos_two | rstepl (a[+]a) ]. -apply plus_resp_leEq_both; auto; elim H2; auto. -elim H3; auto. -eapply leEq_transitive. -apply Min_leEq_lft. -apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. -apply plus_resp_leEq; apply less_leEq; auto. -split. -apply leEq_Min; auto; elim H3; auto. -apply Min_leEq_lft. -apply leEq_Min. -eapply leEq_transitive. -apply Min_leEq_lft. -apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. -apply plus_resp_leEq; apply less_leEq; auto. -apply Min_leEq_rht. -rewrite leEq_def; intro H6. -cut (y [<=] b). intro H7. -apply (less_irreflexive_unfolded _ (F y Hy)). -eapply less_wdr. -apply H6. -apply pfwdef; eapply eq_transitive_unfolded. -apply Min_comm. -apply leEq_imp_Min_is_lft; auto. -rewrite leEq_def; intro H7. -apply (less_irreflexive_unfolded _ (F y Hy)). -eapply less_transitive_unfolded. -apply H6. -apply less_wdl with (F b Hb). -2: apply pfwdef; apply eq_symmetric_unfolded; apply leEq_imp_Min_is_lft; - apply less_leEq; auto. -apply H1; auto. -apply compact_inc_lft. -split; [ apply less_leEq | elim H3 ]; auto. - -cut (Dom F (Max b x)); [ intro H5 | apply H; split ]. -3: apply Max_leEq; auto; elim H2; auto. -2: eapply leEq_transitive; [ apply Hab | apply lft_leEq_Max ]. -apply leEq_less_trans with (F _ H5). -2: cut (Dom F (Max ((y[+]b) [/]TwoNZ) x)); [ intro Hxy | apply H; split ]. -3: elim H2; intros; eapply leEq_transitive; [ apply a0 | apply rht_leEq_Max ]. -3: apply Max_leEq. -4: elim H2; auto. -3: apply shift_div_leEq; [ apply pos_two | rstepr (c[+]c) ]. -3: apply plus_resp_leEq_both; elim H3; auto. -2: apply leEq_less_trans with (F _ Hxy). -3: apply H1; try split. -6: elim H3; auto. -5: apply less_leEq; auto. -4: apply Max_leEq. -5: elim H2; auto. -4: apply shift_div_leEq; [ apply pos_two | rstepr (c[+]c) ]. -4: apply plus_resp_leEq_both; elim H3; auto. -3: eapply leEq_transitive. -4: apply lft_leEq_Max. -3: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. -3: apply plus_resp_leEq; apply less_leEq; auto. -3: apply Max_less; auto. -3: apply shift_div_less; [ apply pos_two | rstepr (y[+]y) ]. -3: apply plus_resp_less_lft; auto. -2: apply part_mon_imp_mon' with (Compact Hbc); auto. -2: intros x0 H6; apply H; inversion_clear H6; split; auto. -2: apply leEq_transitive with b; auto. -3: split. -4: apply Max_leEq. -4: apply shift_div_leEq; [ apply pos_two | rstepr (c[+]c) ]. -4: apply plus_resp_leEq_both; auto; elim H3; auto. -4: elim H2; auto. -3: eapply leEq_transitive. -4: apply lft_leEq_Max. -3: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. -3: apply plus_resp_leEq; apply less_leEq; auto. -2: split. -3: apply Max_leEq; auto; elim H2; auto. -2: apply lft_leEq_Max. -2: apply Max_leEq. -2: eapply leEq_transitive. -3: apply lft_leEq_Max. -2: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. -2: apply plus_resp_leEq; apply less_leEq; auto. -2: apply rht_leEq_Max. -rewrite leEq_def; intro H6. -cut (b [<=] x); rewrite leEq_def; intro H7. -apply (less_irreflexive_unfolded _ (F x Hx)). -eapply less_wdl. -apply H6. -apply pfwdef; apply leEq_imp_Max_is_rht; rewrite leEq_def; auto. -apply (less_irreflexive_unfolded _ (F x Hx)). -eapply less_transitive_unfolded. -2: apply H6. -apply less_wdr with (F b Hb). -2: apply pfwdef; apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply Max_comm. -2: apply leEq_imp_Max_is_rht; apply less_leEq; auto. -apply H0; auto. -2: apply compact_inc_rht. -split; [ elim H2 | apply less_leEq ]; auto. +Proof. + do 7 intro. intros H H0 H1 x y H2 H3 H4 Hx Hy. + cut (Dom F a); [ intro Ha | apply H; apply compact_inc_lft ]. + cut (Dom F b); [ intro Hb | apply H; split; auto ]. + cut (Dom F c); [ intro Hc | apply H; apply compact_inc_rht ]. + elim (less_cotransitive_unfolded _ _ _ H4 b); intro. + cut (Dom F (Min b y)); [ intro H5 | apply H; split ]. + 2: apply leEq_Min; auto; elim H3; auto. + 2: eapply leEq_transitive; [ apply Min_leEq_lft | auto ]. + apply less_leEq_trans with (F _ H5). + cut (Dom F (Min ((x[+]b) [/]TwoNZ) y)); [ intro Hxy | apply H; split ]. + 3: elim H3; intros; eapply leEq_transitive; [ apply Min_leEq_rht | auto ]. + 2: apply leEq_Min. + 3: elim H3; auto. + 2: apply shift_leEq_div; [ apply pos_two | rstepl (a[+]a) ]. + 2: apply plus_resp_leEq_both; elim H2; auto. + apply less_leEq_trans with (F _ Hxy). + apply H0; try split. + elim H2; auto. + apply less_leEq; auto. + apply leEq_Min. + 2: elim H3; auto. + apply shift_leEq_div; [ apply pos_two | rstepl (a[+]a) ]. + apply plus_resp_leEq_both; elim H2; auto. + eapply leEq_transitive. + apply Min_leEq_lft. + apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. + apply plus_resp_leEq; apply less_leEq; auto. + apply less_Min; auto. + apply shift_less_div; [ apply pos_two | rstepl (x[+]x) ]. + apply plus_resp_leEq_less; [ apply leEq_reflexive | auto ]. + apply part_mon_imp_mon' with (Compact Hab); auto. + intros x0 H6; apply H; inversion_clear H6; split; auto. + apply leEq_transitive with b; auto. + split. + apply leEq_Min. + apply shift_leEq_div; [ apply pos_two | rstepl (a[+]a) ]. + apply plus_resp_leEq_both; auto; elim H2; auto. + elim H3; auto. + eapply leEq_transitive. + apply Min_leEq_lft. + apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. + apply plus_resp_leEq; apply less_leEq; auto. + split. + apply leEq_Min; auto; elim H3; auto. + apply Min_leEq_lft. + apply leEq_Min. + eapply leEq_transitive. + apply Min_leEq_lft. + apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. + apply plus_resp_leEq; apply less_leEq; auto. + apply Min_leEq_rht. + rewrite leEq_def; intro H6. + cut (y [<=] b). intro H7. + apply (less_irreflexive_unfolded _ (F y Hy)). + eapply less_wdr. + apply H6. + apply pfwdef; eapply eq_transitive_unfolded. + apply Min_comm. + apply leEq_imp_Min_is_lft; auto. + rewrite leEq_def; intro H7. + apply (less_irreflexive_unfolded _ (F y Hy)). + eapply less_transitive_unfolded. + apply H6. + apply less_wdl with (F b Hb). + 2: apply pfwdef; apply eq_symmetric_unfolded; apply leEq_imp_Min_is_lft; apply less_leEq; auto. + apply H1; auto. + apply compact_inc_lft. + split; [ apply less_leEq | elim H3 ]; auto. + cut (Dom F (Max b x)); [ intro H5 | apply H; split ]. + 3: apply Max_leEq; auto; elim H2; auto. + 2: eapply leEq_transitive; [ apply Hab | apply lft_leEq_Max ]. + apply leEq_less_trans with (F _ H5). + 2: cut (Dom F (Max ((y[+]b) [/]TwoNZ) x)); [ intro Hxy | apply H; split ]. + 3: elim H2; intros; eapply leEq_transitive; [ apply a0 | apply rht_leEq_Max ]. + 3: apply Max_leEq. + 4: elim H2; auto. + 3: apply shift_div_leEq; [ apply pos_two | rstepr (c[+]c) ]. + 3: apply plus_resp_leEq_both; elim H3; auto. + 2: apply leEq_less_trans with (F _ Hxy). + 3: apply H1; try split. + 6: elim H3; auto. + 5: apply less_leEq; auto. + 4: apply Max_leEq. + 5: elim H2; auto. + 4: apply shift_div_leEq; [ apply pos_two | rstepr (c[+]c) ]. + 4: apply plus_resp_leEq_both; elim H3; auto. + 3: eapply leEq_transitive. + 4: apply lft_leEq_Max. + 3: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. + 3: apply plus_resp_leEq; apply less_leEq; auto. + 3: apply Max_less; auto. + 3: apply shift_div_less; [ apply pos_two | rstepr (y[+]y) ]. + 3: apply plus_resp_less_lft; auto. + 2: apply part_mon_imp_mon' with (Compact Hbc); auto. + 2: intros x0 H6; apply H; inversion_clear H6; split; auto. + 2: apply leEq_transitive with b; auto. + 3: split. + 4: apply Max_leEq. + 4: apply shift_div_leEq; [ apply pos_two | rstepr (c[+]c) ]. + 4: apply plus_resp_leEq_both; auto; elim H3; auto. + 4: elim H2; auto. + 3: eapply leEq_transitive. + 4: apply lft_leEq_Max. + 3: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. + 3: apply plus_resp_leEq; apply less_leEq; auto. + 2: split. + 3: apply Max_leEq; auto; elim H2; auto. + 2: apply lft_leEq_Max. + 2: apply Max_leEq. + 2: eapply leEq_transitive. + 3: apply lft_leEq_Max. + 2: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. + 2: apply plus_resp_leEq; apply less_leEq; auto. + 2: apply rht_leEq_Max. + rewrite leEq_def; intro H6. + cut (b [<=] x); rewrite leEq_def; intro H7. + apply (less_irreflexive_unfolded _ (F x Hx)). + eapply less_wdl. + apply H6. + apply pfwdef; apply leEq_imp_Max_is_rht; rewrite leEq_def; auto. + apply (less_irreflexive_unfolded _ (F x Hx)). + eapply less_transitive_unfolded. + 2: apply H6. + apply less_wdr with (F b Hb). + 2: apply pfwdef; apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply Max_comm. + 2: apply leEq_imp_Max_is_rht; apply less_leEq; auto. + apply H0; auto. + 2: apply compact_inc_rht. + split; [ elim H2 | apply less_leEq ]; auto. Qed. Lemma strict_inc_glues' : forall a b c F, a [<] b -> b [<] c -> included (olor a c) (Dom F) -> (forall x y, olcr a b x -> olcr a b y -> x [<] y -> forall Hx Hy, F x Hx [<] F y Hy) -> (forall x y, clor b c x -> clor b c y -> x [<] y -> forall Hx Hy, F x Hx [<] F y Hy) -> forall x y, olor a c x -> olor a c y -> x [<] y -> forall Hx Hy, F x Hx [<] F y Hy. -intros a b c F Hab Hbc H H0 H1 x y H2 H3 H4 Hx Hy. -cut (Dom F b); [ intro Hb | apply H; split; auto ]. -elim (less_cotransitive_unfolded _ _ _ H4 b); intro. -cut (Dom F (Min b y)); [ intro H5 | apply H; split ]. -2: apply less_Min; auto; elim H3; auto. -2: eapply leEq_less_trans; [ apply Min_leEq_lft | auto ]. -apply less_leEq_trans with (F _ H5). -cut (Dom F (Min ((x[+]b) [/]TwoNZ) y)); [ intro Hxy | apply H; split ]. -3: elim H3; intros; eapply leEq_less_trans; [ apply Min_leEq_rht | auto ]. -2: apply less_Min. -3: elim H3; auto. -2: apply shift_less_div; [ apply pos_two | rstepl (a[+]a) ]. -2: apply plus_resp_less_both; elim H2; auto. -apply less_leEq_trans with (F _ Hxy). -apply H0; try split. -elim H2; auto. -apply less_leEq; auto. -apply less_Min. -2: elim H3; auto. -apply shift_less_div; [ apply pos_two | rstepl (a[+]a) ]. -apply plus_resp_less_both; elim H2; auto. -eapply leEq_transitive. -apply Min_leEq_lft. -apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. -apply plus_resp_leEq; apply less_leEq; auto. -apply less_Min; auto. -apply shift_less_div; [ apply pos_two | rstepl (x[+]x) ]. -apply plus_resp_leEq_less; [ apply leEq_reflexive | auto ]. -apply part_mon_imp_mon' with (iprop (olcr a b)); auto. -intros x0 H6; apply H; inversion_clear H6; split; auto. -apply leEq_less_trans with b; auto. -split. -apply less_Min. -apply shift_less_div; [ apply pos_two | rstepl (a[+]a) ]. -apply plus_resp_less_both; auto; elim H2; auto. -elim H3; auto. -eapply leEq_transitive. -apply Min_leEq_lft. -apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. -apply plus_resp_leEq; apply less_leEq; auto. -split. -apply less_Min; auto; elim H3; auto. -apply Min_leEq_lft. -apply leEq_Min. -eapply leEq_transitive. -apply Min_leEq_lft. -apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. -apply plus_resp_leEq; apply less_leEq; auto. -apply Min_leEq_rht. -rewrite leEq_def; intro H6. -cut (y [<=] b); rewrite leEq_def; intro H7. -apply (less_irreflexive_unfolded _ (F y Hy)). -eapply less_wdr. -apply H6. -apply pfwdef; eapply eq_transitive_unfolded. -apply Min_comm. -apply leEq_imp_Min_is_lft; rewrite leEq_def; auto. -apply (less_irreflexive_unfolded _ (F y Hy)). -eapply less_transitive_unfolded. -apply H6. -apply less_wdl with (F b Hb). -2: apply pfwdef; apply eq_symmetric_unfolded; apply leEq_imp_Min_is_lft; - apply less_leEq; auto. -apply H1; auto. -split; auto; apply leEq_reflexive. -split; [ apply less_leEq | elim H3 ]; auto. - -cut (Dom F (Max b x)); [ intro H5 | apply H; split ]. -3: apply Max_less; auto; elim H2; auto. -2: eapply less_leEq_trans; [ apply Hab | apply lft_leEq_Max ]. -apply leEq_less_trans with (F _ H5). -2: cut (Dom F (Max ((y[+]b) [/]TwoNZ) x)); [ intro Hxy | apply H; split ]. -3: elim H2; intros; eapply less_leEq_trans; [ apply a0 | apply rht_leEq_Max ]. -3: apply Max_less. -4: elim H2; auto. -3: apply shift_div_less; [ apply pos_two | rstepr (c[+]c) ]. -3: apply plus_resp_less_both; elim H3; auto. -2: apply leEq_less_trans with (F _ Hxy). -3: apply H1; try split. -6: elim H3; auto. -5: apply less_leEq; auto. -4: apply Max_less. -5: elim H2; auto. -4: apply shift_div_less; [ apply pos_two | rstepr (c[+]c) ]. -4: apply plus_resp_less_both; elim H3; auto. -3: eapply leEq_transitive. -4: apply lft_leEq_Max. -3: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. -3: apply plus_resp_leEq; apply less_leEq; auto. -3: apply Max_less; auto. -3: apply shift_div_less; [ apply pos_two | rstepr (y[+]y) ]. -3: apply plus_resp_less_lft; auto. -2: apply part_mon_imp_mon' with (iprop (clor b c)); auto. -2: intros x0 H6; apply H; inversion_clear H6; split; auto. -2: apply less_leEq_trans with b; auto. -3: split. -4: apply Max_less. -4: apply shift_div_less; [ apply pos_two | rstepr (c[+]c) ]. -4: apply plus_resp_less_both; auto; elim H3; auto. -4: elim H2; auto. -3: eapply leEq_transitive. -4: apply lft_leEq_Max. -3: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. -3: apply plus_resp_leEq; apply less_leEq; auto. -2: split. -3: apply Max_less; auto; elim H2; auto. -2: apply lft_leEq_Max. -2: apply Max_leEq. -2: eapply leEq_transitive. -3: apply lft_leEq_Max. -2: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. -2: apply plus_resp_leEq; apply less_leEq; auto. -2: apply rht_leEq_Max. -rewrite leEq_def; intro H6. -cut (b [<=] x); rewrite leEq_def; intro H7. -apply (less_irreflexive_unfolded _ (F x Hx)). -eapply less_wdl. -apply H6. -apply pfwdef; apply leEq_imp_Max_is_rht; rewrite leEq_def; auto. -apply (less_irreflexive_unfolded _ (F x Hx)). -eapply less_transitive_unfolded. -2: apply H6. -apply less_wdr with (F b Hb). -2: apply pfwdef; apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply Max_comm. -2: apply leEq_imp_Max_is_rht; apply less_leEq; auto. -apply H0; auto. -split; [ elim H2 | apply less_leEq ]; auto. -split; auto; apply leEq_reflexive. +Proof. + intros a b c F Hab Hbc H H0 H1 x y H2 H3 H4 Hx Hy. + cut (Dom F b); [ intro Hb | apply H; split; auto ]. + elim (less_cotransitive_unfolded _ _ _ H4 b); intro. + cut (Dom F (Min b y)); [ intro H5 | apply H; split ]. + 2: apply less_Min; auto; elim H3; auto. + 2: eapply leEq_less_trans; [ apply Min_leEq_lft | auto ]. + apply less_leEq_trans with (F _ H5). + cut (Dom F (Min ((x[+]b) [/]TwoNZ) y)); [ intro Hxy | apply H; split ]. + 3: elim H3; intros; eapply leEq_less_trans; [ apply Min_leEq_rht | auto ]. + 2: apply less_Min. + 3: elim H3; auto. + 2: apply shift_less_div; [ apply pos_two | rstepl (a[+]a) ]. + 2: apply plus_resp_less_both; elim H2; auto. + apply less_leEq_trans with (F _ Hxy). + apply H0; try split. + elim H2; auto. + apply less_leEq; auto. + apply less_Min. + 2: elim H3; auto. + apply shift_less_div; [ apply pos_two | rstepl (a[+]a) ]. + apply plus_resp_less_both; elim H2; auto. + eapply leEq_transitive. + apply Min_leEq_lft. + apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. + apply plus_resp_leEq; apply less_leEq; auto. + apply less_Min; auto. + apply shift_less_div; [ apply pos_two | rstepl (x[+]x) ]. + apply plus_resp_leEq_less; [ apply leEq_reflexive | auto ]. + apply part_mon_imp_mon' with (iprop (olcr a b)); auto. + intros x0 H6; apply H; inversion_clear H6; split; auto. + apply leEq_less_trans with b; auto. + split. + apply less_Min. + apply shift_less_div; [ apply pos_two | rstepl (a[+]a) ]. + apply plus_resp_less_both; auto; elim H2; auto. + elim H3; auto. + eapply leEq_transitive. + apply Min_leEq_lft. + apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. + apply plus_resp_leEq; apply less_leEq; auto. + split. + apply less_Min; auto; elim H3; auto. + apply Min_leEq_lft. + apply leEq_Min. + eapply leEq_transitive. + apply Min_leEq_lft. + apply shift_div_leEq; [ apply pos_two | rstepr (b[+]b) ]. + apply plus_resp_leEq; apply less_leEq; auto. + apply Min_leEq_rht. + rewrite leEq_def; intro H6. + cut (y [<=] b); rewrite leEq_def; intro H7. + apply (less_irreflexive_unfolded _ (F y Hy)). + eapply less_wdr. + apply H6. + apply pfwdef; eapply eq_transitive_unfolded. + apply Min_comm. + apply leEq_imp_Min_is_lft; rewrite leEq_def; auto. + apply (less_irreflexive_unfolded _ (F y Hy)). + eapply less_transitive_unfolded. + apply H6. + apply less_wdl with (F b Hb). + 2: apply pfwdef; apply eq_symmetric_unfolded; apply leEq_imp_Min_is_lft; apply less_leEq; auto. + apply H1; auto. + split; auto; apply leEq_reflexive. + split; [ apply less_leEq | elim H3 ]; auto. + cut (Dom F (Max b x)); [ intro H5 | apply H; split ]. + 3: apply Max_less; auto; elim H2; auto. + 2: eapply less_leEq_trans; [ apply Hab | apply lft_leEq_Max ]. + apply leEq_less_trans with (F _ H5). + 2: cut (Dom F (Max ((y[+]b) [/]TwoNZ) x)); [ intro Hxy | apply H; split ]. + 3: elim H2; intros; eapply less_leEq_trans; [ apply a0 | apply rht_leEq_Max ]. + 3: apply Max_less. + 4: elim H2; auto. + 3: apply shift_div_less; [ apply pos_two | rstepr (c[+]c) ]. + 3: apply plus_resp_less_both; elim H3; auto. + 2: apply leEq_less_trans with (F _ Hxy). + 3: apply H1; try split. + 6: elim H3; auto. + 5: apply less_leEq; auto. + 4: apply Max_less. + 5: elim H2; auto. + 4: apply shift_div_less; [ apply pos_two | rstepr (c[+]c) ]. + 4: apply plus_resp_less_both; elim H3; auto. + 3: eapply leEq_transitive. + 4: apply lft_leEq_Max. + 3: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. + 3: apply plus_resp_leEq; apply less_leEq; auto. + 3: apply Max_less; auto. + 3: apply shift_div_less; [ apply pos_two | rstepr (y[+]y) ]. + 3: apply plus_resp_less_lft; auto. + 2: apply part_mon_imp_mon' with (iprop (clor b c)); auto. + 2: intros x0 H6; apply H; inversion_clear H6; split; auto. + 2: apply less_leEq_trans with b; auto. + 3: split. + 4: apply Max_less. + 4: apply shift_div_less; [ apply pos_two | rstepr (c[+]c) ]. + 4: apply plus_resp_less_both; auto; elim H3; auto. + 4: elim H2; auto. + 3: eapply leEq_transitive. + 4: apply lft_leEq_Max. + 3: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. + 3: apply plus_resp_leEq; apply less_leEq; auto. + 2: split. + 3: apply Max_less; auto; elim H2; auto. + 2: apply lft_leEq_Max. + 2: apply Max_leEq. + 2: eapply leEq_transitive. + 3: apply lft_leEq_Max. + 2: apply shift_leEq_div; [ apply pos_two | rstepl (b[+]b) ]. + 2: apply plus_resp_leEq; apply less_leEq; auto. + 2: apply rht_leEq_Max. + rewrite leEq_def; intro H6. + cut (b [<=] x); rewrite leEq_def; intro H7. + apply (less_irreflexive_unfolded _ (F x Hx)). + eapply less_wdl. + apply H6. + apply pfwdef; apply leEq_imp_Max_is_rht; rewrite leEq_def; auto. + apply (less_irreflexive_unfolded _ (F x Hx)). + eapply less_transitive_unfolded. + 2: apply H6. + apply less_wdr with (F b Hb). + 2: apply pfwdef; apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply Max_comm. + 2: apply leEq_imp_Max_is_rht; apply less_leEq; auto. + apply H0; auto. + split; [ elim H2 | apply less_leEq ]; auto. + split; auto; apply leEq_reflexive. Qed. Lemma strict_dec_glues : forall a b c F (Hab : a [<=] b) (Hbc : b [<=] c) (Hac : a [<=] c), @@ -436,24 +435,26 @@ Lemma strict_dec_glues : forall a b c F (Hab : a [<=] b) (Hbc : b [<=] c) (Hac : (forall x y, Compact Hab x -> Compact Hab y -> y[<]x -> forall Hx Hy, F x Hx [<] F y Hy) -> (forall x y, Compact Hbc x -> Compact Hbc y -> y[<]x -> forall Hx Hy, F x Hx [<] F y Hy) -> forall x y, Compact Hac x -> Compact Hac y -> y[<]x -> forall Hx Hy, F x Hx [<] F y Hy. -intros. -apply inv_cancel_less. -astepl ( {--}F y Hy); astepr ( {--}F x Hx). -apply strict_inc_glues with a b c Hab Hbc Hac; auto. -intros; simpl in |- *; apply inv_resp_less; auto. -intros; simpl in |- *; apply inv_resp_less; auto. +Proof. + intros. + apply inv_cancel_less. + astepl ( {--}F y Hy); astepr ( {--}F x Hx). + apply strict_inc_glues with a b c Hab Hbc Hac; auto. + intros; simpl in |- *; apply inv_resp_less; auto. + intros; simpl in |- *; apply inv_resp_less; auto. Qed. Lemma strict_dec_glues' : forall a b c F, a [<] b -> b [<] c -> included (olor a c) (Dom F) -> (forall x y, olcr a b x -> olcr a b y -> y[<]x -> forall Hx Hy, F x Hx [<] F y Hy) -> (forall x y, clor b c x -> clor b c y -> y[<]x -> forall Hx Hy, F x Hx [<] F y Hy) -> forall x y, olor a c x -> olor a c y -> y[<]x -> forall Hx Hy, F x Hx [<] F y Hy. -intros. -apply inv_cancel_less. -astepl ( {--}F y Hy); astepr ( {--}F x Hx). -apply strict_inc_glues' with a b c; auto. -intros; simpl in |- *; apply inv_resp_less; auto. -intros; simpl in |- *; apply inv_resp_less; auto. +Proof. + intros. + apply inv_cancel_less. + astepl ( {--}F y Hy); astepr ( {--}F x Hx). + apply strict_inc_glues' with a b c; auto. + intros; simpl in |- *; apply inv_resp_less; auto. + intros; simpl in |- *; apply inv_resp_less; auto. Qed. (** More on glueing intervals. *) @@ -461,68 +462,68 @@ Qed. Lemma olor_pos_clor_nonneg : forall a b (F : PartIR), (forall x, olor a b x -> forall Hx, Zero [<] F x Hx) -> forall Ha, Zero [<=] F a Ha -> forall x, clor a b x -> forall Hx, Zero [<=] F x Hx. -intros a b F H Ha H0 x H1 Hx. -rewrite leEq_def; intros H2. -cut (Not (olor a b x)); intro H3. -cut (x [=] a). intro H4. -rewrite -> leEq_def in H0; apply H0. -eapply less_wdl; [ apply H2 | algebra ]. -red in H3. -apply not_ap_imp_eq; intro H4. -inversion_clear H1. -elim (ap_imp_less _ _ _ H4); intros. -apply (less_irreflexive_unfolded _ a); apply leEq_less_trans with x; auto. -apply H3; split; auto. -apply (less_irreflexive_unfolded IR Zero); - apply less_transitive_unfolded with (F x Hx); auto. +Proof. + intros a b F H Ha H0 x H1 Hx. + rewrite leEq_def; intros H2. + cut (Not (olor a b x)); intro H3. + cut (x [=] a). intro H4. + rewrite -> leEq_def in H0; apply H0. + eapply less_wdl; [ apply H2 | algebra ]. + red in H3. + apply not_ap_imp_eq; intro H4. + inversion_clear H1. + elim (ap_imp_less _ _ _ H4); intros. + apply (less_irreflexive_unfolded _ a); apply leEq_less_trans with x; auto. + apply H3; split; auto. + apply (less_irreflexive_unfolded IR Zero); apply less_transitive_unfolded with (F x Hx); auto. Qed. Lemma olor_pos_olcr_nonneg : forall a b (F : PartIR), (forall x, olor a b x -> forall Hx, Zero [<] F x Hx) -> forall Hb, Zero [<=] F b Hb -> forall x, olcr a b x -> forall Hx, Zero [<=] F x Hx. -intros a b F H Ha H0 x H1 Hx. -rewrite leEq_def; intros H2. -cut (Not (olor a b x)); intro H3. -cut (x [=] b). intro H4. -rewrite -> leEq_def in H0; apply H0. -eapply less_wdl; [ apply H2 | algebra ]. -red in H3. -apply not_ap_imp_eq; intro H4. -inversion_clear H1. -elim (ap_imp_less _ _ _ H4); intros. -apply H3; split; auto. -apply (less_irreflexive_unfolded _ b); apply less_leEq_trans with x; auto. -apply (less_irreflexive_unfolded IR Zero); - apply less_transitive_unfolded with (F x Hx); auto. +Proof. + intros a b F H Ha H0 x H1 Hx. + rewrite leEq_def; intros H2. + cut (Not (olor a b x)); intro H3. + cut (x [=] b). intro H4. + rewrite -> leEq_def in H0; apply H0. + eapply less_wdl; [ apply H2 | algebra ]. + red in H3. + apply not_ap_imp_eq; intro H4. + inversion_clear H1. + elim (ap_imp_less _ _ _ H4); intros. + apply H3; split; auto. + apply (less_irreflexive_unfolded _ b); apply less_leEq_trans with x; auto. + apply (less_irreflexive_unfolded IR Zero); apply less_transitive_unfolded with (F x Hx); auto. Qed. Lemma olor_pos_clcr_nonneg : forall a b (F : PartIR), a [<] b -> (forall x, olor a b x -> forall Hx, Zero [<] F x Hx) -> forall Ha, Zero [<=] F a Ha -> forall Hb, Zero [<=] F b Hb -> forall x, clcr a b x -> forall Hx, Zero [<=] F x Hx. -intros a b F Hab H Ha H0 Hb H1 x H2 Hx. -rewrite leEq_def; intros H3. -cut (Not (olor a b x)); intro H4. -elim (less_cotransitive_unfolded _ _ _ Hab x); intro H5. -cut (x [=] b). intro H6. -rewrite -> leEq_def in H1; apply H1. -eapply less_wdl; [ apply H3 | algebra ]. -red in H4. -apply not_ap_imp_eq; intro H6. -inversion_clear H2. -elim (ap_imp_less _ _ _ H6); intros. -apply H4; split; auto. -apply (less_irreflexive_unfolded _ b); apply less_leEq_trans with x; auto. -cut (x [=] a); intros. -rewrite -> leEq_def in H0; apply H0. -eapply less_wdl; [ apply H3 | algebra ]. -red in H4. -apply not_ap_imp_eq; intro. -inversion_clear H2. -elim (ap_imp_less _ _ _ X); intros. -apply (less_irreflexive_unfolded _ a); apply leEq_less_trans with x; auto. -apply H4; split; auto. -apply (less_irreflexive_unfolded IR Zero); - apply less_transitive_unfolded with (F x Hx); auto. +Proof. + intros a b F Hab H Ha H0 Hb H1 x H2 Hx. + rewrite leEq_def; intros H3. + cut (Not (olor a b x)); intro H4. + elim (less_cotransitive_unfolded _ _ _ Hab x); intro H5. + cut (x [=] b). intro H6. + rewrite -> leEq_def in H1; apply H1. + eapply less_wdl; [ apply H3 | algebra ]. + red in H4. + apply not_ap_imp_eq; intro H6. + inversion_clear H2. + elim (ap_imp_less _ _ _ H6); intros. + apply H4; split; auto. + apply (less_irreflexive_unfolded _ b); apply less_leEq_trans with x; auto. + cut (x [=] a); intros. + rewrite -> leEq_def in H0; apply H0. + eapply less_wdl; [ apply H3 | algebra ]. + red in H4. + apply not_ap_imp_eq; intro. + inversion_clear H2. + elim (ap_imp_less _ _ _ X); intros. + apply (less_irreflexive_unfolded _ a); apply leEq_less_trans with x; auto. + apply H4; split; auto. + apply (less_irreflexive_unfolded IR Zero); apply less_transitive_unfolded with (F x Hx); auto. Qed. (** @@ -530,19 +531,20 @@ Any function that has the null function as its derivative must be constant. *) Lemma FConst_prop : forall J pJ F', Derivative J pJ F' [-C-]Zero -> {c : IR | Feq J F' [-C-]c}. -intros J pJ F' H. -elim (nonvoid_point _ (proper_nonvoid _ pJ)); intros x0 Hx0. -exists (F' x0 (Derivative_imp_inc _ _ _ _ H x0 Hx0)). -FEQ. rename X into H0. -simpl in |- *. -apply cg_inv_unique_2. -apply AbsIR_approach_zero; intros e H1. -simpl in Hx'. -elim (Law_of_the_Mean _ _ _ _ H _ _ Hx0 H0 e H1). -intros y H2 H3. -eapply leEq_wdl. -apply (H3 (Derivative_imp_inc _ _ _ _ H _ Hx0) Hx CI). -apply AbsIR_wd; simpl in |- *; rational. +Proof. + intros J pJ F' H. + elim (nonvoid_point _ (proper_nonvoid _ pJ)); intros x0 Hx0. + exists (F' x0 (Derivative_imp_inc _ _ _ _ H x0 Hx0)). + FEQ. rename X into H0. + simpl in |- *. + apply cg_inv_unique_2. + apply AbsIR_approach_zero; intros e H1. + simpl in Hx'. + elim (Law_of_the_Mean _ _ _ _ H _ _ Hx0 H0 e H1). + intros y H2 H3. + eapply leEq_wdl. + apply (H3 (Derivative_imp_inc _ _ _ _ H _ Hx0) Hx CI). + apply AbsIR_wd; simpl in |- *; rational. Qed. (** As a corollary, two functions with the same derivative must differ @@ -551,9 +553,10 @@ by a constant. Lemma Feq_crit_with_const : forall J pJ F G H, Derivative J pJ F H -> Derivative J pJ G H -> {c : IR | Feq J (F{-}G) [-C-]c}. -intros. -apply FConst_prop with pJ. -Derivative_Help; FEQ. +Proof. + intros. + apply FConst_prop with pJ. + Derivative_Help; FEQ. Qed. (** This yields the following known result: any differential equation @@ -562,29 +565,30 @@ of the form [f'=g] with initial condition [f(a) [=] b] has a unique solution. Lemma Feq_criterium : forall J pJ F G H, Derivative J pJ F H -> Derivative J pJ G H -> forall x, J x -> (forall Hx Hx', F x Hx [=] G x Hx') -> Feq J F G. -do 5 intro. intros H0 H1 x H2 H3. -elim (Feq_crit_with_const _ _ _ _ _ H0 H1); intros c Hc. -apply Feq_transitive with (F{-}G{+}G). -FEQ. -apply Feq_transitive with ( [-C-]Zero{+}G). -2: FEQ. -apply Feq_plus. -2: apply Feq_reflexive; Included. -apply Feq_transitive with ( [-C-]c). -auto. -FEQ. rename X into H4. -simpl in |- *. -elim Hc; intros H5 H6. -elim H6; clear H6; intros H7 H6. -clear Hc H5 H7 Hx' Hx. -simpl in H6. -cut (Conj (Dom F) (Dom G) x). intro H5. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply H6 with (Hx := H5); auto. -apply eq_symmetric_unfolded; apply x_minus_x; auto. -split. -exact (Derivative_imp_inc _ _ _ _ H0 _ H2). -exact (Derivative_imp_inc _ _ _ _ H1 _ H2). +Proof. + do 5 intro. intros H0 H1 x H2 H3. + elim (Feq_crit_with_const _ _ _ _ _ H0 H1); intros c Hc. + apply Feq_transitive with (F{-}G{+}G). + FEQ. + apply Feq_transitive with ( [-C-]Zero{+}G). + 2: FEQ. + apply Feq_plus. + 2: apply Feq_reflexive; Included. + apply Feq_transitive with ( [-C-]c). + auto. + FEQ. rename X into H4. + simpl in |- *. + elim Hc; intros H5 H6. + elim H6; clear H6; intros H7 H6. + clear Hc H5 H7 Hx' Hx. + simpl in H6. + cut (Conj (Dom F) (Dom G) x). intro H5. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply H6 with (Hx := H5); auto. + apply eq_symmetric_unfolded; apply x_minus_x; auto. + split. + exact (Derivative_imp_inc _ _ _ _ H0 _ H2). + exact (Derivative_imp_inc _ _ _ _ H1 _ H2). Qed. (** @@ -597,91 +601,81 @@ formalization and from the mathematical point of view. Lemma Derivative_imp_resp_less : forall J pJ a b F F', Derivative J pJ F F' -> a [<] b -> J a -> J b -> (forall contF', Zero [<] glb_funct _ _ (Min_leEq_Max a b) F' contF') -> forall Ha Hb, F a Ha [<] F b Hb. -intros J pJ a b F F' derF Hab HaJ HbJ Hglb Ha Hb. -apply shift_zero_less_minus'. -cut (Continuous_I (Min_leEq_Max a b) F'). intro H. -2: apply included_imp_Continuous with J; - [ apply Derivative_imp_Continuous' with pJ F | apply included_interval ]; +Proof. + intros J pJ a b F F' derF Hab HaJ HbJ Hglb Ha Hb. + apply shift_zero_less_minus'. + cut (Continuous_I (Min_leEq_Max a b) F'). intro H. + 2: apply included_imp_Continuous with J; + [ apply Derivative_imp_Continuous' with pJ F | apply included_interval ]; auto. + elim (glb_is_glb _ _ _ _ H). + simpl in |- *; intros Hglb1 Hglb2. + cut (Zero [<] glb_funct _ _ _ _ H); [ intro H0 | auto ]. + elim (Law_of_the_Mean _ _ _ _ derF a b) with (e := (glb_funct _ _ _ _ H[*] (b[-]a)) [/]TwoNZ); auto. + intros x H1 H2. + apply less_leEq_trans with (F' x (contin_imp_inc _ _ _ _ H x H1) [*] (b[-]a) [-] + (glb_funct _ _ _ _ H[*] (b[-]a)) [/]TwoNZ). + rstepr ((F' x (contin_imp_inc _ _ _ _ H x H1) [-]glb_funct _ _ _ _ H [/]TwoNZ) [*] (b[-]a)). + apply mult_resp_pos. + apply shift_less_minus; astepl (glb_funct _ _ _ _ H [/]TwoNZ). + eapply less_leEq_trans. + apply pos_div_two'; auto. + apply glb_prop. auto. -elim (glb_is_glb _ _ _ _ H). -simpl in |- *; intros Hglb1 Hglb2. -cut (Zero [<] glb_funct _ _ _ _ H); [ intro H0 | auto ]. -elim - (Law_of_the_Mean _ _ _ _ derF a b) - with (e := (glb_funct _ _ _ _ H[*] (b[-]a)) [/]TwoNZ); - auto. -intros x H1 H2. -apply - less_leEq_trans - with - (F' x (contin_imp_inc _ _ _ _ H x H1) [*] (b[-]a) [-] - (glb_funct _ _ _ _ H[*] (b[-]a)) [/]TwoNZ). -rstepr - ((F' x (contin_imp_inc _ _ _ _ H x H1) [-]glb_funct _ _ _ _ H [/]TwoNZ) [*] - (b[-]a)). -apply mult_resp_pos. -apply shift_less_minus; astepl (glb_funct _ _ _ _ H [/]TwoNZ). -eapply less_leEq_trans. -apply pos_div_two'; auto. -apply glb_prop. -auto. -apply shift_less_minus; astepl a; auto. -apply shift_minus_leEq; apply shift_leEq_plus'. -rstepl - ( [--] - (Part _ _ Hb[-]Part _ _ Ha[-] - Part _ _ (contin_imp_inc _ _ _ _ H _ H1) [*] (b[-]a))). -eapply leEq_transitive. -apply inv_leEq_AbsIR. -apply H2. -apply pos_div_two; apply mult_resp_pos; auto. -apply shift_less_minus; astepl a; auto. + apply shift_less_minus; astepl a; auto. + apply shift_minus_leEq; apply shift_leEq_plus'. + rstepl ( [--] (Part _ _ Hb[-]Part _ _ Ha[-] Part _ _ (contin_imp_inc _ _ _ _ H _ H1) [*] (b[-]a))). + eapply leEq_transitive. + apply inv_leEq_AbsIR. + apply H2. + apply pos_div_two; apply mult_resp_pos; auto. + apply shift_less_minus; astepl a; auto. Qed. Lemma Derivative_imp_resp_leEq : forall J pJ a b F F', Derivative J pJ F F' -> a [<=] b -> J a -> J b -> (forall contF', Zero [<=] glb_funct _ _ (Min_leEq_Max b a) F' contF') -> forall Ha Hb, F a Ha [<=] F b Hb. -intros J pJ a b F F' derF Hab HaJ HbJ Hglb Ha Hb. -astepr (Zero[+]Part _ _ Hb); apply shift_leEq_plus. -cut (Continuous_I (Min_leEq_Max b a) F'). intro H. -2: apply included_imp_Continuous with J; - [ apply Derivative_imp_Continuous' with pJ F | apply included_interval ]; - auto. -elim (glb_is_glb _ _ _ _ H). -simpl in |- *; intros Hglb1 Hglb2. -cut (Zero [<=] glb_funct _ _ _ _ H); [ intro H0 | auto ]. -apply approach_zero_weak. -intros. -elim (Law_of_the_Mean _ _ _ _ derF b a) with (e := e); auto. -intros x H2 H3. -eapply leEq_transitive. -2: apply (H3 Hb Ha (contin_imp_inc _ _ _ _ H x H2)). -eapply leEq_transitive. -2: apply leEq_AbsIR. -rstepl (Part _ _ Ha[-]Part _ _ Hb[-][--]Zero). -unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq. -rstepl ( [--] (Part _ _ (contin_imp_inc _ _ _ _ H _ H2) [*] (b[-]a))). -apply inv_resp_leEq. -apply mult_resp_nonneg. -eapply leEq_transitive; [ apply H0 | apply Hglb1 ]. -exists x. -split. auto. -split; algebra. -apply (contin_imp_inc _ _ _ _ H); auto. -apply shift_leEq_minus; astepl a; auto. +Proof. + intros J pJ a b F F' derF Hab HaJ HbJ Hglb Ha Hb. + astepr (Zero[+]Part _ _ Hb); apply shift_leEq_plus. + cut (Continuous_I (Min_leEq_Max b a) F'). intro H. + 2: apply included_imp_Continuous with J; + [ apply Derivative_imp_Continuous' with pJ F | apply included_interval ]; auto. + elim (glb_is_glb _ _ _ _ H). + simpl in |- *; intros Hglb1 Hglb2. + cut (Zero [<=] glb_funct _ _ _ _ H); [ intro H0 | auto ]. + apply approach_zero_weak. + intros. + elim (Law_of_the_Mean _ _ _ _ derF b a) with (e := e); auto. + intros x H2 H3. + eapply leEq_transitive. + 2: apply (H3 Hb Ha (contin_imp_inc _ _ _ _ H x H2)). + eapply leEq_transitive. + 2: apply leEq_AbsIR. + rstepl (Part _ _ Ha[-]Part _ _ Hb[-][--]Zero). + unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq. + rstepl ( [--] (Part _ _ (contin_imp_inc _ _ _ _ H _ H2) [*] (b[-]a))). + apply inv_resp_leEq. + apply mult_resp_nonneg. + eapply leEq_transitive; [ apply H0 | apply Hglb1 ]. + exists x. + split. auto. + split; algebra. + apply (contin_imp_inc _ _ _ _ H); auto. + apply shift_leEq_minus; astepl a; auto. Qed. Lemma Derivative_imp_resp_less' : forall J pJ a b F F', Derivative J pJ F F' -> a [<] b -> J a -> J b -> (forall contF', Zero [<=] glb_funct _ _ (Min_leEq_Max b a) F' contF') -> forall Ha Hb, F a Ha [#] F b Hb -> F a Ha [<] F b Hb. -intros J pJ a b F F' H H0 H1 H2 H3 Ha Hb H4. -elim (ap_imp_less _ _ _ H4); intro; auto. -elimtype False. -apply less_irreflexive_unfolded with (x := F a Ha). -apply leEq_less_trans with (F b Hb); auto. -apply Derivative_imp_resp_leEq with J pJ F'; auto. -apply less_leEq; auto. +Proof. + intros J pJ a b F F' H H0 H1 H2 H3 Ha Hb H4. + elim (ap_imp_less _ _ _ H4); intro; auto. + elimtype False. + apply less_irreflexive_unfolded with (x := F a Ha). + apply leEq_less_trans with (F b Hb); auto. + apply Derivative_imp_resp_leEq with J pJ F'; auto. + apply less_leEq; auto. Qed. (** From these results we can finally prove that exponentiation to a @@ -689,29 +683,29 @@ real power preserves the less or equal than relation! *) Lemma nexp_resp_leEq_odd : forall n, odd n -> forall x y : IR, x [<=] y -> x[^]n [<=] y[^]n. -intro; case n. -intros; elimtype False; inversion H. -clear n; intros. -astepl (Part (FId{^}S n) x CI). -astepr (Part (FId{^}S n) y CI). -apply - Derivative_imp_resp_leEq with realline CI (nring (R:=IR) (S n) {**}FId{^}n). -Opaque nring. -Derivative_Help. -FEQ. -Transparent nring. -auto. -split. -split. -intros. -apply leEq_glb; intros. -simpl in |- *. -apply mult_resp_nonneg. -apply less_leEq; eapply leEq_less_trans. -2: apply less_plusOne. -apply nring_nonneg. -astepr (y0[^]n); apply nexp_even_nonneg. -inversion H; auto. +Proof. + intro; case n. + intros; elimtype False; inversion H. + clear n; intros. + astepl (Part (FId{^}S n) x CI). + astepr (Part (FId{^}S n) y CI). + apply Derivative_imp_resp_leEq with realline CI (nring (R:=IR) (S n) {**}FId{^}n). + Opaque nring. + Derivative_Help. + FEQ. + Transparent nring. + auto. + split. + split. + intros. + apply leEq_glb; intros. + simpl in |- *. + apply mult_resp_nonneg. + apply less_leEq; eapply leEq_less_trans. + 2: apply less_plusOne. + apply nring_nonneg. + astepr (y0[^]n); apply nexp_even_nonneg. + inversion H; auto. Qed. End Various_Theorems. diff --git a/ftc/Composition.v b/ftc/Composition.v index d55141438..ed88c7f58 100644 --- a/ftc/Composition.v +++ b/ftc/Composition.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export MoreFunctions. Require Export MoreFunSeries. @@ -87,20 +87,23 @@ Hypothesis maps : maps_into_compacts. (* end show *) Lemma maps_lemma' : forall x Hx, I x -> Compact Hcd (F x Hx). -inversion_clear maps. -assumption. +Proof. + inversion_clear maps. + assumption. Qed. Lemma maps_lemma : forall x, I x -> forall Hx, Compact Hcd (F x Hx). -intros. -simpl in |- *. -apply maps_lemma'. -assumption. +Proof. + intros. + simpl in |- *. + apply maps_lemma'. + assumption. Qed. Lemma maps_lemma_inc : included (Compact Hcd) (Dom G). -inversion_clear maps. -assumption. +Proof. + inversion_clear maps. + assumption. Qed. End Part_Funct. @@ -128,11 +131,12 @@ Hypothesis maps : maps_into_compacts F G a b Hab c d Hcd. (* end show *) Lemma included_comp : included (Compact Hab) (Dom (G[o]F)). -intros x H. -simpl in |- *. -exists (Hf x H). -apply Hg. -apply maps_lemma' with G a b Hab; assumption. +Proof. + intros x H. + simpl in |- *. + exists (Hf x H). + apply Hg. + apply maps_lemma' with G a b Hab; assumption. Qed. End Mapping. @@ -163,33 +167,30 @@ Hypothesis Hmap : maps_into_compacts F G a b Hab c d Hcd. (* end show *) Lemma Continuous_I_comp : Continuous_I Hab (G[o]F). -red in |- *. -elim contF; intros incF contF'. -elim contG; intros incG contG'. -split. -exact (included_comp F G a b Hab c d Hcd incF incG Hmap). -intros e H. -elim (contG' e H). -intros dh H0 H1. -elim (contF' dh H0). -intros df H2 H3. -exists df. -assumption. -intros x y H4 H5 Hx Hy H6. -simpl in |- *. -cut (forall x : IR, Compact Hab x -> forall Hx, Compact Hcd (F x Hx)). intro H7. -apply - leEq_wdl - with - (AbsIR - (G _ (incG _ (H7 x H4 (incF x H4))) [-] - G _ (incG _ (H7 y H5 (incF y H5))))). -apply H1; simpl in |- *. -apply H7; assumption. -apply H7; assumption. -apply H3; assumption. -apply AbsIR_wd; rational. -intros. apply maps_lemma with G a b Hab; simpl in |- *; assumption. +Proof. + red in |- *. + elim contF; intros incF contF'. + elim contG; intros incG contG'. + split. + exact (included_comp F G a b Hab c d Hcd incF incG Hmap). + intros e H. + elim (contG' e H). + intros dh H0 H1. + elim (contF' dh H0). + intros df H2 H3. + exists df. + assumption. + intros x y H4 H5 Hx Hy H6. + simpl in |- *. + cut (forall x : IR, Compact Hab x -> forall Hx, Compact Hcd (F x Hx)). intro H7. + apply leEq_wdl with (AbsIR (G _ (incG _ (H7 x H4 (incF x H4))) [-] + G _ (incG _ (H7 y H5 (incF y H5))))). + apply H1; simpl in |- *. + apply H7; assumption. + apply H7; assumption. + apply H3; assumption. + apply AbsIR_wd; rational. + intros. apply maps_lemma with G a b Hab; simpl in |- *; assumption. Qed. End Interval_Continuity. @@ -223,151 +224,145 @@ Hypothesis Hmap : maps_into_compacts F G a b Hab c d Hcd. (* end show *) Lemma included_comp' : included (Compact Hab) (Dom (G'[o]F)). -intros x H. -simpl in |- *. -exists (derivative_imp_inc _ _ _ _ _ derF x H). -apply (derivative_imp_inc' _ _ _ _ _ derG). -apply maps_lemma' with G a b Hab; assumption. +Proof. + intros x H. + simpl in |- *. + exists (derivative_imp_inc _ _ _ _ _ derF x H). + apply (derivative_imp_inc' _ _ _ _ _ derG). + apply maps_lemma' with G a b Hab; assumption. Qed. Lemma maps' : maps_into_compacts F G' a b Hab c d Hcd. -inversion_clear Hmap. -split. -unfold Hcd in |- *; apply derivative_imp_inc' with G; assumption. -assumption. +Proof. + inversion_clear Hmap. + split. + unfold Hcd in |- *; apply derivative_imp_inc' with G; assumption. + assumption. Qed. Lemma Derivative_I_comp : Derivative_I Hab' (G[o]F) ((G'[o]F) {*}F'). -elim derF; intros incF H1. -elim H1; intros incF' H2. -elim derG; intros incG H4. -elim H4; intros incG' H5. -clear H1 H4. -apply Derivative_I_char. -exact (included_comp _ _ _ _ _ _ _ _ incF incG Hmap). -exact - (included_FMult _ _ _ _ (included_comp _ _ _ _ _ _ _ _ incF incG' maps') incF'). -intros e He. -set (contF' := deriv_imp_contin'_I _ _ _ _ _ Hab derF) in *. -set (nF' := Norm_Funct contF') in *. -cut (Zero [<] One[+]nF'). intro H. -cut (One[+]nF'[#]Zero). -intro HnF'. -2: apply Greater_imp_ap; assumption. -set (alpha := (One[/] _[//]HnF') [*]e [/]TwoNZ) in *. -set (contG' := deriv_imp_contin'_I _ _ _ _ _ Hcd derG) in *. -set (nH' := Norm_Funct contG') in *. -cut (Zero [<] alpha). -intro Halpha. -cut (Zero [<] alpha[+]nH'). intro H0. -cut (alpha[+]nH'[#]Zero). -intro HnH'. -2: apply Greater_imp_ap; assumption. -set (beta := (One[/] _[//]HnH') [*]e [/]TwoNZ) in *. -cut (Zero [<] beta). -intro Hbeta. -elim (H2 _ Hbeta). -intros df H1 H3. -elim (H5 _ Halpha). -intros dg H4 H6. -elim (contin_prop _ _ _ _ (deriv_imp_contin_I _ _ _ _ _ Hab derF) _ H4). -intros dc H7 H8. -exists (Min dc df). -apply less_Min; assumption. -intros x y H9 H10 Hx Hy Hx' H11. -simpl in |- *. -set (fx := F x (ProjT1 Hx)) in *. -set (fy := F y (ProjT1 Hy)) in *. -set (gfx := G fx (ProjT2 Hx)) in *. -set (gfy := G fy (ProjT2 Hy)) in *. -set (fx' := F' x (ProjIR2 Hx')) in *. -set (gfx' := G' (F x (ProjT1 (ProjIR1 Hx'))) (ProjT2 (ProjIR1 Hx'))) in *. -simpl in (value of fx'), (value of gfx'); fold fx' gfx' in |- *. -apply - leEq_wdl - with - (AbsIR (gfy[-]gfx[-]gfx'[*] (fy[-]fx) [+]gfx'[*] (fy[-]fx[-]fx'[*] (y[-]x)))). -2: apply AbsIR_wd; rational. -eapply leEq_transitive. -apply triangle_IR. -apply - leEq_transitive - with - (alpha[*]nF'[*]AbsIR (y[-]x) [+]alpha[*]AbsIR (fy[-]fx[-]fx'[*] (y[-]x)) [+] - nH'[*]AbsIR (fy[-]fx[-]fx'[*] (y[-]x))). -apply plus_resp_leEq_both. -apply leEq_transitive with (alpha[*]AbsIR (fy[-]fx)). -unfold gfx' in |- *. -cut (Dom G' fx). intro H12. -apply leEq_wdl with (AbsIR (gfy[-]gfx[-]G' fx H12[*] (fy[-]fx))). -unfold gfy, gfx in |- *; apply H6; unfold fx, fy in |- *. -apply maps_lemma with G a b Hab; assumption. -apply maps_lemma with G a b Hab; assumption. -apply H8; try assumption. -eapply leEq_transitive. -apply H11. -apply Min_leEq_lft. -apply AbsIR_wd; unfold fx, fy, gfx, gfy in |- *; rational. -apply (dom_wd _ G' _ fx (ProjT2 (ProjIR1 Hx'))). -unfold fx in |- *; rational. -rstepr (alpha[*] (nF'[*]AbsIR (y[-]x) [+]AbsIR (fy[-]fx[-]fx'[*] (y[-]x)))). -apply mult_resp_leEq_lft. -2: apply less_leEq; assumption. -apply leEq_wdl with (AbsIR (fx'[*] (y[-]x) [+] (fy[-]fx[-]fx'[*] (y[-]x)))). -2: apply un_op_wd_unfolded; rational. -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -unfold fx', nF', I in |- *; apply norm_bnd_AbsIR; assumption. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -unfold gfx', nH' in |- *; apply norm_bnd_AbsIR; - apply maps_lemma with G a b Hab; assumption. -rstepl - (alpha[*]nF'[*]AbsIR (y[-]x) [+] - (alpha[+]nH') [*]AbsIR (fy[-]fx[-]fx'[*] (y[-]x))). -rstepr (e [/]TwoNZ[*]ABSIR (y[-]x) [+]e [/]TwoNZ[*]ABSIR (y[-]x)). -apply plus_resp_leEq_both. -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -unfold alpha in |- *. -rstepl ((nF'[/] _[//]HnF') [*]e [/]TwoNZ). -astepr (One[*]e [/]TwoNZ). -apply mult_resp_leEq_rht. -2: apply less_leEq; apply pos_div_two; assumption. -apply shift_div_leEq'. -apply leEq_less_trans with nF'. -unfold nF' in |- *; apply positive_norm. -astepr (nF'[+]One); apply less_plusOne. -apply less_leEq; rstepr (nF'[+]One); apply less_plusOne. -apply shift_mult_leEq' with HnH'. -assumption. -apply leEq_wdr with (beta[*]ABSIR (y[-]x)). -2: unfold beta in |- *; rational. -unfold fx, fy, fx' in |- *; apply H3; try assumption. -eapply leEq_transitive. -apply H11. -apply Min_leEq_rht. -unfold beta in |- *. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. -apply recip_resp_pos; assumption. -apply pos_div_two; assumption. -apply leEq_less_trans with nH'. -unfold nH' in |- *; apply positive_norm. -astepl (Zero[+]nH'); apply plus_resp_less_rht; assumption. -unfold alpha in |- *. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. -apply recip_resp_pos; assumption. -apply pos_div_two; assumption. -apply leEq_less_trans with nF'. -unfold nF' in |- *; apply positive_norm. -astepr (nF'[+]One); apply less_plusOne. +Proof. + elim derF; intros incF H1. + elim H1; intros incF' H2. + elim derG; intros incG H4. + elim H4; intros incG' H5. + clear H1 H4. + apply Derivative_I_char. + exact (included_comp _ _ _ _ _ _ _ _ incF incG Hmap). + exact (included_FMult _ _ _ _ (included_comp _ _ _ _ _ _ _ _ incF incG' maps') incF'). + intros e He. + set (contF' := deriv_imp_contin'_I _ _ _ _ _ Hab derF) in *. + set (nF' := Norm_Funct contF') in *. + cut (Zero [<] One[+]nF'). intro H. + cut (One[+]nF'[#]Zero). + intro HnF'. + 2: apply Greater_imp_ap; assumption. + set (alpha := (One[/] _[//]HnF') [*]e [/]TwoNZ) in *. + set (contG' := deriv_imp_contin'_I _ _ _ _ _ Hcd derG) in *. + set (nH' := Norm_Funct contG') in *. + cut (Zero [<] alpha). + intro Halpha. + cut (Zero [<] alpha[+]nH'). intro H0. + cut (alpha[+]nH'[#]Zero). + intro HnH'. + 2: apply Greater_imp_ap; assumption. + set (beta := (One[/] _[//]HnH') [*]e [/]TwoNZ) in *. + cut (Zero [<] beta). + intro Hbeta. + elim (H2 _ Hbeta). + intros df H1 H3. + elim (H5 _ Halpha). + intros dg H4 H6. + elim (contin_prop _ _ _ _ (deriv_imp_contin_I _ _ _ _ _ Hab derF) _ H4). + intros dc H7 H8. + exists (Min dc df). + apply less_Min; assumption. + intros x y H9 H10 Hx Hy Hx' H11. + simpl in |- *. + set (fx := F x (ProjT1 Hx)) in *. + set (fy := F y (ProjT1 Hy)) in *. + set (gfx := G fx (ProjT2 Hx)) in *. + set (gfy := G fy (ProjT2 Hy)) in *. + set (fx' := F' x (ProjIR2 Hx')) in *. + set (gfx' := G' (F x (ProjT1 (ProjIR1 Hx'))) (ProjT2 (ProjIR1 Hx'))) in *. + simpl in (value of fx'), (value of gfx'); fold fx' gfx' in |- *. + apply leEq_wdl with (AbsIR (gfy[-]gfx[-]gfx'[*] (fy[-]fx) [+]gfx'[*] (fy[-]fx[-]fx'[*] (y[-]x)))). + 2: apply AbsIR_wd; rational. + eapply leEq_transitive. + apply triangle_IR. + apply leEq_transitive with + (alpha[*]nF'[*]AbsIR (y[-]x) [+]alpha[*]AbsIR (fy[-]fx[-]fx'[*] (y[-]x)) [+] + nH'[*]AbsIR (fy[-]fx[-]fx'[*] (y[-]x))). + apply plus_resp_leEq_both. + apply leEq_transitive with (alpha[*]AbsIR (fy[-]fx)). + unfold gfx' in |- *. + cut (Dom G' fx). intro H12. + apply leEq_wdl with (AbsIR (gfy[-]gfx[-]G' fx H12[*] (fy[-]fx))). + unfold gfy, gfx in |- *; apply H6; unfold fx, fy in |- *. + apply maps_lemma with G a b Hab; assumption. + apply maps_lemma with G a b Hab; assumption. + apply H8; try assumption. + eapply leEq_transitive. + apply H11. + apply Min_leEq_lft. + apply AbsIR_wd; unfold fx, fy, gfx, gfy in |- *; rational. + apply (dom_wd _ G' _ fx (ProjT2 (ProjIR1 Hx'))). + unfold fx in |- *; rational. + rstepr (alpha[*] (nF'[*]AbsIR (y[-]x) [+]AbsIR (fy[-]fx[-]fx'[*] (y[-]x)))). + apply mult_resp_leEq_lft. + 2: apply less_leEq; assumption. + apply leEq_wdl with (AbsIR (fx'[*] (y[-]x) [+] (fy[-]fx[-]fx'[*] (y[-]x)))). + 2: apply un_op_wd_unfolded; rational. + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + unfold fx', nF', I in |- *; apply norm_bnd_AbsIR; assumption. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + unfold gfx', nH' in |- *; apply norm_bnd_AbsIR; apply maps_lemma with G a b Hab; assumption. + rstepl (alpha[*]nF'[*]AbsIR (y[-]x) [+] (alpha[+]nH') [*]AbsIR (fy[-]fx[-]fx'[*] (y[-]x))). + rstepr (e [/]TwoNZ[*]ABSIR (y[-]x) [+]e [/]TwoNZ[*]ABSIR (y[-]x)). + apply plus_resp_leEq_both. + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + unfold alpha in |- *. + rstepl ((nF'[/] _[//]HnF') [*]e [/]TwoNZ). + astepr (One[*]e [/]TwoNZ). + apply mult_resp_leEq_rht. + 2: apply less_leEq; apply pos_div_two; assumption. + apply shift_div_leEq'. + apply leEq_less_trans with nF'. + unfold nF' in |- *; apply positive_norm. + astepr (nF'[+]One); apply less_plusOne. + apply less_leEq; rstepr (nF'[+]One); apply less_plusOne. + apply shift_mult_leEq' with HnH'. + assumption. + apply leEq_wdr with (beta[*]ABSIR (y[-]x)). + 2: unfold beta in |- *; rational. + unfold fx, fy, fx' in |- *; apply H3; try assumption. + eapply leEq_transitive. + apply H11. + apply Min_leEq_rht. + unfold beta in |- *. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. + apply recip_resp_pos; assumption. + apply pos_div_two; assumption. + apply leEq_less_trans with nH'. + unfold nH' in |- *; apply positive_norm. + astepl (Zero[+]nH'); apply plus_resp_less_rht; assumption. + unfold alpha in |- *. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. + apply recip_resp_pos; assumption. + apply pos_div_two; assumption. + apply leEq_less_trans with nF'. + unfold nF' in |- *; apply positive_norm. + astepr (nF'[+]One); apply less_plusOne. Qed. (** @@ -375,20 +370,17 @@ The next lemma will be useful when we move on to differentiability. *) Lemma Diffble_I_comp_aux : Diffble_I Hab' (G[o]F). -elim derF; intros incF H1. -elim H1; intros incF' H2. -elim derG; intros incG H4. -elim H4; intros incG' H5. -clear H1 H4. -exists - (IntPartIR - (included_FMult _ _ _ _ (included_comp _ _ _ _ _ _ _ _ incF incG' maps') - incF')). -eapply Derivative_I_wdr. -2: apply Derivative_I_comp. -FEQ. -exact - (included_FMult _ _ _ _ (included_comp _ _ _ _ _ _ _ _ incF incG' maps') incF'). +Proof. + elim derF; intros incF H1. + elim H1; intros incF' H2. + elim derG; intros incG H4. + elim H4; intros incG' H5. + clear H1 H4. + exists (IntPartIR (included_FMult _ _ _ _ (included_comp _ _ _ _ _ _ _ _ incF incG' maps') incF')). + eapply Derivative_I_wdr. + 2: apply Derivative_I_comp. + FEQ. + exact (included_FMult _ _ _ _ (included_comp _ _ _ _ _ _ _ _ incF incG' maps') incF'). Qed. End Derivative. @@ -422,9 +414,10 @@ Hypothesis Hmap : maps_into_compacts F G a b Hab c d Hcd. (* end show *) Lemma Diffble_I_comp : Diffble_I Hab' (G[o]F). -elim diffF; intros f' derF. -elim diffG; intros g' derG. -apply Diffble_I_comp_aux with (PartInt f') (PartInt g') c d Hcd'; auto. +Proof. + elim diffF; intros f' derF. + elim diffG; intros g' derG. + apply Diffble_I_comp_aux with (PartInt f') (PartInt g') c d Hcd'; auto. Qed. End Differentiability. @@ -478,63 +471,58 @@ Hypothesis rangeF : forall (x : IR) (Hx : Dom F x), I x -> Compact Hcd (F x Hx). Lemma fun_Lim_seq_comp' : forall H H', conv_fun_seq' a b Hab (fun n => g n[o]f n) (G[o]F) H H'. Proof. -intros H H'. -intros e He. -destruct (convG _ (pos_div_two _ _ He)) as [N HN]. -destruct (CAnd_proj2 _ _ contG _ (pos_div_two _ _ He)) as [z Hz Hz0]. -destruct (convF _ Hz) as [M HM]. -exists (max N M). -intros n Hn x Hx. -assert (Hn0 : N <= n). - apply le_trans with (max N M); auto with *. -assert (Hn1 : M <= n). - apply le_trans with (max N M); auto with *. -apply AbsSmall_imp_AbsIR. -assert (X:Continuous_I (a:=a) (b:=b) Hab (G[o]f n)). - eapply Continuous_I_comp. - apply contf. - apply contG. - (split; try assumption). - apply (rangef n). -rstepr (((g n[o]f n) x (contin_imp_inc a b Hab (g n[o]f n) (H n) x Hx)[-] - ((G[o]f n) x (contin_imp_inc a b Hab _ X x Hx)))[+] - (((G[o]f n) x (contin_imp_inc a b Hab _ X x Hx))[-] - (G[o]F) x (contin_imp_inc a b Hab (G[o]F) H' x Hx))). -apply AbsSmall_eps_div_two. + intros H H'. + intros e He. + destruct (convG _ (pos_div_two _ _ He)) as [N HN]. + destruct (CAnd_proj2 _ _ contG _ (pos_div_two _ _ He)) as [z Hz Hz0]. + destruct (convF _ Hz) as [M HM]. + exists (max N M). + intros n Hn x Hx. + assert (Hn0 : N <= n). + apply le_trans with (max N M); auto with *. + assert (Hn1 : M <= n). + apply le_trans with (max N M); auto with *. + apply AbsSmall_imp_AbsIR. + assert (X:Continuous_I (a:=a) (b:=b) Hab (G[o]f n)). + eapply Continuous_I_comp. + apply contf. + apply contG. + (split; try assumption). + apply (rangef n). + rstepr (((g n[o]f n) x (contin_imp_inc a b Hab (g n[o]f n) (H n) x Hx)[-] + ((G[o]f n) x (contin_imp_inc a b Hab _ X x Hx)))[+] + (((G[o]f n) x (contin_imp_inc a b Hab _ X x Hx))[-] + (G[o]F) x (contin_imp_inc a b Hab (G[o]F) H' x Hx))). + apply AbsSmall_eps_div_two. + apply AbsIR_imp_AbsSmall. + simpl (AbsIR ((g n[o]f n) x (contin_imp_inc a b Hab (g n[o]f n) (H n) x Hx)[-] + (G[o]f n) x (contin_imp_inc a b Hab (G[o]f n) X x Hx))). + generalize (ProjT1 (contin_imp_inc a b Hab (g n[o]f n) (H n) x Hx)) + (ProjT1 (contin_imp_inc a b Hab (G[o]f n) X x Hx)) + (ProjT2 (contin_imp_inc a b Hab (g n[o]f n) (H n) x Hx)) + (ProjT2 (contin_imp_inc a b Hab (G[o]f n) X x Hx)). + intros Y0 Y1 Y2 Y3. + assert (fnx := pfwdef _ _ _ _ Y0 Y1 (eq_reflexive _ x)). + assert (Y4 : Dom (g n) (f n x Y1)). + apply (dom_wd _ (g n) (f n x Y0));assumption. + stepl (ABSIR (g n (f n x Y1) Y4[-]G (f n x Y1) Y3)) by (apply AbsIR_wd; rational). + generalize (rangef n x Y1 Hx). + generalize (f n x Y1) Y4 Y3. + clear Y0 Y1 Y2 Y3 fnx Y4. + intros y Hy0 Hy1 Hy. + stepl (ABSIR (g n y (contin_imp_inc c d Hcd (g n) (contg n) y Hy)[-] + G y (contin_imp_inc c d Hcd G contG y Hy))) by (apply AbsIR_wd; rational). + apply HN. + assumption. apply AbsIR_imp_AbsSmall. - simpl (AbsIR - ((g n[o]f n) x (contin_imp_inc a b Hab (g n[o]f n) (H n) x Hx)[-] - (G[o]f n) x (contin_imp_inc a b Hab (G[o]f n) X x Hx))). - generalize (ProjT1 (contin_imp_inc a b Hab (g n[o]f n) (H n) x Hx)) - (ProjT1 (contin_imp_inc a b Hab (G[o]f n) X x Hx)) - (ProjT2 (contin_imp_inc a b Hab (g n[o]f n) (H n) x Hx)) - (ProjT2 (contin_imp_inc a b Hab (G[o]f n) X x Hx)). - intros Y0 Y1 Y2 Y3. - assert (fnx := pfwdef _ _ _ _ Y0 Y1 (eq_reflexive _ x)). - assert (Y4 : Dom (g n) (f n x Y1)). - apply (dom_wd _ (g n) (f n x Y0));assumption. - stepl (ABSIR (g n (f n x Y1) Y4[-]G (f n x Y1) Y3)) by - (apply AbsIR_wd; rational). - generalize (rangef n x Y1 Hx). - generalize (f n x Y1) Y4 Y3. - clear Y0 Y1 Y2 Y3 fnx Y4. - intros y Hy0 Hy1 Hy. - stepl (ABSIR (g n y (contin_imp_inc c d Hcd (g n) (contg n) y Hy)[-] - G y (contin_imp_inc c d Hcd G contG y Hy))) by - (apply AbsIR_wd; rational). - apply HN. + simpl. + apply Hz0. + apply rangef; assumption. + apply rangeF; assumption. + stepl (AbsIR (f n x (contin_imp_inc a b Hab (f n) (contf n) x Hx)[-] + F x (contin_imp_inc a b Hab F contF x Hx))) by (apply AbsIR_wd; rational). + apply HM. assumption. -apply AbsIR_imp_AbsSmall. -simpl. -apply Hz0. - apply rangef; assumption. - apply rangeF; assumption. -stepl (AbsIR - (f n x (contin_imp_inc a b Hab (f n) (contf n) x Hx)[-] - F x (contin_imp_inc a b Hab F contF x Hx))) by - (apply AbsIR_wd; rational). -apply HM. -assumption. Qed. End ExplicitLimit. @@ -551,33 +539,31 @@ Hypothesis Hg : Cauchy_fun_seq _ _ _ _ contg. Lemma fun_Lim_seq_comp : forall H H', conv_fun_seq' a b Hab (fun n => g n[o]f n) (Cauchy_fun_seq_Lim _ _ _ _ _ Hg[o]Cauchy_fun_seq_Lim _ _ _ _ _ Hf) H H'. Proof. -intros H H' e H0. -set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *. -cut (Continuous_I Hab F). intro H1. -2: unfold F in |- *; apply Cauchy_cont_Lim. -cut (conv_fun_seq' _ _ _ _ _ contf H1). -2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption. -intro Hf'. -set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *. -cut (Continuous_I Hcd G). intro H2. -2: unfold G in |- *; apply Cauchy_cont_Lim. -cut (conv_fun_seq' _ _ _ _ _ contg H2). -2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption. -intro Hg'. -assert (X: (forall (x : IR) (Hx : Dom F x), I x -> Compact Hcd (F x Hx)) ). - intros x Hx Hx'. - assert (X:=fun_conv_imp_seq_conv _ _ Hab _ contf _ H1 Hf' _ Hx' (fun n => incf n _ Hx') Hx). - assert (X0:Cauchy_prop2 (fun n : nat => Part (f n) x ((fun n0 : nat => incf n0 x Hx') n))). - exists (F x Hx). - assumption. - pose (cs:= (Build_CauchySeq _ _ (Cauchy_prop2_prop _ X0))). - assert (X1:=Limits_unique cs _ X). - apply compact_wd with (Lim cs);[|apply eq_symmetric; assumption]. - split;[apply leEq_seq_so_leEq_Lim|apply seq_leEq_so_Lim_leEq]; - intros i; simpl; - destruct (rangef i _ (incf i _ Hx') Hx'); - assumption. -apply (fun_Lim_seq_comp' _ _ H1 H2 Hf' Hg' X H); auto. + intros H H' e H0. + set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *. + cut (Continuous_I Hab F). intro H1. + 2: unfold F in |- *; apply Cauchy_cont_Lim. + cut (conv_fun_seq' _ _ _ _ _ contf H1). + 2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption. + intro Hf'. + set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *. + cut (Continuous_I Hcd G). intro H2. + 2: unfold G in |- *; apply Cauchy_cont_Lim. + cut (conv_fun_seq' _ _ _ _ _ contg H2). + 2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption. + intro Hg'. + assert (X: (forall (x : IR) (Hx : Dom F x), I x -> Compact Hcd (F x Hx)) ). + intros x Hx Hx'. + assert (X:=fun_conv_imp_seq_conv _ _ Hab _ contf _ H1 Hf' _ Hx' (fun n => incf n _ Hx') Hx). + assert (X0:Cauchy_prop2 (fun n : nat => Part (f n) x ((fun n0 : nat => incf n0 x Hx') n))). + exists (F x Hx). + assumption. + pose (cs:= (Build_CauchySeq _ _ (Cauchy_prop2_prop _ X0))). + assert (X1:=Limits_unique cs _ X). + apply compact_wd with (Lim cs);[|apply eq_symmetric; assumption]. + split;[apply leEq_seq_so_leEq_Lim|apply seq_leEq_so_Lim_leEq]; intros i; simpl; + destruct (rangef i _ (incf i _ Hx') Hx'); assumption. + apply (fun_Lim_seq_comp' _ _ H1 H2 Hf' Hg' X H); auto. Qed. End Sequences. @@ -609,64 +595,60 @@ Hypothesis rangeF : forall (x : IR) (Hx : Dom F x), Compact Hab x -> (Compact Hc Lemma conv_fun_series_comp : fun_series_convergent _ _ Hab (fun n => g n[o]F). Proof. -destruct convG as [contg X]. -assert (incg := fun (n : nat) => contin_imp_inc _ _ _ _ (contg n)). -assert (incpsg : forall n : nat, included (Compact Hcd) (Dom (fun_seq_part_sum g n))). - intros n. - apply contin_imp_inc. - apply fun_seq_part_sum_cont. - assumption. -assert (convG': forall H, Cauchy_fun_seq _ _ Hcd (fun_seq_part_sum g) H). - intros H. - eapply Cauchy_fun_seq_wd. + destruct convG as [contg X]. + assert (incg := fun (n : nat) => contin_imp_inc _ _ _ _ (contg n)). + assert (incpsg : forall n : nat, included (Compact Hcd) (Dom (fun_seq_part_sum g n))). + intros n. + apply contin_imp_inc. + apply fun_seq_part_sum_cont. + assumption. + assert (convG': forall H, Cauchy_fun_seq _ _ Hcd (fun_seq_part_sum g) H). + intros H. + eapply Cauchy_fun_seq_wd. intros n; apply Feq_reflexive. - apply incpsg. - apply X. -clear X. -assert (X0:forall n, maps_into_compacts F (g n) _ _ Hab _ _ Hcd). - intros n. - split. - apply incg. - apply rangeF. -set (H' := fun n : nat => Continuous_I_comp _ _ _ _ _ _ _ _ contF (contg n) (X0 n)) in *. + apply incpsg. + apply X. + clear X. + assert (X0:forall n, maps_into_compacts F (g n) _ _ Hab _ _ Hcd). + intros n. + split. + apply incg. + apply rangeF. + set (H' := fun n : nat => Continuous_I_comp _ _ _ _ _ _ _ _ contF (contg n) (X0 n)) in *. exists H'. -cut (forall n : nat, Continuous_I Hcd (fun_seq_part_sum g n)); - [ intro H0 | Contin ]. -cut (forall n : nat, Continuous_I Hab ((fun_seq_part_sum g n)[o]F)); - [ intro H1 - |intros n; eapply Continuous_I_comp with _ _ Hcd; Contin; - split;[apply incpsg|apply rangeF]]. -apply Cauchy_fun_seq_wd with (fun n : nat => (fun_seq_part_sum g n)[o]F) H1. - intros n. - FEQ. - apply contin_imp_inc; Contin. - simpl. - apply Sum0_wd; algebra. -pose (G:=(Cauchy_fun_seq_Lim _ _ _ _ _ (convG' H0))). -assert (contG:Continuous_I Hcd G). - unfold G; Contin. -assert (contGF:Continuous_I Hab (G[o]F)). - apply Continuous_I_comp with c d Hcd; try assumption. - split; try assumption. - apply contin_imp_inc. + cut (forall n : nat, Continuous_I Hcd (fun_seq_part_sum g n)); [ intro H0 | Contin ]. + cut (forall n : nat, Continuous_I Hab ((fun_seq_part_sum g n)[o]F)); [ intro H1 + |intros n; eapply Continuous_I_comp with _ _ Hcd; Contin; split;[apply incpsg|apply rangeF]]. + apply Cauchy_fun_seq_wd with (fun n : nat => (fun_seq_part_sum g n)[o]F) H1. + intros n. + FEQ. + apply contin_imp_inc; Contin. + simpl. + apply Sum0_wd; algebra. + pose (G:=(Cauchy_fun_seq_Lim _ _ _ _ _ (convG' H0))). + assert (contG:Continuous_I Hcd G). + unfold G; Contin. + assert (contGF:Continuous_I Hab (G[o]F)). + apply Continuous_I_comp with c d Hcd; try assumption. + split; try assumption. + apply contin_imp_inc. + assumption. + apply conv_Cauchy_fun_seq' with (G[o]F) contGF. + refine (fun_Lim_seq_comp' _ _ Hab _ _ Hcd _ _ (fun n => contF) H0 _ _ _ contF contG _ _ _ _ _). + intros _; apply rangeF. + apply fun_Lim_seq_const. + apply (Cauchy_conv_fun_seq' _ _ _ _ _ (convG' H0)). assumption. -apply conv_Cauchy_fun_seq' with (G[o]F) contGF. -refine (fun_Lim_seq_comp' _ _ Hab _ _ Hcd _ _ (fun n => contF) H0 - _ _ _ contF contG _ _ _ _ _). - intros _; apply rangeF. - apply fun_Lim_seq_const. - apply (Cauchy_conv_fun_seq' _ _ _ _ _ (convG' H0)). -assumption. Qed. Lemma Fun_Series_Sum_comp : forall H' : fun_series_convergent _ _ Hab (fun n => g n[o]F), Feq I (Fun_Series_Sum H') (Fun_Series_Sum convG[o]F). Proof. -intros H'. -FEQ. -simpl. -apply series_sum_wd. -algebra. + intros H'. + FEQ. + simpl. + apply series_sum_wd. + algebra. Qed. End Series. @@ -696,43 +678,45 @@ Now everything comes naturally: Lemma comp_inc_lemma : forall F, maps_compacts_into_weak F -> forall x Hx, I x -> J (F x Hx). -intros F H x Hx H0. -cut (included (Compact (leEq_reflexive _ x)) I). intro H1. -elim (H _ _ _ H1); intros c Hc. -elim Hc; clear Hc; intros d Hd. -elim Hd; clear Hd; intros Hcd Hmap'. -elim Hmap'; intros H2 H3. -apply H2; apply H3; auto. -split; apply leEq_reflexive. -intros x0 H1. -inversion_clear H1. -apply iprop_wd with x; auto. -apply leEq_imp_eq; auto. +Proof. + intros F H x Hx H0. + cut (included (Compact (leEq_reflexive _ x)) I). intro H1. + elim (H _ _ _ H1); intros c Hc. + elim Hc; clear Hc; intros d Hd. + elim Hd; clear Hd; intros Hcd Hmap'. + elim Hmap'; intros H2 H3. + apply H2; apply H3; auto. + split; apply leEq_reflexive. + intros x0 H1. + inversion_clear H1. + apply iprop_wd with x; auto. + apply leEq_imp_eq; auto. Qed. Variables F F' G G' : PartIR. (* begin show *) Hypothesis Hmap : maps_compacts_into_weak F. -(* end show *) +(* end show *) Lemma Continuous_comp : Continuous I F -> Continuous J G -> Continuous I (G[o]F). -intros H H0. -elim H; clear H; intros incF contF. -elim H0; clear H0; intros incG contG. -split. -intros x H. -exists (incF _ H). -apply incG. -apply comp_inc_lemma; auto. -intros a b Hab H. -elim (Hmap _ _ Hab H); clear Hmap; intros c Hc. -elim Hc; clear Hc; intros d Hd. -elim Hd; clear Hd; intros Hcd Hmap'. -inversion_clear Hmap'. -apply Continuous_I_comp with c d Hcd; auto. -red in |- *; intros. -split; auto. -Included. +Proof. + intros H H0. + elim H; clear H; intros incF contF. + elim H0; clear H0; intros incG contG. + split. + intros x H. + exists (incF _ H). + apply incG. + apply comp_inc_lemma; auto. + intros a b Hab H. + elim (Hmap _ _ Hab H); clear Hmap; intros c Hc. + elim Hc; clear Hc; intros d Hd. + elim Hd; clear Hd; intros Hcd Hmap'. + inversion_clear Hmap'. + apply Continuous_I_comp with c d Hcd; auto. + red in |- *; intros. + split; auto. + Included. Qed. Definition maps_compacts_into (F : PartIR) := forall a b Hab, included (compact a b Hab) I -> @@ -742,12 +726,12 @@ Definition maps_compacts_into (F : PartIR) := forall a b Hab, included (compact Lemma maps_compacts_into_strict_imp_weak : forall F, maps_compacts_into F -> maps_compacts_into_weak F. Proof. -intros X HX a b Hab Hinc. -destruct (HX a b Hab Hinc) as [c [d [Hcd Hcd0]]]. -exists c. -exists d. -exists (less_leEq _ _ _ Hcd). -assumption. + intros X HX a b Hab Hinc. + destruct (HX a b Hab Hinc) as [c [d [Hcd Hcd0]]]. + exists c. + exists d. + exists (less_leEq _ _ _ Hcd). + assumption. Qed. (* begin show *) @@ -756,30 +740,31 @@ Hypothesis Hmap' : maps_compacts_into F. Lemma Derivative_comp : Derivative I pI F F' -> Derivative J pJ G G' -> Derivative I pI (G[o]F) ((G'[o]F) {*}F'). -clear Hmap. -assert (Hmap := maps_compacts_into_strict_imp_weak F Hmap'). -intros H H0. -elim H; clear H; intros incF H'. -elim H'; clear H'; intros incF' derF. -elim H0; clear H0; intros incG H'. -elim H'; clear H'; intros incG' derG. -split. -simpl in |- *; red in |- *; intros x H; exists (incF _ H). -apply incG; apply comp_inc_lemma; auto. -split. -apply included_FMult. -simpl in |- *; red in |- *; intros x H; exists (incF _ H). -apply incG'; apply comp_inc_lemma; auto. -Included. -intros a b Hab H. -elim (Hmap' _ _ (less_leEq _ _ _ Hab) H); clear Hmap'; intros c Hc. -elim Hc; clear Hc; intros d Hd. -elim Hd; clear Hd; intros Hcd Hmap2. -inversion_clear Hmap2. -apply Derivative_I_comp with c d Hcd; auto. -red in |- *; intros. -split; auto. -Included. +Proof. + clear Hmap. + assert (Hmap := maps_compacts_into_strict_imp_weak F Hmap'). + intros H H0. + elim H; clear H; intros incF H'. + elim H'; clear H'; intros incF' derF. + elim H0; clear H0; intros incG H'. + elim H'; clear H'; intros incG' derG. + split. + simpl in |- *; red in |- *; intros x H; exists (incF _ H). + apply incG; apply comp_inc_lemma; auto. + split. + apply included_FMult. + simpl in |- *; red in |- *; intros x H; exists (incF _ H). + apply incG'; apply comp_inc_lemma; auto. + Included. + intros a b Hab H. + elim (Hmap' _ _ (less_leEq _ _ _ Hab) H); clear Hmap'; intros c Hc. + elim Hc; clear Hc; intros d Hd. + elim Hd; clear Hd; intros Hcd Hmap2. + inversion_clear Hmap2. + apply Derivative_I_comp with c d Hcd; auto. + red in |- *; intros. + split; auto. + Included. Qed. Variable g : nat -> PartIR. @@ -790,35 +775,36 @@ Hypothesis convG : fun_series_convergent_IR J g. (* end show *) Lemma FSeries_Sum_comp_conv : fun_series_convergent_IR I (fun n => g n[o]F). -red in |- *; intros. -destruct (Hmap a b Hab Hinc) as [c [d [Hcd [H0 H1]]]]. -apply conv_fun_series_comp with c d Hcd; auto. -eapply included_imp_Continuous. -apply contF. -auto. +Proof. + red in |- *; intros. + destruct (Hmap a b Hab Hinc) as [c [d [Hcd [H0 H1]]]]. + apply conv_fun_series_comp with c d Hcd; auto. + eapply included_imp_Continuous. + apply contF. + auto. Qed. Lemma FSeries_Sum_comp : forall H' : fun_series_convergent_IR I (fun n => g n[o]F), Feq I (FSeries_Sum H') (FSeries_Sum convG[o]F). -intros. -apply included_Feq'; intros a b Hab Hinc. -destruct (Hmap a b Hab Hinc) as [c [d [Hcd [H0 H1]]]]. -assert (H2:Continuous_I Hab F). -eapply included_imp_Continuous. -apply contF. -auto. -eapply Feq_transitive. -apply (FSeries_Sum_char _ _ H' a b Hab Hinc). -apply Feq_transitive with - (Fun_Series_Sum (a:=c) (b:=d) (Hab:=Hcd) (f:=g) (convG _ _ _ H0)[o]F). -apply Fun_Series_Sum_comp. -auto. -apply H1. -eapply Feq_comp; try apply H1. - apply Feq_reflexive. - Included. -apply Feq_symmetric. -apply FSeries_Sum_char. +Proof. + intros. + apply included_Feq'; intros a b Hab Hinc. + destruct (Hmap a b Hab Hinc) as [c [d [Hcd [H0 H1]]]]. + assert (H2:Continuous_I Hab F). + eapply included_imp_Continuous. + apply contF. + auto. + eapply Feq_transitive. + apply (FSeries_Sum_char _ _ H' a b Hab Hinc). + apply Feq_transitive with (Fun_Series_Sum (a:=c) (b:=d) (Hab:=Hcd) (f:=g) (convG _ _ _ H0)[o]F). + apply Fun_Series_Sum_comp. + auto. + apply H1. + eapply Feq_comp; try apply H1. + apply Feq_reflexive. + Included. + apply Feq_symmetric. + apply FSeries_Sum_char. Qed. Variable f : nat -> PartIR. @@ -832,30 +818,31 @@ Hypothesis Hmapf : forall a b Hab, included (compact a b Hab) I -> (forall n x Hx, Compact Hab x -> compact c d Hcd (f n x Hx))}}}. (* end show *) -Lemma fun_Lim_seq_comp'_IR : +Lemma fun_Lim_seq_comp'_IR : (conv_fun_seq'_IR _ _ _ contf contF) -> (conv_fun_seq'_IR _ _ _ contg contG) -> forall H H', conv_fun_seq'_IR I (fun n => g n[o]f n) (G[o]F) H H'. -red in |- *; intros. -destruct (Hmapf a b Hab Hinc) as [c [d [Hcd [Hcd0 Hcd1]]]]. -eapply fun_Lim_seq_comp'. - apply Hcd1. - apply (X a b Hab Hinc). - apply (X0 _ _ Hcd Hcd0). -intros. -assert (Y:forall n : nat, Dom (f n) x). -intros n. -refine (Continuous_imp_inc _ _ _ _ _). -apply contf. -Included. -assert (Z:=fun_conv_imp_seq_conv _ _ _ _ _ _ _ (X a b Hab Hinc) x X1 Y Hx). -pose (seq:= Build_CauchySeq2_y _ _ Z). -assert (Z0:=Limits_unique seq (F x Hx) Z). -apply (compact_wd c d Hcd (Lim seq)). -assert (HcdX := fun n => Hcd1 n x (Y n) X1). -split;[apply leEq_seq_so_leEq_Lim|apply seq_leEq_so_Lim_leEq]; - intros i; simpl; destruct (HcdX i); assumption. -apply eq_symmetric; assumption. +Proof. + red in |- *; intros. + destruct (Hmapf a b Hab Hinc) as [c [d [Hcd [Hcd0 Hcd1]]]]. + eapply fun_Lim_seq_comp'. + apply Hcd1. + apply (X a b Hab Hinc). + apply (X0 _ _ Hcd Hcd0). + intros. + assert (Y:forall n : nat, Dom (f n) x). + intros n. + refine (Continuous_imp_inc _ _ _ _ _). + apply contf. + Included. + assert (Z:=fun_conv_imp_seq_conv _ _ _ _ _ _ _ (X a b Hab Hinc) x X1 Y Hx). + pose (seq:= Build_CauchySeq2_y _ _ Z). + assert (Z0:=Limits_unique seq (F x Hx) Z). + apply (compact_wd c d Hcd (Lim seq)). + assert (HcdX := fun n => Hcd1 n x (Y n) X1). + split;[apply leEq_seq_so_leEq_Lim|apply seq_leEq_so_Lim_leEq]; + intros i; simpl; destruct (HcdX i); assumption. + apply eq_symmetric; assumption. Qed. (* begin show *) @@ -865,71 +852,61 @@ Hypothesis Hg : Cauchy_fun_seq_IR _ _ contg. Lemma fun_Lim_seq_comp_IR : forall H H', conv_fun_seq'_IR I (fun n => g n[o]f n) (Cauchy_fun_seq_Lim_IR _ _ _ Hg[o]Cauchy_fun_seq_Lim_IR _ _ _ Hf) H H'. -intros H H'. -red; intros. -destruct (Hmapf a b Hab Hinc) as [c [d [Hcd [Hcd0 Hcd1]]]]. -assert (X:forall n : nat, Continuous_I (a:=a) (b:=b) Hab (g n[o]f n)). -intros n. - apply Continuous_I_comp with c d Hcd. - destruct (contf n) as [A B]. +Proof. + intros H H'. + red; intros. + destruct (Hmapf a b Hab Hinc) as [c [d [Hcd [Hcd0 Hcd1]]]]. + assert (X:forall n : nat, Continuous_I (a:=a) (b:=b) Hab (g n[o]f n)). + intros n. + apply Continuous_I_comp with c d Hcd. + destruct (contf n) as [A B]. + apply B. + assumption. + destruct (contg n) as [A B]. apply B. assumption. - destruct (contg n) as [A B]. - apply B. - assumption. - split. - destruct (contg n) as [A B]. - eapply included_trans. - apply Hcd0. - assumption. - apply Hcd1. -assert (W:forall (x : IR) - (Hx : Dom - (Cauchy_fun_seq_Lim a b Hab f - (fun n : nat => - included_imp_Continuous I (f n) (contf n) a b Hab Hinc) - (Hf a b Hab Hinc)) x), -Compact Hab x -> -Compact Hcd - (Cauchy_fun_seq_Lim a b Hab f - (fun n : nat => included_imp_Continuous I (f n) (contf n) a b Hab Hinc) - (Hf a b Hab Hinc) x Hx)). - intros x Hx Habx. - pose (Z:=fun i => contin_imp_inc a b Hab (f i) - (included_imp_Continuous I (f i) (contf i) a b Hab Hinc) x Hx). - simpl. - assert (HcdX := fun n => Hcd1 n x (Z n) Habx). - split;[apply leEq_seq_so_leEq_Lim|apply seq_leEq_so_Lim_leEq]; - intros i; simpl; destruct (HcdX i); assumption. -assert (Z0:Continuous_I (a:=a) (b:=b) Hab - (Cauchy_fun_seq_Lim c d Hcd g - (fun n : nat => - included_imp_Continuous J (g n) (contg n) c d Hcd Hcd0) - (Hg c d Hcd Hcd0)[o] - Cauchy_fun_seq_Lim a b Hab f - (fun n : nat => - included_imp_Continuous I (f n) (contf n) a b Hab Hinc) - (Hf a b Hab Hinc))). - apply Continuous_I_comp with c d Hcd; try apply Cauchy_cont_Lim. - split. - apply contin_imp_inc. - apply Cauchy_cont_Lim. - apply W. -assert (Z:=fun_Lim_seq_comp _ _ Hab _ _ Hcd _ _ _ _ Hcd1 (Hf _ _ Hab Hinc) (Hg _ _ Hcd Hcd0) X Z0). -eapply conv_fun_seq'_wdr;[|apply Z]. -clear Z Z0. -apply Feq_comp with (Compact Hcd). - apply W. + split. + destruct (contg n) as [A B]. + eapply included_trans. + apply Hcd0. + assumption. + apply Hcd1. + assert (W:forall (x : IR) (Hx : Dom (Cauchy_fun_seq_Lim a b Hab f (fun n : nat => + included_imp_Continuous I (f n) (contf n) a b Hab Hinc) (Hf a b Hab Hinc)) x), Compact Hab x -> + Compact Hcd (Cauchy_fun_seq_Lim a b Hab f + (fun n : nat => included_imp_Continuous I (f n) (contf n) a b Hab Hinc) + (Hf a b Hab Hinc) x Hx)). intros x Hx Habx. + pose (Z:=fun i => contin_imp_inc a b Hab (f i) + (included_imp_Continuous I (f i) (contf i) a b Hab Hinc) x Hx). simpl. - pose (Z:=fun i => (Continuous_imp_inc I (f i) (contf i) x Hx)). assert (HcdX := fun n => Hcd1 n x (Z n) Habx). split;[apply leEq_seq_so_leEq_Lim|apply seq_leEq_so_Lim_leEq]; intros i; simpl; destruct (HcdX i); assumption. + assert (Z0:Continuous_I (a:=a) (b:=b) Hab (Cauchy_fun_seq_Lim c d Hcd g (fun n : nat => + included_imp_Continuous J (g n) (contg n) c d Hcd Hcd0) (Hg c d Hcd Hcd0)[o] + Cauchy_fun_seq_Lim a b Hab f (fun n : nat => + included_imp_Continuous I (f n) (contf n) a b Hab Hinc) (Hf a b Hab Hinc))). + apply Continuous_I_comp with c d Hcd; try apply Cauchy_cont_Lim. + split. + apply contin_imp_inc. + apply Cauchy_cont_Lim. + apply W. + assert (Z:=fun_Lim_seq_comp _ _ Hab _ _ Hcd _ _ _ _ Hcd1 (Hf _ _ Hab Hinc) (Hg _ _ Hcd Hcd0) X Z0). + eapply conv_fun_seq'_wdr;[|apply Z]. + clear Z Z0. + apply Feq_comp with (Compact Hcd). + apply W. + intros x Hx Habx. + simpl. + pose (Z:=fun i => (Continuous_imp_inc I (f i) (contf i) x Hx)). + assert (HcdX := fun n => Hcd1 n x (Z n) Habx). + split;[apply leEq_seq_so_leEq_Lim|apply seq_leEq_so_Lim_leEq]; + intros i; simpl; destruct (HcdX i); assumption. + apply Feq_symmetric. + apply Cauchy_fun_seq_Lim_char. apply Feq_symmetric. apply Cauchy_fun_seq_Lim_char. -apply Feq_symmetric. -apply Cauchy_fun_seq_Lim_char. Qed. End Generalized_Intervals. @@ -948,100 +925,93 @@ Definition negative_fun P F := included P (Dom F) and Lemma positive_imp_maps_compacts_into : forall (J : interval) F, positive_fun J F -> Continuous J F -> maps_compacts_into J (openl Zero) F. -intros J F H H0 a b Hab H1. -elim H; intros incF H2. -elim H2; clear H H2 incF; intros MinF H H2. -set (MaxF := Norm_Funct (included_imp_Continuous _ _ H0 _ _ _ H1) [+]One) in *. -cut (MinF [<] MaxF). intro H3. -exists MinF; exists MaxF; exists H3. -split. -eapply included_trans. -apply compact_map2 with (Hab' := Min_leEq_Max MinF MaxF). -apply included_interval; simpl in |- *. -auto. -unfold MaxF in |- *; eapply leEq_less_trans. -2: apply less_plusOne. -apply positive_norm. -intros; split. -auto. -unfold MaxF in |- *; eapply leEq_transitive. -2: apply less_leEq; apply less_plusOne. -eapply leEq_transitive. -apply leEq_AbsIR. -apply norm_bnd_AbsIR; auto. -unfold MaxF in |- *; eapply leEq_less_trans. -2: apply less_plusOne. -apply - leEq_transitive - with (F a (Continuous_imp_inc _ _ H0 _ (H1 a (compact_inc_lft _ _ Hab)))). -apply H2; auto. -apply H1; apply compact_inc_lft. -eapply leEq_transitive. -apply leEq_AbsIR. -apply norm_bnd_AbsIR; apply compact_inc_lft. +Proof. + intros J F H H0 a b Hab H1. + elim H; intros incF H2. + elim H2; clear H H2 incF; intros MinF H H2. + set (MaxF := Norm_Funct (included_imp_Continuous _ _ H0 _ _ _ H1) [+]One) in *. + cut (MinF [<] MaxF). intro H3. + exists MinF; exists MaxF; exists H3. + split. + eapply included_trans. + apply compact_map2 with (Hab' := Min_leEq_Max MinF MaxF). + apply included_interval; simpl in |- *. + auto. + unfold MaxF in |- *; eapply leEq_less_trans. + 2: apply less_plusOne. + apply positive_norm. + intros; split. + auto. + unfold MaxF in |- *; eapply leEq_transitive. + 2: apply less_leEq; apply less_plusOne. + eapply leEq_transitive. + apply leEq_AbsIR. + apply norm_bnd_AbsIR; auto. + unfold MaxF in |- *; eapply leEq_less_trans. + 2: apply less_plusOne. + apply leEq_transitive with (F a (Continuous_imp_inc _ _ H0 _ (H1 a (compact_inc_lft _ _ Hab)))). + apply H2; auto. + apply H1; apply compact_inc_lft. + eapply leEq_transitive. + apply leEq_AbsIR. + apply norm_bnd_AbsIR; apply compact_inc_lft. Qed. Lemma negative_imp_maps_compacts_into : forall (J : interval) F, negative_fun J F -> Continuous J F -> maps_compacts_into J (openr Zero) F. -intros J F H H0 a b Hab H1. -elim H; intros incF H2. -elim H2; clear H H2 incF; intros MaxF H H2. -set - (MinF := [--] (Norm_Funct (included_imp_Continuous _ _ H0 _ _ _ H1)) [-]One) - in *. -cut (MinF [<] MaxF). intro H3. -exists MinF; exists MaxF; exists H3. -split. -eapply included_trans. -apply compact_map2 with (Hab' := Min_leEq_Max MinF MaxF). -apply included_interval; simpl in |- *. -unfold MinF in |- *; eapply less_leEq_trans. -apply minusOne_less. -astepr ( [--]ZeroR); apply inv_resp_leEq; apply positive_norm. -auto. -intros; split. -unfold MinF in |- *; eapply leEq_transitive. -apply less_leEq; apply minusOne_less. -astepr ( [--][--] (Part _ _ Hx)); apply inv_resp_leEq. -eapply leEq_transitive. -apply inv_leEq_AbsIR. -apply norm_bnd_AbsIR; auto. -auto. -unfold MinF in |- *; eapply less_leEq_trans. -apply minusOne_less. -apply - leEq_transitive - with (F a (Continuous_imp_inc _ _ H0 _ (H1 a (compact_inc_lft _ _ Hab)))). -2: apply H2; auto. -2: apply H1; apply compact_inc_lft. -astepr - ( [--] - [--] - (Part _ _ (Continuous_imp_inc _ _ H0 _ (H1 _ (compact_inc_lft _ _ Hab))))); - apply inv_resp_leEq. -eapply leEq_transitive. -apply inv_leEq_AbsIR. -apply norm_bnd_AbsIR; apply compact_inc_lft. +Proof. + intros J F H H0 a b Hab H1. + elim H; intros incF H2. + elim H2; clear H H2 incF; intros MaxF H H2. + set (MinF := [--] (Norm_Funct (included_imp_Continuous _ _ H0 _ _ _ H1)) [-]One) in *. + cut (MinF [<] MaxF). intro H3. + exists MinF; exists MaxF; exists H3. + split. + eapply included_trans. + apply compact_map2 with (Hab' := Min_leEq_Max MinF MaxF). + apply included_interval; simpl in |- *. + unfold MinF in |- *; eapply less_leEq_trans. + apply minusOne_less. + astepr ( [--]ZeroR); apply inv_resp_leEq; apply positive_norm. + auto. + intros; split. + unfold MinF in |- *; eapply leEq_transitive. + apply less_leEq; apply minusOne_less. + astepr ( [--][--] (Part _ _ Hx)); apply inv_resp_leEq. + eapply leEq_transitive. + apply inv_leEq_AbsIR. + apply norm_bnd_AbsIR; auto. + auto. + unfold MinF in |- *; eapply less_leEq_trans. + apply minusOne_less. + apply leEq_transitive with (F a (Continuous_imp_inc _ _ H0 _ (H1 a (compact_inc_lft _ _ Hab)))). + 2: apply H2; auto. + 2: apply H1; apply compact_inc_lft. + astepr ( [--] [--] (Part _ _ (Continuous_imp_inc _ _ H0 _ (H1 _ (compact_inc_lft _ _ Hab))))); + apply inv_resp_leEq. + eapply leEq_transitive. + apply inv_leEq_AbsIR. + apply norm_bnd_AbsIR; apply compact_inc_lft. Qed. Lemma Continuous_imp_maps_compacts_into : forall J F, Continuous J F -> maps_compacts_into J realline F. -intros J F H a b Hab H0. -set (ModF := Norm_Funct (included_imp_Continuous _ _ H _ _ _ H0)) in *. -cut ( [--]ModF [<] ModF[+]One). intro H1. -exists ( [--]ModF); exists (ModF[+]One); exists H1; split. -repeat split. -intros; unfold ModF in |- *; split. -astepr ( [--][--] (Part _ _ Hx)); apply inv_resp_leEq. -eapply leEq_transitive; [ apply inv_leEq_AbsIR | apply norm_bnd_AbsIR ]; auto. -eapply leEq_transitive. -2: apply less_leEq; apply less_plusOne. -eapply leEq_transitive; [ apply leEq_AbsIR | apply norm_bnd_AbsIR ]; auto. -unfold ModF in |- *. -eapply leEq_less_trans; - [ apply leEq_transitive with ZeroR | apply less_plusOne ]. -astepr ( [--]ZeroR); apply inv_resp_leEq; apply positive_norm. -apply positive_norm. +Proof. + intros J F H a b Hab H0. + set (ModF := Norm_Funct (included_imp_Continuous _ _ H _ _ _ H0)) in *. + cut ( [--]ModF [<] ModF[+]One). intro H1. + exists ( [--]ModF); exists (ModF[+]One); exists H1; split. + repeat split. + intros; unfold ModF in |- *; split. + astepr ( [--][--] (Part _ _ Hx)); apply inv_resp_leEq. + eapply leEq_transitive; [ apply inv_leEq_AbsIR | apply norm_bnd_AbsIR ]; auto. + eapply leEq_transitive. + 2: apply less_leEq; apply less_plusOne. + eapply leEq_transitive; [ apply leEq_AbsIR | apply norm_bnd_AbsIR ]; auto. + unfold ModF in |- *. + eapply leEq_less_trans; [ apply leEq_transitive with ZeroR | apply less_plusOne ]. + astepr ( [--]ZeroR); apply inv_resp_leEq; apply positive_norm. + apply positive_norm. Qed. (** @@ -1050,9 +1020,10 @@ As a corollary, we get the generalization of differentiability property. Lemma Diffble_comp : forall I J pI pJ F G, maps_compacts_into I J F -> Diffble I pI F -> Diffble J pJ G -> Diffble I pI (G[o]F). -intros I J pI pJ F G H H0 H1. -apply Derivative_imp_Diffble with ((Deriv _ _ _ H1[o]F) {*}Deriv _ _ _ H0). -apply Derivative_comp with J pJ; auto; apply Deriv_lemma. +Proof. + intros I J pI pJ F G H H0 H1. + apply Derivative_imp_Diffble with ((Deriv _ _ _ H1[o]F) {*}Deriv _ _ _ H0). + apply Derivative_comp with J pJ; auto; apply Deriv_lemma. Qed. End Corollaries. diff --git a/ftc/Continuity.v b/ftc/Continuity.v index 8c5b21ee3..df72ae080 100644 --- a/ftc/Continuity.v +++ b/ftc/Continuity.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Norm_Funct %\ensuremath{\|\cdot\|}% *) @@ -86,12 +86,14 @@ For convenience, we distinguish the two properties of continuous functions. *) Lemma contin_imp_inc : Continuous_I -> included (Compact Hab) P. -intro H; elim H; intros; assumption. +Proof. + intro H; elim H; intros; assumption. Qed. Lemma contin_prop : Continuous_I -> forall e, Zero [<] e -> {d : IR | Zero [<] d | forall x y, I x -> I y -> forall Hx Hy, AbsIR (x[-]y) [<=] d -> AbsIR (F x Hx[-]F y Hy) [<=] e}. -intro H; elim H; do 2 intro; assumption. +Proof. + intro H; elim H; do 2 intro; assumption. Qed. (** @@ -105,71 +107,74 @@ Let Hinc' := contin_imp_inc contF. (* end hide *) Lemma Continuous_I_imp_tb_image : totally_bounded (fun_image F I). -assert (H := compact_is_totally_bounded a b Hab). -elim contF; intros H0 H1. -split. -elim H; clear H; intros H2 H3. -elim H2; clear H2; intros x H. -exists (Part F x (H0 _ H)). -exists x; split. -auto. -split. -apply H0; auto. -algebra. -intros e H2. -elim (H1 _ H2). -intros d H3 H4. -clear H1. -elim H; clear H. -intros non_empty H. -elim H with d; clear H. -intros l Hl' Hl. -2: assumption. -exists (map2 F l (fun (x : IR) (Hx : member x l) => H0 x (Hl' x Hx))). -intros x H. -clear Hl; induction l as [| a0 l Hrecl]. -elimtype CFalse; assumption. -simpl in H; elim H; clear H; intro H1. -cut (forall x : IR, member x l -> compact a b Hab x). -intro H. -apply Hrecl with H. -eapply map2_wd. -apply H1. -intros x0 H. -apply Hl'; left; assumption. -exists a0. -split. -apply Hl'; right; algebra. -split. -apply H0; apply Hl'; right; algebra. -intro; eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply H1. -algebra. -intros x H; simpl in |- *. -elim H; intros x0 H1. -elim H1; clear H1; intros Hy' H1. -elim H1; intros Hy'' Hy. -elim (Hl x0 Hy'); intros x1 Hx1 H5. -exists (F x1 (H0 x1 (Hl' x1 Hx1))). -apply map2_pres_member; assumption. -astepr (F x0 Hy''[-]F x1 (H0 x1 (Hl' x1 Hx1))). -apply AbsIR_imp_AbsSmall. -apply H4. -assumption. -apply Hl'; assumption. -apply AbsSmall_imp_AbsIR; assumption. +Proof. + assert (H := compact_is_totally_bounded a b Hab). + elim contF; intros H0 H1. + split. + elim H; clear H; intros H2 H3. + elim H2; clear H2; intros x H. + exists (Part F x (H0 _ H)). + exists x; split. + auto. + split. + apply H0; auto. + algebra. + intros e H2. + elim (H1 _ H2). + intros d H3 H4. + clear H1. + elim H; clear H. + intros non_empty H. + elim H with d; clear H. + intros l Hl' Hl. + 2: assumption. + exists (map2 F l (fun (x : IR) (Hx : member x l) => H0 x (Hl' x Hx))). + intros x H. + clear Hl; induction l as [| a0 l Hrecl]. + elimtype CFalse; assumption. + simpl in H; elim H; clear H; intro H1. + cut (forall x : IR, member x l -> compact a b Hab x). + intro H. + apply Hrecl with H. + eapply map2_wd. + apply H1. + intros x0 H. + apply Hl'; left; assumption. + exists a0. + split. + apply Hl'; right; algebra. + split. + apply H0; apply Hl'; right; algebra. + intro; eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply H1. + algebra. + intros x H; simpl in |- *. + elim H; intros x0 H1. + elim H1; clear H1; intros Hy' H1. + elim H1; intros Hy'' Hy. + elim (Hl x0 Hy'); intros x1 Hx1 H5. + exists (F x1 (H0 x1 (Hl' x1 Hx1))). + apply map2_pres_member; assumption. + astepr (F x0 Hy''[-]F x1 (H0 x1 (Hl' x1 Hx1))). + apply AbsIR_imp_AbsSmall. + apply H4. + assumption. + apply Hl'; assumption. + apply AbsSmall_imp_AbsIR; assumption. Qed. Lemma Continuous_I_imp_lub : {x : IR | fun_lub_IR F I x}. -unfold fun_lub_IR in |- *. -apply totally_bounded_has_lub. -apply Continuous_I_imp_tb_image. +Proof. + unfold fun_lub_IR in |- *. + apply totally_bounded_has_lub. + apply Continuous_I_imp_tb_image. Qed. Lemma Continuous_I_imp_glb : {x : IR | fun_glb_IR F I x}. -unfold fun_glb_IR in |- *. -apply totally_bounded_has_glb. -apply Continuous_I_imp_tb_image. +Proof. + unfold fun_glb_IR in |- *. + apply totally_bounded_has_glb. + apply Continuous_I_imp_tb_image. Qed. (** @@ -184,29 +189,33 @@ These operators have the expected properties. *) Lemma lub_is_lub : fun_lub_IR F I lub_funct. -exact (ProjT2 Continuous_I_imp_lub). +Proof. + exact (ProjT2 Continuous_I_imp_lub). Qed. Lemma glb_is_glb : fun_glb_IR F I glb_funct. -exact (ProjT2 Continuous_I_imp_glb). +Proof. + exact (ProjT2 Continuous_I_imp_glb). Qed. Lemma glb_prop : forall x : IR, I x -> forall Hx, glb_funct [<=] F x Hx. -intros. -elim glb_is_glb. -intros. -apply a0. -exists x. -split; algebra. +Proof. + intros. + elim glb_is_glb. + intros. + apply a0. + exists x. + split; algebra. Qed. Lemma lub_prop : forall x : IR, I x -> forall Hx, F x Hx [<=] lub_funct. -intros. -elim lub_is_lub. -intros. -apply a0. -exists x. -split; algebra. +Proof. + intros. + elim lub_is_lub. + intros. + apply a0. + exists x. + split; algebra. Qed. (** @@ -220,19 +229,19 @@ The norm effectively bounds the absolute value of a function. *) Lemma norm_bnd_AbsIR : forall x, I x -> forall Hx, AbsIR (F x Hx) [<=] Norm_Funct. -intros. -generalize lub_is_lub. -generalize glb_is_glb. -intros; simpl in |- *; unfold ABSIR in |- *. -apply Max_leEq. -apply leEq_transitive with lub_funct. -apply lub_prop; auto. -unfold Norm_Funct in |- *; apply lft_leEq_Max. - -apply leEq_transitive with ( [--]glb_funct). -apply inv_resp_leEq. -apply glb_prop; auto. -unfold Norm_Funct in |- *; apply rht_leEq_Max. +Proof. + intros. + generalize lub_is_lub. + generalize glb_is_glb. + intros; simpl in |- *; unfold ABSIR in |- *. + apply Max_leEq. + apply leEq_transitive with lub_funct. + apply lub_prop; auto. + unfold Norm_Funct in |- *; apply lft_leEq_Max. + apply leEq_transitive with ( [--]glb_funct). + apply inv_resp_leEq. + apply glb_prop; auto. + unfold Norm_Funct in |- *; apply rht_leEq_Max. Qed. (** @@ -240,8 +249,9 @@ The following is another way of characterizing the norm: *) Lemma Continuous_I_imp_abs_lub : {z : IR | forall x, I x -> forall Hx, AbsIR (F x Hx) [<=] z}. -exists Norm_Funct. -exact norm_bnd_AbsIR. +Proof. + exists Norm_Funct. + exact norm_bnd_AbsIR. Qed. (** @@ -249,102 +259,103 @@ We now prove some basic properties of the norm---namely that it is positive, and *) Lemma positive_norm : Zero [<=] Norm_Funct. -apply leEq_transitive with (AbsIR (FRestr Hinc' a (compact_inc_lft _ _ _))). -apply AbsIR_nonneg. -simpl in |- *; apply norm_bnd_AbsIR; unfold I in |- *; apply compact_inc_lft. +Proof. + apply leEq_transitive with (AbsIR (FRestr Hinc' a (compact_inc_lft _ _ _))). + apply AbsIR_nonneg. + simpl in |- *; apply norm_bnd_AbsIR; unfold I in |- *; apply compact_inc_lft. Qed. Lemma norm_fun_lub : forall e, Zero [<] e -> {x : IR | I x and (forall Hx, Norm_Funct[-]e [<] AbsIR (F x Hx))}. -intros e H. -cut {x : IR | I x and (forall Hx' : P x, Norm_Funct [<] AbsIR (F x Hx') [+]e)}. -intro H0. -elim H0; intros y Hy. -elim Hy; clear H0 Hy; intros Hy Hy'. -exists y; split. -auto. -intro; apply shift_minus_less; apply Hy'. -generalize lub_is_lub. -generalize glb_is_glb. -intros H0 H1. -cut {x : IR | I x and (forall Hx' : P x, F x Hx' [<] glb_funct[+]e [/]TwoNZ)}. -cut {x : IR | I x and (forall Hx' : P x, lub_funct[-]e [/]TwoNZ [<] F x Hx')}. -intros H2 H3. -elim H2; intros x Hx. -elim Hx; clear H2 Hx; intros Hx Hx0. -elim H3; intros x' Hx'. -elim Hx'; clear H3 Hx'; intros Hx' Hx'0. -elim - (less_cotransitive_unfolded _ _ _ (pos_div_two _ _ H) ( [--]glb_funct[-]lub_funct)); - intro H2. -exists x'; split. -auto. -unfold Norm_Funct in |- *. -intro; eapply less_wdl. -2: apply eq_symmetric_unfolded; apply leEq_imp_Max_is_rht. -apply shift_less_plus. -rstepl ( [--] (glb_funct[+]e)). -eapply less_leEq_trans. -2: apply inv_leEq_AbsIR. -apply inv_resp_less. -eapply less_transitive_unfolded. -apply Hx'0 with (Hx' := Hx'1). -apply plus_resp_less_lft. -apply pos_div_two'; assumption. -astepl (Zero[+]lub_funct); apply less_leEq; apply shift_plus_less. -assumption. -exists x; split. -auto. -unfold Norm_Funct in |- *. -intro; apply less_leEq_trans with (lub_funct[+]e [/]TwoNZ). -apply Max_less. -apply shift_less_plus'; astepl ZeroR. -apply pos_div_two; assumption. -apply shift_less_plus'; assumption. -apply shift_leEq_plus. -rstepl (lub_funct[-]e [/]TwoNZ). -eapply leEq_transitive. -apply less_leEq; apply Hx0 with (Hx' := Hx'1). -apply leEq_AbsIR. -elim H1; clear H1; intros H2 H3. -elim (H3 _ (pos_div_two _ _ H)). -intros x Hx; elim Hx; clear Hx; intros y Hx'; elim Hx'; clear Hx'; - intros Hx' Hx''; elim Hx''; clear Hx''; intros Hx'' Hx'''. -exists y; split. -auto. -intro; apply shift_minus_less; apply shift_less_plus'. -eapply less_wdl; [ apply q | algebra ]. -elim H0; clear H0; intros H2 H3. -elim (H3 _ (pos_div_two _ _ H)). -intros x Hx; elim Hx; clear Hx; intros y Hx'; elim Hx'; clear Hx'; - intros Hx' Hx''; elim Hx''; clear Hx''; intros Hx'' Hx'''. -exists y; split. -auto. -intro; apply shift_less_plus'. -eapply less_wdl; [ apply q | algebra ]. +Proof. + intros e H. + cut {x : IR | I x and (forall Hx' : P x, Norm_Funct [<] AbsIR (F x Hx') [+]e)}. + intro H0. + elim H0; intros y Hy. + elim Hy; clear H0 Hy; intros Hy Hy'. + exists y; split. + auto. + intro; apply shift_minus_less; apply Hy'. + generalize lub_is_lub. + generalize glb_is_glb. + intros H0 H1. + cut {x : IR | I x and (forall Hx' : P x, F x Hx' [<] glb_funct[+]e [/]TwoNZ)}. + cut {x : IR | I x and (forall Hx' : P x, lub_funct[-]e [/]TwoNZ [<] F x Hx')}. + intros H2 H3. + elim H2; intros x Hx. + elim Hx; clear H2 Hx; intros Hx Hx0. + elim H3; intros x' Hx'. + elim Hx'; clear H3 Hx'; intros Hx' Hx'0. + elim (less_cotransitive_unfolded _ _ _ (pos_div_two _ _ H) ( [--]glb_funct[-]lub_funct)); intro H2. + exists x'; split. + auto. + unfold Norm_Funct in |- *. + intro; eapply less_wdl. + 2: apply eq_symmetric_unfolded; apply leEq_imp_Max_is_rht. + apply shift_less_plus. + rstepl ( [--] (glb_funct[+]e)). + eapply less_leEq_trans. + 2: apply inv_leEq_AbsIR. + apply inv_resp_less. + eapply less_transitive_unfolded. + apply Hx'0 with (Hx' := Hx'1). + apply plus_resp_less_lft. + apply pos_div_two'; assumption. + astepl (Zero[+]lub_funct); apply less_leEq; apply shift_plus_less. + assumption. + exists x; split. + auto. + unfold Norm_Funct in |- *. + intro; apply less_leEq_trans with (lub_funct[+]e [/]TwoNZ). + apply Max_less. + apply shift_less_plus'; astepl ZeroR. + apply pos_div_two; assumption. + apply shift_less_plus'; assumption. + apply shift_leEq_plus. + rstepl (lub_funct[-]e [/]TwoNZ). + eapply leEq_transitive. + apply less_leEq; apply Hx0 with (Hx' := Hx'1). + apply leEq_AbsIR. + elim H1; clear H1; intros H2 H3. + elim (H3 _ (pos_div_two _ _ H)). + intros x Hx; elim Hx; clear Hx; intros y Hx'; elim Hx'; clear Hx'; + intros Hx' Hx''; elim Hx''; clear Hx''; intros Hx'' Hx'''. + exists y; split. + auto. + intro; apply shift_minus_less; apply shift_less_plus'. + eapply less_wdl; [ apply q | algebra ]. + elim H0; clear H0; intros H2 H3. + elim (H3 _ (pos_div_two _ _ H)). + intros x Hx; elim Hx; clear Hx; intros y Hx'; elim Hx'; clear Hx'; + intros Hx' Hx''; elim Hx''; clear Hx''; intros Hx'' Hx'''. + exists y; split. + auto. + intro; apply shift_less_plus'. + eapply less_wdl; [ apply q | algebra ]. Qed. Lemma leEq_Norm_Funct : forall e, (forall x, I x -> forall Hx, AbsIR (F x Hx) [<=] e) -> Norm_Funct [<=] e. -intros e H. -astepr (Zero[+]e); apply shift_leEq_plus. -apply approach_zero_weak. -intros d Hd. -apply shift_minus_leEq. -elim (norm_fun_lub d Hd); intros x Hx. -elim Hx; clear Hx; intros Hx Hx'. -apply plus_cancel_leEq_rht with ( [--] (AbsIR (F x (Hinc' x Hx)))). -astepl (Norm_Funct[-]AbsIR (F x (Hinc' x Hx))). -apply less_leEq; apply less_leEq_trans with d. -apply shift_minus_less; apply shift_less_plus'; apply Hx'. -rstepr (d[+] (e[-]AbsIR (F x (Hinc' x Hx)))). -astepl (d[+]Zero); apply plus_resp_leEq_lft. -apply shift_leEq_minus; astepl (AbsIR (F x (Hinc' x Hx))); apply H; - assumption. +Proof. + intros e H. + astepr (Zero[+]e); apply shift_leEq_plus. + apply approach_zero_weak. + intros d Hd. + apply shift_minus_leEq. + elim (norm_fun_lub d Hd); intros x Hx. + elim Hx; clear Hx; intros Hx Hx'. + apply plus_cancel_leEq_rht with ( [--] (AbsIR (F x (Hinc' x Hx)))). + astepl (Norm_Funct[-]AbsIR (F x (Hinc' x Hx))). + apply less_leEq; apply less_leEq_trans with d. + apply shift_minus_less; apply shift_less_plus'; apply Hx'. + rstepr (d[+] (e[-]AbsIR (F x (Hinc' x Hx)))). + astepl (d[+]Zero); apply plus_resp_leEq_lft. + apply shift_leEq_minus; astepl (AbsIR (F x (Hinc' x Hx))); apply H; assumption. Qed. Lemma less_Norm_Funct : forall e, (forall x, I x -> forall Hx, AbsIR (F x Hx) [<] e) -> Norm_Funct [<=] e. -intros x H. -apply leEq_Norm_Funct. -intros; apply less_leEq; apply H; assumption. +Proof. + intros x H. + apply leEq_Norm_Funct. + intros; apply less_leEq; apply H; assumption. Qed. End Definitions_and_Basic_Results. @@ -383,55 +394,58 @@ The first result does not require the function to be continuous; however, its pr Lemma cont_no_sign_change : forall e, Zero [<] e -> forall x y, I x -> I y -> forall Hx Hy, AbsIR (F x Hx[-]F y Hy) [<=] e -> e [<] AbsIR (F x Hx) -> (Zero [<] F x Hx -> Zero [<] F y Hy) and (F x Hx [<] Zero -> F y Hy [<] Zero). -intros e H x y H0 H1 Hx Hy H2 H3. -set (fx := F x Hx) in *. -set (fy := F y Hy) in *. -split; intro H4. -cut (e [<] fx). -intro H5. -astepl (e[-]e). -apply shift_minus_less; apply shift_less_plus'. -apply less_leEq_trans with (fx[-]fy). -apply minus_resp_less; assumption. -eapply leEq_transitive; [ apply leEq_AbsIR | assumption ]. -elim (less_AbsIR _ _ H H3); intro H6. -assumption. -elimtype False. -cut (Zero [<] [--]e). -intro; cut (e [<] Zero). -exact (less_antisymmetric_unfolded _ _ _ H). -astepl ( [--][--]e); astepr ( [--]ZeroR); apply inv_resp_less; assumption. -apply less_transitive_unfolded with fx; assumption. -astepr (e[-]e). -apply shift_less_minus. -apply less_leEq_trans with (fy[-]fx). -2: eapply leEq_transitive. -3: apply H2. -2: eapply leEq_wdr; [ apply leEq_AbsIR | apply AbsIR_minus ]. -unfold cg_minus in |- *; apply plus_resp_less_lft. -elim (less_AbsIR _ _ H H3); intro H6. -apply less_transitive_unfolded with ZeroR. -apply less_transitive_unfolded with fx; assumption. -astepl ( [--]ZeroR); apply inv_resp_less; assumption. -astepl ( [--][--]e); apply inv_resp_less; assumption. +Proof. + intros e H x y H0 H1 Hx Hy H2 H3. + set (fx := F x Hx) in *. + set (fy := F y Hy) in *. + split; intro H4. + cut (e [<] fx). + intro H5. + astepl (e[-]e). + apply shift_minus_less; apply shift_less_plus'. + apply less_leEq_trans with (fx[-]fy). + apply minus_resp_less; assumption. + eapply leEq_transitive; [ apply leEq_AbsIR | assumption ]. + elim (less_AbsIR _ _ H H3); intro H6. + assumption. + elimtype False. + cut (Zero [<] [--]e). + intro; cut (e [<] Zero). + exact (less_antisymmetric_unfolded _ _ _ H). + astepl ( [--][--]e); astepr ( [--]ZeroR); apply inv_resp_less; assumption. + apply less_transitive_unfolded with fx; assumption. + astepr (e[-]e). + apply shift_less_minus. + apply less_leEq_trans with (fy[-]fx). + 2: eapply leEq_transitive. + 3: apply H2. + 2: eapply leEq_wdr; [ apply leEq_AbsIR | apply AbsIR_minus ]. + unfold cg_minus in |- *; apply plus_resp_less_lft. + elim (less_AbsIR _ _ H H3); intro H6. + apply less_transitive_unfolded with ZeroR. + apply less_transitive_unfolded with fx; assumption. + astepl ( [--]ZeroR); apply inv_resp_less; assumption. + astepl ( [--][--]e); apply inv_resp_less; assumption. Qed. Lemma cont_no_sign_change_pos : forall e, Zero [<] e -> forall x y, I x -> I y -> forall Hx Hy, AbsIR (F x Hx[-]F y Hy) [<=] e -> e [<] AbsIR (F x Hx) -> e [<] F x Hx -> Zero [<] F y Hy. -intros e H x y H0 H1 Hx Hy H2 H3 H4. -elim (cont_no_sign_change e H x y H0 H1 Hx Hy H2 H3); intros H5 H6. -apply H5. -apply less_transitive_unfolded with e; auto. +Proof. + intros e H x y H0 H1 Hx Hy H2 H3 H4. + elim (cont_no_sign_change e H x y H0 H1 Hx Hy H2 H3); intros H5 H6. + apply H5. + apply less_transitive_unfolded with e; auto. Qed. Lemma cont_no_sign_change_neg : forall e, Zero [<] e -> forall x y, I x -> I y -> forall Hx Hy, AbsIR (F x Hx[-]F y Hy) [<=] e -> e [<] AbsIR (F x Hx) -> F x Hx [<] [--]e -> F y Hy [<] Zero. -intros e H x y H0 H1 Hx Hy H2 H3 H4. -elim (cont_no_sign_change e H x y H0 H1 Hx Hy H2 H3); intros H5 H6. -apply H6. -apply less_transitive_unfolded with ( [--]e). -assumption. -astepr ( [--]ZeroR); apply inv_resp_less; assumption. +Proof. + intros e H x y H0 H1 Hx Hy H2 H3 H4. + elim (cont_no_sign_change e H x y H0 H1 Hx Hy H2 H3); intros H5 H6. + apply H6. + apply less_transitive_unfolded with ( [--]e). + assumption. + astepr ( [--]ZeroR); apply inv_resp_less; assumption. Qed. (** @@ -439,21 +453,22 @@ Being continuous is an extensional property. *) Lemma Continuous_I_wd : Feq I F G -> Continuous_I Hab F -> Continuous_I Hab G. -intros H H0. -elim H0; clear H0; intros Hinc H0. -elim H; clear H; intros incF' H'. -elim H'; clear H'; intros incG' H. -split. -apply incG'. -intros e He; elim (H0 e He); clear H0; intros d H0 H1. -exists d. -assumption. -intros x y H2 H3 Hx Hy H4. -apply leEq_wdl with (AbsIR (F x (incF' x H2) [-]F y (incF' y H3))). -apply H1; assumption. -simpl in H. -apply AbsIR_wd. -apply cg_minus_wd; apply H; assumption. +Proof. + intros H H0. + elim H0; clear H0; intros Hinc H0. + elim H; clear H; intros incF' H'. + elim H'; clear H'; intros incG' H. + split. + apply incG'. + intros e He; elim (H0 e He); clear H0; intros d H0 H1. + exists d. + assumption. + intros x y H2 H3 Hx Hy H4. + apply leEq_wdl with (AbsIR (F x (incF' x H2) [-]F y (incF' y H3))). + apply H1; assumption. + simpl in H. + apply AbsIR_wd. + apply cg_minus_wd; apply H; assumption. Qed. (** @@ -462,17 +477,18 @@ A continuous function remains continuous if you restrict its domain. Lemma included_imp_contin : forall c d Hcd, included (compact c d Hcd) (Compact Hab) -> Continuous_I Hab F -> Continuous_I Hcd F. -intros c d Hcd H H0. -elim H0; clear H0; intros incF' contF. -split. -apply included_trans with (Compact Hab); [ apply H | apply incF' ]. -intros e He; elim (contF e He); intros e' H0 H1. -exists e'. -assumption. -intros; apply H1. -apply H; assumption. -apply H; assumption. -assumption. +Proof. + intros c d Hcd H H0. + elim H0; clear H0; intros incF' contF. + split. + apply included_trans with (Compact Hab); [ apply H | apply incF' ]. + intros e He; elim (contF e He); intros e' H0 H1. + exists e'. + assumption. + intros; apply H1. + apply H; assumption. + apply H; assumption. + assumption. Qed. (** @@ -480,23 +496,25 @@ Constant functions and identity are continuous. *) Lemma Continuous_I_const : forall c : IR, Continuous_I Hab [-C-]c. -intro. -split. -Included. -intros; exists OneR. -apply pos_one. -intros. -apply leEq_wdl with (AbsIR Zero). -astepl ZeroR; apply less_leEq; assumption. -algebra. +Proof. + intro. + split. + Included. + intros; exists OneR. + apply pos_one. + intros. + apply leEq_wdl with (AbsIR Zero). + astepl ZeroR; apply less_leEq; assumption. + algebra. Qed. Lemma Continuous_I_id : Continuous_I Hab FId. -split. -Included. -intros; exists e. -assumption. -intros; assumption. +Proof. + split. + Included. + intros; exists e. + assumption. + intros; assumption. Qed. (** @@ -507,195 +525,181 @@ Hypothesis contF : Continuous_I Hab F. Hypothesis contG : Continuous_I Hab G. Lemma Continuous_I_plus : Continuous_I Hab (F{+}G). -clear incF incG. -elim contF; intros incF' contF'. -elim contG; intros incG' contG'. -split. -Included. -intros. -elim (contF' (e [/]TwoNZ)). -elim (contG' (e [/]TwoNZ)). -clear contF contG contF' contG'. -2: apply pos_div_two; assumption. -2: apply pos_div_two; assumption. -intros df H0 H1 dg H2 H3. -exists (Min df dg). -apply less_Min; assumption. -intros. -simpl in |- *. -apply - leEq_wdl - with - (AbsIR - (F x (ProjIR1 Hx) [-]F y (ProjIR1 Hy) [+] - (G x (ProjIR2 Hx) [-]G y (ProjIR2 Hy)))). -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -simpl in |- *; apply H3; try assumption. -apply leEq_transitive with (Min df dg); [ assumption | apply Min_leEq_rht ]. -simpl in |- *; apply H1; try assumption. -apply leEq_transitive with (Min df dg); [ assumption | apply Min_leEq_lft ]. -apply AbsIR_wd; rational. +Proof. + clear incF incG. + elim contF; intros incF' contF'. + elim contG; intros incG' contG'. + split. + Included. + intros. + elim (contF' (e [/]TwoNZ)). + elim (contG' (e [/]TwoNZ)). + clear contF contG contF' contG'. + 2: apply pos_div_two; assumption. + 2: apply pos_div_two; assumption. + intros df H0 H1 dg H2 H3. + exists (Min df dg). + apply less_Min; assumption. + intros. + simpl in |- *. + apply leEq_wdl with (AbsIR (F x (ProjIR1 Hx) [-]F y (ProjIR1 Hy) [+] + (G x (ProjIR2 Hx) [-]G y (ProjIR2 Hy)))). + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + simpl in |- *; apply H3; try assumption. + apply leEq_transitive with (Min df dg); [ assumption | apply Min_leEq_rht ]. + simpl in |- *; apply H1; try assumption. + apply leEq_transitive with (Min df dg); [ assumption | apply Min_leEq_lft ]. + apply AbsIR_wd; rational. Qed. Lemma Continuous_I_inv : Continuous_I Hab {--}F. -clear incF. -elim contF; intros incF' contF'. -split. -Included. -intros e H. -elim (contF' e H). -intros d H0 H1. -exists d. -assumption. -intros; simpl in |- *. -apply leEq_wdl with (AbsIR (F x Hx[-]F y Hy)). -apply H1; assumption. -eapply eq_transitive_unfolded. -apply AbsIR_inv. -apply AbsIR_wd; rational. +Proof. + clear incF. + elim contF; intros incF' contF'. + split. + Included. + intros e H. + elim (contF' e H). + intros d H0 H1. + exists d. + assumption. + intros; simpl in |- *. + apply leEq_wdl with (AbsIR (F x Hx[-]F y Hy)). + apply H1; assumption. + eapply eq_transitive_unfolded. + apply AbsIR_inv. + apply AbsIR_wd; rational. Qed. Lemma Continuous_I_mult : Continuous_I Hab (F{*}G). -clear incF incG. -elim contF; intros incF' contF'. -elim contG; intros incG' contG'. -split; [ Included | intros e H ]. -cut {xf : IR | forall (x : IR) (Hx : I x) (Hx' : P x), AbsIR (F x Hx') [<=] xf}. -cut {xg : IR | forall (x : IR) (Hx : I x) (Hx' : Q x), AbsIR (G x Hx') [<=] xg}. -2: unfold I, Q in |- *; apply Continuous_I_imp_abs_lub; assumption. -2: unfold I, P in |- *; apply Continuous_I_imp_abs_lub; assumption. -intros H0 H1. -elim H0; clear H0; intros x H2. -elim H1; clear H1; intros x0 H0. -elim (contF' (e [/]TwoNZ[/] Max x One[//]max_one_ap_zero _)); clear contF. -elim (contG' (e [/]TwoNZ[/] Max x0 One[//]max_one_ap_zero _)); clear contG. -intros dg H1 H3 df H4 H5. -2: apply div_resp_pos. -2: apply pos_max_one. -2: apply pos_div_two; assumption. -2: apply div_resp_pos. -2: apply pos_max_one. -2: apply pos_div_two; assumption. -exists (Min df dg). -apply less_Min; assumption. -intros; simpl in |- *. -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -apply - leEq_wdl - with - (AbsIR - (F x1 (ProjIR1 Hx) [*] (G x1 (ProjIR2 Hx) [-]G y (ProjIR2 Hy)) [+] - (F x1 (ProjIR1 Hx) [-]F y (ProjIR1 Hy)) [*]G y (ProjIR2 Hy))). -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply - leEq_transitive with (x0[*]AbsIR (G x1 (ProjIR2 Hx) [-]G y (ProjIR2 Hy))). -apply mult_resp_leEq_rht. -apply H0; assumption. -apply AbsIR_nonneg. -apply - leEq_transitive - with (Max x0 One[*]AbsIR (G x1 (ProjIR2 Hx) [-]G y (ProjIR2 Hy))). -apply mult_resp_leEq_rht; [ apply lft_leEq_Max | apply AbsIR_nonneg ]. -astepl (AbsIR (G x1 (ProjIR2 Hx) [-]G y (ProjIR2 Hy)) [*]Max x0 One). -apply shift_mult_leEq with (max_one_ap_zero x0); - [ apply pos_max_one | simpl in |- *; apply H3 ]; try assumption. -apply leEq_transitive with (Min df dg); [ assumption | apply Min_leEq_rht ]. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply leEq_transitive with (AbsIR (F x1 (ProjIR1 Hx) [-]F y (ProjIR1 Hy)) [*]x). -apply mult_resp_leEq_lft; [ apply H2 | apply AbsIR_nonneg ]; assumption. -apply - leEq_transitive - with (AbsIR (F x1 (ProjIR1 Hx) [-]F y (ProjIR1 Hy)) [*]Max x One). -apply mult_resp_leEq_lft; - [ apply lft_leEq_Max with (y := OneR) | apply AbsIR_nonneg ]. -apply shift_mult_leEq with (max_one_ap_zero x); - [ apply pos_max_one | simpl in |- *; apply H5 ]; try assumption. -apply leEq_transitive with (Min df dg); [ assumption | apply Min_leEq_lft ]. -apply AbsIR_wd; rational. +Proof. + clear incF incG. + elim contF; intros incF' contF'. + elim contG; intros incG' contG'. + split; [ Included | intros e H ]. + cut {xf : IR | forall (x : IR) (Hx : I x) (Hx' : P x), AbsIR (F x Hx') [<=] xf}. + cut {xg : IR | forall (x : IR) (Hx : I x) (Hx' : Q x), AbsIR (G x Hx') [<=] xg}. + 2: unfold I, Q in |- *; apply Continuous_I_imp_abs_lub; assumption. + 2: unfold I, P in |- *; apply Continuous_I_imp_abs_lub; assumption. + intros H0 H1. + elim H0; clear H0; intros x H2. + elim H1; clear H1; intros x0 H0. + elim (contF' (e [/]TwoNZ[/] Max x One[//]max_one_ap_zero _)); clear contF. + elim (contG' (e [/]TwoNZ[/] Max x0 One[//]max_one_ap_zero _)); clear contG. + intros dg H1 H3 df H4 H5. + 2: apply div_resp_pos. + 2: apply pos_max_one. + 2: apply pos_div_two; assumption. + 2: apply div_resp_pos. + 2: apply pos_max_one. + 2: apply pos_div_two; assumption. + exists (Min df dg). + apply less_Min; assumption. + intros; simpl in |- *. + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + apply leEq_wdl with (AbsIR (F x1 (ProjIR1 Hx) [*] (G x1 (ProjIR2 Hx) [-]G y (ProjIR2 Hy)) [+] + (F x1 (ProjIR1 Hx) [-]F y (ProjIR1 Hy)) [*]G y (ProjIR2 Hy))). + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_transitive with (x0[*]AbsIR (G x1 (ProjIR2 Hx) [-]G y (ProjIR2 Hy))). + apply mult_resp_leEq_rht. + apply H0; assumption. + apply AbsIR_nonneg. + apply leEq_transitive with (Max x0 One[*]AbsIR (G x1 (ProjIR2 Hx) [-]G y (ProjIR2 Hy))). + apply mult_resp_leEq_rht; [ apply lft_leEq_Max | apply AbsIR_nonneg ]. + astepl (AbsIR (G x1 (ProjIR2 Hx) [-]G y (ProjIR2 Hy)) [*]Max x0 One). + apply shift_mult_leEq with (max_one_ap_zero x0); + [ apply pos_max_one | simpl in |- *; apply H3 ]; try assumption. + apply leEq_transitive with (Min df dg); [ assumption | apply Min_leEq_rht ]. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_transitive with (AbsIR (F x1 (ProjIR1 Hx) [-]F y (ProjIR1 Hy)) [*]x). + apply mult_resp_leEq_lft; [ apply H2 | apply AbsIR_nonneg ]; assumption. + apply leEq_transitive with (AbsIR (F x1 (ProjIR1 Hx) [-]F y (ProjIR1 Hy)) [*]Max x One). + apply mult_resp_leEq_lft; [ apply lft_leEq_Max with (y := OneR) | apply AbsIR_nonneg ]. + apply shift_mult_leEq with (max_one_ap_zero x); + [ apply pos_max_one | simpl in |- *; apply H5 ]; try assumption. + apply leEq_transitive with (Min df dg); [ assumption | apply Min_leEq_lft ]. + apply AbsIR_wd; rational. Qed. Lemma Continuous_I_max : Continuous_I Hab (FMax F G). -clear incF incG. -elim contF; intros incF contF'. -elim contG; intros incG contG'. -split. - Included. -intros e He. -elim (contF' (e [/]TwoNZ) (pos_div_two _ _ He)); intros dF dFpos HdF. -elim (contG' (e [/]TwoNZ) (pos_div_two _ _ He)); intros dG dGpos HdG. -clear contF contG contF' contG'. -exists (Min dF dG). - apply less_Min; auto. -intros x y Hx' Hy' Hx Hy Hxy. -assert (AbsIR (x[-]y) [<=] dF). - eapply leEq_transitive; [ apply Hxy | apply Min_leEq_lft ]. -assert (AbsIR (x[-]y) [<=] dG). - eapply leEq_transitive; [ apply Hxy | apply Min_leEq_rht ]. -assert (HF := HdF x y Hx' Hy' (ProjIR1 Hx) (ProjIR1 Hy) H). -assert (HG := HdG x y Hx' Hy' (ProjIR2 Hx) (ProjIR2 Hy) H0). -Opaque AbsIR Max. -simpl in |- *. -Transparent AbsIR Max. -set (Fx := F x (ProjIR1 Hx)) in *. -set (Fy := F y (ProjIR1 Hy)) in *. -set (Gx := G x (ProjIR2 Hx)) in *. -set (Gy := G y (ProjIR2 Hy)) in *. -elim (AbsIR_imp_AbsSmall _ _ HF); intros HF1 HF2. -elim (AbsIR_imp_AbsSmall _ _ HG); intros HG1 HG2. -apply leEq_wdl with (AbsIR (Max Fx Gx[-]Max Fx Gy[+] (Max Fx Gy[-]Max Fy Gy))). - 2: apply AbsIR_wd; rational. -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -eapply leEq_transitive. - apply triangle_IR. -apply plus_resp_leEq_both; apply AbsSmall_imp_AbsIR; split. - apply shift_zero_leEq_minus'. - rstepr (e [/]TwoNZ[+]Max Fx Gx[-]Max Fx Gy). - apply shift_zero_leEq_minus. - apply Max_leEq. +Proof. + clear incF incG. + elim contF; intros incF contF'. + elim contG; intros incG contG'. + split. + Included. + intros e He. + elim (contF' (e [/]TwoNZ) (pos_div_two _ _ He)); intros dF dFpos HdF. + elim (contG' (e [/]TwoNZ) (pos_div_two _ _ He)); intros dG dGpos HdG. + clear contF contG contF' contG'. + exists (Min dF dG). + apply less_Min; auto. + intros x y Hx' Hy' Hx Hy Hxy. + assert (AbsIR (x[-]y) [<=] dF). + eapply leEq_transitive; [ apply Hxy | apply Min_leEq_lft ]. + assert (AbsIR (x[-]y) [<=] dG). + eapply leEq_transitive; [ apply Hxy | apply Min_leEq_rht ]. + assert (HF := HdF x y Hx' Hy' (ProjIR1 Hx) (ProjIR1 Hy) H). + assert (HG := HdG x y Hx' Hy' (ProjIR2 Hx) (ProjIR2 Hy) H0). + Opaque AbsIR Max. + simpl in |- *. + Transparent AbsIR Max. + set (Fx := F x (ProjIR1 Hx)) in *. + set (Fy := F y (ProjIR1 Hy)) in *. + set (Gx := G x (ProjIR2 Hx)) in *. + set (Gy := G y (ProjIR2 Hy)) in *. + elim (AbsIR_imp_AbsSmall _ _ HF); intros HF1 HF2. + elim (AbsIR_imp_AbsSmall _ _ HG); intros HG1 HG2. + apply leEq_wdl with (AbsIR (Max Fx Gx[-]Max Fx Gy[+] (Max Fx Gy[-]Max Fy Gy))). + 2: apply AbsIR_wd; rational. + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both; apply AbsSmall_imp_AbsIR; split. + apply shift_zero_leEq_minus'. + rstepr (e [/]TwoNZ[+]Max Fx Gx[-]Max Fx Gy). + apply shift_zero_leEq_minus. + apply Max_leEq. + apply leEq_transitive with (e [/]TwoNZ[+]Fx). + apply shift_leEq_plus; astepl ZeroR; apply less_leEq; apply pos_div_two; auto. + apply plus_resp_leEq_lft; apply lft_leEq_Max. + apply leEq_transitive with (e [/]TwoNZ[+]Gx). + 2: apply plus_resp_leEq_lft; apply rht_leEq_Max. + apply shift_leEq_plus. + apply inv_cancel_leEq; rstepr (Gx[-]Gy); auto. + apply shift_minus_leEq; apply Max_leEq. apply leEq_transitive with (e [/]TwoNZ[+]Fx). - apply shift_leEq_plus; astepl ZeroR; apply less_leEq; apply pos_div_two; - auto. + apply shift_leEq_plus; astepl ZeroR; apply less_leEq; apply pos_div_two; auto. apply plus_resp_leEq_lft; apply lft_leEq_Max. - apply leEq_transitive with (e [/]TwoNZ[+]Gx). + apply leEq_transitive with (e [/]TwoNZ[+]Gy). 2: apply plus_resp_leEq_lft; apply rht_leEq_Max. - apply shift_leEq_plus. - apply inv_cancel_leEq; rstepr (Gx[-]Gy); auto. - apply shift_minus_leEq; apply Max_leEq. + apply shift_leEq_plus; auto. + apply shift_zero_leEq_minus'. + rstepr (e [/]TwoNZ[+]Max Fx Gy[-]Max Fy Gy). + apply shift_zero_leEq_minus. + apply Max_leEq. apply leEq_transitive with (e [/]TwoNZ[+]Fx). - apply shift_leEq_plus; astepl ZeroR; apply less_leEq; apply pos_div_two; - auto. + apply shift_leEq_plus. + apply inv_cancel_leEq; rstepr (Fx[-]Fy); auto. apply plus_resp_leEq_lft; apply lft_leEq_Max. apply leEq_transitive with (e [/]TwoNZ[+]Gy). 2: apply plus_resp_leEq_lft; apply rht_leEq_Max. - apply shift_leEq_plus; auto. - apply shift_zero_leEq_minus'. - rstepr (e [/]TwoNZ[+]Max Fx Gy[-]Max Fy Gy). - apply shift_zero_leEq_minus. - apply Max_leEq. - apply leEq_transitive with (e [/]TwoNZ[+]Fx). - apply shift_leEq_plus. - apply inv_cancel_leEq; rstepr (Fx[-]Fy); auto. + apply shift_leEq_plus; astepl ZeroR; apply less_leEq; apply pos_div_two; auto. + apply shift_minus_leEq; apply Max_leEq. + apply leEq_transitive with (e [/]TwoNZ[+]Fy). + apply shift_leEq_plus; auto. apply plus_resp_leEq_lft; apply lft_leEq_Max. apply leEq_transitive with (e [/]TwoNZ[+]Gy). - 2: apply plus_resp_leEq_lft; apply rht_leEq_Max. - apply shift_leEq_plus; astepl ZeroR; apply less_leEq; apply pos_div_two; - auto. -apply shift_minus_leEq; apply Max_leEq. - apply leEq_transitive with (e [/]TwoNZ[+]Fy). - apply shift_leEq_plus; auto. - apply plus_resp_leEq_lft; apply lft_leEq_Max. -apply leEq_transitive with (e [/]TwoNZ[+]Gy). - apply shift_leEq_plus; astepl ZeroR; apply less_leEq; apply pos_div_two; - auto. -apply plus_resp_leEq_lft; apply rht_leEq_Max. + apply shift_leEq_plus; astepl ZeroR; apply less_leEq; apply pos_div_two; auto. + apply plus_resp_leEq_lft; apply rht_leEq_Max. Qed. (* begin show *) @@ -704,125 +708,101 @@ Hypothesis Hg'' : forall x Hx, I x -> G x Hx [#] Zero. (* end show *) Lemma Continuous_I_recip : Continuous_I Hab {1/}G. -clear incF incG. -elim contG; intros incG' contG'. -split. -Included; assumption. -elim Hg'; intros Haux Hg2. -elim Hg2; clear Haux Hg2; intros c H H0. -intros. -elim contG' with (c[*]c[*]e); clear contG contG'. -intros d H2 H3. -exists d. -assumption. -intros x y H4 H5 Hx Hy H6. -simpl in |- *. -set (Hxx := incG' x H4) in *. -set (Hyy := incG' y H5) in *. -apply - leEq_wdl - with - (AbsIR - (G y Hyy[-]G x Hxx[/] _[//] - mult_resp_ap_zero _ _ _ (Hg'' x Hxx H4) (Hg'' y Hyy H5))). -apply - leEq_wdl - with - (AbsIR (G y Hyy[-]G x Hxx) [/] _[//] - AbsIR_resp_ap_zero _ - (mult_resp_ap_zero _ _ _ (Hg'' x Hxx H4) (Hg'' y Hyy H5))). -apply - leEq_transitive - with - (AbsIR (G y Hyy[-]G x Hxx) [/] _[//] - mult_resp_ap_zero _ _ _ (pos_ap_zero _ _ H) (pos_ap_zero _ _ H)). -rstepl - (AbsIR (G y Hyy[-]G x Hxx) [*] - (One[/] _[//] - AbsIR_resp_ap_zero _ - (mult_resp_ap_zero _ _ _ (Hg'' x Hxx H4) (Hg'' y Hyy H5)))). -rstepr - (AbsIR (G y Hyy[-]G x Hxx) [*] - (One[/] _[//] - mult_resp_ap_zero _ _ _ (pos_ap_zero _ _ H) (pos_ap_zero _ _ H))). -apply mult_resp_leEq_lft. -apply recip_resp_leEq. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; - assumption. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try (apply less_leEq; assumption). -eapply leEq_wdr; [ apply (H0 x Hxx H4) | algebra ]. -eapply leEq_wdr; [ apply (H0 y Hyy H5) | algebra ]. -apply AbsIR_nonneg. -apply shift_div_leEq'. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; - assumption. -eapply leEq_wdl. -2: apply AbsIR_minus. -apply H3; assumption. -apply eq_symmetric_unfolded; apply AbsIR_division. -apply AbsIR_wd. -rational. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; +Proof. + clear incF incG. + elim contG; intros incG' contG'. + split. + Included; assumption. + elim Hg'; intros Haux Hg2. + elim Hg2; clear Haux Hg2; intros c H H0. + intros. + elim contG' with (c[*]c[*]e); clear contG contG'. + intros d H2 H3. + exists d. + assumption. + intros x y H4 H5 Hx Hy H6. + simpl in |- *. + set (Hxx := incG' x H4) in *. + set (Hyy := incG' y H5) in *. + apply leEq_wdl with (AbsIR (G y Hyy[-]G x Hxx[/] _[//] + mult_resp_ap_zero _ _ _ (Hg'' x Hxx H4) (Hg'' y Hyy H5))). + apply leEq_wdl with (AbsIR (G y Hyy[-]G x Hxx) [/] _[//] AbsIR_resp_ap_zero _ + (mult_resp_ap_zero _ _ _ (Hg'' x Hxx H4) (Hg'' y Hyy H5))). + apply leEq_transitive with (AbsIR (G y Hyy[-]G x Hxx) [/] _[//] + mult_resp_ap_zero _ _ _ (pos_ap_zero _ _ H) (pos_ap_zero _ _ H)). + rstepl (AbsIR (G y Hyy[-]G x Hxx) [*] (One[/] _[//] AbsIR_resp_ap_zero _ + (mult_resp_ap_zero _ _ _ (Hg'' x Hxx H4) (Hg'' y Hyy H5)))). + rstepr (AbsIR (G y Hyy[-]G x Hxx) [*] (One[/] _[//] + mult_resp_ap_zero _ _ _ (pos_ap_zero _ _ H) (pos_ap_zero _ _ H))). + apply mult_resp_leEq_lft. + apply recip_resp_leEq. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; assumption. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try (apply less_leEq; assumption). + eapply leEq_wdr; [ apply (H0 x Hxx H4) | algebra ]. + eapply leEq_wdr; [ apply (H0 y Hyy H5) | algebra ]. + apply AbsIR_nonneg. + apply shift_div_leEq'. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; assumption. + eapply leEq_wdl. + 2: apply AbsIR_minus. + apply H3; assumption. + apply eq_symmetric_unfolded; apply AbsIR_division. + apply AbsIR_wd. + rational. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; assumption. assumption. -assumption. Qed. Lemma Continuous_I_NRoot : forall n Hn, (forall x Hx, I x -> Zero[<=]F x Hx) -> Continuous_I Hab (FNRoot F n Hn). Proof. -intros n Hn H. -split. - Included. -intros e He. -destruct contF as [contF'' contF']. -destruct (contF' (e[^]n)) as [d Hd H0]; clear contF contF'. - apply nexp_resp_pos; assumption. -exists d. - assumption. -intros x y Hx0 Hy0 Hx Hy Hxy. -set (x':=FNRoot F n Hn x Hx). -set (y':=FNRoot F n Hn y Hy). -stepl (Max x' y'[-]Min x' y'); - [|apply eq_symmetric;apply Abs_Max]. -apply shift_minus_leEq. -apply power_cancel_leEq with n; try assumption. - apply plus_resp_nonneg. - apply less_leEq; assumption. - apply leEq_Min; apply: NRoot_nonneg. -apply leEq_transitive with (e[^]n[+]Min x' y'[^]n). - apply shift_leEq_plus. - set (Hx':=(ProjT1 - (ext2_a IR (Dom F) - (fun (x0 : IR) (Hx1 : Dom F x0) => Zero[<=]F x0 Hx1) x Hx))). - set (Hy':=(ProjT1 - (ext2_a IR (Dom F) - (fun (x0 : IR) (Hx1 : Dom F x0) => Zero[<=]F x0 Hx1) y Hy))). - stepl (AbsIR (F x Hx'[-]F y Hy')). - apply H0; try assumption. - stepr (AbsIR (x'[^]n[-]y'[^]n)). - apply AbsIR_wd. - apply: bin_op_wd_unfolded; - apply eq_symmetric; try apply un_op_wd_unfolded; apply: NRoot_power. - csetoid_rewrite (Abs_Max (x'[^]n) (y'[^]n)). - apply: bin_op_wd_unfolded; try apply un_op_wd_unfolded. - change (Max ((FId{^}n) x' CI) ((FId{^}n) y' CI)[=]((FId{^}n) (Max x' y') CI)). - apply Max_monotone. + intros n Hn H. + split. + Included. + intros e He. + destruct contF as [contF'' contF']. + destruct (contF' (e[^]n)) as [d Hd H0]; clear contF contF'. + apply nexp_resp_pos; assumption. + exists d. + assumption. + intros x y Hx0 Hy0 Hx Hy Hxy. + set (x':=FNRoot F n Hn x Hx). + set (y':=FNRoot F n Hn y Hy). + stepl (Max x' y'[-]Min x' y'); [|apply eq_symmetric;apply Abs_Max]. + apply shift_minus_leEq. + apply power_cancel_leEq with n; try assumption. + apply plus_resp_nonneg. + apply less_leEq; assumption. + apply leEq_Min; apply: NRoot_nonneg. + apply leEq_transitive with (e[^]n[+]Min x' y'[^]n). + apply shift_leEq_plus. + set (Hx':=(ProjT1 (ext2_a IR (Dom F) (fun (x0 : IR) (Hx1 : Dom F x0) => Zero[<=]F x0 Hx1) x Hx))). + set (Hy':=(ProjT1 (ext2_a IR (Dom F) (fun (x0 : IR) (Hx1 : Dom F x0) => Zero[<=]F x0 Hx1) y Hy))). + stepl (AbsIR (F x Hx'[-]F y Hy')). + apply H0; try assumption. + stepr (AbsIR (x'[^]n[-]y'[^]n)). + apply AbsIR_wd. + apply: bin_op_wd_unfolded; apply eq_symmetric; try apply un_op_wd_unfolded; apply: NRoot_power. + csetoid_rewrite (Abs_Max (x'[^]n) (y'[^]n)). + apply: bin_op_wd_unfolded; try apply un_op_wd_unfolded. + change (Max ((FId{^}n) x' CI) ((FId{^}n) y' CI)[=]((FId{^}n) (Max x' y') CI)). + apply Max_monotone. + simpl; intros r s _ _ X0 X1 X2. + apply: nexp_resp_leEq; try assumption. + eapply leEq_transitive;[|apply X0]. + apply leEq_Min; apply: NRoot_nonneg. + change (Min ((FId{^}n) x' CI) ((FId{^}n) y' CI)[=]((FId{^}n) (Min x' y') CI)). + apply Min_monotone. simpl; intros r s _ _ X0 X1 X2. apply: nexp_resp_leEq; try assumption. eapply leEq_transitive;[|apply X0]. apply leEq_Min; apply: NRoot_nonneg. - change (Min ((FId{^}n) x' CI) ((FId{^}n) y' CI)[=]((FId{^}n) (Min x' y') CI)). - apply Min_monotone. - simpl; intros r s _ _ X0 X1 X2. - apply: nexp_resp_leEq; try assumption. - eapply leEq_transitive;[|apply X0]. + apply power_plus_leEq; try assumption. + apply less_leEq; assumption. apply leEq_Min; apply: NRoot_nonneg. -apply power_plus_leEq; try assumption. - apply less_leEq; assumption. -apply leEq_Min; apply: NRoot_nonneg. Qed. End Local_Results. @@ -855,51 +835,57 @@ product and constant functions. *) Lemma Continuous_I_minus : Continuous_I Hab (F{-}G). -apply Continuous_I_wd with (F{+}{--}G). -FEQ. -apply Continuous_I_plus. -apply contF. -apply Continuous_I_inv; apply contG. +Proof. + apply Continuous_I_wd with (F{+}{--}G). + FEQ. + apply Continuous_I_plus. + apply contF. + apply Continuous_I_inv; apply contG. Qed. Lemma Continuous_I_scal : forall c : IR, Continuous_I Hab (c{**}F). -intros. -unfold Fscalmult in |- *. -apply Continuous_I_mult. -apply Continuous_I_const. -apply contF. +Proof. + intros. + unfold Fscalmult in |- *. + apply Continuous_I_mult. + apply Continuous_I_const. + apply contF. Qed. Lemma Continuous_I_nth : forall n : nat, Continuous_I Hab (F{^}n). -simple induction n. -apply Continuous_I_wd with ( [-C-]OneR). -apply FNth_zero'; apply contin_imp_inc; auto. -apply Continuous_I_const. -clear n; intros. -apply Continuous_I_wd with (F{*}F{^}n). -apply FNth_mult'; apply contin_imp_inc; auto. -apply Continuous_I_mult; assumption. +Proof. + simple induction n. + apply Continuous_I_wd with ( [-C-]OneR). + apply FNth_zero'; apply contin_imp_inc; auto. + apply Continuous_I_const. + clear n; intros. + apply Continuous_I_wd with (F{*}F{^}n). + apply FNth_mult'; apply contin_imp_inc; auto. + apply Continuous_I_mult; assumption. Qed. Lemma Continuous_I_min : Continuous_I Hab (FMin F G). -unfold FMin in |- *. -apply Continuous_I_inv; apply Continuous_I_max; apply Continuous_I_inv; auto. +Proof. + unfold FMin in |- *. + apply Continuous_I_inv; apply Continuous_I_max; apply Continuous_I_inv; auto. Qed. Lemma Continuous_I_abs : Continuous_I Hab (FAbs F). -unfold FAbs in |- *. -apply Continuous_I_max; try apply Continuous_I_inv; auto. +Proof. + unfold FAbs in |- *. + apply Continuous_I_max; try apply Continuous_I_inv; auto. Qed. Hypothesis Hg' : bnd_away_zero I G. Hypothesis Hg'' : forall x Hx, I x -> G x Hx [#] Zero. Lemma Continuous_I_div : Continuous_I Hab (F{/}G). -apply Continuous_I_wd with (F{*}{1/}G). -FEQ. -apply Continuous_I_mult. -assumption. -apply Continuous_I_recip; assumption. +Proof. + apply Continuous_I_wd with (F{*}{1/}G). + FEQ. + apply Continuous_I_mult. + assumption. + apply Continuous_I_recip; assumption. Qed. End Corolaries. @@ -922,35 +908,38 @@ Let I := Compact Hab. Lemma Continuous_I_Sum0 : forall f : nat -> PartIR, (forall n, Continuous_I Hab (f n)) -> forall n, Continuous_I Hab (FSum0 n f). -intros. -induction n as [| n Hrecn]. -eapply Continuous_I_wd. -apply FSum0_0. -2: apply Continuous_I_const. -intro; apply contin_imp_inc; auto. -eapply Continuous_I_wd. -apply FSum0_S. -intro; apply contin_imp_inc; auto. -apply Continuous_I_plus; auto. +Proof. + intros. + induction n as [| n Hrecn]. + eapply Continuous_I_wd. + apply FSum0_0. + 2: apply Continuous_I_const. + intro; apply contin_imp_inc; auto. + eapply Continuous_I_wd. + apply FSum0_S. + intro; apply contin_imp_inc; auto. + apply Continuous_I_plus; auto. Qed. Lemma Continuous_I_Sumx : forall n (f : forall i, i < n -> PartIR), (forall i Hi, Continuous_I Hab (f i Hi)) -> Continuous_I Hab (FSumx n f). -intro; induction n as [| n Hrecn]; intros f contF. -simpl in |- *; apply Continuous_I_const. -simpl in |- *; apply Continuous_I_plus. -apply Hrecn. -intros; apply contF. -apply contF. +Proof. + intro; induction n as [| n Hrecn]; intros f contF. + simpl in |- *; apply Continuous_I_const. + simpl in |- *; apply Continuous_I_plus. + apply Hrecn. + intros; apply contF. + apply contF. Qed. Lemma Continuous_I_Sum : forall f : nat -> PartIR, (forall n, Continuous_I Hab (f n)) -> forall m n, Continuous_I Hab (FSum m n f). -intros. -eapply Continuous_I_wd. -apply Feq_symmetric; apply FSum_FSum0'. -intro; apply contin_imp_inc; auto. -apply Continuous_I_minus; apply Continuous_I_Sum0; auto. +Proof. + intros. + eapply Continuous_I_wd. + apply Feq_symmetric; apply FSum_FSum0'. + intro; apply contin_imp_inc; auto. + apply Continuous_I_minus; apply Continuous_I_Sum0; auto. Qed. End Sums. @@ -961,60 +950,58 @@ For practical purposes, these characterization results are useful: Lemma lub_charact : forall a b Hab F (contF : Continuous_I Hab F) z, fun_lub_IR F (compact a b Hab) z -> z [=] lub_funct a b Hab F contF. -intros a b Hab F contF z H. -elim H; intros Hz Hz'; clear H. -assert (H := lub_is_lub _ _ _ _ contF). -set (y := lub_funct _ _ _ _ contF) in *. -elim H; intros Hy Hy'; clear H. -apply leEq_imp_eq; apply shift_zero_leEq_minus'; apply inv_cancel_leEq; - astepr ZeroR; apply approach_zero; intros e He. - -rstepl (z[-]y). -apply shift_minus_less. -elim (Hz' e He); intros x Hx. -intro H. -apply less_leEq_trans with (x[+]e). -apply shift_less_plus'; auto. -astepr (y[+]e). -apply plus_resp_leEq; apply Hy. -auto. - -rstepl (y[-]z). -apply shift_minus_less. -elim (Hy' e He); intros x Hx. -intro H. -apply less_leEq_trans with (x[+]e). -apply shift_less_plus'; auto. -astepr (z[+]e). -apply plus_resp_leEq; apply Hz. -auto. +Proof. + intros a b Hab F contF z H. + elim H; intros Hz Hz'; clear H. + assert (H := lub_is_lub _ _ _ _ contF). + set (y := lub_funct _ _ _ _ contF) in *. + elim H; intros Hy Hy'; clear H. + apply leEq_imp_eq; apply shift_zero_leEq_minus'; apply inv_cancel_leEq; + astepr ZeroR; apply approach_zero; intros e He. + rstepl (z[-]y). + apply shift_minus_less. + elim (Hz' e He); intros x Hx. + intro H. + apply less_leEq_trans with (x[+]e). + apply shift_less_plus'; auto. + astepr (y[+]e). + apply plus_resp_leEq; apply Hy. + auto. + rstepl (y[-]z). + apply shift_minus_less. + elim (Hy' e He); intros x Hx. + intro H. + apply less_leEq_trans with (x[+]e). + apply shift_less_plus'; auto. + astepr (z[+]e). + apply plus_resp_leEq; apply Hz. + auto. Qed. Lemma glb_charact : forall a b Hab F (contF : Continuous_I Hab F) z, fun_glb_IR F (compact a b Hab) z -> z [=] glb_funct a b Hab F contF. -intros a b Hab F contF z H. -elim H; intros Hz Hz'; clear H. -assert (H := glb_is_glb _ _ _ _ contF). -set (y := glb_funct _ _ _ _ contF) in *. -elim H; intros Hy Hy'; clear H. -apply leEq_imp_eq; apply shift_zero_leEq_minus'; apply inv_cancel_leEq; - astepr ZeroR; apply approach_zero; intros e He. - -rstepl (z[-]y). -apply shift_minus_less. -elim (Hy' e He); intros x Hx. -intro H. -apply leEq_less_trans with x. -apply Hz; auto. -apply shift_less_plus; auto. - -rstepl (y[-]z). -apply shift_minus_less. -elim (Hz' e He); intros x Hx. -intro H. -apply leEq_less_trans with x. -apply Hy; auto. -apply shift_less_plus; auto. +Proof. + intros a b Hab F contF z H. + elim H; intros Hz Hz'; clear H. + assert (H := glb_is_glb _ _ _ _ contF). + set (y := glb_funct _ _ _ _ contF) in *. + elim H; intros Hy Hy'; clear H. + apply leEq_imp_eq; apply shift_zero_leEq_minus'; apply inv_cancel_leEq; + astepr ZeroR; apply approach_zero; intros e He. + rstepl (z[-]y). + apply shift_minus_less. + elim (Hy' e He); intros x Hx. + intro H. + apply leEq_less_trans with x. + apply Hz; auto. + apply shift_less_plus; auto. + rstepl (y[-]z). + apply shift_minus_less. + elim (Hz' e He); intros x Hx. + intro H. + apply leEq_less_trans with x. + apply Hy; auto. + apply shift_less_plus; auto. Qed. (** @@ -1023,19 +1010,20 @@ The following result is also extremely useful, as it allows us to set a lower bo Lemma leEq_glb : forall a b Hab (F : PartIR) contF x, (forall y, Compact Hab y -> forall Hy, x [<=] F y Hy) -> x [<=] glb_funct a b Hab F contF. -intros a b Hab F contF x H. -elim (glb_is_glb _ _ _ _ contF); intros. -astepr (glb_funct _ _ _ _ contF[+]Zero); apply shift_leEq_plus'. -apply approach_zero_weak. -intros e H0. -elim (b0 _ H0); intro y; intros. -apply less_leEq; eapply leEq_less_trans. -2: apply q. -apply minus_resp_leEq. -elim p; intros z Hz. -elim Hz; intros H1 H2. -elim H2; intros H3 H4. -astepr (F z H3); auto. +Proof. + intros a b Hab F contF x H. + elim (glb_is_glb _ _ _ _ contF); intros. + astepr (glb_funct _ _ _ _ contF[+]Zero); apply shift_leEq_plus'. + apply approach_zero_weak. + intros e H0. + elim (b0 _ H0); intro y; intros. + apply less_leEq; eapply leEq_less_trans. + 2: apply q. + apply minus_resp_leEq. + elim p; intros z Hz. + elim Hz; intros H1 H2. + elim H2; intros H3 H4. + astepr (F z H3); auto. Qed. (** @@ -1044,40 +1032,40 @@ The norm is also an extensional property. Lemma Norm_Funct_wd : forall a b Hab F G, Feq (compact a b Hab) F G -> forall contF contG, Norm_Funct (Hab:=Hab) (F:=F) contF [=] Norm_Funct (Hab:=Hab) (F:=G) contG. -intros a b Hab F G H contF contG. -elim H; intros incF H''. -elim H''; clear H''; intros incG H''. -unfold Norm_Funct in |- *; apply bin_op_wd_unfolded. -generalize (lub_is_lub _ _ _ _ contF); intro Hlub. -apply lub_charact. -elim Hlub; clear Hlub; intros H0 H1. -split. -intros x H2. -apply H0. -apply fun_image_wd with G. -apply Feq_symmetric; auto. -auto. -intros e H2. -elim (H1 e H2); intro x; intros. -exists x. -apply fun_image_wd with F; auto. -auto. - -apply un_op_wd_unfolded. -generalize (glb_is_glb _ _ _ _ contF); intro Hglb. -apply glb_charact. -elim Hglb; intros H0 H1. -split. -intros x H2. -apply H0. -apply fun_image_wd with G. -apply Feq_symmetric; auto. -auto. -intros e H2. -elim (H1 e H2); intro x; intros. -exists x. -apply fun_image_wd with F; auto. -auto. +Proof. + intros a b Hab F G H contF contG. + elim H; intros incF H''. + elim H''; clear H''; intros incG H''. + unfold Norm_Funct in |- *; apply bin_op_wd_unfolded. + generalize (lub_is_lub _ _ _ _ contF); intro Hlub. + apply lub_charact. + elim Hlub; clear Hlub; intros H0 H1. + split. + intros x H2. + apply H0. + apply fun_image_wd with G. + apply Feq_symmetric; auto. + auto. + intros e H2. + elim (H1 e H2); intro x; intros. + exists x. + apply fun_image_wd with F; auto. + auto. + apply un_op_wd_unfolded. + generalize (glb_is_glb _ _ _ _ contF); intro Hglb. + apply glb_charact. + elim Hglb; intros H0 H1. + split. + intros x H2. + apply H0. + apply fun_image_wd with G. + apply Feq_symmetric; auto. + auto. + intros e H2. + elim (H1 e H2); intro x; intros. + exists x. + apply fun_image_wd with F; auto. + auto. Qed. (** @@ -1087,9 +1075,10 @@ The value of the norm is covariant with the length of the interval. Lemma included_imp_norm_leEq : forall a b c d Hab Hcd F contF1 contF2, included (compact c d Hcd) (compact a b Hab) -> Norm_Funct (Hab:=Hcd) (F:=F) contF2 [<=] Norm_Funct (Hab:=Hab) (F:=F) contF1. -intros. -apply leEq_Norm_Funct; intros. -apply norm_bnd_AbsIR; auto. +Proof. + intros. + apply leEq_Norm_Funct; intros. + apply norm_bnd_AbsIR; auto. Qed. End Other. diff --git a/ftc/Derivative.v b/ftc/Derivative.v index 233dc9334..e23bbd71f 100644 --- a/ftc/Derivative.v +++ b/ftc/Derivative.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Continuity. @@ -110,10 +110,11 @@ Lemma Derivative_I_char : forall F F' (P:=Dom F) (P':=Dom F'), (forall e, Zero [<] e -> {d : IR | Zero [<] d | forall x y, I x -> I y -> forall Hx Hy Hx', AbsIR (x[-]y) [<=] d -> AbsIR (F y Hy[-]F x Hx[-]F' x Hx'[*] (y[-]x)) [<=] e[*]AbsIR (y[-]x)}) -> Derivative_I Hab' F F'. -(* begin hide *) -unfold Hab in |- *. -intros. -repeat (split; auto). +Proof. + (* begin hide *) + unfold Hab in |- *. + intros. + repeat (split; auto). Qed. (* end hide *) @@ -131,33 +132,35 @@ Let R := Dom H. Lemma Derivative_I_wdl : Feq I F G -> Derivative_I Hab' F H -> Derivative_I Hab' G H. -intros H0 H1. -elim H0; intros incF H0'. -elim H0'; intros incG Heq. -elim H1; intros incF' H2. -elim H2; intros incH H3. -clear H0' H1 H2. -apply Derivative_I_char; auto. -intros e He. -elim (H3 e He); clear H3; intros d H1 H2. -exists d; auto. -intros x y H3 H4 Hx Hy Hx' H5. -astepl (AbsIR (F y (incF y H4) [-]F x (incF x H3) [-]H x Hx'[*] (y[-]x))); auto. +Proof. + intros H0 H1. + elim H0; intros incF H0'. + elim H0'; intros incG Heq. + elim H1; intros incF' H2. + elim H2; intros incH H3. + clear H0' H1 H2. + apply Derivative_I_char; auto. + intros e He. + elim (H3 e He); clear H3; intros d H1 H2. + exists d; auto. + intros x y H3 H4 Hx Hy Hx' H5. + astepl (AbsIR (F y (incF y H4) [-]F x (incF x H3) [-]H x Hx'[*] (y[-]x))); auto. Qed. Lemma Derivative_I_wdr : Feq I F G -> Derivative_I Hab' H F -> Derivative_I Hab' H G. -intros H0 H1. -elim H0; intros incF H0'. -elim H0'; intros incG Heq. -elim H1; intros incH H2. -elim H2; intros incF0 H3. -apply Derivative_I_char; auto. -intros e He. -elim (H3 e He); clear H3; intros d H3 H4. -exists d; auto. -intros x y H5 H6 Hx Hy Hx' H7. -astepl (AbsIR (H y Hy[-]H x Hx[-]F x (incF x H5) [*] (y[-]x))); auto. +Proof. + intros H0 H1. + elim H0; intros incF H0'. + elim H0'; intros incG Heq. + elim H1; intros incH H2. + elim H2; intros incF0 H3. + apply Derivative_I_char; auto. + intros e He. + elim (H3 e He); clear H3; intros d H3 H4. + exists d; auto. + intros x y H5 H6 Hx Hy Hx' H7. + astepl (AbsIR (H y Hy[-]H x Hx[-]F x (incF x H5) [*] (y[-]x))); auto. Qed. (* begin hide *) @@ -166,65 +169,65 @@ Let Derivative_I_unique_lemma : Compact Hab x -> forall d : IR, Zero [<] d -> {y : IR | AbsIR (x[-]y) [<=] d | Compact Hab y and y[-]x [#] Zero}. -intros x Hx d Hd. -elim (less_cotransitive_unfolded _ _ _ Hab' x); intro. -exists (Max a (x[-]d [/]TwoNZ)); auto. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply less_leEq; apply shift_minus_less'; apply shift_less_plus. -apply less_leEq_trans with (x[-]d [/]TwoNZ). -apply minus_resp_less_rht. -apply pos_div_two'; assumption. -simpl in |- *. -apply rht_leEq_Max. -apply shift_leEq_minus. -simpl in |- *. -astepl (Max a (x[-]d [/]TwoNZ)). -apply less_leEq. -apply Max_less; [ assumption | astepr (x[-]Zero) ]. -apply minus_resp_less_rht; apply pos_div_two; assumption. -split. -split. -apply lft_leEq_Max. -apply Max_leEq. -apply less_leEq; assumption. -apply leEq_transitive with x. -apply shift_minus_leEq; apply shift_leEq_plus'; astepl ZeroR. -apply less_leEq; apply pos_div_two; assumption. -inversion_clear Hx; assumption. -apply less_imp_ap; apply shift_minus_less; astepr x; apply Max_less. -assumption. -apply shift_minus_less; apply shift_less_plus'; astepl ZeroR. -apply pos_div_two with (eps := d); assumption. -exists (Min b (x[+]d [/]TwoNZ)). -apply leEq_wdl with (Min b (x[+]d [/]TwoNZ) [-]x). -apply less_leEq. -apply shift_minus_less. -rstepr (x[+]d). -eapply leEq_less_trans. -apply Min_leEq_rht. -apply plus_resp_less_lft. -apply pos_div_two'; assumption. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded; [ apply AbsIR_minus | apply AbsIR_eq_x ]. -apply less_leEq; apply shift_less_minus; astepl x; apply less_Min. -assumption. -astepl (x[+]Zero); apply plus_resp_less_lft. -apply pos_div_two; assumption. -split. -split. -apply leEq_Min. -auto. -apply leEq_transitive with x. -inversion_clear Hx; auto. -astepl (x[+]ZeroR); apply plus_resp_leEq_lft; apply less_leEq; - apply pos_div_two; assumption. -apply Min_leEq_lft. -apply Greater_imp_ap. -apply shift_less_minus; astepl x. -astepr (Min b (x[+]d [/]TwoNZ)); apply less_Min. -assumption. -astepl (x[+]Zero); apply plus_resp_less_lft; apply pos_div_two; assumption. +Proof. + intros x Hx d Hd. + elim (less_cotransitive_unfolded _ _ _ Hab' x); intro. + exists (Max a (x[-]d [/]TwoNZ)); auto. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply less_leEq; apply shift_minus_less'; apply shift_less_plus. + apply less_leEq_trans with (x[-]d [/]TwoNZ). + apply minus_resp_less_rht. + apply pos_div_two'; assumption. + simpl in |- *. + apply rht_leEq_Max. + apply shift_leEq_minus. + simpl in |- *. + astepl (Max a (x[-]d [/]TwoNZ)). + apply less_leEq. + apply Max_less; [ assumption | astepr (x[-]Zero) ]. + apply minus_resp_less_rht; apply pos_div_two; assumption. + split. + split. + apply lft_leEq_Max. + apply Max_leEq. + apply less_leEq; assumption. + apply leEq_transitive with x. + apply shift_minus_leEq; apply shift_leEq_plus'; astepl ZeroR. + apply less_leEq; apply pos_div_two; assumption. + inversion_clear Hx; assumption. + apply less_imp_ap; apply shift_minus_less; astepr x; apply Max_less. + assumption. + apply shift_minus_less; apply shift_less_plus'; astepl ZeroR. + apply pos_div_two with (eps := d); assumption. + exists (Min b (x[+]d [/]TwoNZ)). + apply leEq_wdl with (Min b (x[+]d [/]TwoNZ) [-]x). + apply less_leEq. + apply shift_minus_less. + rstepr (x[+]d). + eapply leEq_less_trans. + apply Min_leEq_rht. + apply plus_resp_less_lft. + apply pos_div_two'; assumption. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded; [ apply AbsIR_minus | apply AbsIR_eq_x ]. + apply less_leEq; apply shift_less_minus; astepl x; apply less_Min. + assumption. + astepl (x[+]Zero); apply plus_resp_less_lft. + apply pos_div_two; assumption. + split. + split. + apply leEq_Min. + auto. + apply leEq_transitive with x. + inversion_clear Hx; auto. + astepl (x[+]ZeroR); apply plus_resp_leEq_lft; apply less_leEq; apply pos_div_two; assumption. + apply Min_leEq_lft. + apply Greater_imp_ap. + apply shift_less_minus; astepl x. + astepr (Min b (x[+]d [/]TwoNZ)); apply less_Min. + assumption. + astepl (x[+]Zero); apply plus_resp_less_lft; apply pos_div_two; assumption. Qed. (* end hide *) @@ -234,49 +237,44 @@ Derivative is unique. Lemma Derivative_I_unique : Derivative_I Hab' F G -> Derivative_I Hab' F H -> Feq I G H. -intros H0 H1. -elim H0; intros incF H2. -elim H2; intros incG H3. -elim H1; intros incF' H6. -elim H6; intros incH H4. -clear H0 H2 H6. -apply eq_imp_Feq; auto. -intros x H0 Hx Hx'. -apply cg_inv_unique_2. -apply AbsIR_approach_zero; intros e H2. -elim (H3 _ (pos_div_two _ _ H2)). -intros dg H6 H7. -elim (H4 _ (pos_div_two _ _ H2)). -clear H4 H3; intros dh H3 H4. -set (d := Min (Min dg dh) One) in *. -elim (Derivative_I_unique_lemma x H0 d). -intros y Hy' Hy''. -elim Hy''; clear Hy''; intros Hy'' Hy. -apply mult_cancel_leEq with (AbsIR (y[-]x)). -apply AbsIR_pos; assumption. -eapply leEq_wdl. -2: apply AbsIR_resp_mult. -set (Hxx := incF x H0) in *. -set (Hyy := incF y Hy'') in *. -apply - leEq_wdl - with - (AbsIR - (F y Hyy[-]F x Hxx[-]H x Hx'[*] (y[-]x) [-] - (F y Hyy[-]F x Hxx[-]G x Hx[*] (y[-]x)))). -2: apply un_op_wd_unfolded; rational. -eapply leEq_transitive. -apply triangle_IR_minus. -rstepr (e [/]TwoNZ[*]AbsIR (y[-]x) [+]e [/]TwoNZ[*]AbsIR (y[-]x)). -apply plus_resp_leEq_both; [ apply H4 | apply H7 ]; try assumption; - eapply leEq_transitive; try apply Hy'; unfold d in |- *; - eapply leEq_transitive. -apply Min_leEq_lft. -apply Min_leEq_rht. -apply Min_leEq_lft. -apply Min_leEq_lft. -unfold d in |- *; repeat apply less_Min; - [ assumption | assumption | apply pos_one ]. +Proof. + intros H0 H1. + elim H0; intros incF H2. + elim H2; intros incG H3. + elim H1; intros incF' H6. + elim H6; intros incH H4. + clear H0 H2 H6. + apply eq_imp_Feq; auto. + intros x H0 Hx Hx'. + apply cg_inv_unique_2. + apply AbsIR_approach_zero; intros e H2. + elim (H3 _ (pos_div_two _ _ H2)). + intros dg H6 H7. + elim (H4 _ (pos_div_two _ _ H2)). + clear H4 H3; intros dh H3 H4. + set (d := Min (Min dg dh) One) in *. + elim (Derivative_I_unique_lemma x H0 d). + intros y Hy' Hy''. + elim Hy''; clear Hy''; intros Hy'' Hy. + apply mult_cancel_leEq with (AbsIR (y[-]x)). + apply AbsIR_pos; assumption. + eapply leEq_wdl. + 2: apply AbsIR_resp_mult. + set (Hxx := incF x H0) in *. + set (Hyy := incF y Hy'') in *. + apply leEq_wdl with (AbsIR (F y Hyy[-]F x Hxx[-]H x Hx'[*] (y[-]x) [-] + (F y Hyy[-]F x Hxx[-]G x Hx[*] (y[-]x)))). + 2: apply un_op_wd_unfolded; rational. + eapply leEq_transitive. + apply triangle_IR_minus. + rstepr (e [/]TwoNZ[*]AbsIR (y[-]x) [+]e [/]TwoNZ[*]AbsIR (y[-]x)). + apply plus_resp_leEq_both; [ apply H4 | apply H7 ]; try assumption; + eapply leEq_transitive; try apply Hy'; unfold d in |- *; eapply leEq_transitive. + apply Min_leEq_lft. + apply Min_leEq_rht. + apply Min_leEq_lft. + apply Min_leEq_lft. + unfold d in |- *; repeat apply less_Min; [ assumption | assumption | apply pos_one ]. Qed. (** @@ -284,14 +282,16 @@ Finally, the set where we are considering the relation is included in the domain *) Lemma derivative_imp_inc : Derivative_I Hab' F G -> included I P. -intro H0. -inversion_clear H0; assumption. +Proof. + intro H0. + inversion_clear H0; assumption. Qed. Lemma derivative_imp_inc' : Derivative_I Hab' F G -> included I Q. -intro H0. -elim H0; intros H1 H2. -inversion_clear H2; assumption. +Proof. + intro H0. + elim H0; intros H1 H2. + inversion_clear H2; assumption. Qed. (** @@ -301,121 +301,109 @@ Any function that is or has a derivative is continuous. Variable Hab'' : a [<=] b. Lemma deriv_imp_contin'_I : Derivative_I Hab' F G -> Continuous_I Hab'' G. -intro derF. -elim derF; intros incF H0. -elim H0; intros incG derivFG. -clear derF H0. -split. -Included. -intros e He. -elim (derivFG _ (pos_div_two _ _ He)); intros d posd Hde; clear derivFG. -exists d. auto. intros x y H0 H1 Hx Hy H2. -set (Hx' := incF _ H0) in *. -set (Hy' := incF _ H1) in *. -apply equal_less_leEq with (a := ZeroR) (b := AbsIR (y[-]x)); intros. -3: apply AbsIR_nonneg. -apply mult_cancel_leEq with (AbsIR (y[-]x)); auto. -rstepr (e [/]TwoNZ[*]AbsIR (y[-]x) [+]e [/]TwoNZ[*]AbsIR (y[-]x)). -eapply leEq_wdl. -2: apply AbsIR_resp_mult. -apply - leEq_wdl - with - (AbsIR - (F y Hy'[-]F x Hx'[-]G x Hx[*] (y[-]x) [+] - (F x Hx'[-]F y Hy'[-]G y Hy[*] (x[-]y)))). -2: eapply eq_transitive_unfolded. -2: apply AbsIR_inv. -2: apply AbsIR_wd; rational. -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -auto. -apply leEq_wdr with (e [/]TwoNZ[*]AbsIR (x[-]y)). -apply Hde; auto. -eapply leEq_wdl. -apply H2. -apply AbsIR_minus. -apply mult_wdr; apply AbsIR_minus. -apply leEq_wdl with ZeroR. -apply less_leEq; auto. -astepl (AbsIR Zero). -apply AbsIR_wd. -apply eq_symmetric_unfolded; apply x_minus_x. -apply pfwdef. -apply cg_inv_unique_2. -apply AbsIR_eq_zero. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -apply H3. -apply AbsIR_minus. +Proof. + intro derF. + elim derF; intros incF H0. + elim H0; intros incG derivFG. + clear derF H0. + split. + Included. + intros e He. + elim (derivFG _ (pos_div_two _ _ He)); intros d posd Hde; clear derivFG. + exists d. auto. intros x y H0 H1 Hx Hy H2. + set (Hx' := incF _ H0) in *. + set (Hy' := incF _ H1) in *. + apply equal_less_leEq with (a := ZeroR) (b := AbsIR (y[-]x)); intros. + 3: apply AbsIR_nonneg. + apply mult_cancel_leEq with (AbsIR (y[-]x)); auto. + rstepr (e [/]TwoNZ[*]AbsIR (y[-]x) [+]e [/]TwoNZ[*]AbsIR (y[-]x)). + eapply leEq_wdl. + 2: apply AbsIR_resp_mult. + apply leEq_wdl with (AbsIR (F y Hy'[-]F x Hx'[-]G x Hx[*] (y[-]x) [+] + (F x Hx'[-]F y Hy'[-]G y Hy[*] (x[-]y)))). + 2: eapply eq_transitive_unfolded. + 2: apply AbsIR_inv. + 2: apply AbsIR_wd; rational. + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + auto. + apply leEq_wdr with (e [/]TwoNZ[*]AbsIR (x[-]y)). + apply Hde; auto. + eapply leEq_wdl. + apply H2. + apply AbsIR_minus. + apply mult_wdr; apply AbsIR_minus. + apply leEq_wdl with ZeroR. + apply less_leEq; auto. + astepl (AbsIR Zero). + apply AbsIR_wd. + apply eq_symmetric_unfolded; apply x_minus_x. + apply pfwdef. + apply cg_inv_unique_2. + apply AbsIR_eq_zero. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + apply H3. + apply AbsIR_minus. Qed. Lemma deriv_imp_contin_I : Derivative_I Hab' F G -> Continuous_I Hab'' F. -intro derF. -elim derF; intros incF H2; elim H2; clear H2; intros incG deriv. -split; auto. -intros e He. -elim deriv with e; auto. -clear deriv; intros d posd Hd. -set (contG := deriv_imp_contin'_I derF) in *. -set (M := Norm_Funct contG) in *. -set - (D := - Min d - (Min (One [/]TwoNZ) - (e[/] _[//] - mult_resp_ap_zero _ _ _ (two_ap_zero IR) (max_one_ap_zero M)))) - in *. -exists D. -unfold D in |- *; repeat apply less_Min. -auto. -apply (pos_half IR). -apply div_resp_pos; auto. -apply shift_less_mult' with (two_ap_zero IR). -apply pos_two. -astepl ZeroR. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -apply pos_one. -intros x y H0 H1 Hx Hy H2. -apply - leEq_wdl - with - (AbsIR - (F x Hx[-]F y Hy[-]G y (incG _ H1) [*] (x[-]y) [+] - G y (incG _ H1) [*] (x[-]y))). -2: apply AbsIR_wd; rational. -eapply leEq_transitive. -apply triangle_IR. -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -apply plus_resp_leEq_both. -apply leEq_transitive with (e[*]AbsIR (x[-]y)). -apply Hd; auto. -apply leEq_transitive with D. -eapply leEq_wdl; [ apply H2 | apply AbsIR_minus ]. -unfold D in |- *; apply Min_leEq_lft. -rstepr (e[*]One [/]TwoNZ). -apply mult_resp_leEq_lft. -apply leEq_transitive with D; auto. -unfold D in |- *; eapply leEq_transitive; - [ apply Min_leEq_rht | apply Min_leEq_lft ]. -apply less_leEq; auto. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply leEq_transitive with (Max M One[*]AbsIR (x[-]y)). -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -eapply leEq_transitive. -2: apply lft_leEq_Max. -unfold M in |- *; apply norm_bnd_AbsIR; auto. -apply shift_mult_leEq' with (max_one_ap_zero M). -eapply less_leEq_trans; [ apply pos_one | apply rht_leEq_Max ]. -eapply leEq_wdr. -eapply leEq_transitive. -apply H2. -unfold D in |- *. -eapply leEq_transitive; apply Min_leEq_rht. -rational. +Proof. + intro derF. + elim derF; intros incF H2; elim H2; clear H2; intros incG deriv. + split; auto. + intros e He. + elim deriv with e; auto. + clear deriv; intros d posd Hd. + set (contG := deriv_imp_contin'_I derF) in *. + set (M := Norm_Funct contG) in *. + set (D := Min d (Min (One [/]TwoNZ) (e[/] _[//] + mult_resp_ap_zero _ _ _ (two_ap_zero IR) (max_one_ap_zero M)))) in *. + exists D. + unfold D in |- *; repeat apply less_Min. + auto. + apply (pos_half IR). + apply div_resp_pos; auto. + apply shift_less_mult' with (two_ap_zero IR). + apply pos_two. + astepl ZeroR. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + apply pos_one. + intros x y H0 H1 Hx Hy H2. + apply leEq_wdl with (AbsIR (F x Hx[-]F y Hy[-]G y (incG _ H1) [*] (x[-]y) [+] + G y (incG _ H1) [*] (x[-]y))). + 2: apply AbsIR_wd; rational. + eapply leEq_transitive. + apply triangle_IR. + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + apply plus_resp_leEq_both. + apply leEq_transitive with (e[*]AbsIR (x[-]y)). + apply Hd; auto. + apply leEq_transitive with D. + eapply leEq_wdl; [ apply H2 | apply AbsIR_minus ]. + unfold D in |- *; apply Min_leEq_lft. + rstepr (e[*]One [/]TwoNZ). + apply mult_resp_leEq_lft. + apply leEq_transitive with D; auto. + unfold D in |- *; eapply leEq_transitive; [ apply Min_leEq_rht | apply Min_leEq_lft ]. + apply less_leEq; auto. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_transitive with (Max M One[*]AbsIR (x[-]y)). + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + unfold M in |- *; apply norm_bnd_AbsIR; auto. + apply shift_mult_leEq' with (max_one_ap_zero M). + eapply less_leEq_trans; [ apply pos_one | apply rht_leEq_Max ]. + eapply leEq_wdr. + eapply leEq_transitive. + apply H2. + unfold D in |- *. + eapply leEq_transitive; apply Min_leEq_rht. + rational. Qed. End Basic_Properties. @@ -427,12 +415,13 @@ If [G] is the derivative of [F] in a given interval, then [G] is also the deriva Lemma included_imp_deriv : forall a b Hab c d Hcd F F', included (compact c d (less_leEq _ _ _ Hcd)) (compact a b (less_leEq _ _ _ Hab)) -> Derivative_I Hab F F' -> Derivative_I Hcd F F'. -intros a b Hab c d Hcd F F' H H0. -elim H0; clear H0; intros incF H0. -elim H0; clear H0; intros incF' H0. -apply Derivative_I_char. -apply included_trans with (Compact (less_leEq _ _ _ Hab)); auto. -apply included_trans with (Compact (less_leEq _ _ _ Hab)); auto. -intros e He; elim (H0 e He); intros e' He'. -exists e'; auto. +Proof. + intros a b Hab c d Hcd F F' H H0. + elim H0; clear H0; intros incF H0. + elim H0; clear H0; intros incF' H0. + apply Derivative_I_char. + apply included_trans with (Compact (less_leEq _ _ _ Hab)); auto. + apply included_trans with (Compact (less_leEq _ _ _ Hab)); auto. + intros e He; elim (H0 e He); intros e' He'. + exists e'; auto. Qed. diff --git a/ftc/DerivativeOps.v b/ftc/DerivativeOps.v index 4918d95f9..f5944d7ea 100644 --- a/ftc/DerivativeOps.v +++ b/ftc/DerivativeOps.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Derivative. @@ -67,21 +67,20 @@ Hypothesis Fbnd : bnd_away_zero I F. (* end show *) Lemma bnd_away_zero_square : bnd_away_zero I (F{*}F). -elim Fbnd; clear Fbnd; intros H H0. -elim H0; clear H0; intros x H1 H2. -split. -Included. -exists (x[*]x). -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; - assumption. -intros y Hy H0. -unfold I in H; - apply leEq_wdr with (AbsIR (FRestr H y H0)[*]AbsIR (FRestr H y H0)). -apply mult_resp_leEq_both; try (apply less_leEq; assumption); simpl in |- *; - apply H2; try assumption. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply AbsIR_wd; simpl in |- *; rational. +Proof. + elim Fbnd; clear Fbnd; intros H H0. + elim H0; clear H0; intros x H1 H2. + split. + Included. + exists (x[*]x). + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; assumption. + intros y Hy H0. + unfold I in H; apply leEq_wdr with (AbsIR (FRestr H y H0)[*]AbsIR (FRestr H y H0)). + apply mult_resp_leEq_both; try (apply less_leEq; assumption); simpl in |- *; + apply H2; try assumption. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply AbsIR_wd; simpl in |- *; rational. Qed. End Lemmas. @@ -105,40 +104,42 @@ Let I := Compact Hab. (* end hide *) Lemma Derivative_I_const : forall c : IR, Derivative_I Hab' [-C-]c [-C-]Zero. -intros. -apply Derivative_I_char. -Included. -Included. -intros e He. -exists OneR. -apply pos_one. -intros. -simpl in |- *. -apply leEq_wdl with ZeroR. -astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. -apply less_leEq; assumption. -apply AbsIR_nonneg. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply AbsIRz_isz. -apply AbsIR_wd; rational. +Proof. + intros. + apply Derivative_I_char. + Included. + Included. + intros e He. + exists OneR. + apply pos_one. + intros. + simpl in |- *. + apply leEq_wdl with ZeroR. + astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. + apply less_leEq; assumption. + apply AbsIR_nonneg. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply AbsIRz_isz. + apply AbsIR_wd; rational. Qed. Lemma Derivative_I_id : Derivative_I Hab' FId [-C-]One. -intros. -apply Derivative_I_char. -Included. -Included. -intros e He. -exists e. -assumption. -intros. -apply leEq_wdl with ZeroR. -astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. -apply less_leEq; assumption. -apply AbsIR_nonneg. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply AbsIRz_isz. -apply AbsIR_wd; simpl in |- *; rational. +Proof. + intros. + apply Derivative_I_char. + Included. + Included. + intros e He. + exists e. + assumption. + intros. + apply leEq_wdl with ZeroR. + astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. + apply less_leEq; assumption. + apply AbsIR_nonneg. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply AbsIRz_isz. + apply AbsIR_wd; simpl in |- *; rational. Qed. Variables F F' G G' : PartIR. @@ -147,197 +148,185 @@ Hypothesis derF : Derivative_I Hab' F F'. Hypothesis derG : Derivative_I Hab' G G'. Lemma Derivative_I_plus : Derivative_I Hab' (F{+}G) (F'{+}G'). -elim derF; intros incF H1. -elim H1; intros incF' H2. -elim derG; intros incG H5. -elim H5; intros incG' H6. -clear H5 H1. -apply Derivative_I_char. -Included. -Included. -intros e He. -elim (H2 _ (pos_div_two _ _ He)). -intros df H H0. -elim (H6 _ (pos_div_two _ _ He)). -intros dg H1 H3. -clear H2 H6. -exists (Min df dg). -apply less_Min; assumption. -intros. -rstepr (e [/]TwoNZ[*]AbsIR (y[-]x)[+]e [/]TwoNZ[*]AbsIR (y[-]x)); - simpl in |- *. -set (fx := F x (ProjIR1 Hx)) in *. -set (fy := F y (ProjIR1 Hy)) in *. -set (gx := G x (ProjIR2 Hx)) in *. -set (gy := G y (ProjIR2 Hy)) in *. -set (f'x := F' x (ProjIR1 Hx')) in *. -set (g'x := G' x (ProjIR2 Hx')) in *. -apply - leEq_wdl with (AbsIR (fy[-]fx[-]f'x[*](y[-]x)[+](gy[-]gx[-]g'x[*](y[-]x)))). -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both; unfold fx, fy, gx, gy, f'x, g'x in |- *; - [ apply H0 | apply H3 ]; try assumption; - apply leEq_transitive with (Min df dg). -assumption. -apply Min_leEq_lft. -assumption. -apply Min_leEq_rht. -apply AbsIR_wd; rational. +Proof. + elim derF; intros incF H1. + elim H1; intros incF' H2. + elim derG; intros incG H5. + elim H5; intros incG' H6. + clear H5 H1. + apply Derivative_I_char. + Included. + Included. + intros e He. + elim (H2 _ (pos_div_two _ _ He)). + intros df H H0. + elim (H6 _ (pos_div_two _ _ He)). + intros dg H1 H3. + clear H2 H6. + exists (Min df dg). + apply less_Min; assumption. + intros. + rstepr (e [/]TwoNZ[*]AbsIR (y[-]x)[+]e [/]TwoNZ[*]AbsIR (y[-]x)); simpl in |- *. + set (fx := F x (ProjIR1 Hx)) in *. + set (fy := F y (ProjIR1 Hy)) in *. + set (gx := G x (ProjIR2 Hx)) in *. + set (gy := G y (ProjIR2 Hy)) in *. + set (f'x := F' x (ProjIR1 Hx')) in *. + set (g'x := G' x (ProjIR2 Hx')) in *. + apply leEq_wdl with (AbsIR (fy[-]fx[-]f'x[*](y[-]x)[+](gy[-]gx[-]g'x[*](y[-]x)))). + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both; unfold fx, fy, gx, gy, f'x, g'x in |- *; + [ apply H0 | apply H3 ]; try assumption; apply leEq_transitive with (Min df dg). + assumption. + apply Min_leEq_lft. + assumption. + apply Min_leEq_rht. + apply AbsIR_wd; rational. Qed. Lemma Derivative_I_inv : Derivative_I Hab' {--}F {--}F'. -clear derG. -elim derF; intros incF H1. -elim H1; intros incF' H2. -clear H1. -apply Derivative_I_char. -Included. -Included. -intros e He. -elim (H2 e He); intros d H0 H1. -exists d. -assumption. -intros. -simpl in |- *. -apply leEq_wdl with (AbsIR [--](F y Hy[-]F x Hx[-]F' x Hx'[*](y[-]x))). -eapply leEq_wdl. -2: apply AbsIR_inv. -auto. -apply AbsIR_wd; rational. +Proof. + clear derG. + elim derF; intros incF H1. + elim H1; intros incF' H2. + clear H1. + apply Derivative_I_char. + Included. + Included. + intros e He. + elim (H2 e He); intros d H0 H1. + exists d. + assumption. + intros. + simpl in |- *. + apply leEq_wdl with (AbsIR [--](F y Hy[-]F x Hx[-]F' x Hx'[*](y[-]x))). + eapply leEq_wdl. + 2: apply AbsIR_inv. + auto. + apply AbsIR_wd; rational. Qed. Lemma Derivative_I_mult : Derivative_I Hab' (F{*}G) (F{*}G'{+}F'{*}G). -elim derF; intros incF H1. -elim H1; intros incF' H2. -elim derG; intros incG H5. -elim H5; intros incG' H6. -clear H5 H1. -set (contF := deriv_imp_contin_I _ _ _ _ _ (less_leEq _ _ _ Hab') derF) in *. -set (contG := deriv_imp_contin_I _ _ _ _ _ (less_leEq _ _ _ Hab') derG) in *. -set (contG' := deriv_imp_contin'_I _ _ _ _ _ (less_leEq _ _ _ Hab') derG) - in *. -set (nF := Norm_Funct contF) in *. -set (nG := Norm_Funct contG) in *. -set (nG' := Norm_Funct contG') in *. -apply Derivative_I_char. -Contin. -Contin. -intros e He. -set (M := Max (Max nF nG) nG'[+]One) in *. -cut (Zero [<] M). -intro HM'. -cut (M [#] Zero). -intro HM. -2: apply Greater_imp_ap; assumption. -cut (Three[*]M [#] Zero). -intro H3M. -2: apply mult_resp_ap_zero; [ apply three_ap_zero | assumption ]. -cut (Zero [<] (e[/] _[//]H3M)). -intro HeM. -elim (contin_prop _ _ _ _ contF _ HeM); intros dc H H0. -elim (H2 _ HeM); intros df H1 H3. -elim (H6 _ HeM); intros dg H4 H5. -clear H2 H6. -set (d := Min (Min df dg) dc) in *. -exists d. -unfold d in |- *; repeat apply less_Min; assumption. -intros x y H2 H6 Hx Hy Hx' H7. -simpl in |- *. -set (fx := F x (ProjIR1 Hx)) in *. -set (fy := F y (ProjIR1 Hy)) in *. -set (gx := G x (ProjIR2 Hx)) in *. -set (gy := G y (ProjIR2 Hy)) in *. -set (f'x := F' x (ProjIR1 (ProjIR2 Hx'))) in *. -set (g'x := G' x (ProjIR2 (ProjIR1 Hx'))) in *. -apply - leEq_wdl with (AbsIR (fy[*]gy[-]fx[*]gx[-](fx[*]g'x[+]f'x[*]gx)[*](y[-]x))). -2: apply AbsIR_wd; unfold fx, f'x, gx, g'x in |- *; rational. -apply - leEq_wdl - with - (AbsIR - (fy[*](gy[-]gx[-]g'x[*](y[-]x))[+](fy[-]fx)[*]g'x[*](y[-]x)[+] - gx[*](fy[-]fx[-]f'x[*](y[-]x)))). -astepr (e[*]AbsIR (y[-]x)). -rstepr - (e [/]ThreeNZ[*]AbsIR (y[-]x)[+]e [/]ThreeNZ[*]AbsIR (y[-]x)[+] - e [/]ThreeNZ[*]AbsIR (y[-]x)). -eapply leEq_transitive; [ apply triangle_IR | apply plus_resp_leEq_both ]. -eapply leEq_transitive; [ apply triangle_IR | apply plus_resp_leEq_both ]. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply leEq_transitive with (M[*]AbsIR (gy[-]gx[-]g'x[*](y[-]x))). -apply mult_resp_leEq_rht; - [ apply leEq_transitive with nF | apply AbsIR_nonneg ]. -unfold nF, I, fy in |- *; apply norm_bnd_AbsIR. -assumption. -unfold M in |- *; eapply leEq_transitive. -2: apply less_leEq; apply less_plusOne. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply lft_leEq_Max. -apply shift_mult_leEq' with HM. -assumption. -rstepr ((e[/] _[//]H3M)[*]AbsIR (y[-]x)). -unfold gx, gy, g'x in |- *; apply H5; try assumption. -apply leEq_transitive with d. -assumption. -unfold d in |- *; eapply leEq_transitive; - [ apply Min_leEq_lft | apply Min_leEq_rht ]. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply leEq_transitive with (AbsIR (fy[-]fx)[*]M). -apply mult_resp_leEq_lft. -unfold M in |- *; eapply leEq_transitive. -2: apply less_leEq; apply less_plusOne. -eapply leEq_transitive. -2: apply rht_leEq_Max. -unfold nG', I, g'x in |- *; apply norm_bnd_AbsIR; assumption. -apply AbsIR_nonneg. -apply shift_mult_leEq with HM. -assumption. -rstepr (e[/] _[//]H3M). -unfold fx, fy in |- *; apply H0; try assumption. -apply leEq_transitive with d. -2: unfold d in |- *; apply Min_leEq_rht. -eapply leEq_wdl. -apply H7. -apply AbsIR_minus. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply leEq_transitive with (M[*]AbsIR (fy[-]fx[-]f'x[*](y[-]x))). -apply mult_resp_leEq_rht; - [ apply leEq_transitive with nG | apply AbsIR_nonneg ]. -unfold nG, I, gx in |- *; apply norm_bnd_AbsIR; assumption. -unfold M in |- *; eapply leEq_transitive. -2: apply less_leEq; apply less_plusOne. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply rht_leEq_Max. -apply shift_mult_leEq' with HM. -assumption. -rstepr ((e[/] _[//]H3M)[*]AbsIR (y[-]x)). -unfold fx, fy, f'x in |- *; apply H3; try assumption. -apply leEq_transitive with d. -assumption. -unfold d in |- *; eapply leEq_transitive; - [ apply Min_leEq_lft | apply Min_leEq_lft ]. -apply AbsIR_wd; rational. -apply div_resp_pos. -astepl (Three[*]ZeroR); apply mult_resp_less_lft. -assumption. -apply pos_three. -assumption. -unfold M in |- *; eapply leEq_less_trans. -2: apply less_plusOne. -eapply leEq_transitive. -2: apply rht_leEq_Max. -unfold nG' in |- *; apply positive_norm. +Proof. + elim derF; intros incF H1. + elim H1; intros incF' H2. + elim derG; intros incG H5. + elim H5; intros incG' H6. + clear H5 H1. + set (contF := deriv_imp_contin_I _ _ _ _ _ (less_leEq _ _ _ Hab') derF) in *. + set (contG := deriv_imp_contin_I _ _ _ _ _ (less_leEq _ _ _ Hab') derG) in *. + set (contG' := deriv_imp_contin'_I _ _ _ _ _ (less_leEq _ _ _ Hab') derG) in *. + set (nF := Norm_Funct contF) in *. + set (nG := Norm_Funct contG) in *. + set (nG' := Norm_Funct contG') in *. + apply Derivative_I_char. + Contin. + Contin. + intros e He. + set (M := Max (Max nF nG) nG'[+]One) in *. + cut (Zero [<] M). + intro HM'. + cut (M [#] Zero). + intro HM. + 2: apply Greater_imp_ap; assumption. + cut (Three[*]M [#] Zero). + intro H3M. + 2: apply mult_resp_ap_zero; [ apply three_ap_zero | assumption ]. + cut (Zero [<] (e[/] _[//]H3M)). + intro HeM. + elim (contin_prop _ _ _ _ contF _ HeM); intros dc H H0. + elim (H2 _ HeM); intros df H1 H3. + elim (H6 _ HeM); intros dg H4 H5. + clear H2 H6. + set (d := Min (Min df dg) dc) in *. + exists d. + unfold d in |- *; repeat apply less_Min; assumption. + intros x y H2 H6 Hx Hy Hx' H7. + simpl in |- *. + set (fx := F x (ProjIR1 Hx)) in *. + set (fy := F y (ProjIR1 Hy)) in *. + set (gx := G x (ProjIR2 Hx)) in *. + set (gy := G y (ProjIR2 Hy)) in *. + set (f'x := F' x (ProjIR1 (ProjIR2 Hx'))) in *. + set (g'x := G' x (ProjIR2 (ProjIR1 Hx'))) in *. + apply leEq_wdl with (AbsIR (fy[*]gy[-]fx[*]gx[-](fx[*]g'x[+]f'x[*]gx)[*](y[-]x))). + 2: apply AbsIR_wd; unfold fx, f'x, gx, g'x in |- *; rational. + apply leEq_wdl with (AbsIR (fy[*](gy[-]gx[-]g'x[*](y[-]x))[+](fy[-]fx)[*]g'x[*](y[-]x)[+] + gx[*](fy[-]fx[-]f'x[*](y[-]x)))). + astepr (e[*]AbsIR (y[-]x)). + rstepr (e [/]ThreeNZ[*]AbsIR (y[-]x)[+]e [/]ThreeNZ[*]AbsIR (y[-]x)[+] e [/]ThreeNZ[*]AbsIR (y[-]x)). + eapply leEq_transitive; [ apply triangle_IR | apply plus_resp_leEq_both ]. + eapply leEq_transitive; [ apply triangle_IR | apply plus_resp_leEq_both ]. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_transitive with (M[*]AbsIR (gy[-]gx[-]g'x[*](y[-]x))). + apply mult_resp_leEq_rht; [ apply leEq_transitive with nF | apply AbsIR_nonneg ]. + unfold nF, I, fy in |- *; apply norm_bnd_AbsIR. + assumption. + unfold M in |- *; eapply leEq_transitive. + 2: apply less_leEq; apply less_plusOne. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply lft_leEq_Max. + apply shift_mult_leEq' with HM. + assumption. + rstepr ((e[/] _[//]H3M)[*]AbsIR (y[-]x)). + unfold gx, gy, g'x in |- *; apply H5; try assumption. + apply leEq_transitive with d. + assumption. + unfold d in |- *; eapply leEq_transitive; [ apply Min_leEq_lft | apply Min_leEq_rht ]. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_transitive with (AbsIR (fy[-]fx)[*]M). + apply mult_resp_leEq_lft. + unfold M in |- *; eapply leEq_transitive. + 2: apply less_leEq; apply less_plusOne. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + unfold nG', I, g'x in |- *; apply norm_bnd_AbsIR; assumption. + apply AbsIR_nonneg. + apply shift_mult_leEq with HM. + assumption. + rstepr (e[/] _[//]H3M). + unfold fx, fy in |- *; apply H0; try assumption. + apply leEq_transitive with d. + 2: unfold d in |- *; apply Min_leEq_rht. + eapply leEq_wdl. + apply H7. + apply AbsIR_minus. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_transitive with (M[*]AbsIR (fy[-]fx[-]f'x[*](y[-]x))). + apply mult_resp_leEq_rht; [ apply leEq_transitive with nG | apply AbsIR_nonneg ]. + unfold nG, I, gx in |- *; apply norm_bnd_AbsIR; assumption. + unfold M in |- *; eapply leEq_transitive. + 2: apply less_leEq; apply less_plusOne. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply rht_leEq_Max. + apply shift_mult_leEq' with HM. + assumption. + rstepr ((e[/] _[//]H3M)[*]AbsIR (y[-]x)). + unfold fx, fy, f'x in |- *; apply H3; try assumption. + apply leEq_transitive with d. + assumption. + unfold d in |- *; eapply leEq_transitive; [ apply Min_leEq_lft | apply Min_leEq_lft ]. + apply AbsIR_wd; rational. + apply div_resp_pos. + astepl (Three[*]ZeroR); apply mult_resp_less_lft. + assumption. + apply pos_three. + assumption. + unfold M in |- *; eapply leEq_less_trans. + 2: apply less_plusOne. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + unfold nG' in |- *; apply positive_norm. Qed. (** @@ -349,154 +338,133 @@ Hypothesis Fbnd : bnd_away_zero I F. (* end show *) Lemma Derivative_I_recip : Derivative_I Hab' {1/}F {--} (F'{/}F{*}F). -cut (forall (x : IR) (Hx : I x) Hx', F x Hx' [#] Zero). -cut (forall (x : IR) (Hx : I x) Hx', (F{*}F) x Hx' [#] Zero). -intros Hff Hf. -clear derG. -elim derF; intros incF H1. -elim H1; intros incF' H2. -assert (contF := deriv_imp_contin_I _ _ _ _ _ Hab derF). -assert (contF' := deriv_imp_contin'_I _ _ _ _ _ Hab derF). -assert (contF_ := contin_prop _ _ _ _ contF). -clear H1. -apply Derivative_I_char. -Contin. -Contin. -intros e He. -cut (Continuous_I Hab {1/}F); [ intro H | Contin ]. -set (nF1 := Norm_Funct H) in *. -set (nF' := Norm_Funct contF') in *. -set (M := Max nF1 nF'[+]One) in *. -cut (Zero [<] M). -intro HM. -cut (M [#] Zero). -intro H0. -2: apply Greater_imp_ap; assumption. -cut (Two[*]M[*]M [#] Zero). -intro HM2. -cut (Two[*]M[*]M[*]M[*]M [#] Zero). -intro HM4. -cut (Zero [<] (e[/] _[//]HM2)). -intro HeM2. -cut (Zero [<] (e[/] _[//]HM4)). -intro HeM4. -elim (contF_ _ HeM4). -intros d1 H1 H3. -elim (H2 _ HeM2). -intros d2 H4 H5. -clear H2. -exists (Min d1 d2). -apply less_Min; assumption. -intros x y H2 H6 Hx Hy Hx' H7. -cut (forall (x : IR) (Hx : I x) Hx', AbsIR (One[/] _[//]Hf x Hx Hx') [<=] M). -intro leEqM. -2: intros z Hz Hz'. -2: apply leEq_wdl with (AbsIR ( {1/}F z (contin_imp_inc _ _ _ _ H z Hz))). -2: unfold M in |- *; eapply leEq_transitive. -3: apply less_leEq; apply less_plusOne. -2: eapply leEq_transitive. -3: apply lft_leEq_Max. -2: unfold nF1 in |- *; apply norm_bnd_AbsIR; assumption. -2: apply AbsIR_wd; simpl in |- *; algebra. -cut (Dom F x); - [ intro Hxx - | simpl in Hx; unfold extend in Hx; inversion_clear Hx; assumption ]. -cut (Dom F y); - [ intro Hyy - | simpl in Hy; unfold extend in Hy; inversion_clear Hy; assumption ]. -cut (Dom F' x); - [ intro Hxx' - | simpl in Hx'; unfold extend in Hx'; inversion_clear Hx'; assumption ]. -apply - leEq_wdl - with - (AbsIR - ((One[/] _[//]Hf y H6 Hyy)[-](One[/] _[//]Hf x H2 Hxx)[+] - (F' x Hxx'[/] _[//] - mult_resp_ap_zero _ _ _ (Hf x H2 Hxx) (Hf x H2 Hxx))[*]( - y[-]x))). -apply - leEq_wdl - with - (AbsIR - ([--](One[/] _[//]mult_resp_ap_zero _ _ _ (Hf x H2 Hxx) (Hf y H6 Hyy))[*] - (F y Hyy[-]F x Hxx[-]F' x Hxx'[*](y[-]x)[+] - F' x Hxx'[*](F x Hxx[-]F y Hyy[/] _[//]Hf x H2 Hxx)[*](y[-]x)))). -2: apply AbsIR_wd; rational. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -rstepr (M[*]M[*]((e[/] _[//]mult_resp_ap_zero _ _ _ H0 H0)[*]AbsIR (y[-]x))). -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -eapply leEq_wdl. -2: apply AbsIR_inv. -apply - leEq_wdl - with (AbsIR ((One[/] _[//]Hf x H2 Hxx)[*](One[/] _[//]Hf y H6 Hyy))). -2: apply AbsIR_wd; rational. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try apply AbsIR_nonneg; apply leEqM. -eapply leEq_transitive. -apply triangle_IR. -rstepr ((e[/] _[//]HM2)[*]AbsIR (y[-]x)[+](e[/] _[//]HM2)[*]AbsIR (y[-]x)). -apply plus_resp_leEq_both. -apply H5; try assumption. -eapply leEq_transitive. -apply H7. -apply Min_leEq_rht. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -apply - leEq_wdl - with (AbsIR ((F x Hxx[-]F y Hyy)[*](F' x Hxx'[/] _[//]Hf x H2 Hxx))). -2: apply AbsIR_wd; rational. -rstepr ((e[/] _[//]HM4)[*](M[*]M)). -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -apply H3; try assumption. -eapply leEq_transitive. -apply H7. -apply Min_leEq_lft. -apply leEq_wdl with (AbsIR (F' x Hxx'[*](One[/] _[//]Hf x H2 Hxx))). -2: apply AbsIR_wd; rational. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -unfold M in |- *; eapply leEq_transitive. -2: apply less_leEq; apply less_plusOne. -eapply leEq_transitive. -2: apply rht_leEq_Max. -unfold nF' in |- *; apply norm_bnd_AbsIR; assumption. -apply leEqM. -apply AbsIR_wd. -simpl in |- *; rational. -apply div_resp_pos. -repeat (astepl (ZeroR[*]Zero); apply mult_resp_less_both); - try apply leEq_reflexive; try assumption. -apply pos_two. -assumption. -apply div_resp_pos. -repeat (astepl (ZeroR[*]Zero); apply mult_resp_less_both); - try apply leEq_reflexive; try assumption. -apply pos_two. -assumption. -repeat apply mult_resp_ap_zero; try assumption. -apply two_ap_zero. -repeat apply mult_resp_ap_zero; try assumption. -apply two_ap_zero. -unfold M in |- *; eapply leEq_less_trans. -2: apply less_plusOne. -eapply leEq_transitive. -2: apply lft_leEq_Max. -unfold nF1 in |- *; apply positive_norm. -intros. -apply bnd_imp_ap_zero with I; auto. -unfold I in |- *; Included. -intros. -apply bnd_imp_ap_zero with I; auto. +Proof. + cut (forall (x : IR) (Hx : I x) Hx', F x Hx' [#] Zero). + cut (forall (x : IR) (Hx : I x) Hx', (F{*}F) x Hx' [#] Zero). + intros Hff Hf. + clear derG. + elim derF; intros incF H1. + elim H1; intros incF' H2. + assert (contF := deriv_imp_contin_I _ _ _ _ _ Hab derF). + assert (contF' := deriv_imp_contin'_I _ _ _ _ _ Hab derF). + assert (contF_ := contin_prop _ _ _ _ contF). + clear H1. + apply Derivative_I_char. + Contin. + Contin. + intros e He. + cut (Continuous_I Hab {1/}F); [ intro H | Contin ]. + set (nF1 := Norm_Funct H) in *. + set (nF' := Norm_Funct contF') in *. + set (M := Max nF1 nF'[+]One) in *. + cut (Zero [<] M). + intro HM. + cut (M [#] Zero). + intro H0. + 2: apply Greater_imp_ap; assumption. + cut (Two[*]M[*]M [#] Zero). + intro HM2. + cut (Two[*]M[*]M[*]M[*]M [#] Zero). + intro HM4. + cut (Zero [<] (e[/] _[//]HM2)). + intro HeM2. + cut (Zero [<] (e[/] _[//]HM4)). + intro HeM4. + elim (contF_ _ HeM4). + intros d1 H1 H3. + elim (H2 _ HeM2). + intros d2 H4 H5. + clear H2. + exists (Min d1 d2). + apply less_Min; assumption. + intros x y H2 H6 Hx Hy Hx' H7. + cut (forall (x : IR) (Hx : I x) Hx', AbsIR (One[/] _[//]Hf x Hx Hx') [<=] M). + intro leEqM. + 2: intros z Hz Hz'. + 2: apply leEq_wdl with (AbsIR ( {1/}F z (contin_imp_inc _ _ _ _ H z Hz))). + 2: unfold M in |- *; eapply leEq_transitive. + 3: apply less_leEq; apply less_plusOne. + 2: eapply leEq_transitive. + 3: apply lft_leEq_Max. + 2: unfold nF1 in |- *; apply norm_bnd_AbsIR; assumption. + 2: apply AbsIR_wd; simpl in |- *; algebra. + cut (Dom F x); [ intro Hxx | simpl in Hx; unfold extend in Hx; inversion_clear Hx; assumption ]. + cut (Dom F y); [ intro Hyy | simpl in Hy; unfold extend in Hy; inversion_clear Hy; assumption ]. + cut (Dom F' x); [ intro Hxx' | simpl in Hx'; unfold extend in Hx'; inversion_clear Hx'; assumption ]. + apply leEq_wdl with (AbsIR ((One[/] _[//]Hf y H6 Hyy)[-](One[/] _[//]Hf x H2 Hxx)[+] + (F' x Hxx'[/] _[//] mult_resp_ap_zero _ _ _ (Hf x H2 Hxx) (Hf x H2 Hxx))[*]( y[-]x))). + apply leEq_wdl with (AbsIR ([--](One[/] _[//]mult_resp_ap_zero _ _ _ (Hf x H2 Hxx) (Hf y H6 Hyy))[*] + (F y Hyy[-]F x Hxx[-]F' x Hxx'[*](y[-]x)[+] + F' x Hxx'[*](F x Hxx[-]F y Hyy[/] _[//]Hf x H2 Hxx)[*](y[-]x)))). + 2: apply AbsIR_wd; rational. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + rstepr (M[*]M[*]((e[/] _[//]mult_resp_ap_zero _ _ _ H0 H0)[*]AbsIR (y[-]x))). + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + eapply leEq_wdl. + 2: apply AbsIR_inv. + apply leEq_wdl with (AbsIR ((One[/] _[//]Hf x H2 Hxx)[*](One[/] _[//]Hf y H6 Hyy))). + 2: apply AbsIR_wd; rational. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try apply AbsIR_nonneg; apply leEqM. + eapply leEq_transitive. + apply triangle_IR. + rstepr ((e[/] _[//]HM2)[*]AbsIR (y[-]x)[+](e[/] _[//]HM2)[*]AbsIR (y[-]x)). + apply plus_resp_leEq_both. + apply H5; try assumption. + eapply leEq_transitive. + apply H7. + apply Min_leEq_rht. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + apply leEq_wdl with (AbsIR ((F x Hxx[-]F y Hyy)[*](F' x Hxx'[/] _[//]Hf x H2 Hxx))). + 2: apply AbsIR_wd; rational. + rstepr ((e[/] _[//]HM4)[*](M[*]M)). + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + apply H3; try assumption. + eapply leEq_transitive. + apply H7. + apply Min_leEq_lft. + apply leEq_wdl with (AbsIR (F' x Hxx'[*](One[/] _[//]Hf x H2 Hxx))). + 2: apply AbsIR_wd; rational. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + unfold M in |- *; eapply leEq_transitive. + 2: apply less_leEq; apply less_plusOne. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + unfold nF' in |- *; apply norm_bnd_AbsIR; assumption. + apply leEqM. + apply AbsIR_wd. + simpl in |- *; rational. + apply div_resp_pos. + repeat (astepl (ZeroR[*]Zero); apply mult_resp_less_both); try apply leEq_reflexive; try assumption. + apply pos_two. + assumption. + apply div_resp_pos. + repeat (astepl (ZeroR[*]Zero); apply mult_resp_less_both); try apply leEq_reflexive; try assumption. + apply pos_two. + assumption. + repeat apply mult_resp_ap_zero; try assumption. + apply two_ap_zero. + repeat apply mult_resp_ap_zero; try assumption. + apply two_ap_zero. + unfold M in |- *; eapply leEq_less_trans. + 2: apply less_plusOne. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + unfold nF1 in |- *; apply positive_norm. + intros. + apply bnd_imp_ap_zero with I; auto. + unfold I in |- *; Included. + intros. + apply bnd_imp_ap_zero with I; auto. Qed. End Local_Results. @@ -526,110 +494,102 @@ From this lemmas the rules for the other algebraic operations follow directly. *) Lemma Derivative_I_minus : Derivative_I Hab' (F{-}G) (F'{-}G'). -apply Derivative_I_wdl with (F{+}{--}G). -FEQ. -apply Derivative_I_wdr with (F'{+}{--}G'). -FEQ. -Deriv. +Proof. + apply Derivative_I_wdl with (F{+}{--}G). + FEQ. + apply Derivative_I_wdr with (F'{+}{--}G'). + FEQ. + Deriv. Qed. Lemma Derivative_I_scal : forall c : IR, Derivative_I Hab' (c{**}F) (c{**}F'). -intro. -unfold Fscalmult in |- *. -apply Derivative_I_wdr with ([-C-]c{*}F'{+}[-C-]Zero{*}F). -FEQ. -Deriv. +Proof. + intro. + unfold Fscalmult in |- *. + apply Derivative_I_wdr with ([-C-]c{*}F'{+}[-C-]Zero{*}F). + FEQ. + Deriv. Qed. Lemma Derivative_I_nth : forall n, Derivative_I Hab' (F{^}S n) (nring (S n) {**} (F'{*}F{^}n)). -unfold Fscalmult in |- *. -intro; induction n as [| n Hrecn]. -apply Derivative_I_wdl with F. -FEQ. -apply Derivative_I_wdr with F'. -FEQ. -assumption. -apply Derivative_I_wdl with (F{*}F{^}S n). -apply FNth_mult'; Included. -apply - Derivative_I_wdr - with (F{*} ([-C-](nring (S n)) {*} (F'{*}F{^}n)) {+}F'{*}F{^}S n). -apply eq_imp_Feq. -Included. -Included. -intros; simpl in |- *. -set (fx := F x (ProjIR1 (ProjIR1 Hx))) in *; simpl in (value of fx); - fold fx in |- *. -set (f'x := F' x (ProjIR1 (ProjIR2 (ProjIR2 (ProjIR1 Hx))))) in *; - simpl in (value of f'x); fold f'x in |- *. -set (fx' := F x (ProjIR2 (ProjIR2 (ProjIR2 (ProjIR1 Hx))))) in *; - simpl in (value of fx'); fold fx' in |- *. -set (f'x' := F' x (ProjIR1 (ProjIR2 Hx))) in *; simpl in (value of f'x'); - fold f'x' in |- *. -set (fx'' := F x (ProjIR2 (ProjIR2 Hx))) in *; simpl in (value of fx''); - fold fx'' in |- *. -set (f'x'' := F' x (ProjIR1 (ProjIR2 Hx'))) in *; simpl in (value of f'x''); - fold f'x'' in |- *. -set (fx''' := F x (ProjIR2 (ProjIR2 Hx'))) in *; simpl in (value of fx'''); - fold fx''' in |- *. -apply - eq_transitive_unfolded - with (fx[*]((nring n[+]One)[*](f'x[*]fx[^]n))[+]f'x[*](fx[^]n[*]fx)). -astepl (fx[*]((nring n[+]One)[*](f'x[*]fx'[^]n))[+]f'x'[*](fx''[^]n[*]fx'')). -repeat apply bin_op_wd_unfolded; try apply nexp_wd; - unfold fx, f'x, fx', f'x', fx'' in |- *; rational. -rstepl ((nring n[+]One[+]One)[*](f'x[*](fx[^]n[*]fx))). -astepr ((nring n[+]One[+]One)[*](f'x''[*](fx'''[^]n[*]fx'''))). -repeat apply bin_op_wd_unfolded; try apply nexp_wd; - unfold fx, f'x, f'x'', fx''' in |- *; rational. -Deriv. +Proof. + unfold Fscalmult in |- *. + intro; induction n as [| n Hrecn]. + apply Derivative_I_wdl with F. + FEQ. + apply Derivative_I_wdr with F'. + FEQ. + assumption. + apply Derivative_I_wdl with (F{*}F{^}S n). + apply FNth_mult'; Included. + apply Derivative_I_wdr with (F{*} ([-C-](nring (S n)) {*} (F'{*}F{^}n)) {+}F'{*}F{^}S n). + apply eq_imp_Feq. + Included. + Included. + intros; simpl in |- *. + set (fx := F x (ProjIR1 (ProjIR1 Hx))) in *; simpl in (value of fx); fold fx in |- *. + set (f'x := F' x (ProjIR1 (ProjIR2 (ProjIR2 (ProjIR1 Hx))))) in *; + simpl in (value of f'x); fold f'x in |- *. + set (fx' := F x (ProjIR2 (ProjIR2 (ProjIR2 (ProjIR1 Hx))))) in *; + simpl in (value of fx'); fold fx' in |- *. + set (f'x' := F' x (ProjIR1 (ProjIR2 Hx))) in *; simpl in (value of f'x'); fold f'x' in |- *. + set (fx'' := F x (ProjIR2 (ProjIR2 Hx))) in *; simpl in (value of fx''); fold fx'' in |- *. + set (f'x'' := F' x (ProjIR1 (ProjIR2 Hx'))) in *; simpl in (value of f'x''); fold f'x'' in |- *. + set (fx''' := F x (ProjIR2 (ProjIR2 Hx'))) in *; simpl in (value of fx'''); fold fx''' in |- *. + apply eq_transitive_unfolded with (fx[*]((nring n[+]One)[*](f'x[*]fx[^]n))[+]f'x[*](fx[^]n[*]fx)). + astepl (fx[*]((nring n[+]One)[*](f'x[*]fx'[^]n))[+]f'x'[*](fx''[^]n[*]fx'')). + repeat apply bin_op_wd_unfolded; try apply nexp_wd; + unfold fx, f'x, fx', f'x', fx'' in |- *; rational. + rstepl ((nring n[+]One[+]One)[*](f'x[*](fx[^]n[*]fx))). + astepr ((nring n[+]One[+]One)[*](f'x''[*](fx'''[^]n[*]fx'''))). + repeat apply bin_op_wd_unfolded; try apply nexp_wd; unfold fx, f'x, f'x'', fx''' in |- *; rational. + Deriv. Qed. Lemma Derivative_I_poly : forall p, Derivative_I Hab' (FPoly _ p) (FPoly _ (_D_ p)). Proof. -induction p. - apply Derivative_I_wdl with ([-C-] Zero). - FEQ. - apply Derivative_I_wdr with ([-C-] Zero). - FEQ. - Deriv. -simpl. -change (FPoly IR (cpoly_linear IR s p)) - with (FPoly IR (s[+X*]p)). -change (FPoly IR (cpoly_plus_cs IR p (cpoly_linear IR Zero (cpoly_diff IR p)))) - with (FPoly IR (p[+](Zero[+X*](_D_ p)))). -apply Derivative_I_wdl with ([-C-] s{+}FId{*}(FPoly IR p)). - repeat constructor. - reflexivity. -apply Derivative_I_wdr with ([-C-]Zero{+}(FId{*}(FPoly IR (_D_ p)){+}[-C-]One{*}(FPoly IR p))). - repeat constructor. + induction p. + apply Derivative_I_wdl with ([-C-] Zero). + FEQ. + apply Derivative_I_wdr with ([-C-] Zero). + FEQ. + Deriv. simpl. - intros x _ _ _. - change (Zero[+](x[*](_D_ p)!x[+]One[*]p!x)[=] - (p[+](Zero[+X*](_D_ p)))!x). - rewrite cpoly_lin. - autorewrite with apply. - rational. -Deriv. + change (FPoly IR (cpoly_linear IR s p)) with (FPoly IR (s[+X*]p)). + change (FPoly IR (cpoly_plus_cs IR p (cpoly_linear IR Zero (cpoly_diff IR p)))) + with (FPoly IR (p[+](Zero[+X*](_D_ p)))). + apply Derivative_I_wdl with ([-C-] s{+}FId{*}(FPoly IR p)). + repeat constructor. + reflexivity. + apply Derivative_I_wdr with ([-C-]Zero{+}(FId{*}(FPoly IR (_D_ p)){+}[-C-]One{*}(FPoly IR p))). + repeat constructor. + simpl. + intros x _ _ _. + change (Zero[+](x[*](_D_ p)!x[+]One[*]p!x)[=] (p[+](Zero[+X*](_D_ p)))!x). + rewrite cpoly_lin. + autorewrite with apply. + rational. + Deriv. Qed. Hypothesis Gbnd : bnd_away_zero I G. Lemma Derivative_I_div : Derivative_I Hab' (F{/}G) ((F'{*}G{-}F{*}G') {/}G{*}G). -cut (Derivative_I Hab' (F{/}G) (F{*}{--} (G'{/}G{*}G) {+}F'{*}{1/}G)). -intro H. -eapply Derivative_I_wdr. -2: apply H. -apply eq_imp_Feq. -Included. -apply included_FDiv. -Included. -Included. -intros; apply bnd_imp_ap_zero with I; unfold I in |- *; Included. -intros; simpl in |- *; rational. -apply Derivative_I_wdl with (F{*}{1/}G). -FEQ. -Deriv. +Proof. + cut (Derivative_I Hab' (F{/}G) (F{*}{--} (G'{/}G{*}G) {+}F'{*}{1/}G)). + intro H. + eapply Derivative_I_wdr. + 2: apply H. + apply eq_imp_Feq. + Included. + apply included_FDiv. + Included. + Included. + intros; apply bnd_imp_ap_zero with I; unfold I in |- *; Included. + intros; simpl in |- *; rational. + apply Derivative_I_wdl with (F{*}{1/}G). + FEQ. + Deriv. Qed. End Corolaries. @@ -653,36 +613,39 @@ Let I := Compact Hab. Lemma Derivative_I_Sum0 : forall f f' : nat -> PartIR, (forall n, Derivative_I Hab' (f n) (f' n)) -> forall n, Derivative_I Hab' (FSum0 n f) (FSum0 n f'). -intros. -induction n as [| n Hrecn]. -eapply Derivative_I_wdl. -apply FSum0_0; Included. -eapply Derivative_I_wdr. -apply FSum0_0; Included. -apply Derivative_I_const. -eapply Derivative_I_wdl. -apply FSum0_S; Included. -eapply Derivative_I_wdr. -apply FSum0_S; Included. -apply Derivative_I_plus; auto. +Proof. + intros. + induction n as [| n Hrecn]. + eapply Derivative_I_wdl. + apply FSum0_0; Included. + eapply Derivative_I_wdr. + apply FSum0_0; Included. + apply Derivative_I_const. + eapply Derivative_I_wdl. + apply FSum0_S; Included. + eapply Derivative_I_wdr. + apply FSum0_S; Included. + apply Derivative_I_plus; auto. Qed. Lemma Derivative_I_Sumx : forall n (f f' : forall i, i < n -> PartIR), (forall i Hi Hi', Derivative_I Hab' (f i Hi) (f' i Hi')) -> Derivative_I Hab' (FSumx n f) (FSumx n f'). -intro; induction n as [| n Hrecn]; intros f f' derF. -simpl in |- *; apply Derivative_I_const; auto. -simpl in |- *; apply Derivative_I_plus; auto. +Proof. + intro; induction n as [| n Hrecn]; intros f f' derF. + simpl in |- *; apply Derivative_I_const; auto. + simpl in |- *; apply Derivative_I_plus; auto. Qed. Lemma Derivative_I_Sum : forall f f' : nat -> PartIR, (forall n, Derivative_I Hab' (f n) (f' n)) -> forall m n, Derivative_I Hab' (FSum m n f) (FSum m n f'). -intros. -eapply Derivative_I_wdl. -apply Feq_symmetric; apply FSum_FSum0'; Included. -eapply Derivative_I_wdr. -apply Feq_symmetric; apply FSum_FSum0'; Included. -apply Derivative_I_minus; apply Derivative_I_Sum0; auto. +Proof. + intros. + eapply Derivative_I_wdl. + apply Feq_symmetric; apply FSum_FSum0'; Included. + eapply Derivative_I_wdr. + apply Feq_symmetric; apply FSum_FSum0'; Included. + apply Derivative_I_minus; apply Derivative_I_Sum0; auto. Qed. End Derivative_Sums. diff --git a/ftc/Differentiability.v b/ftc/Differentiability.v index 9eb6cf06e..d2692356d 100644 --- a/ftc/Differentiability.v +++ b/ftc/Differentiability.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export PartInterval. Require Export DerivativeOps. @@ -89,15 +89,14 @@ A function differentiable in [[a,b]] is differentiable in every proper compact s Lemma included_imp_diffble : forall a b Hab c d Hcd F, included (compact c d (less_leEq _ _ _ Hcd)) (compact a b (less_leEq _ _ _ Hab)) -> Diffble_I Hab F -> Diffble_I Hcd F. -intros a b Hab c d Hcd F H H0. -elim H0; clear H0; intros f' derF. -exists - (IntPartIR (F:=(Frestr (F:=PartInt f') (compact_wd _ _ _) H)) - (included_refl _ _)). -apply Derivative_I_wdr with (PartInt f'). -FEQ. -simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -exact (included_imp_deriv _ _ _ _ _ _ _ _ H derF). +Proof. + intros a b Hab c d Hcd F H H0. + elim H0; clear H0; intros f' derF. + exists (IntPartIR (F:=(Frestr (F:=PartInt f') (compact_wd _ _ _) H)) (included_refl _ _)). + apply Derivative_I_wdr with (PartInt f'). + FEQ. + simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + exact (included_imp_deriv _ _ _ _ _ _ _ _ H derF). Qed. (** @@ -113,9 +112,10 @@ Let I := Compact Hab. (* end hide *) Lemma diffble_imp_inc : forall F, Diffble_I Hab' F -> included I (Dom F). -intros F H. -inversion_clear H. -unfold I, Hab in |- *; Included. +Proof. + intros F H. + inversion_clear H. + unfold I, Hab in |- *; Included. Qed. (** @@ -123,11 +123,12 @@ If a function has a derivative in an interval then it is differentiable in that *) Lemma deriv_imp_Diffble_I : forall F F', Derivative_I Hab' F F' -> Diffble_I Hab' F. -intros F F' H. -exists (IntPartIR (derivative_imp_inc' _ _ _ _ _ H)). -apply Derivative_I_wdr with F'. -apply int_part_int. -assumption. +Proof. + intros F F' H. + exists (IntPartIR (derivative_imp_inc' _ _ _ _ _ H)). + apply Derivative_I_wdr with F'. + apply int_part_int. + assumption. Qed. End Local_Properties. @@ -151,27 +152,29 @@ Let I := Compact Hab. Section Constants. Lemma Diffble_I_const : forall c : IR, Diffble_I Hab' [-C-]c. -intros. -exists (IConst (Hab:=Hab) Zero). -apply Derivative_I_wdr with ( [-C-]Zero:PartIR). -apply part_int_const. -Deriv. +Proof. + intros. + exists (IConst (Hab:=Hab) Zero). + apply Derivative_I_wdr with ( [-C-]Zero:PartIR). + apply part_int_const. + Deriv. Qed. Lemma Diffble_I_id : Diffble_I Hab' FId. -exists (IConst (Hab:=Hab) One). -apply Derivative_I_wdr with ( [-C-]One:PartIR). -apply part_int_const. -Deriv. +Proof. + exists (IConst (Hab:=Hab) One). + apply Derivative_I_wdr with ( [-C-]One:PartIR). + apply part_int_const. + Deriv. Qed. Lemma Diffble_I_poly : forall p, Diffble_I Hab' (FPoly _ p). Proof. -intros p. -exists (@IntPartIR (FPoly _ (_D_ p)) _ _ Hab (included_IR _)). -apply Derivative_I_wdr with (FPoly _ (_D_ p)). -apply int_part_int. -Deriv. + intros p. + exists (@IntPartIR (FPoly _ (_D_ p)) _ _ Hab (included_IR _)). + apply Derivative_I_wdr with (FPoly _ (_D_ p)). + apply int_part_int. + Deriv. Qed. End Constants. @@ -183,11 +186,12 @@ Variables F H : PartIR. Hypothesis diffF : Diffble_I Hab' F. Lemma Diffble_I_wd : Feq (Compact Hab) F H -> Diffble_I Hab' H. -intro H0. -exists (ProjT1 diffF). -eapply Derivative_I_wdl. -apply H0. -apply projT2. +Proof. + intro H0. + exists (ProjT1 diffF). + eapply Derivative_I_wdl. + apply H0. + apply projT2. Qed. End Well_Definedness. @@ -198,48 +202,47 @@ Hypothesis diffF : Diffble_I Hab' F. Hypothesis diffG : Diffble_I Hab' G. Lemma Diffble_I_plus : Diffble_I Hab' (F{+}G). -elim diffF; intros F' derF. -elim diffG; intros G' derG. -exists (IPlus F' G'). -eapply Derivative_I_wdr. -apply part_int_plus with (F := PartInt F') (G := PartInt G'). -apply Feq_reflexive; Included. -apply Feq_reflexive; Included. -Deriv. +Proof. + elim diffF; intros F' derF. + elim diffG; intros G' derG. + exists (IPlus F' G'). + eapply Derivative_I_wdr. + apply part_int_plus with (F := PartInt F') (G := PartInt G'). + apply Feq_reflexive; Included. + apply Feq_reflexive; Included. + Deriv. Qed. Lemma Diffble_I_inv : Diffble_I Hab' {--}F. -elim diffF; intros F' derF. -exists (IInv F'). -eapply Derivative_I_wdr. -apply part_int_inv with (F := PartInt F'). -apply Feq_reflexive; Included. -Deriv. +Proof. + elim diffF; intros F' derF. + exists (IInv F'). + eapply Derivative_I_wdr. + apply part_int_inv with (F := PartInt F'). + apply Feq_reflexive; Included. + Deriv. Qed. Lemma Diffble_I_mult : Diffble_I Hab' (F{*}G). -elim diffF; intros F' derF. -elim diffG; intros G' derG. -exists - (IPlus (IMult (IntPartIR (diffble_imp_inc _ _ _ _ diffF)) G') - (IMult F' (IntPartIR (diffble_imp_inc _ _ _ _ diffG)))). -eapply Derivative_I_wdr. -apply - part_int_plus - with - (F := PartInt (IMult (IntPartIR (diffble_imp_inc _ _ _ _ diffF)) G')) +Proof. + elim diffF; intros F' derF. + elim diffG; intros G' derG. + exists (IPlus (IMult (IntPartIR (diffble_imp_inc _ _ _ _ diffF)) G') + (IMult F' (IntPartIR (diffble_imp_inc _ _ _ _ diffG)))). + eapply Derivative_I_wdr. + apply part_int_plus with (F := PartInt (IMult (IntPartIR (diffble_imp_inc _ _ _ _ diffF)) G')) (G := PartInt (IMult F' (IntPartIR (diffble_imp_inc _ _ _ _ diffG)))). -apply Feq_reflexive; Included. -apply Feq_reflexive; Included. -eapply Derivative_I_wdr. -apply Feq_plus with (F := F{*}PartInt G') (G := PartInt F'{*}G). -apply part_int_mult. -FEQ. -apply Feq_reflexive; Included. -apply part_int_mult. -apply Feq_reflexive; Included. -FEQ. -Deriv. + apply Feq_reflexive; Included. + apply Feq_reflexive; Included. + eapply Derivative_I_wdr. + apply Feq_plus with (F := F{*}PartInt G') (G := PartInt F'{*}G). + apply part_int_mult. + FEQ. + apply Feq_reflexive; Included. + apply part_int_mult. + apply Feq_reflexive; Included. + FEQ. + Deriv. Qed. (* begin show *) @@ -247,45 +250,44 @@ Hypothesis Gbnd : bnd_away_zero I G. (* end show *) Lemma Diffble_I_recip : Diffble_I Hab' {1/}G. -elim diffG; intros G' derG. -cut (included I (Dom G)); [ intro Hg' | unfold I, Hab in |- *; Included ]. -unfold I in Hg'; - cut (forall x : subset I, IMult (IntPartIR Hg') (IntPartIR Hg') x [#] Zero). intro H. -exists (IInv (IDiv G' _ H)). -eapply Derivative_I_wdr. -apply part_int_inv with (F := PartInt (IDiv G' _ H)). -apply Feq_reflexive; Included. -eapply Derivative_I_wdr. -apply - Feq_inv - with (F := PartInt G'{/}PartInt (IMult (IntPartIR Hg') (IntPartIR Hg'))). -apply part_int_div. -apply Feq_reflexive; Included. -apply Feq_reflexive; simpl in |- *; Included. -red in |- *; intros. -split. -simpl in |- *; Included. -elim Gbnd; intros Hinc c. -elim c; clear c; intros c H0 H1. -exists (c[*]c). -apply mult_resp_pos; assumption. -intros. -simpl in |- *. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; auto; apply less_leEq; assumption. -eapply Derivative_I_wdr. -apply Feq_inv with (F := PartInt G'{/}G{*}G). -apply Feq_div. -Included. -apply Feq_reflexive; Included. -apply part_int_mult. -FEQ. -FEQ. -Deriv. -intro x. -simpl in |- *. -apply mult_resp_ap_zero; apply bnd_imp_ap_zero with I; auto; apply scs_prf. +Proof. + elim diffG; intros G' derG. + cut (included I (Dom G)); [ intro Hg' | unfold I, Hab in |- *; Included ]. + unfold I in Hg'; + cut (forall x : subset I, IMult (IntPartIR Hg') (IntPartIR Hg') x [#] Zero). intro H. + exists (IInv (IDiv G' _ H)). + eapply Derivative_I_wdr. + apply part_int_inv with (F := PartInt (IDiv G' _ H)). + apply Feq_reflexive; Included. + eapply Derivative_I_wdr. + apply Feq_inv with (F := PartInt G'{/}PartInt (IMult (IntPartIR Hg') (IntPartIR Hg'))). + apply part_int_div. + apply Feq_reflexive; Included. + apply Feq_reflexive; simpl in |- *; Included. + red in |- *; intros. + split. + simpl in |- *; Included. + elim Gbnd; intros Hinc c. + elim c; clear c; intros c H0 H1. + exists (c[*]c). + apply mult_resp_pos; assumption. + intros. + simpl in |- *. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; auto; apply less_leEq; assumption. + eapply Derivative_I_wdr. + apply Feq_inv with (F := PartInt G'{/}G{*}G). + apply Feq_div. + Included. + apply Feq_reflexive; Included. + apply part_int_mult. + FEQ. + FEQ. + Deriv. + intro x. + simpl in |- *. + apply mult_resp_ap_zero; apply bnd_imp_ap_zero with I; auto; apply scs_prf. Qed. End Operations. @@ -306,40 +308,44 @@ Hypothesis diffF : Diffble_I Hab' F. Hypothesis diffG : Diffble_I Hab' G. Lemma Diffble_I_minus : Diffble_I Hab' (F{-}G). -apply Diffble_I_wd with (F{+}{--}G). -apply Diffble_I_plus. -assumption. -apply Diffble_I_inv; assumption. -FEQ. +Proof. + apply Diffble_I_wd with (F{+}{--}G). + apply Diffble_I_plus. + assumption. + apply Diffble_I_inv; assumption. + FEQ. Qed. Lemma Diffble_I_scal : forall c : IR, Diffble_I Hab' (c{**}F). -intro. -unfold Fscalmult in |- *. -apply Diffble_I_mult. -apply Diffble_I_const. -assumption. +Proof. + intro. + unfold Fscalmult in |- *. + apply Diffble_I_mult. + apply Diffble_I_const. + assumption. Qed. Lemma Diffble_I_nth : forall n : nat, Diffble_I Hab' (F{^}n). -intro. -induction n as [| n Hrecn]. -eapply Diffble_I_wd. -2: apply FNth_zero'; Included. -apply Diffble_I_const. -eapply Diffble_I_wd. -2: apply FNth_mult'; Included. -apply Diffble_I_mult; assumption. +Proof. + intro. + induction n as [| n Hrecn]. + eapply Diffble_I_wd. + 2: apply FNth_zero'; Included. + apply Diffble_I_const. + eapply Diffble_I_wd. + 2: apply FNth_mult'; Included. + apply Diffble_I_mult; assumption. Qed. Hypothesis Gbnd : bnd_away_zero I G. Lemma Diffble_I_div : Diffble_I Hab' (F{/}G). -apply Diffble_I_wd with (F{*}{1/}G). -apply Diffble_I_mult. -assumption. -apply Diffble_I_recip; assumption. -FEQ. +Proof. + apply Diffble_I_wd with (F{*}{1/}G). + apply Diffble_I_mult. + assumption. + apply Diffble_I_recip; assumption. + FEQ. Qed. End Corollaries. @@ -356,38 +362,41 @@ Hypothesis Hab' : a [<] b. Lemma Diffble_I_Sum0 : forall (f : nat -> PartIR), (forall n, Diffble_I Hab' (f n)) -> forall n, Diffble_I Hab' (FSum0 n f). -intros f diffF. -induction n as [| n Hrecn]. -apply Diffble_I_wd with (Fconst (S:=IR) Zero). -apply Diffble_I_const. -FEQ. -red in |- *; simpl in |- *; intros. -apply (diffble_imp_inc _ _ _ _ (diffF n)); assumption. -apply Diffble_I_wd with (FSum0 n f{+}f n). -apply Diffble_I_plus. -auto. -auto. -FEQ. -simpl in |- *; red in |- *; intros. -apply (diffble_imp_inc _ _ _ _ (diffF n0)); assumption. -simpl in |- *. -apply bin_op_wd_unfolded; try apply Sum0_wd; intros; rational. +Proof. + intros f diffF. + induction n as [| n Hrecn]. + apply Diffble_I_wd with (Fconst (S:=IR) Zero). + apply Diffble_I_const. + FEQ. + red in |- *; simpl in |- *; intros. + apply (diffble_imp_inc _ _ _ _ (diffF n)); assumption. + apply Diffble_I_wd with (FSum0 n f{+}f n). + apply Diffble_I_plus. + auto. + auto. + FEQ. + simpl in |- *; red in |- *; intros. + apply (diffble_imp_inc _ _ _ _ (diffF n0)); assumption. + simpl in |- *. + apply bin_op_wd_unfolded; try apply Sum0_wd; intros; rational. Qed. Lemma Diffble_I_Sumx : forall n (f : forall i, i < n -> PartIR), (forall i Hi, Diffble_I Hab' (f i Hi)) -> Diffble_I Hab' (FSumx n f). -intro; induction n as [| n Hrecn]; intros. -simpl in |- *; apply Diffble_I_const. -simpl in |- *. -apply Diffble_I_plus; auto. +Proof. + intro; induction n as [| n Hrecn]; intros. + simpl in |- *; apply Diffble_I_const. + simpl in |- *. + apply Diffble_I_plus; auto. Qed. Lemma Diffble_I_Sum : forall (f : nat -> PartIR), (forall n, Diffble_I Hab' (f n)) -> forall m n, Diffble_I Hab' (FSum m n f). -intros. -eapply Diffble_I_wd. -2: apply Feq_symmetric; apply FSum_FSum0'; Included. -apply Diffble_I_minus; apply Diffble_I_Sum0; auto. +Proof. + intros. + eapply Diffble_I_wd. + 2: apply Feq_symmetric; apply FSum_FSum0'; Included. + apply Diffble_I_minus; apply Diffble_I_Sum0; auto. Qed. End Other_Properties. @@ -401,9 +410,10 @@ Finally, a differentiable function is continuous. Lemma diffble_imp_contin_I : forall a b (Hab' : a [<] b) (Hab : a [<=] b) F, Diffble_I Hab' F -> Continuous_I Hab F. -intros a b Hab' Hab F H. -apply deriv_imp_contin_I with Hab' (PartInt (ProjT1 H)). -apply projT2. +Proof. + intros a b Hab' Hab F H. + apply deriv_imp_contin_I with Hab' (PartInt (ProjT1 H)). + apply projT2. Qed. Hint Immediate included_imp_contin deriv_imp_contin_I deriv_imp_contin'_I diff --git a/ftc/FTC.v b/ftc/FTC.v index 7a40e39c0..a23a1e3ef 100644 --- a/ftc/FTC.v +++ b/ftc/FTC.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing [-S-] %\ensuremath{\int}% #∫# *) @@ -70,26 +70,27 @@ Variable a : IR. Hypothesis Ha : I a. Lemma prim_lemma : forall x : IR, I x -> Continuous_I (Min_leEq_Max a x) F. -intros. -elim contF; intros incI contI. -Included. +Proof. + intros. + elim contF; intros incI contI. + Included. Qed. Lemma Fprim_strext : forall x y Hx Hy, Integral (prim_lemma x Hx) [#] Integral (prim_lemma y Hy) -> x [#] y. -intros x y Hx Hy H. -elim (Integral_strext' _ _ _ _ _ _ _ _ _ H). -intro; elimtype False. -generalize a0; apply ap_irreflexive_unfolded. -auto. +Proof. + intros x y Hx Hy H. + elim (Integral_strext' _ _ _ _ _ _ _ _ _ H). + intro; elimtype False. + generalize a0; apply ap_irreflexive_unfolded. + auto. Qed. Definition Fprim : PartIR. -apply - Build_PartFunct - with (pfpfun := fun (x : IR) (Hx : I x) => Integral (prim_lemma x Hx)). -apply iprop_wd. -exact Fprim_strext. + apply Build_PartFunct with (pfpfun := fun (x : IR) (Hx : I x) => Integral (prim_lemma x Hx)). +Proof. + apply iprop_wd. + exact Fprim_strext. Defined. End Indefinite_Integral. @@ -125,58 +126,50 @@ Let G := ( [-S-]contF) x0 Hx0. (* end hide *) Lemma Continuous_prim : Continuous J G. -split. -Included. -intros a b Hab H. split. -Included. -intros e H0. -simpl in |- *; simpl in H. -exists - (e[/] _[//] - max_one_ap_zero (Norm_Funct (included_imp_Continuous _ _ contF _ _ _ H))). -apply div_resp_pos. -apply pos_max_one. -assumption. -intros x y H1 H2 Hx Hy H3. -cut (included (Compact (Min_leEq_Max y x)) (Compact Hab)). -intro Hinc. -cut (Continuous_I (Min_leEq_Max y x) F). intro H4. -apply leEq_wdl with (AbsIR (Integral H4)). -eapply leEq_transitive. -apply Integral_leEq_norm. -apply - leEq_transitive - with - (Max (Norm_Funct (included_imp_Continuous _ _ contF _ _ _ H)) One[*] - AbsIR (x[-]y)). -apply mult_resp_leEq_rht. -apply - leEq_transitive - with (Norm_Funct (included_imp_Continuous _ _ contF _ _ _ H)). -apply leEq_Norm_Funct. -intros. -apply norm_bnd_AbsIR. -apply Hinc; auto. -apply lft_leEq_Max. -apply AbsIR_nonneg. -eapply shift_mult_leEq'. -apply pos_max_one. -apply H3. -apply AbsIR_wd. -rstepl - (Integral (prim_lemma J F contF x0 Hx0 y Hy) [+]Integral H4[-] - Integral (prim_lemma J F contF x0 Hx0 y Hy)). -apply cg_minus_wd. -apply eq_symmetric_unfolded; - apply Integral_plus_Integral with (Min3_leEq_Max3 x0 x y). -apply included_imp_Continuous with J; auto. -apply included3_interval; auto. -apply Integral_wd. -apply Feq_reflexive. -apply (included_trans _ (Compact (Min_leEq_Max x0 y)) J); Included. -apply included_imp_Continuous with J; auto. -Included. -Included. +Proof. + split. + Included. + intros a b Hab H. split. + Included. + intros e H0. + simpl in |- *; simpl in H. + exists (e[/] _[//] max_one_ap_zero (Norm_Funct (included_imp_Continuous _ _ contF _ _ _ H))). + apply div_resp_pos. + apply pos_max_one. + assumption. + intros x y H1 H2 Hx Hy H3. + cut (included (Compact (Min_leEq_Max y x)) (Compact Hab)). + intro Hinc. + cut (Continuous_I (Min_leEq_Max y x) F). intro H4. + apply leEq_wdl with (AbsIR (Integral H4)). + eapply leEq_transitive. + apply Integral_leEq_norm. + apply leEq_transitive with (Max (Norm_Funct (included_imp_Continuous _ _ contF _ _ _ H)) One[*] + AbsIR (x[-]y)). + apply mult_resp_leEq_rht. + apply leEq_transitive with (Norm_Funct (included_imp_Continuous _ _ contF _ _ _ H)). + apply leEq_Norm_Funct. + intros. + apply norm_bnd_AbsIR. + apply Hinc; auto. + apply lft_leEq_Max. + apply AbsIR_nonneg. + eapply shift_mult_leEq'. + apply pos_max_one. + apply H3. + apply AbsIR_wd. + rstepl (Integral (prim_lemma J F contF x0 Hx0 y Hy) [+]Integral H4[-] + Integral (prim_lemma J F contF x0 Hx0 y Hy)). + apply cg_minus_wd. + apply eq_symmetric_unfolded; apply Integral_plus_Integral with (Min3_leEq_Max3 x0 x y). + apply included_imp_Continuous with J; auto. + apply included3_interval; auto. + apply Integral_wd. + apply Feq_reflexive. + apply (included_trans _ (Compact (Min_leEq_Max x0 y)) J); Included. + apply included_imp_Continuous with J; auto. + Included. + Included. Qed. (** @@ -186,74 +179,64 @@ The derivative of [G] is simply [F]. Hypothesis pJ : proper J. Theorem FTC1 : Derivative J pJ G F. -split; Included. -split; Included. -intros; apply Derivative_I_char. -Included. -inversion_clear contF. -Included. -intros. -red in contF. -inversion_clear contF. -elim (contin_prop _ _ _ _ (X2 _ _ _ X) e X0); intros d H3 H4. -exists d. -assumption. -intros x y X3 X4 Hx Hy Hx' H. -simpl in |- *. -rename Hab into Hab'. -set (Hab := less_leEq _ _ _ Hab') in *. -cut (included (Compact (Min_leEq_Max x y)) (Compact Hab)). -intro Hinc. -cut (Continuous_I (Min_leEq_Max x y) F). -2: apply included_imp_Continuous with J; auto. -intro H8. -apply - leEq_wdl - with - (AbsIR - (Integral H8[-] - Integral (Continuous_I_const _ _ (Min_leEq_Max x y) (F x Hx')))). -apply - leEq_wdl - with - (AbsIR - (Integral - (Continuous_I_minus _ _ _ _ _ H8 - (Continuous_I_const _ _ _ (F x Hx'))))). -eapply leEq_transitive. -apply Integral_leEq_norm. -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -apply leEq_Norm_Funct. -intros z Hz Hz1. -simpl in |- *. -apply leEq_wdl with (AbsIR (F z (X1 z (X z (Hinc z Hz))) [-]F x Hx')). -2: apply AbsIR_wd; algebra. -apply H4; auto. -eapply leEq_transitive. -2: apply H. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply Abs_Max. -eapply leEq_wdr. -2: apply AbsIR_eq_x; apply shift_leEq_minus. -2: astepl (Min x y); apply Min_leEq_Max. -apply compact_elements with (Min_leEq_Max x y); auto. -apply compact_Min_lft. -apply AbsIR_wd; apply Integral_minus. -apply AbsIR_wd; apply cg_minus_wd. -rstepl - (Integral (prim_lemma _ _ contF x0 Hx0 _ Hx) [+]Integral H8[-] - Integral (prim_lemma _ _ contF x0 Hx0 _ Hx)). -apply cg_minus_wd. -apply eq_symmetric_unfolded; - apply Integral_plus_Integral with (Min3_leEq_Max3 x0 y x). -apply included_imp_Continuous with J; auto. -apply included3_interval; auto. -apply Integral_wd. apply Feq_reflexive. -apply (included_trans _ (Compact (Min_leEq_Max x0 x)) J); try apply included_interval; auto. -apply Integral_const. -Included. -Included. +Proof. + split; Included. + split; Included. + intros; apply Derivative_I_char. + Included. + inversion_clear contF. + Included. + intros. + red in contF. + inversion_clear contF. + elim (contin_prop _ _ _ _ (X2 _ _ _ X) e X0); intros d H3 H4. + exists d. + assumption. + intros x y X3 X4 Hx Hy Hx' H. + simpl in |- *. + rename Hab into Hab'. + set (Hab := less_leEq _ _ _ Hab') in *. + cut (included (Compact (Min_leEq_Max x y)) (Compact Hab)). + intro Hinc. + cut (Continuous_I (Min_leEq_Max x y) F). + 2: apply included_imp_Continuous with J; auto. + intro H8. + apply leEq_wdl with (AbsIR (Integral H8[-] + Integral (Continuous_I_const _ _ (Min_leEq_Max x y) (F x Hx')))). + apply leEq_wdl with (AbsIR (Integral (Continuous_I_minus _ _ _ _ _ H8 + (Continuous_I_const _ _ _ (F x Hx'))))). + eapply leEq_transitive. + apply Integral_leEq_norm. + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + apply leEq_Norm_Funct. + intros z Hz Hz1. + simpl in |- *. + apply leEq_wdl with (AbsIR (F z (X1 z (X z (Hinc z Hz))) [-]F x Hx')). + 2: apply AbsIR_wd; algebra. + apply H4; auto. + eapply leEq_transitive. + 2: apply H. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply Abs_Max. + eapply leEq_wdr. + 2: apply AbsIR_eq_x; apply shift_leEq_minus. + 2: astepl (Min x y); apply Min_leEq_Max. + apply compact_elements with (Min_leEq_Max x y); auto. + apply compact_Min_lft. + apply AbsIR_wd; apply Integral_minus. + apply AbsIR_wd; apply cg_minus_wd. + rstepl (Integral (prim_lemma _ _ contF x0 Hx0 _ Hx) [+]Integral H8[-] + Integral (prim_lemma _ _ contF x0 Hx0 _ Hx)). + apply cg_minus_wd. + apply eq_symmetric_unfolded; apply Integral_plus_Integral with (Min3_leEq_Max3 x0 y x). + apply included_imp_Continuous with J; auto. + apply included3_interval; auto. + apply Integral_wd. apply Feq_reflexive. + apply (included_trans _ (Compact (Min_leEq_Max x0 x)) J); try apply included_interval; auto. + apply Integral_const. + Included. + Included. Qed. (** @@ -264,11 +247,12 @@ Variable G0 : PartIR. Hypothesis derG0 : Derivative J pJ G0 F. Theorem FTC2 : {c : IR | Feq J (G{-}G0) [-C-]c}. -apply FConst_prop with pJ. -apply Derivative_wdr with (F{-}F). -FEQ. -apply Derivative_minus; auto. -apply FTC1. +Proof. + apply FConst_prop with pJ. + apply Derivative_wdr with (F{-}F). + FEQ. + apply Derivative_minus; auto. + apply FTC1. Qed. (** @@ -285,71 +269,72 @@ Theorem Barrow : forall J F (contF : Continuous J F) (pJ:proper J) G0 (derG0 : Derivative J pJ G0 F) a b (H : Continuous_I (Min_leEq_Max a b) F) Ha Hb, let Ha' := Derivative_imp_inc _ _ _ _ derG0 a Ha in let Hb' := Derivative_imp_inc _ _ _ _ derG0 b Hb in Integral H [=] G0 b Hb'[-]G0 a Ha'. -(* begin hide *) -intros J F contF pJ G0 derG0 a b H1 Ha Hb; intros. -pose (x0:=a). -pose (Hx0:=Ha). -set (G := ( [-S-]contF) x0 Hx0). -elim (@FTC2 J F contF x0 Hx0 pJ G0 derG0); intros c Hc. -elim Hc; intros H2 H. -elim H; clear H Hc; intros H3 H0. -(* Allow G0a to be G0 of a. -Allow G0b to be G0 of b. *) -set (G0a := G0 a Ha') in *. -set (G0b := G0 b Hb') in *. -rstepr (G0b[+]c[-] (G0a[+]c)). -(* Allow Ga to be G of a. -Allow Gb to be G of b.*) -set (Ga := G a Ha) in *. -set (Gb := G b Hb) in *. -apply eq_transitive_unfolded with (Gb[-]Ga). -unfold Ga, Gb, G in |- *; simpl in |- *. -cut (forall x y z : IR, z [=] x[+]y -> y [=] z[-]x). intro H5. -apply H5. -apply Integral_plus_Integral with (Min3_leEq_Max3 x0 b a). -apply included_imp_Continuous with J. -auto. -apply included3_interval; auto. -intros; apply eq_symmetric_unfolded. -rstepr (x[+]y[-]x); algebra. -cut (forall x y z : IR, x[-]y [=] z -> x [=] y[+]z); intros. -fold G in H0. -apply cg_minus_wd; unfold Ga, Gb, G0a, G0b in |- *; apply H; auto. -simpl in H0. -apply eq_transitive_unfolded with ((G{-}G0) b (CAnd_intro _ _ Hb Hb')). -2: apply H0 with (Hx := CAnd_intro _ _ Hb Hb'). -simpl. -apply cg_minus_wd. -apply Integral_wd. -apply Feq_reflexive. -destruct H1 as [H1 _]. -apply H1. -algebra. -auto. -auto. -change c with ([-C-]c a CI). -apply eq_transitive_unfolded with ((G{-}G0) a (CAnd_intro _ _ Ha Ha')). -2: apply H0 with (Hx := CAnd_intro _ _ Ha Ha'). -simpl. -apply cg_minus_wd. -apply Integral_wd. -apply Feq_reflexive. -destruct H1 as [H1 _]. -intros y Hy. -apply H1. -apply (compact_wd _ _ (Min_leEq_Max a b) a). -apply compact_Min_lft. -unfold compact, x0 in Hy. -destruct Hy. -apply leEq_imp_eq. -astepl (Min a a). assumption. -apply Min_id. -stepr(Max a a). assumption. -apply Max_id. -algebra. -auto. -rstepl (y[+] (x[-]y)). -algebra. +Proof. + (* begin hide *) + intros J F contF pJ G0 derG0 a b H1 Ha Hb; intros. + pose (x0:=a). + pose (Hx0:=Ha). + set (G := ( [-S-]contF) x0 Hx0). + elim (@FTC2 J F contF x0 Hx0 pJ G0 derG0); intros c Hc. + elim Hc; intros H2 H. + elim H; clear H Hc; intros H3 H0. + (* Allow G0a to be G0 of a. + Allow G0b to be G0 of b. *) + set (G0a := G0 a Ha') in *. + set (G0b := G0 b Hb') in *. + rstepr (G0b[+]c[-] (G0a[+]c)). + (* Allow Ga to be G of a. + Allow Gb to be G of b.*) + set (Ga := G a Ha) in *. + set (Gb := G b Hb) in *. + apply eq_transitive_unfolded with (Gb[-]Ga). + unfold Ga, Gb, G in |- *; simpl in |- *. + cut (forall x y z : IR, z [=] x[+]y -> y [=] z[-]x). intro H5. + apply H5. + apply Integral_plus_Integral with (Min3_leEq_Max3 x0 b a). + apply included_imp_Continuous with J. + auto. + apply included3_interval; auto. + intros; apply eq_symmetric_unfolded. + rstepr (x[+]y[-]x); algebra. + cut (forall x y z : IR, x[-]y [=] z -> x [=] y[+]z); intros. + fold G in H0. + apply cg_minus_wd; unfold Ga, Gb, G0a, G0b in |- *; apply H; auto. + simpl in H0. + apply eq_transitive_unfolded with ((G{-}G0) b (CAnd_intro _ _ Hb Hb')). + 2: apply H0 with (Hx := CAnd_intro _ _ Hb Hb'). + simpl. + apply cg_minus_wd. + apply Integral_wd. + apply Feq_reflexive. + destruct H1 as [H1 _]. + apply H1. + algebra. + auto. + auto. + change c with ([-C-]c a CI). + apply eq_transitive_unfolded with ((G{-}G0) a (CAnd_intro _ _ Ha Ha')). + 2: apply H0 with (Hx := CAnd_intro _ _ Ha Ha'). + simpl. + apply cg_minus_wd. + apply Integral_wd. + apply Feq_reflexive. + destruct H1 as [H1 _]. + intros y Hy. + apply H1. + apply (compact_wd _ _ (Min_leEq_Max a b) a). + apply compact_Min_lft. + unfold compact, x0 in Hy. + destruct Hy. + apply leEq_imp_eq. + astepl (Min a a). assumption. + apply Min_id. + stepr(Max a a). assumption. + apply Max_id. + algebra. + auto. + rstepl (y[+] (x[-]y)). + algebra. Qed. (* end hide *) @@ -418,48 +403,42 @@ Hypothesis contG : Continuous_I Hab G. (* end show *) Lemma fun_lim_seq_integral : conv_fun_seq' a b Hab g G contg contG. -assert (H : conv_norm_fun_seq _ _ _ _ _ contIf contIF). -apply conv_fun_seq'_norm; assumption. -intros e H0. -elim (Archimedes (AbsIR (b[-]a) [/] _[//]pos_ap_zero _ _ H0)); intros k Hk. -elim (H k); intros N HN. -exists N; intros. -assert (H2 : included (Compact (Min_leEq_Max x0 x)) (Compact Hab)). -apply included2_compact; auto. -simpl in |- *. -apply - leEq_wdl - with - (AbsIR - (Integral - (Continuous_I_minus _ _ _ _ _ - (prim_lemma _ _ (contf n) x0 Hx0 _ - (contin_imp_inc _ _ _ _ (contg n) _ Hx)) - (prim_lemma _ _ contF x0 Hx0 _ - (contin_imp_inc _ _ _ _ contG _ Hx))))). -2: apply AbsIR_wd; apply Integral_minus. -eapply leEq_transitive. -apply Integral_leEq_norm. -apply leEq_transitive with (one_div_succ k[*]AbsIR (b[-]a)). -apply mult_resp_leEq_both. -apply positive_norm. -apply AbsIR_nonneg. -eapply leEq_transitive. -2: apply (HN n H1). -apply leEq_Norm_Funct; intros. -apply norm_bnd_AbsIR. -apply H2; auto. -apply compact_elements with Hab; auto. -unfold one_div_succ, Snring in |- *. -rstepl (AbsIR (b[-]a) [/] _[//]nring_ap_zero _ _ (sym_not_eq (O_S k))). -apply shift_div_leEq. -apply pos_nring_S. -eapply shift_leEq_mult'. -assumption. -apply less_leEq; eapply leEq_less_trans. -apply Hk. -simpl in |- *. -apply less_plusOne. +Proof. + assert (H : conv_norm_fun_seq _ _ _ _ _ contIf contIF). + apply conv_fun_seq'_norm; assumption. + intros e H0. + elim (Archimedes (AbsIR (b[-]a) [/] _[//]pos_ap_zero _ _ H0)); intros k Hk. + elim (H k); intros N HN. + exists N; intros. + assert (H2 : included (Compact (Min_leEq_Max x0 x)) (Compact Hab)). + apply included2_compact; auto. + simpl in |- *. + apply leEq_wdl with (AbsIR (Integral (Continuous_I_minus _ _ _ _ _ (prim_lemma _ _ (contf n) x0 Hx0 _ + (contin_imp_inc _ _ _ _ (contg n) _ Hx)) (prim_lemma _ _ contF x0 Hx0 _ + (contin_imp_inc _ _ _ _ contG _ Hx))))). + 2: apply AbsIR_wd; apply Integral_minus. + eapply leEq_transitive. + apply Integral_leEq_norm. + apply leEq_transitive with (one_div_succ k[*]AbsIR (b[-]a)). + apply mult_resp_leEq_both. + apply positive_norm. + apply AbsIR_nonneg. + eapply leEq_transitive. + 2: apply (HN n H1). + apply leEq_Norm_Funct; intros. + apply norm_bnd_AbsIR. + apply H2; auto. + apply compact_elements with Hab; auto. + unfold one_div_succ, Snring in |- *. + rstepl (AbsIR (b[-]a) [/] _[//]nring_ap_zero _ _ (sym_not_eq (O_S k))). + apply shift_div_leEq. + apply pos_nring_S. + eapply shift_leEq_mult'. + assumption. + apply less_leEq; eapply leEq_less_trans. + apply Hk. + simpl in |- *. + apply less_plusOne. Qed. End Compact. @@ -471,65 +450,59 @@ And now we can generalize it step by step. Lemma limit_of_integral : conv_fun_seq'_IR J f F contf contF -> forall x y Hxy, included (Compact Hxy) J -> forall Hf HF, Cauchy_Lim_prop2 (fun n => integral x y Hxy (f n) (Hf n)) (integral x y Hxy F HF). -intros H x y Hxy H0 Hf HF. -assert (Hx : J x). apply H0; apply compact_inc_lft. -assert (Hy : J y). apply H0; apply compact_inc_rht. -set (g := fun n : nat => ( [-S-]contf n) x Hx) in *. -set (G := ( [-S-]contF) x Hx) in *. -set (Hxg := fun n : nat => Hy) in *. -apply Lim_wd with (Part G y Hy). -simpl in |- *; apply Integral_integral. -apply Cauchy_Lim_prop2_wd with (fun n : nat => Part (g n) y (Hxg n)). -2: intro; simpl in |- *; apply Integral_integral. -cut (forall n : nat, Continuous_I Hxy (g n)). intro H1. -cut (Continuous_I Hxy G). intro H2. -apply fun_conv_imp_seq_conv with (contf := H1) (contF := H2). -set (H4 := fun n : nat => included_imp_Continuous _ _ (contf n) _ _ _ H0) - in *. -set (H5 := included_imp_Continuous _ _ contF _ _ _ H0) in *. -unfold g, G in |- *. -apply fun_lim_seq_integral with H4 H5. -unfold H4, H5 in |- *. -apply H; auto. -apply compact_inc_lft. -apply compact_inc_rht. -unfold G in |- *; apply included_imp_Continuous with J; Contin. -intro; unfold g in |- *; apply included_imp_Continuous with J; Contin. +Proof. + intros H x y Hxy H0 Hf HF. + assert (Hx : J x). apply H0; apply compact_inc_lft. + assert (Hy : J y). apply H0; apply compact_inc_rht. + set (g := fun n : nat => ( [-S-]contf n) x Hx) in *. + set (G := ( [-S-]contF) x Hx) in *. + set (Hxg := fun n : nat => Hy) in *. + apply Lim_wd with (Part G y Hy). + simpl in |- *; apply Integral_integral. + apply Cauchy_Lim_prop2_wd with (fun n : nat => Part (g n) y (Hxg n)). + 2: intro; simpl in |- *; apply Integral_integral. + cut (forall n : nat, Continuous_I Hxy (g n)). intro H1. + cut (Continuous_I Hxy G). intro H2. + apply fun_conv_imp_seq_conv with (contf := H1) (contF := H2). + set (H4 := fun n : nat => included_imp_Continuous _ _ (contf n) _ _ _ H0) in *. + set (H5 := included_imp_Continuous _ _ contF _ _ _ H0) in *. + unfold g, G in |- *. + apply fun_lim_seq_integral with H4 H5. + unfold H4, H5 in |- *. + apply H; auto. + apply compact_inc_lft. + apply compact_inc_rht. + unfold G in |- *; apply included_imp_Continuous with J; Contin. + intro; unfold g in |- *; apply included_imp_Continuous with J; Contin. Qed. Lemma limit_of_Integral : conv_fun_seq'_IR J f F contf contF -> forall x y, included (Compact (Min_leEq_Max x y)) J -> forall Hxy Hf HF, Cauchy_Lim_prop2 (fun n => Integral (a:=x) (b:=y) (Hab:=Hxy) (F:=f n) (Hf n)) (Integral (Hab:=Hxy) (F:=F) HF). -intros convF x y H. -set (x0 := Min x y) in *. -intros. -assert (Hx0 : J x0). - apply H; apply compact_inc_lft. -assert (Hx0' : Compact Hxy x0). - apply compact_inc_lft. -set (g := fun n : nat => ( [-S-]contf n) x0 Hx0) in *. -set (G := ( [-S-]contF) x0 Hx0) in *. -unfold Integral in |- *; fold x0 in |- *. -apply - (Cauchy_Lim_minus - (fun n : nat => integral _ _ _ _ (Integral_inc2 _ _ _ _ (Hf n))) - (fun n : nat => integral _ _ _ _ (Integral_inc1 _ _ _ _ (Hf n)))); - fold x0 in |- *. -apply - limit_of_integral with (Hf := fun n : nat => Integral_inc2 _ _ Hxy _ (Hf n)); - auto. -apply included_trans with (Compact (Min_leEq_Max x y)); Included. -apply included_compact. -apply compact_inc_lft. -apply compact_Min_rht. -apply - limit_of_integral with (Hf := fun n : nat => Integral_inc1 _ _ Hxy _ (Hf n)); - auto. -apply included_trans with (Compact (Min_leEq_Max x y)); auto. -apply included_compact. -apply compact_inc_lft. -apply compact_Min_lft. +Proof. + intros convF x y H. + set (x0 := Min x y) in *. + intros. + assert (Hx0 : J x0). + apply H; apply compact_inc_lft. + assert (Hx0' : Compact Hxy x0). + apply compact_inc_lft. + set (g := fun n : nat => ( [-S-]contf n) x0 Hx0) in *. + set (G := ( [-S-]contF) x0 Hx0) in *. + unfold Integral in |- *; fold x0 in |- *. + apply (Cauchy_Lim_minus (fun n : nat => integral _ _ _ _ (Integral_inc2 _ _ _ _ (Hf n))) + (fun n : nat => integral _ _ _ _ (Integral_inc1 _ _ _ _ (Hf n)))); fold x0 in |- *. + apply limit_of_integral with (Hf := fun n : nat => Integral_inc2 _ _ Hxy _ (Hf n)); auto. + apply included_trans with (Compact (Min_leEq_Max x y)); Included. + apply included_compact. + apply compact_inc_lft. + apply compact_Min_rht. + apply limit_of_integral with (Hf := fun n : nat => Integral_inc1 _ _ Hxy _ (Hf n)); auto. + apply included_trans with (Compact (Min_leEq_Max x y)); auto. + apply included_compact. + apply compact_inc_lft. + apply compact_Min_lft. Qed. Section General. @@ -554,70 +527,51 @@ Hypothesis contg : forall n : nat, Continuous J (g n). Hypothesis contG : Continuous J G. Lemma fun_lim_seq_integral_IR : conv_fun_seq'_IR J g G contg contG. -red in |- *; intros. -unfold g, G in |- *. -cut (J a). intro H. -set - (h := fun n : nat => [-C-] (Integral (prim_lemma _ _ (contf n) x0 Hx0 a H))) - in *. -set (g' := fun n : nat => h n{+} ( [-S-]contf n) a H) in *. -set - (G' := [-C-] (Integral (prim_lemma _ _ contF x0 Hx0 a H)) {+} ( [-S-]contF) a H) - in *. -assert (H0 : forall n : nat, Continuous_I Hab (h n)). - intro; unfold h in |- *; Contin. -cut (forall n : nat, Continuous_I Hab (( [-S-]contf n) a H)). intro H1. -assert (H2 : forall n : nat, Continuous_I Hab (g' n)). - intro; unfold g' in |- *; Contin. -cut (Continuous_I Hab (( [-S-]contF) a H)). intro H3. -assert (H4 : Continuous_I Hab G'). - unfold G' in |- *; Contin. -apply - conv_fun_seq'_wdl with g' H2 (included_imp_Continuous _ _ contG _ _ _ Hinc). -intro; FEQ. -simpl in |- *. -apply eq_symmetric_unfolded; - apply Integral_plus_Integral with (Min3_leEq_Max3 x0 x a). -apply included_imp_Continuous with J; Contin. -apply conv_fun_seq'_wdr with H2 G' H4. -FEQ. -simpl in |- *. -apply eq_symmetric_unfolded; - apply Integral_plus_Integral with (Min3_leEq_Max3 x0 x a). -apply included_imp_Continuous with J; Contin. -unfold g', G' in |- *. -apply - conv_fun_seq'_wdl - with - (f := g') - (contf := fun n : nat => Continuous_I_plus _ _ _ _ _ (H0 n) (H1 n)) - (contF := H4). -unfold g' in H2. -intro; apply Feq_reflexive; Included. -unfold g', G' in |- *. -apply - (fun_Lim_seq_plus' _ _ Hab h (fun n : nat => ( [-S-]contf n) a H) H0 H1 _ _ - (Continuous_I_const _ _ _ (Integral (prim_lemma _ _ contF x0 Hx0 a H))) - H3). -unfold h in |- *. -apply - seq_conv_imp_fun_conv - with (x := fun n : nat => Integral (prim_lemma _ _ (contf n) x0 Hx0 a H)). -apply - limit_of_Integral - with (Hf := fun n : nat => prim_lemma _ _ (contf n) x0 Hx0 a H); - auto. -Included. -apply - fun_lim_seq_integral - with - (fun n : nat => included_imp_Continuous _ _ (contf n) _ _ _ Hinc) - (included_imp_Continuous _ _ contF _ _ _ Hinc). -apply convF; auto. -apply compact_inc_lft. -apply included_imp_Continuous with J; Contin. -intro; apply included_imp_Continuous with J; Contin. -apply Hinc; apply compact_inc_lft. +Proof. + red in |- *; intros. + unfold g, G in |- *. + cut (J a). intro H. + set (h := fun n : nat => [-C-] (Integral (prim_lemma _ _ (contf n) x0 Hx0 a H))) in *. + set (g' := fun n : nat => h n{+} ( [-S-]contf n) a H) in *. + set (G' := [-C-] (Integral (prim_lemma _ _ contF x0 Hx0 a H)) {+} ( [-S-]contF) a H) in *. + assert (H0 : forall n : nat, Continuous_I Hab (h n)). + intro; unfold h in |- *; Contin. + cut (forall n : nat, Continuous_I Hab (( [-S-]contf n) a H)). intro H1. + assert (H2 : forall n : nat, Continuous_I Hab (g' n)). + intro; unfold g' in |- *; Contin. + cut (Continuous_I Hab (( [-S-]contF) a H)). intro H3. + assert (H4 : Continuous_I Hab G'). + unfold G' in |- *; Contin. + apply conv_fun_seq'_wdl with g' H2 (included_imp_Continuous _ _ contG _ _ _ Hinc). + intro; FEQ. + simpl in |- *. + apply eq_symmetric_unfolded; apply Integral_plus_Integral with (Min3_leEq_Max3 x0 x a). + apply included_imp_Continuous with J; Contin. + apply conv_fun_seq'_wdr with H2 G' H4. + FEQ. + simpl in |- *. + apply eq_symmetric_unfolded; apply Integral_plus_Integral with (Min3_leEq_Max3 x0 x a). + apply included_imp_Continuous with J; Contin. + unfold g', G' in |- *. + apply conv_fun_seq'_wdl with (f := g') + (contf := fun n : nat => Continuous_I_plus _ _ _ _ _ (H0 n) (H1 n)) (contF := H4). + unfold g' in H2. + intro; apply Feq_reflexive; Included. + unfold g', G' in |- *. + apply (fun_Lim_seq_plus' _ _ Hab h (fun n : nat => ( [-S-]contf n) a H) H0 H1 _ _ + (Continuous_I_const _ _ _ (Integral (prim_lemma _ _ contF x0 Hx0 a H))) H3). + unfold h in |- *. + apply seq_conv_imp_fun_conv + with (x := fun n : nat => Integral (prim_lemma _ _ (contf n) x0 Hx0 a H)). + apply limit_of_Integral with (Hf := fun n : nat => prim_lemma _ _ (contf n) x0 Hx0 a H); auto. + Included. + apply fun_lim_seq_integral with (fun n : nat => included_imp_Continuous _ _ (contf n) _ _ _ Hinc) + (included_imp_Continuous _ _ contF _ _ _ Hinc). + apply convF; auto. + apply compact_inc_lft. + apply included_imp_Continuous with J; Contin. + intro; apply included_imp_Continuous with J; Contin. + apply Hinc; apply compact_inc_lft. Qed. End General. @@ -650,42 +604,40 @@ Hypothesis convG : conv_fun_seq'_IR J g G contg contG. Hypothesis derf : forall n : nat, Derivative J pJ (f n) (g n). Lemma fun_lim_seq_derivative : Derivative J pJ F G. -elim (nonvoid_point _ (proper_nonvoid _ pJ)); intros a Ha. -set (h := fun n : nat => ( [-S-]contg n) a Ha) in *. -set (H := ( [-S-]contG) a Ha) in *. -assert (H0 : Derivative J pJ H G). unfold H in |- *; apply FTC1. -assert (H1 : forall n : nat, Derivative J pJ (h n) (g n)). intro; unfold h in |- *; apply FTC1. -assert - (H2 : - conv_fun_seq'_IR J _ _ - (fun n : nat => Derivative_imp_Continuous _ _ _ _ (H1 n)) +Proof. + elim (nonvoid_point _ (proper_nonvoid _ pJ)); intros a Ha. + set (h := fun n : nat => ( [-S-]contg n) a Ha) in *. + set (H := ( [-S-]contG) a Ha) in *. + assert (H0 : Derivative J pJ H G). unfold H in |- *; apply FTC1. + assert (H1 : forall n : nat, Derivative J pJ (h n) (g n)). intro; unfold h in |- *; apply FTC1. + assert (H2 : conv_fun_seq'_IR J _ _ (fun n : nat => Derivative_imp_Continuous _ _ _ _ (H1 n)) (Derivative_imp_Continuous _ _ _ _ H0)). - unfold h, H in |- *. eapply fun_lim_seq_integral_IR with (contf := contg); auto. -cut {c : IR | Feq J (F{-}H) [-C-]c}. -intro H3. -elim H3; clear H3; intros c Hc. -apply Derivative_wdl with (H{+} [-C-]c). -apply Feq_transitive with (H{+} (F{-}H)). -apply Feq_plus. -apply Feq_reflexive; Included. -apply Feq_symmetric; assumption. -clear Hc H2 H1; clearbody H. -FEQ. -apply Derivative_wdr with (G{+} [-C-]Zero). -FEQ. -apply Derivative_plus; auto. -apply Derivative_const. -assert (H3 : forall n : nat, {c : IR | Feq J (f n{-}h n) [-C-]c}). - intro; apply FConst_prop with pJ. - apply Derivative_wdr with (g n{-}g n). FEQ. apply Derivative_minus; auto. -assert (contw : forall n : nat, Continuous J (f n{-}h n)). unfold h in |- *; Contin. -assert (contW : Continuous J (F{-}H)). unfold H in |- *; Contin. -apply fun_const_Lim with (fun n : nat => f n{-}h n) contw contW. -auto. -eapply fun_Lim_seq_minus'_IR. -apply convF. -apply H2. -assumption. + unfold h, H in |- *. eapply fun_lim_seq_integral_IR with (contf := contg); auto. + cut {c : IR | Feq J (F{-}H) [-C-]c}. + intro H3. + elim H3; clear H3; intros c Hc. + apply Derivative_wdl with (H{+} [-C-]c). + apply Feq_transitive with (H{+} (F{-}H)). + apply Feq_plus. + apply Feq_reflexive; Included. + apply Feq_symmetric; assumption. + clear Hc H2 H1; clearbody H. + FEQ. + apply Derivative_wdr with (G{+} [-C-]Zero). + FEQ. + apply Derivative_plus; auto. + apply Derivative_const. + assert (H3 : forall n : nat, {c : IR | Feq J (f n{-}h n) [-C-]c}). + intro; apply FConst_prop with pJ. + apply Derivative_wdr with (g n{-}g n). FEQ. apply Derivative_minus; auto. + assert (contw : forall n : nat, Continuous J (f n{-}h n)). unfold h in |- *; Contin. + assert (contW : Continuous J (F{-}H)). unfold H in |- *; Contin. + apply fun_const_Lim with (fun n : nat => f n{-}h n) contw contW. + auto. + eapply fun_Lim_seq_minus'_IR. + apply convF. + apply H2. + assumption. Qed. End Limit_of_Derivative_Seq. @@ -707,18 +659,15 @@ Hypothesis convG : fun_series_convergent_IR J g. Hypothesis derF : forall n : nat, Derivative J pJ (f n) (g n). Lemma Derivative_FSeries : Derivative J pJ (FSeries_Sum convF) (FSeries_Sum convG). -apply - fun_lim_seq_derivative - with - (f := fun n : nat => FSum0 n f) - (contf := Continuous_Sum0 _ _ (convergent_imp_Continuous _ _ convF)) - (contF := Continuous_FSeries_Sum _ _ convF) - (g := fun n : nat => FSum0 n g) - (contg := Continuous_Sum0 _ _ (convergent_imp_Continuous _ _ convG)) - (contG := Continuous_FSeries_Sum _ _ convG). -3: Deriv. -apply FSeries_conv. -apply FSeries_conv. +Proof. + apply fun_lim_seq_derivative with (f := fun n : nat => FSum0 n f) + (contf := Continuous_Sum0 _ _ (convergent_imp_Continuous _ _ convF)) + (contF := Continuous_FSeries_Sum _ _ convF) (g := fun n : nat => FSum0 n g) + (contg := Continuous_Sum0 _ _ (convergent_imp_Continuous _ _ convG)) + (contG := Continuous_FSeries_Sum _ _ convG). + 3: Deriv. + apply FSeries_conv. + apply FSeries_conv. Qed. End Derivative_Series. diff --git a/ftc/FunctSequence.v b/ftc/FunctSequence.v index 871ea6dc3..7066bdcdc 100644 --- a/ftc/FunctSequence.v +++ b/ftc/FunctSequence.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Continuity. Require Export PartInterval. @@ -104,173 +104,176 @@ These definitions are all shown to be equivalent. *) Lemma Cauchy_fun_seq_seq' : Cauchy_fun_seq -> Cauchy_fun_seq'. -intro H. -red in |- *; red in H. -intro. -exact (H (one_div_succ k) (one_div_succ_pos _ k)). +Proof. + intro H. + red in |- *; red in H. + intro. + exact (H (one_div_succ k) (one_div_succ_pos _ k)). Qed. Lemma Cauchy_fun_seq'_seq : Cauchy_fun_seq' -> Cauchy_fun_seq. -intro H. -red in |- *; red in H. -intros e He. -elim (Archimedes (One[/] e[//]pos_ap_zero _ _ He)). -intros i Hei. -cut (Zero [<] nring (R:=IR) i). -intro Hi. -elim (H i). -intros N HN; exists N. -intros. -apply leEq_transitive with (one_div_succ (R:=IR) i). -apply HN; assumption. -unfold one_div_succ in |- *. -rstepr (One[/] _[//]recip_ap_zero _ _ (pos_ap_zero _ _ He)). -unfold Snring in |- *. -apply recip_resp_leEq. -apply recip_resp_pos; assumption. -apply less_leEq; apply leEq_less_trans with (nring (R:=IR) i). -assumption. -simpl in |- *; apply less_plusOne. -apply less_leEq_trans with (One[/] e[//]pos_ap_zero _ _ He). -apply recip_resp_pos; assumption. -assumption. +Proof. + intro H. + red in |- *; red in H. + intros e He. + elim (Archimedes (One[/] e[//]pos_ap_zero _ _ He)). + intros i Hei. + cut (Zero [<] nring (R:=IR) i). + intro Hi. + elim (H i). + intros N HN; exists N. + intros. + apply leEq_transitive with (one_div_succ (R:=IR) i). + apply HN; assumption. + unfold one_div_succ in |- *. + rstepr (One[/] _[//]recip_ap_zero _ _ (pos_ap_zero _ _ He)). + unfold Snring in |- *. + apply recip_resp_leEq. + apply recip_resp_pos; assumption. + apply less_leEq; apply leEq_less_trans with (nring (R:=IR) i). + assumption. + simpl in |- *; apply less_plusOne. + apply less_leEq_trans with (One[/] e[//]pos_ap_zero _ _ He). + apply recip_resp_pos; assumption. + assumption. Qed. Lemma conv_Cauchy_fun_seq' : conv_fun_seq' -> Cauchy_fun_seq. -intro H. -red in |- *; red in H. -intros e He. -elim (H _ (pos_div_two _ _ He)). -intros N HN. -exists N; intros. -apply - leEq_wdl - with - (AbsIR - (f m x (incf m x Hx) [-]F x (incF x Hx) [+] - (F x (incF x Hx) [-]f n x (incf n x Hx)))). -2: apply AbsIR_wd; rational. -eapply leEq_transitive. -apply triangle_IR. -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -apply plus_resp_leEq_both. -apply HN; assumption. -eapply leEq_wdl. -2: apply AbsIR_minus. -apply HN; assumption. +Proof. + intro H. + red in |- *; red in H. + intros e He. + elim (H _ (pos_div_two _ _ He)). + intros N HN. + exists N; intros. + apply leEq_wdl with (AbsIR (f m x (incf m x Hx) [-]F x (incF x Hx) [+] + (F x (incF x Hx) [-]f n x (incf n x Hx)))). + 2: apply AbsIR_wd; rational. + eapply leEq_transitive. + apply triangle_IR. + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + apply plus_resp_leEq_both. + apply HN; assumption. + eapply leEq_wdl. + 2: apply AbsIR_minus. + apply HN; assumption. Qed. Lemma Cauchy_fun_seq_seq2 : Cauchy_fun_seq -> Cauchy_fun_seq2. -intro H. -red in |- *; red in H. -intros e H0. -elim (H e H0); intros N HN; exists N. -intros; apply HN; auto with arith. +Proof. + intro H. + red in |- *; red in H. + intros e H0. + elim (H e H0); intros N HN; exists N. + intros; apply HN; auto with arith. Qed. Lemma Cauchy_fun_seq2_seq : Cauchy_fun_seq2 -> Cauchy_fun_seq. -intro H. -red in |- *; red in H. -intros e H0. -elim (H _ (pos_div_two _ _ H0)); intros N HN; exists N; intros. -apply - leEq_wdl - with - (AbsIR - (Part _ _ (incf m x Hx) [-]Part _ _ (incf N x Hx) [-] - (Part _ _ (incf n x Hx) [-]Part _ _ (incf N x Hx)))). -2: apply AbsIR_wd; rational. -eapply leEq_transitive. -apply triangle_IR_minus. -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -apply plus_resp_leEq_both; apply HN; auto with arith. +Proof. + intro H. + red in |- *; red in H. + intros e H0. + elim (H _ (pos_div_two _ _ H0)); intros N HN; exists N; intros. + apply leEq_wdl with (AbsIR (Part _ _ (incf m x Hx) [-]Part _ _ (incf N x Hx) [-] + (Part _ _ (incf n x Hx) [-]Part _ _ (incf N x Hx)))). + 2: apply AbsIR_wd; rational. + eapply leEq_transitive. + apply triangle_IR_minus. + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + apply plus_resp_leEq_both; apply HN; auto with arith. Qed. Lemma conv_fun_seq'_norm : conv_fun_seq' -> conv_norm_fun_seq. -intro H. -red in |- *; red in H. -intro. -elim (H (one_div_succ k) (one_div_succ_pos _ k)). -intros N HN. -exists N. -intros. -apply leEq_Norm_Funct. -fold I in |- *; intros x H1 Hx. -eapply leEq_wdl. -apply (HN n H0 x H1). -apply AbsIR_wd; simpl in |- *; rational. +Proof. + intro H. + red in |- *; red in H. + intro. + elim (H (one_div_succ k) (one_div_succ_pos _ k)). + intros N HN. + exists N. + intros. + apply leEq_Norm_Funct. + fold I in |- *; intros x H1 Hx. + eapply leEq_wdl. + apply (HN n H0 x H1). + apply AbsIR_wd; simpl in |- *; rational. Qed. Lemma conv_fun_norm_seq : conv_norm_fun_seq -> conv_fun_seq'. -intro H. -red in |- *; red in H. -intros e He. -elim (Archimedes (One[/] _[//]pos_ap_zero _ _ He)). -intros k Hk. -elim (H k); clear H. -intros N HN. -exists N. -intros. -cut (Dom (f n{-}F) x). intro H0. -apply leEq_wdl with (AbsIR ((f n{-}F) x H0)). -eapply leEq_transitive. -2: apply leEq_transitive with (one_div_succ (R:=IR) k). -2: apply HN with (n := n); assumption. -apply norm_bnd_AbsIR; assumption. -unfold one_div_succ in |- *. -unfold Snring in |- *. -apply less_leEq; apply swap_div with (pos_ap_zero _ _ He). -apply pos_nring_S. -assumption. -eapply leEq_less_trans. -apply Hk. -simpl in |- *; apply less_plusOne. -apply AbsIR_wd; simpl in |- *; rational. -split. -apply incf; assumption. -apply incF; assumption. +Proof. + intro H. + red in |- *; red in H. + intros e He. + elim (Archimedes (One[/] _[//]pos_ap_zero _ _ He)). + intros k Hk. + elim (H k); clear H. + intros N HN. + exists N. + intros. + cut (Dom (f n{-}F) x). intro H0. + apply leEq_wdl with (AbsIR ((f n{-}F) x H0)). + eapply leEq_transitive. + 2: apply leEq_transitive with (one_div_succ (R:=IR) k). + 2: apply HN with (n := n); assumption. + apply norm_bnd_AbsIR; assumption. + unfold one_div_succ in |- *. + unfold Snring in |- *. + apply less_leEq; apply swap_div with (pos_ap_zero _ _ He). + apply pos_nring_S. + assumption. + eapply leEq_less_trans. + apply Hk. + simpl in |- *; apply less_plusOne. + apply AbsIR_wd; simpl in |- *; rational. + split. + apply incf; assumption. + apply incF; assumption. Qed. Lemma Cauchy_fun_seq1_seq' : Cauchy_fun_seq1 -> Cauchy_fun_seq'. -intro H. -red in |- *; red in H. -intro. -elim (H k); clear H; intros N HN. -exists N; intros. -eapply leEq_transitive. -2: apply HN with (m := m) (n := n); assumption. -cut (Dom (f m{-}f n) x). intro H1. -apply leEq_wdl with (AbsIR (Part _ _ H1)). -apply norm_bnd_AbsIR; assumption. -apply AbsIR_wd; simpl in |- *; rational. -split; simpl in |- *; apply incf; assumption. +Proof. + intro H. + red in |- *; red in H. + intro. + elim (H k); clear H; intros N HN. + exists N; intros. + eapply leEq_transitive. + 2: apply HN with (m := m) (n := n); assumption. + cut (Dom (f m{-}f n) x). intro H1. + apply leEq_wdl with (AbsIR (Part _ _ H1)). + apply norm_bnd_AbsIR; assumption. + apply AbsIR_wd; simpl in |- *; rational. + split; simpl in |- *; apply incf; assumption. Qed. Lemma Cauchy_fun_seq'_seq1 : Cauchy_fun_seq' -> Cauchy_fun_seq1. -intro H. -red in |- *; red in H. -intro. -elim (H k); clear H; intros N HN. -exists N; intros. -apply leEq_Norm_Funct. -intros x H1 Hx. -eapply leEq_wdl. -apply (HN m n H H0 x H1). -apply AbsIR_wd; simpl in |- *; rational. +Proof. + intro H. + red in |- *; red in H. + intro. + elim (H k); clear H; intros N HN. + exists N; intros. + apply leEq_Norm_Funct. + intros x H1 Hx. + eapply leEq_wdl. + apply (HN m n H H0 x H1). + apply AbsIR_wd; simpl in |- *; rational. Qed. Lemma Cauchy_fun_seq_seq1 : Cauchy_fun_seq -> Cauchy_fun_seq1. -intro. -apply Cauchy_fun_seq'_seq1. -apply Cauchy_fun_seq_seq'. -assumption. +Proof. + intro. + apply Cauchy_fun_seq'_seq1. + apply Cauchy_fun_seq_seq'. + assumption. Qed. Lemma Cauchy_fun_seq1_seq : Cauchy_fun_seq1 -> Cauchy_fun_seq. -intro. -apply Cauchy_fun_seq'_seq. -apply Cauchy_fun_seq1_seq'. -assumption. +Proof. + intro. + apply Cauchy_fun_seq'_seq. + apply Cauchy_fun_seq1_seq'. + assumption. Qed. (** @@ -279,16 +282,17 @@ A Cauchy sequence of functions is pointwise a Cauchy sequence. Lemma Cauchy_fun_real : Cauchy_fun_seq -> forall x Hx, Cauchy_prop (fun n => Part _ _ (incf n x Hx)). -intros H x Hx. -red in |- *; red in H. -intros e He. -elim (H _ He); clear H; intros N HN. -exists N. -intros. -apply AbsIR_imp_AbsSmall. -apply HN. -assumption. -apply le_n. +Proof. + intros H x Hx. + red in |- *; red in H. + intros e He. + elim (H _ He); clear H; intros N HN. + exists N. + intros. + apply AbsIR_imp_AbsSmall. + apply HN. + assumption. + apply le_n. Qed. End Definitions. @@ -323,21 +327,15 @@ Hypothesis H : Cauchy_fun_seq _ _ _ f contf. (* end show *) Definition Cauchy_fun_seq_Lim : PartIR. -apply - Build_PartFunct - with - (pfpfun := fun x Hx => - Lim - (Build_CauchySeq _ - (fun n : nat => - Part _ _ (contin_imp_inc _ _ _ _ (contf n) x Hx)) - (Cauchy_fun_real _ _ _ _ contf H x Hx))). -unfold I in |- *; apply compact_wd. -intros x y Hx Hy H0. -elim (Lim_strext _ _ H0). -intros n Hn. -simpl in Hn. -exact (pfstrx _ _ _ _ _ _ Hn). +Proof. + apply Build_PartFunct with (pfpfun := fun x Hx => Lim (Build_CauchySeq _ (fun n : nat => + Part _ _ (contin_imp_inc _ _ _ _ (contf n) x Hx)) (Cauchy_fun_real _ _ _ _ contf H x Hx))). + unfold I in |- *; apply compact_wd. + intros x y Hx Hy H0. + elim (Lim_strext _ _ H0). + intros n Hn. + simpl in Hn. + exact (pfstrx _ _ _ _ _ _ Hn). Defined. End More_Definitions. @@ -368,54 +366,59 @@ Hypotheses contF contF0 : Continuous_I Hab F. Lemma conv_fun_seq'_wd : conv_fun_seq' _ _ _ _ _ contf contF -> conv_fun_seq' _ _ _ _ _ contf0 contF0. -intros H e H0. -elim (H e H0); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN n H1 x Hx). -apply AbsIR_wd; rational. +Proof. + intros H e H0. + elim (H e H0); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN n H1 x Hx). + apply AbsIR_wd; rational. Qed. Lemma Cauchy_fun_seq'_wd : Cauchy_fun_seq' _ _ _ _ contf -> Cauchy_fun_seq' _ _ _ _ contf0. -intros H k. -elim (H k); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN m n H0 H1 x Hx). -apply AbsIR_wd; rational. +Proof. + intros H k. + elim (H k); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN m n H0 H1 x Hx). + apply AbsIR_wd; rational. Qed. Lemma Cauchy_fun_seq2_wd : Cauchy_fun_seq2 _ _ _ _ contf -> Cauchy_fun_seq2 _ _ _ _ contf0. -intros H e H0. -elim (H e H0); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN m H1 x Hx). -apply AbsIR_wd; rational. +Proof. + intros H e H0. + elim (H e H0); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN m H1 x Hx). + apply AbsIR_wd; rational. Qed. Lemma conv_norm_fun_seq_wd : conv_norm_fun_seq _ _ _ _ _ contf contF -> conv_norm_fun_seq _ _ _ _ _ contf0 contF0. -intros H k. -elim (H k); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN n H0). -apply Norm_Funct_wd. -apply Feq_reflexive; Included. +Proof. + intros H k. + elim (H k); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN n H0). + apply Norm_Funct_wd. + apply Feq_reflexive; Included. Qed. Lemma Cauchy_fun_seq1_wd : Cauchy_fun_seq1 _ _ _ _ contf -> Cauchy_fun_seq1 _ _ _ _ contf0. -intros H k. -elim (H k); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN m n H0 H1). -apply Norm_Funct_wd. -apply Feq_reflexive; Included. +Proof. + intros H k. + elim (H k); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN m n H0 H1). + apply Norm_Funct_wd. + apply Feq_reflexive; Included. Qed. End Irrelevance_of_Proofs. @@ -424,13 +427,14 @@ Section More_Proof_Irrelevance. Lemma conv_fun_seq_wd : forall a b Hab f contf contf0, conv_fun_seq a b Hab f contf -> conv_fun_seq a b Hab f contf0. -intros a b Hab f contf contf0 H. -elim H; intros f' Hf'. -exists f'. -elim Hf'; intros contf' H0. -exists contf'. -eapply conv_fun_seq'_wd. -apply H0. +Proof. + intros a b Hab f contf contf0 H. + elim H; intros f' Hf'. + exists f'. + elim Hf'; intros contf' H0. + exists contf'. + eapply conv_fun_seq'_wd. + apply H0. Qed. End More_Proof_Irrelevance. @@ -459,42 +463,33 @@ Hypotheses contg contg0 : forall n, Continuous_I Hab (g n). Lemma Cauchy_conv_fun_seq' : forall H contf', conv_fun_seq' _ _ _ _ (Cauchy_fun_seq_Lim _ _ _ f contf H) contf contf'. -intros H contf' e H0. -elim (H e H0). -intros N HN. -exists N. -intros. -set (incf := fun n : nat => contin_imp_inc _ _ _ _ (contf n)) in *. -set (incf' := contin_imp_inc _ _ _ _ contf') in *. -apply - leEq_wdl - with - (AbsIR - (Lim (Cauchy_const (f n x (incf n x Hx))) [-] - Part (Cauchy_fun_seq_Lim _ _ _ _ _ H) x (incf' x Hx))). -2: apply AbsIR_wd; apply cg_minus_wd. -2: apply eq_symmetric_unfolded; apply Lim_const. -2: algebra. -simpl in |- *. -apply - leEq_wdl - with - (AbsIR - (Lim - (Build_CauchySeq IR _ - (Cauchy_minus (Cauchy_const (Part _ _ (incf n x Hx))) - (Build_CauchySeq _ _ - (Cauchy_fun_real _ _ _ _ _ H x (incf' x Hx))))))). -2: apply AbsIR_wd; apply Lim_minus. -eapply leEq_wdl. -2: apply Lim_abs. -simpl in |- *. -apply str_seq_leEq_so_Lim_leEq. -exists N; intros. -simpl in |- *. -eapply leEq_wdl. -apply (HN n i H1 H2 x Hx). -apply AbsIR_wd; rational. +Proof. + intros H contf' e H0. + elim (H e H0). + intros N HN. + exists N. + intros. + set (incf := fun n : nat => contin_imp_inc _ _ _ _ (contf n)) in *. + set (incf' := contin_imp_inc _ _ _ _ contf') in *. + apply leEq_wdl with (AbsIR (Lim (Cauchy_const (f n x (incf n x Hx))) [-] + Part (Cauchy_fun_seq_Lim _ _ _ _ _ H) x (incf' x Hx))). + 2: apply AbsIR_wd; apply cg_minus_wd. + 2: apply eq_symmetric_unfolded; apply Lim_const. + 2: algebra. + simpl in |- *. + apply leEq_wdl with (AbsIR (Lim (Build_CauchySeq IR _ + (Cauchy_minus (Cauchy_const (Part _ _ (incf n x Hx))) (Build_CauchySeq _ _ + (Cauchy_fun_real _ _ _ _ _ H x (incf' x Hx))))))). + 2: apply AbsIR_wd; apply Lim_minus. + eapply leEq_wdl. + 2: apply Lim_abs. + simpl in |- *. + apply str_seq_leEq_so_Lim_leEq. + exists N; intros. + simpl in |- *. + eapply leEq_wdl. + apply (HN n i H1 H2 x Hx). + apply AbsIR_wd; rational. Qed. Variables F G : PartIR. @@ -505,188 +500,177 @@ Hypotheses contG contG0 : Continuous_I Hab G. Lemma conv_fun_seq'_wdl : (forall n, Feq I (f n) (g n)) -> conv_fun_seq' _ _ _ _ _ contf contF -> conv_fun_seq' _ _ _ _ _ contg contF0. -intros H H0 e H1. -elim (H0 e H1); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN n H2 x Hx). -apply AbsIR_wd; apply cg_minus_wd. -elim (H n); intros Haux inc. -inversion_clear inc. -auto. -algebra. +Proof. + intros H H0 e H1. + elim (H0 e H1); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN n H2 x Hx). + apply AbsIR_wd; apply cg_minus_wd. + elim (H n); intros Haux inc. + inversion_clear inc. + auto. + algebra. Qed. Lemma conv_fun_seq'_wdr : Feq I F G -> conv_fun_seq' _ _ _ _ _ contf contF -> conv_fun_seq' _ _ _ _ _ contf0 contG. -intros H H0 e H1. -elim (H0 e H1); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN n H2 x Hx). -apply AbsIR_wd; apply cg_minus_wd. -algebra. -elim H; intros Haux inc. -inversion_clear inc. -auto. +Proof. + intros H H0 e H1. + elim (H0 e H1); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN n H2 x Hx). + apply AbsIR_wd; apply cg_minus_wd. + algebra. + elim H; intros Haux inc. + inversion_clear inc. + auto. Qed. Lemma conv_fun_seq'_wdl' : (forall n, Feq I (f n) (g n)) -> conv_fun_seq' _ _ _ _ _ contf contF -> conv_fun_seq' _ _ _ _ _ contg contF. -intros H H0 e H1. -elim (H0 e H1); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN n H2 x Hx). -apply AbsIR_wd; apply cg_minus_wd. -elim (H n); intros Haux inc. -inversion_clear inc. -auto. -algebra. +Proof. + intros H H0 e H1. + elim (H0 e H1); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN n H2 x Hx). + apply AbsIR_wd; apply cg_minus_wd. + elim (H n); intros Haux inc. + inversion_clear inc. + auto. + algebra. Qed. Lemma conv_fun_seq'_wdr' : Feq I F G -> conv_fun_seq' _ _ _ _ _ contf contF -> conv_fun_seq' _ _ _ _ _ contf contG. -intros H H0 e H1. -elim (H0 e H1); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN n H2 x Hx). -apply AbsIR_wd; apply cg_minus_wd. -algebra. -elim H; intros Haux inc. -inversion_clear inc. -auto. +Proof. + intros H H0 e H1. + elim (H0 e H1); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN n H2 x Hx). + apply AbsIR_wd; apply cg_minus_wd. + algebra. + elim H; intros Haux inc. + inversion_clear inc. + auto. Qed. Lemma Cauchy_fun_seq_wd : (forall n, Feq I (f n) (g n)) -> Cauchy_fun_seq _ _ _ _ contf -> Cauchy_fun_seq _ _ _ _ contg. -intros H H0 e H1. -elim (H0 e H1); clear H0; intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN m n H0 H2 x Hx). -elim (H n); intros. -inversion_clear b0. -elim (H m); intros. -inversion_clear b0. -apply AbsIR_wd; algebra. +Proof. + intros H H0 e H1. + elim (H0 e H1); clear H0; intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN m n H0 H2 x Hx). + elim (H n); intros. + inversion_clear b0. + elim (H m); intros. + inversion_clear b0. + apply AbsIR_wd; algebra. Qed. Lemma Cauchy_cont_Lim : forall H : Cauchy_fun_seq a b Hab f contf, Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ contf H). -intros. -split. -Included. -intros e He. -elim (H _ (pos_div_three _ _ He)); intros N HN. -elim (contf N); intros incf contf'. -elim (contf' _ (pos_div_three _ _ He)). -intros d H0 H1. -exists d. -assumption. -intros x y H2 H3 Hx Hy H4. -cut (forall x y z w : IR, AbsIR (x[-]w) [=] AbsIR (x[-]y[+] (y[-]z) [+] (z[-]w))); +Proof. intros. -2: apply AbsIR_wd; rational. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; + split. + Included. + intros e He. + elim (H _ (pos_div_three _ _ He)); intros N HN. + elim (contf N); intros incf contf'. + elim (contf' _ (pos_div_three _ _ He)). + intros d H0 H1. + exists d. + assumption. + intros x y H2 H3 Hx Hy H4. + cut (forall x y z w : IR, AbsIR (x[-]w) [=] AbsIR (x[-]y[+] (y[-]z) [+] (z[-]w))); intros. + 2: apply AbsIR_wd; rational. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply H5 with (y := Part _ _ (incf x H2)) (z := Part _ _ (incf y H3)). -rstepr (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ). -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -apply - leEq_wdl - with (AbsIR (Part _ _ Hx[-]Lim (Cauchy_const (Part _ _ (incf x H2))))). -2: apply AbsIR_wd; apply cg_minus_wd. -2: algebra. -2: apply eq_symmetric_unfolded; apply Lim_const. -simpl in |- *. -apply - leEq_wdl - with - (AbsIR - (Lim - (Build_CauchySeq IR _ - (Cauchy_minus - (Build_CauchySeq _ _ (Cauchy_fun_real _ _ _ _ _ H x Hx)) - (Cauchy_const (Part _ _ (incf x H2))))))). -2: apply AbsIR_wd; apply Lim_minus. -eapply leEq_wdl. -2: apply Lim_abs. -simpl in |- *. -apply str_seq_leEq_so_Lim_leEq. -exists N; intros. -simpl in |- *. -eapply leEq_wdl. -apply (HN i N) with (x := x) (Hx := Hx); auto with arith. -apply AbsIR_wd; rational. -apply H1; assumption. -apply - leEq_wdl - with - (AbsIR - (Lim (Cauchy_const (Part _ _ (incf y H3))) [-] - Part (Cauchy_fun_seq_Lim _ _ _ _ _ H) y Hy)). -2: apply AbsIR_wd; apply cg_minus_wd. -2: apply eq_symmetric_unfolded; apply Lim_const. -2: algebra. -simpl in |- *. -apply - leEq_wdl - with - (AbsIR - (Lim - (Build_CauchySeq IR _ - (Cauchy_minus (Cauchy_const (Part _ _ (incf y H3))) - (Build_CauchySeq _ _ (Cauchy_fun_real _ _ _ _ _ H y Hy)))))). -2: apply AbsIR_wd; apply Lim_minus. -eapply leEq_wdl. -2: apply Lim_abs. -simpl in |- *. -apply str_seq_leEq_so_Lim_leEq. -exists N; intros. -simpl in |- *. -eapply leEq_wdl. -apply (HN N i) with (x := y) (Hx := Hy); auto. -apply AbsIR_wd; rational. + rstepr (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ). + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + apply leEq_wdl with (AbsIR (Part _ _ Hx[-]Lim (Cauchy_const (Part _ _ (incf x H2))))). + 2: apply AbsIR_wd; apply cg_minus_wd. + 2: algebra. + 2: apply eq_symmetric_unfolded; apply Lim_const. + simpl in |- *. + apply leEq_wdl with (AbsIR (Lim (Build_CauchySeq IR _ (Cauchy_minus + (Build_CauchySeq _ _ (Cauchy_fun_real _ _ _ _ _ H x Hx)) (Cauchy_const (Part _ _ (incf x H2))))))). + 2: apply AbsIR_wd; apply Lim_minus. + eapply leEq_wdl. + 2: apply Lim_abs. + simpl in |- *. + apply str_seq_leEq_so_Lim_leEq. + exists N; intros. + simpl in |- *. + eapply leEq_wdl. + apply (HN i N) with (x := x) (Hx := Hx); auto with arith. + apply AbsIR_wd; rational. + apply H1; assumption. + apply leEq_wdl with (AbsIR (Lim (Cauchy_const (Part _ _ (incf y H3))) [-] + Part (Cauchy_fun_seq_Lim _ _ _ _ _ H) y Hy)). + 2: apply AbsIR_wd; apply cg_minus_wd. + 2: apply eq_symmetric_unfolded; apply Lim_const. + 2: algebra. + simpl in |- *. + apply leEq_wdl with (AbsIR (Lim (Build_CauchySeq IR _ + (Cauchy_minus (Cauchy_const (Part _ _ (incf y H3))) + (Build_CauchySeq _ _ (Cauchy_fun_real _ _ _ _ _ H y Hy)))))). + 2: apply AbsIR_wd; apply Lim_minus. + eapply leEq_wdl. + 2: apply Lim_abs. + simpl in |- *. + apply str_seq_leEq_so_Lim_leEq. + exists N; intros. + simpl in |- *. + eapply leEq_wdl. + apply (HN N i) with (x := y) (Hx := Hy); auto. + apply AbsIR_wd; rational. Qed. Lemma Cauchy_conv_fun_seq : Cauchy_fun_seq _ _ _ _ contf -> conv_fun_seq _ _ _ _ contf. -intro H. -cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ H)). intro H0. -exists (IntPartIR (contin_imp_inc _ _ _ _ H0)). -cut (Continuous_I Hab (PartInt (IntPartIR (contin_imp_inc _ _ _ _ H0)))). -2: eapply Continuous_I_wd. -3: apply Cauchy_cont_Lim with (H := H). -2: FEQ. -2: simpl in |- *; apply Lim_wd'; intros; algebra. -intro H2; exists H2. -intros e H1. -elim (Cauchy_conv_fun_seq' H H0 e H1); intros N HN. -exists N; intros. -eapply leEq_wdl. -apply (HN n H3 x Hx). -apply AbsIR_wd; apply cg_minus_wd. -algebra. -simpl in |- *; apply Lim_wd'; intros; simpl in |- *; rational. -simpl in |- *; algebra. -simpl in |- *; apply Cauchy_cont_Lim. +Proof. + intro H. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ H)). intro H0. + exists (IntPartIR (contin_imp_inc _ _ _ _ H0)). + cut (Continuous_I Hab (PartInt (IntPartIR (contin_imp_inc _ _ _ _ H0)))). + 2: eapply Continuous_I_wd. + 3: apply Cauchy_cont_Lim with (H := H). + 2: FEQ. + 2: simpl in |- *; apply Lim_wd'; intros; algebra. + intro H2; exists H2. + intros e H1. + elim (Cauchy_conv_fun_seq' H H0 e H1); intros N HN. + exists N; intros. + eapply leEq_wdl. + apply (HN n H3 x Hx). + apply AbsIR_wd; apply cg_minus_wd. + algebra. + simpl in |- *; apply Lim_wd'; intros; simpl in |- *; rational. + simpl in |- *; algebra. + simpl in |- *; apply Cauchy_cont_Lim. Qed. Lemma conv_Cauchy_fun_seq : conv_fun_seq _ _ _ _ contf -> Cauchy_fun_seq _ _ _ _ contf. -intro H. -elim H; intros ff Hff. -inversion_clear Hff. -apply conv_Cauchy_fun_seq' with (PartInt ff) x. -unfold I in |- *; eapply conv_fun_seq'_wd. -apply X. +Proof. + intro H. + elim H; intros ff Hff. + inversion_clear Hff. + apply conv_Cauchy_fun_seq' with (PartInt ff) x. + unfold I in |- *; eapply conv_fun_seq'_wd. + apply X. Qed. (** @@ -695,14 +679,15 @@ More interesting is the fact that a convergent sequence of functions converges p Lemma fun_conv_imp_seq_conv : conv_fun_seq' _ _ _ _ _ contf contF -> forall x, Compact Hab x -> forall Hxf HxF, Cauchy_Lim_prop2 (fun n => f n x (Hxf n)) (F x HxF). -intros H x H0 Hxf HxF eps H1. -elim (H eps H1). -intros N HN. -exists N; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_wdl. -apply (HN m H2 x H0). -apply AbsIR_wd; algebra. +Proof. + intros H x H0 Hxf HxF eps H1. + elim (H eps H1). + intros N HN. + exists N; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_wdl. + apply (HN m H2 x H0). + apply AbsIR_wd; algebra. Qed. (** @@ -711,11 +696,12 @@ And a sequence of real numbers converges iff the corresponding sequence of const Lemma seq_conv_imp_fun_conv : forall x y, Cauchy_Lim_prop2 x y -> forall Hf HF, conv_fun_seq' a b Hab (fun n => [-C-] (x n)) [-C-]y Hf HF. -intros x y H Hf HF e H0. -elim (H e H0); intros N HN. -exists N; intros; simpl in |- *. -apply AbsSmall_imp_AbsIR. -auto. +Proof. + intros x y H Hf HF e H0. + elim (H e H0); intros N HN. + exists N; intros; simpl in |- *. + apply AbsSmall_imp_AbsIR. + auto. Qed. End More_Properties. @@ -746,37 +732,26 @@ First, the limit function is unique. Lemma FLim_unique : forall F G HF HG, conv_fun_seq' a b Hab f F contf HF -> conv_fun_seq' a b Hab f G contf HG -> Feq (Compact Hab) F G. -intros F G HF HG H H0. -cut (Cauchy_fun_seq _ _ Hab _ contf). intro H1. -apply Feq_transitive with (Cauchy_fun_seq_Lim _ _ _ _ _ H1). -FEQ. -simpl in |- *. -apply Limits_unique. -simpl in |- *. -eapply - fun_conv_imp_seq_conv - with - (Hab := Hab) - (Hxf := - fun n : nat => - contin_imp_inc _ _ Hab _ (contf n) x Hx'); - auto. -apply H. -apply Feq_symmetric. -FEQ. -simpl in |- *. -apply Limits_unique. -simpl in |- *. -eapply - fun_conv_imp_seq_conv - with - (Hab := Hab) - (Hxf := - fun n : nat => - contin_imp_inc _ _ Hab _ (contf n) x Hx'); - auto. -apply H0. -apply conv_Cauchy_fun_seq' with F HF; auto. +Proof. + intros F G HF HG H H0. + cut (Cauchy_fun_seq _ _ Hab _ contf). intro H1. + apply Feq_transitive with (Cauchy_fun_seq_Lim _ _ _ _ _ H1). + FEQ. + simpl in |- *. + apply Limits_unique. + simpl in |- *. + eapply fun_conv_imp_seq_conv with (Hab := Hab) (Hxf := fun n : nat => + contin_imp_inc _ _ Hab _ (contf n) x Hx'); auto. + apply H. + apply Feq_symmetric. + FEQ. + simpl in |- *. + apply Limits_unique. + simpl in |- *. + eapply fun_conv_imp_seq_conv with (Hab := Hab) (Hxf := fun n : nat => + contin_imp_inc _ _ Hab _ (contf n) x Hx'); auto. + apply H0. + apply conv_Cauchy_fun_seq' with F HF; auto. Qed. (** Constant sequences (not sequences of constant functions!) always converge. @@ -784,19 +759,21 @@ Qed. Lemma fun_Lim_seq_const : forall H contH contH', conv_fun_seq' a b Hab (fun n => H) H contH contH'. -exists 0; intros. -eapply leEq_wdl. -2: eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply AbsIRz_isz. -apply less_leEq; assumption. -apply AbsIR_wd; rational. +Proof. + exists 0; intros. + eapply leEq_wdl. + 2: eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply AbsIRz_isz. + apply less_leEq; assumption. + apply AbsIR_wd; rational. Qed. Lemma fun_Cauchy_prop_const : forall H (contH:Continuous_I Hab H), Cauchy_fun_seq a b Hab (fun n => H) (fun n => contH). -intros. -apply conv_Cauchy_fun_seq' with H contH. -apply fun_Lim_seq_const. +Proof. + intros. + apply conv_Cauchy_fun_seq' with H contH. + apply fun_Lim_seq_const. Qed. (** @@ -821,181 +798,151 @@ Let incG := contin_imp_inc _ _ _ _ contG. Lemma fun_Lim_seq_plus' : forall H H', conv_fun_seq' a b Hab (fun n => f n{+}g n) (F{+}G) H H'. -intros H H' e H0. -elim (convF _ (pos_div_two _ _ H0)); intros Nf HNf. -elim (convG _ (pos_div_two _ _ H0)); intros Ng HNg. -cut (Nf <= max Nf Ng); [ intro | apply le_max_l ]. -cut (Ng <= max Nf Ng); [ intro | apply le_max_r ]. -exists (max Nf Ng); intros. -apply - leEq_wdl - with - (AbsIR - (Part _ _ (incf n x Hx) [+]Part _ _ (incg n x Hx) [-] - (Part _ _ (incF x Hx) [+]Part _ _ (incG x Hx)))). -2: apply AbsIR_wd; simpl in |- *; algebra. -apply - leEq_wdl - with - (AbsIR - (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx) [+] - (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)))). -2: apply AbsIR_wd; simpl in |- *; rational. -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -unfold incf in |- *; apply HNf; apply le_trans with (max Nf Ng); auto. -unfold incg in |- *; apply HNg; apply le_trans with (max Nf Ng); auto. +Proof. + intros H H' e H0. + elim (convF _ (pos_div_two _ _ H0)); intros Nf HNf. + elim (convG _ (pos_div_two _ _ H0)); intros Ng HNg. + cut (Nf <= max Nf Ng); [ intro | apply le_max_l ]. + cut (Ng <= max Nf Ng); [ intro | apply le_max_r ]. + exists (max Nf Ng); intros. + apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [+]Part _ _ (incg n x Hx) [-] + (Part _ _ (incF x Hx) [+]Part _ _ (incG x Hx)))). + 2: apply AbsIR_wd; simpl in |- *; algebra. + apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx) [+] + (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)))). + 2: apply AbsIR_wd; simpl in |- *; rational. + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + unfold incf in |- *; apply HNf; apply le_trans with (max Nf Ng); auto. + unfold incg in |- *; apply HNg; apply le_trans with (max Nf Ng); auto. Qed. Lemma fun_Lim_seq_minus' : forall H H', conv_fun_seq' a b Hab (fun n => f n{-}g n) (F{-}G) H H'. -intros H H' e H0. -elim (convF _ (pos_div_two _ _ H0)); intros Nf HNf. -elim (convG _ (pos_div_two _ _ H0)); intros Ng HNg. -cut (Nf <= max Nf Ng); [ intro | apply le_max_l ]. -cut (Ng <= max Nf Ng); [ intro | apply le_max_r ]. -exists (max Nf Ng); intros. -apply - leEq_wdl - with - (AbsIR - (Part _ _ (incf n x Hx) [-]Part _ _ (incg n x Hx) [-] - (Part _ _ (incF x Hx) [-]Part _ _ (incG x Hx)))). -2: apply AbsIR_wd; simpl in |- *; algebra. -apply - leEq_wdl - with - (AbsIR - (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx) [-] - (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)))). -2: apply AbsIR_wd; simpl in |- *; rational. -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -eapply leEq_transitive. -apply triangle_IR_minus. -apply plus_resp_leEq_both. -unfold incf in |- *; apply HNf; apply le_trans with (max Nf Ng); auto. -unfold incg in |- *; apply HNg; apply le_trans with (max Nf Ng); auto. +Proof. + intros H H' e H0. + elim (convF _ (pos_div_two _ _ H0)); intros Nf HNf. + elim (convG _ (pos_div_two _ _ H0)); intros Ng HNg. + cut (Nf <= max Nf Ng); [ intro | apply le_max_l ]. + cut (Ng <= max Nf Ng); [ intro | apply le_max_r ]. + exists (max Nf Ng); intros. + apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [-]Part _ _ (incg n x Hx) [-] + (Part _ _ (incF x Hx) [-]Part _ _ (incG x Hx)))). + 2: apply AbsIR_wd; simpl in |- *; algebra. + apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx) [-] + (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)))). + 2: apply AbsIR_wd; simpl in |- *; rational. + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + eapply leEq_transitive. + apply triangle_IR_minus. + apply plus_resp_leEq_both. + unfold incf in |- *; apply HNf; apply le_trans with (max Nf Ng); auto. + unfold incg in |- *; apply HNg; apply le_trans with (max Nf Ng); auto. Qed. Lemma fun_Lim_seq_mult' : forall H H', conv_fun_seq' a b Hab (fun n => f n{*}g n) (F{*}G) H H'. -intros. -set (nF := Norm_Funct contF) in *. -set (nG := Norm_Funct contG) in *. -red in |- *; intros. -set (ee := Min e One) in *. -cut (Zero [<] ee); intros. -set (eg := ee [/]ThreeNZ[/] _[//]max_one_ap_zero nF) in *. -set (ef := ee [/]ThreeNZ[/] _[//]max_one_ap_zero nG) in *. -cut (Zero [<] eg). -intro Heg. -cut (Zero [<] ef). -intro Hef. -elim (convF _ Hef); intros NF HNF; clear convF. -elim (convG _ Heg); intros NG HNG; clear convG. -cut (NF <= max NF NG); [ intro | apply le_max_l ]. -cut (NG <= max NF NG); [ intro | apply le_max_r ]. -exists (max NF NG); intros. -apply leEq_transitive with ee. -2: unfold ee in |- *; apply Min_leEq_lft. -apply - leEq_wdl - with - (AbsIR - (Part _ _ (incf n x Hx) [*]Part _ _ (incg n x Hx) [-] - Part _ _ (incF x Hx) [*]Part _ _ (incG x Hx))). -2: apply AbsIR_wd; simpl in |- *; algebra. -apply - leEq_wdl - with - (AbsIR - (Part _ _ (incF x Hx) [*] - (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)) [+] +Proof. + intros. + set (nF := Norm_Funct contF) in *. + set (nG := Norm_Funct contG) in *. + red in |- *; intros. + set (ee := Min e One) in *. + cut (Zero [<] ee); intros. + set (eg := ee [/]ThreeNZ[/] _[//]max_one_ap_zero nF) in *. + set (ef := ee [/]ThreeNZ[/] _[//]max_one_ap_zero nG) in *. + cut (Zero [<] eg). + intro Heg. + cut (Zero [<] ef). + intro Hef. + elim (convF _ Hef); intros NF HNF; clear convF. + elim (convG _ Heg); intros NG HNG; clear convG. + cut (NF <= max NF NG); [ intro | apply le_max_l ]. + cut (NG <= max NF NG); [ intro | apply le_max_r ]. + exists (max NF NG); intros. + apply leEq_transitive with ee. + 2: unfold ee in |- *; apply Min_leEq_lft. + apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [*]Part _ _ (incg n x Hx) [-] + Part _ _ (incF x Hx) [*]Part _ _ (incG x Hx))). + 2: apply AbsIR_wd; simpl in |- *; algebra. + apply leEq_wdl with (AbsIR (Part _ _ (incF x Hx) [*] + (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)) [+] (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx)) [*] - (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)) [+] - Part _ _ (incG x Hx) [*] - (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx)))). -2: apply AbsIR_wd; simpl in |- *; rational. -rstepr (ee [/]ThreeNZ[+]ee [/]ThreeNZ[+]ee [/]ThreeNZ). -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply - leEq_transitive - with (Max nF One[*]AbsIR (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx))). -apply mult_resp_leEq_rht. -apply leEq_transitive with nF. -unfold nF in |- *; apply norm_bnd_AbsIR; assumption. -apply lft_leEq_Max. -apply AbsIR_nonneg. -eapply shift_mult_leEq'. -apply pos_max_one. -unfold eg in HNG; unfold incg in |- *; apply HNG; - apply le_trans with (max NF NG); auto. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply leEq_transitive with (ee [/]ThreeNZ[*]ee [/]ThreeNZ). -2: astepr (ee [/]ThreeNZ[*]One); apply mult_resp_leEq_lft. -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -eapply leEq_transitive. -unfold incf in |- *; apply HNF; apply le_trans with (max NF NG); auto. -unfold ef in |- *. -apply shift_div_leEq. -apply pos_max_one. -astepl (ee [/]ThreeNZ[*]One); apply mult_resp_leEq_lft. -apply rht_leEq_Max. -apply less_leEq; apply shift_less_div; astepl ZeroR; - [ apply pos_three | assumption ]. -eapply leEq_transitive. -unfold incg in |- *; apply HNG; apply le_trans with (max NF NG); auto. -unfold eg in |- *. -apply shift_div_leEq. -apply pos_max_one. -astepl (ee [/]ThreeNZ[*]One); apply mult_resp_leEq_lft. -apply rht_leEq_Max. -apply less_leEq; apply shift_less_div; astepl ZeroR; - [ apply pos_three | assumption ]. -apply shift_div_leEq. -apply pos_three. -astepr (Three:IR). -unfold ee in |- *; apply leEq_transitive with OneR. -apply Min_leEq_rht. -apply less_leEq; apply one_less_three. -apply less_leEq; apply shift_less_div. -apply pos_three. -astepl ZeroR; assumption. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply - leEq_transitive - with (Max nG One[*]AbsIR (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx))). -apply mult_resp_leEq_rht. -apply leEq_transitive with nG. -unfold nG in |- *; apply norm_bnd_AbsIR; assumption. -apply lft_leEq_Max. -apply AbsIR_nonneg. -eapply shift_mult_leEq'. -apply pos_max_one. -unfold ef in HNF; unfold incf in |- *; apply HNF; - apply le_trans with (max NF NG); auto. -unfold ef in |- *. -apply div_resp_pos. -apply pos_max_one. -apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ]. -unfold eg in |- *. -apply div_resp_pos. -apply pos_max_one. -apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ]. -unfold ee in |- *; apply less_Min. -assumption. -apply pos_one. + (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)) [+] Part _ _ (incG x Hx) [*] + (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx)))). + 2: apply AbsIR_wd; simpl in |- *; rational. + rstepr (ee [/]ThreeNZ[+]ee [/]ThreeNZ[+]ee [/]ThreeNZ). + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_transitive with (Max nF One[*]AbsIR (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx))). + apply mult_resp_leEq_rht. + apply leEq_transitive with nF. + unfold nF in |- *; apply norm_bnd_AbsIR; assumption. + apply lft_leEq_Max. + apply AbsIR_nonneg. + eapply shift_mult_leEq'. + apply pos_max_one. + unfold eg in HNG; unfold incg in |- *; apply HNG; apply le_trans with (max NF NG); auto. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_transitive with (ee [/]ThreeNZ[*]ee [/]ThreeNZ). + 2: astepr (ee [/]ThreeNZ[*]One); apply mult_resp_leEq_lft. + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + eapply leEq_transitive. + unfold incf in |- *; apply HNF; apply le_trans with (max NF NG); auto. + unfold ef in |- *. + apply shift_div_leEq. + apply pos_max_one. + astepl (ee [/]ThreeNZ[*]One); apply mult_resp_leEq_lft. + apply rht_leEq_Max. + apply less_leEq; apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ]. + eapply leEq_transitive. + unfold incg in |- *; apply HNG; apply le_trans with (max NF NG); auto. + unfold eg in |- *. + apply shift_div_leEq. + apply pos_max_one. + astepl (ee [/]ThreeNZ[*]One); apply mult_resp_leEq_lft. + apply rht_leEq_Max. + apply less_leEq; apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ]. + apply shift_div_leEq. + apply pos_three. + astepr (Three:IR). + unfold ee in |- *; apply leEq_transitive with OneR. + apply Min_leEq_rht. + apply less_leEq; apply one_less_three. + apply less_leEq; apply shift_less_div. + apply pos_three. + astepl ZeroR; assumption. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_transitive with (Max nG One[*]AbsIR (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx))). + apply mult_resp_leEq_rht. + apply leEq_transitive with nG. + unfold nG in |- *; apply norm_bnd_AbsIR; assumption. + apply lft_leEq_Max. + apply AbsIR_nonneg. + eapply shift_mult_leEq'. + apply pos_max_one. + unfold ef in HNF; unfold incf in |- *; apply HNF; apply le_trans with (max NF NG); auto. + unfold ef in |- *. + apply div_resp_pos. + apply pos_max_one. + apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ]. + unfold eg in |- *. + apply div_resp_pos. + apply pos_max_one. + apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ]. + unfold ee in |- *; apply less_Min. + assumption. + apply pos_one. Qed. End Algebraic_Properties. @@ -1023,94 +970,89 @@ Hypothesis Hg : Cauchy_fun_seq _ _ _ _ contg. Lemma fun_Lim_seq_plus : forall H H', conv_fun_seq' a b Hab (fun n => f n{+}g n) (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{+}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H H'. -intros H H' e H0. -set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *. -cut (Continuous_I Hab F). intro H1. -2: unfold F in |- *; apply Cauchy_cont_Lim. -cut (conv_fun_seq' _ _ _ _ _ contf H1). -2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption. -intro Hf'. -set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *. -cut (Continuous_I Hab G). intro H2. -2: unfold G in |- *; apply Cauchy_cont_Lim. -cut (conv_fun_seq' _ _ _ _ _ contg H2). -2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption. -intro Hg'. -apply fun_Lim_seq_plus' with contf contg H1 H2; auto. +Proof. + intros H H' e H0. + set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *. + cut (Continuous_I Hab F). intro H1. + 2: unfold F in |- *; apply Cauchy_cont_Lim. + cut (conv_fun_seq' _ _ _ _ _ contf H1). + 2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption. + intro Hf'. + set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *. + cut (Continuous_I Hab G). intro H2. + 2: unfold G in |- *; apply Cauchy_cont_Lim. + cut (conv_fun_seq' _ _ _ _ _ contg H2). + 2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption. + intro Hg'. + apply fun_Lim_seq_plus' with contf contg H1 H2; auto. Qed. Lemma fun_Cauchy_prop_plus : forall H, Cauchy_fun_seq a b Hab (fun n => f n{+}g n) H. -intro. -cut - (Continuous_I Hab - (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{+}Cauchy_fun_seq_Lim _ _ _ _ _ Hg)); - [ intro H0 | Contin ]. -apply - conv_Cauchy_fun_seq' - with (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{+}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H0. -apply fun_Lim_seq_plus. +Proof. + intro. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{+}Cauchy_fun_seq_Lim _ _ _ _ _ Hg)); + [ intro H0 | Contin ]. + apply conv_Cauchy_fun_seq' + with (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{+}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H0. + apply fun_Lim_seq_plus. Qed. Lemma fun_Lim_seq_minus : forall H H', conv_fun_seq' a b Hab (fun n => f n{-}g n) (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{-}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H H'. -intros. -set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *. -cut (Continuous_I Hab F). intro H0. -2: unfold F in |- *; apply Cauchy_cont_Lim. -cut (conv_fun_seq' _ _ _ _ _ contf H0). -2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption. -intro Hf'. -set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *. -cut (Continuous_I Hab G). intro H1. -2: unfold G in |- *; apply Cauchy_cont_Lim. -cut (conv_fun_seq' _ _ _ _ _ contg H1). -2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption. -intro Hg'. -apply fun_Lim_seq_minus' with contf contg H0 H1; auto. +Proof. + intros. + set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *. + cut (Continuous_I Hab F). intro H0. + 2: unfold F in |- *; apply Cauchy_cont_Lim. + cut (conv_fun_seq' _ _ _ _ _ contf H0). + 2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption. + intro Hf'. + set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *. + cut (Continuous_I Hab G). intro H1. + 2: unfold G in |- *; apply Cauchy_cont_Lim. + cut (conv_fun_seq' _ _ _ _ _ contg H1). + 2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption. + intro Hg'. + apply fun_Lim_seq_minus' with contf contg H0 H1; auto. Qed. Lemma fun_Cauchy_prop_minus : forall H, Cauchy_fun_seq a b Hab (fun n => f n{-}g n) H. -intro. -cut - (Continuous_I Hab - (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{-}Cauchy_fun_seq_Lim _ _ _ _ _ Hg)); - [ intro H0 | Contin ]. -apply - conv_Cauchy_fun_seq' - with (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{-}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H0. -apply fun_Lim_seq_minus. +Proof. + intro. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{-}Cauchy_fun_seq_Lim _ _ _ _ _ Hg)); + [ intro H0 | Contin ]. + apply conv_Cauchy_fun_seq' + with (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{-}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H0. + apply fun_Lim_seq_minus. Qed. Lemma fun_Lim_seq_mult : forall H H', conv_fun_seq' a b Hab (fun n => f n{*}g n) (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{*}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H H'. -intros. -set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *. -cut (Continuous_I Hab F); [ intro H0 | unfold F in |- *; Contin ]. -cut (conv_fun_seq' _ _ _ _ _ contf H0). -2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption. -intro convF. -set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *. -cut (Continuous_I Hab G); [ intro H1 | unfold G in |- *; Contin ]. -cut (conv_fun_seq' _ _ _ _ _ contg H1). -2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption. -intro convG. -cut (Continuous_I Hab F); - [ intro HF' | unfold F, I in |- *; apply Cauchy_cont_Lim; assumption ]. -cut (Continuous_I Hab G); - [ intro HG' | unfold G, I in |- *; apply Cauchy_cont_Lim; assumption ]. -apply fun_Lim_seq_mult' with contf contg H0 H1; auto. +Proof. + intros. + set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *. + cut (Continuous_I Hab F); [ intro H0 | unfold F in |- *; Contin ]. + cut (conv_fun_seq' _ _ _ _ _ contf H0). + 2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption. + intro convF. + set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *. + cut (Continuous_I Hab G); [ intro H1 | unfold G in |- *; Contin ]. + cut (conv_fun_seq' _ _ _ _ _ contg H1). + 2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption. + intro convG. + cut (Continuous_I Hab F); [ intro HF' | unfold F, I in |- *; apply Cauchy_cont_Lim; assumption ]. + cut (Continuous_I Hab G); [ intro HG' | unfold G, I in |- *; apply Cauchy_cont_Lim; assumption ]. + apply fun_Lim_seq_mult' with contf contg H0 H1; auto. Qed. Lemma fun_Cauchy_prop_mult : forall H, Cauchy_fun_seq a b Hab (fun n => f n{*}g n) H. -intro H. -cut - (Continuous_I Hab - (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{*}Cauchy_fun_seq_Lim _ _ _ _ _ Hg)); - [ intro H0 | Contin ]. -apply - conv_Cauchy_fun_seq' - with (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{*}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H0. -apply fun_Lim_seq_mult. +Proof. + intro H. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{*}Cauchy_fun_seq_Lim _ _ _ _ _ Hg)); + [ intro H0 | Contin ]. + apply conv_Cauchy_fun_seq' + with (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{*}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H0. + apply fun_Lim_seq_mult. Qed. End More_Algebraic_Properties. @@ -1133,49 +1075,38 @@ As a corollary, we get the analogous property for the sequence of algebraic inve Lemma fun_Lim_seq_inv : forall H H', conv_fun_seq' a b Hab (fun n => {--} (f n)) {--} (Cauchy_fun_seq_Lim _ _ _ _ _ Hf) H H'. -intros. -cut (forall n : nat, Continuous_I Hab ( [-C-]Zero{-}f n)). intro H0. -unfold I in |- *; - eapply conv_fun_seq'_wdl with (fun n : nat => [-C-]Zero{-}f n) H0 H'. -intro H1; FEQ; try (apply contin_imp_inc; apply contf). -cut - (Continuous_I Hab - (Cauchy_fun_seq_Lim _ _ _ _ _ - (fun_Cauchy_prop_const a b Hab [-C-]Zero - (Continuous_I_const _ _ _ _)) {-} - Cauchy_fun_seq_Lim _ _ _ _ _ Hf)). -intros H1. -apply - conv_fun_seq'_wdr - with - H0 - (Cauchy_fun_seq_Lim _ _ _ _ _ - (fun_Cauchy_prop_const a b Hab [-C-]Zero - (Continuous_I_const _ _ _ _)) {-} - Cauchy_fun_seq_Lim _ _ _ _ _ Hf) - H1. -apply eq_imp_Feq. -Included. -Included. -intros; simpl in |- *. -astepr - (Zero[-]Lim (Build_CauchySeq _ _ (Cauchy_fun_real _ _ _ _ contf Hf x Hx'))). -apply cg_minus_wd. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply Lim_const. -apply Lim_wd'; intros; simpl in |- *; algebra. -apply Lim_wd'; intros; simpl in |- *; rational. -apply fun_Lim_seq_minus with (f := fun n : nat => [-C-]Zero:PartIR). -Contin. -Contin. +Proof. + intros. + cut (forall n : nat, Continuous_I Hab ( [-C-]Zero{-}f n)). intro H0. + unfold I in |- *; eapply conv_fun_seq'_wdl with (fun n : nat => [-C-]Zero{-}f n) H0 H'. + intro H1; FEQ; try (apply contin_imp_inc; apply contf). + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (fun_Cauchy_prop_const a b Hab [-C-]Zero + (Continuous_I_const _ _ _ _)) {-} Cauchy_fun_seq_Lim _ _ _ _ _ Hf)). + intros H1. + apply conv_fun_seq'_wdr with H0 (Cauchy_fun_seq_Lim _ _ _ _ _ + (fun_Cauchy_prop_const a b Hab [-C-]Zero (Continuous_I_const _ _ _ _)) {-} + Cauchy_fun_seq_Lim _ _ _ _ _ Hf) H1. + apply eq_imp_Feq. + Included. + Included. + intros; simpl in |- *. + astepr (Zero[-]Lim (Build_CauchySeq _ _ (Cauchy_fun_real _ _ _ _ contf Hf x Hx'))). + apply cg_minus_wd. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply Lim_const. + apply Lim_wd'; intros; simpl in |- *; algebra. + apply Lim_wd'; intros; simpl in |- *; rational. + apply fun_Lim_seq_minus with (f := fun n : nat => [-C-]Zero:PartIR). + Contin. + Contin. Qed. Lemma fun_Cauchy_prop_inv : forall H, Cauchy_fun_seq a b Hab (fun n => {--} (f n)) H. -intro. -cut (Continuous_I Hab {--} (Cauchy_fun_seq_Lim _ _ _ _ _ Hf)); - [ intro H0 | Contin ]. -apply conv_Cauchy_fun_seq' with ( {--} (Cauchy_fun_seq_Lim _ _ _ _ _ Hf)) H0. -apply fun_Lim_seq_inv. +Proof. + intro. + cut (Continuous_I Hab {--} (Cauchy_fun_seq_Lim _ _ _ _ _ Hf)); [ intro H0 | Contin ]. + apply conv_Cauchy_fun_seq' with ( {--} (Cauchy_fun_seq_Lim _ _ _ _ _ Hf)) H0. + apply fun_Lim_seq_inv. Qed. End Still_More_Algebraic_Properties. diff --git a/ftc/FunctSeries.v b/ftc/FunctSeries.v index 3d8e69a27..9c2a7148a 100644 --- a/ftc/FunctSeries.v +++ b/ftc/FunctSeries.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export FunctSequence. Require Export Series. @@ -76,8 +76,9 @@ Definition fun_seq_part_sum (n : nat) := FSum0 n f. Lemma fun_seq_part_sum_cont : (forall n, Continuous_I Hab (f n)) -> forall n, Continuous_I Hab (fun_seq_part_sum n). -intros; unfold fun_seq_part_sum in |- *. -Contin. +Proof. + intros; unfold fun_seq_part_sum in |- *. + Contin. Qed. Definition fun_series_convergent := {contf : _ | @@ -91,18 +92,18 @@ real number series. Lemma fun_series_conv_imp_conv : fun_series_convergent -> forall x, I x -> forall Hx, convergent (fun n => f n x (Hx n)). -intros H x H0 Hx e He. -elim H; intros incF convF. -elim (convF _ He). -intros N HN. -exists N; intros. -apply AbsIR_imp_AbsSmall. -simpl in HN. -eapply leEq_wdl. -apply (HN m N H1 (le_n N) x H0). -apply AbsIR_wd. -apply cg_minus_wd; unfold seq_part_sum in |- *; apply Sum0_wd; intros; - rational. +Proof. + intros H x H0 Hx e He. + elim H; intros incF convF. + elim (convF _ He). + intros N HN. + exists N; intros. + apply AbsIR_imp_AbsSmall. + simpl in HN. + eapply leEq_wdl. + apply (HN m N H1 (le_n N) x H0). + apply AbsIR_wd. + apply cg_minus_wd; unfold seq_part_sum in |- *; apply Sum0_wd; intros; rational. Qed. (** We then define the sum of the series as being the pointwise sum of @@ -119,26 +120,23 @@ Let incf (n : nat) := contin_imp_inc _ _ _ _ (contf n). (* end hide *) Lemma Fun_Series_Sum_strext : forall x y Hx Hy, - series_sum _ (fun_series_conv_imp_conv H x Hx (fun n => incf n x Hx)) [#] + series_sum _ (fun_series_conv_imp_conv H x Hx (fun n => incf n x Hx)) [#] series_sum _ (fun_series_conv_imp_conv H y Hy (fun n => incf n y Hy)) -> x [#] y. -intros x y Hx Hy H0. -unfold series_sum in H0. -elim (Lim_strext _ _ H0); intros m Hm. -simpl in Hm; unfold seq_part_sum in Hm. -elim (Sum0_strext _ _ _ _ Hm); intros i H1 H2. -exact (pfstrx _ _ _ _ _ _ H2). +Proof. + intros x y Hx Hy H0. + unfold series_sum in H0. + elim (Lim_strext _ _ H0); intros m Hm. + simpl in Hm; unfold seq_part_sum in Hm. + elim (Sum0_strext _ _ _ _ Hm); intros i H1 H2. + exact (pfstrx _ _ _ _ _ _ H2). Qed. Definition Fun_Series_Sum : PartIR. -apply - Build_PartFunct - with - (pfpfun := fun (x : IR) (Hx : I x) => - series_sum _ - (fun_series_conv_imp_conv H x Hx - (fun n : nat => incf n x Hx))). -unfold I in |- *; apply compact_wd. -exact Fun_Series_Sum_strext. +Proof. + apply Build_PartFunct with (pfpfun := fun (x : IR) (Hx : I x) => series_sum _ + (fun_series_conv_imp_conv H x Hx (fun n : nat => incf n x Hx))). + unfold I in |- *; apply compact_wd. + exact Fun_Series_Sum_strext. Defined. End Definitions. @@ -176,51 +174,56 @@ Let I := Compact Hab. Lemma fun_seq_part_sum_n : forall f (H' : forall n, Continuous_I Hab (f n)) m n, 0 < n -> m <= n -> Feq I (fun_seq_part_sum f n{-}fun_seq_part_sum f m) (FSum m (pred n) f). -intros. -unfold fun_seq_part_sum in |- *. -apply eq_imp_Feq. -unfold I in |- *; apply contin_imp_inc; Contin. -unfold I in |- *; apply contin_imp_inc; Contin. -intros; simpl in |- *. -unfold Sum, Sum1 in |- *. -rewrite (S_pred n 0); auto. -apply cg_minus_wd; apply Sum0_wd; intros; rational. +Proof. + intros. + unfold fun_seq_part_sum in |- *. + apply eq_imp_Feq. + unfold I in |- *; apply contin_imp_inc; Contin. + unfold I in |- *; apply contin_imp_inc; Contin. + intros; simpl in |- *. + unfold Sum, Sum1 in |- *. + rewrite (S_pred n 0); auto. + apply cg_minus_wd; apply Sum0_wd; intros; rational. Qed. Lemma conv_fun_const_series : forall x, convergent x -> fun_series_convergent _ _ Hab (fun n => [-C-] (x n)). -intros x H. -exists (fun n : nat => Continuous_I_const _ _ Hab (x n)). -apply Cauchy_fun_seq2_seq. -red in |- *; intros e He. -elim (H e He); intros N HN. -exists N; intros. -simpl in |- *. -apply AbsSmall_imp_AbsIR. -apply AbsSmall_wdr_unfolded with (seq_part_sum x m[-]seq_part_sum x N). -apply HN; assumption. -unfold seq_part_sum in |- *; simpl in |- *. -apply cg_minus_wd; apply Sum0_wd; algebra. +Proof. + intros x H. + exists (fun n : nat => Continuous_I_const _ _ Hab (x n)). + apply Cauchy_fun_seq2_seq. + red in |- *; intros e He. + elim (H e He); intros N HN. + exists N; intros. + simpl in |- *. + apply AbsSmall_imp_AbsIR. + apply AbsSmall_wdr_unfolded with (seq_part_sum x m[-]seq_part_sum x N). + apply HN; assumption. + unfold seq_part_sum in |- *; simpl in |- *. + apply cg_minus_wd; apply Sum0_wd; algebra. Qed. Lemma fun_const_series_sum : forall y H (H' : fun_series_convergent _ _ Hab (fun n => [-C-] (y n))) x Hx, Fun_Series_Sum H' x Hx [=] series_sum y H. -intros. -simpl in |- *. -apply series_sum_wd. -algebra. +Proof. + intros. + simpl in |- *. + apply series_sum_wd. + algebra. Qed. Lemma conv_zero_fun_series : fun_series_convergent _ _ Hab (fun n => [-C-]Zero). -apply conv_fun_const_series with (x := fun n : nat => ZeroR). -apply conv_zero_series. +Proof. + apply conv_fun_const_series with (x := fun n : nat => ZeroR). + apply conv_zero_series. Qed. Lemma Fun_Series_Sum_zero : forall (H : fun_series_convergent _ _ Hab (fun n => [-C-]Zero)) x Hx, Fun_Series_Sum H x Hx [=] Zero. -intros. -simpl in |- *. -apply series_sum_zero. +Proof. + intros. + simpl in |- *. + apply series_sum_zero. Qed. (* begin show *) @@ -229,23 +232,22 @@ Variables f g : nat -> PartIR. Lemma fun_series_convergent_wd : (forall n, Feq I (f n) (g n)) -> fun_series_convergent _ _ Hab f -> fun_series_convergent _ _ Hab g. -intros H H0. -elim H0; intros contF convF. -cut (forall n : nat, Continuous_I Hab (g n)). intro H1. -exists H1. -apply - Cauchy_fun_seq_wd - with (fun_seq_part_sum f) (fun_seq_part_sum_cont _ _ _ _ contF). -2: assumption. -intros. -apply eq_imp_Feq. -apply contin_imp_inc; Contin. -apply contin_imp_inc; Contin. -intros x H2 Hx Hx'; simpl in |- *. -apply Sum0_wd. -intro i; elim (H i); intros. -inversion_clear b0; auto. -intro; apply Continuous_I_wd with (f n); auto. +Proof. + intros H H0. + elim H0; intros contF convF. + cut (forall n : nat, Continuous_I Hab (g n)). intro H1. + exists H1. + apply Cauchy_fun_seq_wd with (fun_seq_part_sum f) (fun_seq_part_sum_cont _ _ _ _ contF). + 2: assumption. + intros. + apply eq_imp_Feq. + apply contin_imp_inc; Contin. + apply contin_imp_inc; Contin. + intros x H2 Hx Hx'; simpl in |- *. + apply Sum0_wd. + intro i; elim (H i); intros. + inversion_clear b0; auto. + intro; apply Continuous_I_wd with (f n); auto. Qed. (* begin show *) @@ -254,158 +256,126 @@ Hypothesis convG : fun_series_convergent _ _ Hab g. (* end show *) Lemma Fun_Series_Sum_wd' : (forall n, Feq I (f n) (g n)) -> Feq I (Fun_Series_Sum convF) (Fun_Series_Sum convG). -intro H. -apply eq_imp_Feq. -Included. -Included. -intros x H0 Hx Hx'; simpl in |- *. -apply series_sum_wd. -intro; elim (H n); intros. -inversion_clear b0; auto. +Proof. + intro H. + apply eq_imp_Feq. + Included. + Included. + intros x H0 Hx Hx'; simpl in |- *. + apply series_sum_wd. + intro; elim (H n); intros. + inversion_clear b0; auto. Qed. Lemma conv_fun_series_plus : fun_series_convergent _ _ Hab (fun n => f n{+}g n). -elim convF; intros contF convF'. -elim convG; intros contG convG'. -assert (H := fun n : nat => Continuous_I_plus _ _ _ _ _ (contF n) (contG n)); - exists H. -cut - (forall n : nat, - Continuous_I Hab (fun_seq_part_sum f n{+}fun_seq_part_sum g n)); - [ intro H0 | Contin ]. -apply - Cauchy_fun_seq_wd - with - (f := fun n : nat => fun_seq_part_sum f n{+}fun_seq_part_sum g n) - (contf := H0). -2: eapply fun_Cauchy_prop_plus; auto; [ apply convF' | apply convG' ]. -intros; apply eq_imp_Feq. -Included. -apply contin_imp_inc; Contin. -intros; simpl in |- *. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply Sum0_plus_Sum0. -apply Sum0_wd; intros; rational. +Proof. + elim convF; intros contF convF'. + elim convG; intros contG convG'. + assert (H := fun n : nat => Continuous_I_plus _ _ _ _ _ (contF n) (contG n)); exists H. + cut (forall n : nat, Continuous_I Hab (fun_seq_part_sum f n{+}fun_seq_part_sum g n)); + [ intro H0 | Contin ]. + apply Cauchy_fun_seq_wd with (f := fun n : nat => fun_seq_part_sum f n{+}fun_seq_part_sum g n) + (contf := H0). + 2: eapply fun_Cauchy_prop_plus; auto; [ apply convF' | apply convG' ]. + intros; apply eq_imp_Feq. + Included. + apply contin_imp_inc; Contin. + intros; simpl in |- *. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply Sum0_plus_Sum0. + apply Sum0_wd; intros; rational. Qed. Lemma Fun_Series_Sum_plus : forall H : fun_series_convergent _ _ Hab (fun n => f n{+}g n), Feq I (Fun_Series_Sum H) (Fun_Series_Sum convF{+}Fun_Series_Sum convG). -intros. -apply eq_imp_Feq. -Included. -Included. -intros x H0 Hx Hx'; simpl in |- *. -elim convF; intros contF convF'. -elim convG; intros contG convG'. -cut - (convergent - (fun n : nat => - Part _ _ (contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx')) [+] - Part _ _ (contin_imp_inc _ _ _ _ (contG n) x (ProjIR2 Hx')))). intro H1. -eapply eq_transitive_unfolded. -2: apply - series_sum_plus - with - (x := fun n : nat => - Part _ _ (contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx'))) - (y := fun n : nat => - Part _ _ (contin_imp_inc _ _ _ _ (contG n) x (ProjIR2 Hx'))) - (H := H1). -apply series_sum_wd; intro; rational. -intros e H1. -elim H; intros cont H'. -elim (H' _ H1); intros N HN. -exists N; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_wdl. -apply (HN m N H2 (le_n N) x H0). -apply AbsIR_wd; unfold fun_seq_part_sum in |- *. -simpl in |- *. -unfold seq_part_sum in |- *; apply cg_minus_wd; apply Sum0_wd; intros; - rational. +Proof. + intros. + apply eq_imp_Feq. + Included. + Included. + intros x H0 Hx Hx'; simpl in |- *. + elim convF; intros contF convF'. + elim convG; intros contG convG'. + cut (convergent (fun n : nat => Part _ _ (contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx')) [+] + Part _ _ (contin_imp_inc _ _ _ _ (contG n) x (ProjIR2 Hx')))). intro H1. + eapply eq_transitive_unfolded. + 2: apply series_sum_plus with (x := fun n : nat => + Part _ _ (contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx'))) (y := fun n : nat => + Part _ _ (contin_imp_inc _ _ _ _ (contG n) x (ProjIR2 Hx'))) (H := H1). + apply series_sum_wd; intro; rational. + intros e H1. + elim H; intros cont H'. + elim (H' _ H1); intros N HN. + exists N; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_wdl. + apply (HN m N H2 (le_n N) x H0). + apply AbsIR_wd; unfold fun_seq_part_sum in |- *. + simpl in |- *. + unfold seq_part_sum in |- *; apply cg_minus_wd; apply Sum0_wd; intros; rational. Qed. Lemma conv_fun_series_minus : fun_series_convergent _ _ Hab (fun n => f n{-}g n). -elim convF; intros contF convF'. -elim convG; intros contG convG'. -assert (H := fun n : nat => Continuous_I_minus _ _ _ _ _ (contF n) (contG n)); - exists H. -cut - (forall n : nat, - Continuous_I Hab (fun_seq_part_sum f n{-}fun_seq_part_sum g n)); - [ intro H0 | Contin ]. -apply - Cauchy_fun_seq_wd - with - (f := fun n : nat => fun_seq_part_sum f n{-}fun_seq_part_sum g n) - (contf := H0). -2: eapply fun_Cauchy_prop_minus; auto; [ apply convF' | apply convG' ]. -intros; apply eq_imp_Feq. -Included. -apply contin_imp_inc; Contin. -intros; simpl in |- *. -apply eq_symmetric_unfolded. -apply - eq_transitive_unfolded - with - (Sum0 n (fun i : nat => f i x (ProjIR1 Hx i)) [+] - Sum0 n (fun i : nat => [--] (g i x (ProjIR2 Hx i)))). -eapply eq_transitive_unfolded. -2: apply Sum0_plus_Sum0. -apply Sum0_wd; intros; rational. -unfold cg_minus in |- *. -apply bin_op_wd_unfolded. -algebra. -eapply eq_transitive_unfolded. -2: apply inv_Sum0. -apply Sum0_wd; algebra. +Proof. + elim convF; intros contF convF'. + elim convG; intros contG convG'. + assert (H := fun n : nat => Continuous_I_minus _ _ _ _ _ (contF n) (contG n)); exists H. + cut (forall n : nat, Continuous_I Hab (fun_seq_part_sum f n{-}fun_seq_part_sum g n)); + [ intro H0 | Contin ]. + apply Cauchy_fun_seq_wd with (f := fun n : nat => fun_seq_part_sum f n{-}fun_seq_part_sum g n) + (contf := H0). + 2: eapply fun_Cauchy_prop_minus; auto; [ apply convF' | apply convG' ]. + intros; apply eq_imp_Feq. + Included. + apply contin_imp_inc; Contin. + intros; simpl in |- *. + apply eq_symmetric_unfolded. + apply eq_transitive_unfolded with (Sum0 n (fun i : nat => f i x (ProjIR1 Hx i)) [+] + Sum0 n (fun i : nat => [--] (g i x (ProjIR2 Hx i)))). + eapply eq_transitive_unfolded. + 2: apply Sum0_plus_Sum0. + apply Sum0_wd; intros; rational. + unfold cg_minus in |- *. + apply bin_op_wd_unfolded. + algebra. + eapply eq_transitive_unfolded. + 2: apply inv_Sum0. + apply Sum0_wd; algebra. Qed. Lemma Fun_Series_Sum_min : forall H : fun_series_convergent _ _ Hab (fun n => f n{-}g n), Feq I (Fun_Series_Sum H) (Fun_Series_Sum convF{-}Fun_Series_Sum convG). -intros. -apply eq_imp_Feq. -Included. -Included. -intros x H0 Hx Hx'; simpl in |- *. -elim convF; intros contF convF'. -elim convG; intros contG convG'. -cut - (convergent - (fun n : nat => - Part _ _ (contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx')) [-] - Part _ _ (contin_imp_inc _ _ _ _ (contG n) x (ProjIR2 Hx')))). intro H1. -apply - eq_transitive_unfolded - with - (series_sum _ - (fun_series_conv_imp_conv _ _ _ _ convF x (ProjIR1 Hx') - (fun n : nat => contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx'))) [-] - series_sum _ - (fun_series_conv_imp_conv _ _ _ _ convG x (ProjIR2 Hx') +Proof. + intros. + apply eq_imp_Feq. + Included. + Included. + intros x H0 Hx Hx'; simpl in |- *. + elim convF; intros contF convF'. + elim convG; intros contG convG'. + cut (convergent (fun n : nat => Part _ _ (contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx')) [-] + Part _ _ (contin_imp_inc _ _ _ _ (contG n) x (ProjIR2 Hx')))). intro H1. + apply eq_transitive_unfolded with (series_sum _ + (fun_series_conv_imp_conv _ _ _ _ convF x (ProjIR1 Hx') + (fun n : nat => contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx'))) [-] series_sum _ + (fun_series_conv_imp_conv _ _ _ _ convG x (ProjIR2 Hx') (fun n : nat => contin_imp_inc _ _ _ _ (contG n) x (ProjIR2 Hx')))). -eapply eq_transitive_unfolded. -2: apply - series_sum_minus - with - (x := fun n : nat => - Part _ _ (contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx'))) - (y := fun n : nat => - Part _ _ (contin_imp_inc _ _ _ _ (contG n) x (ProjIR2 Hx'))) - (H := H1). -apply series_sum_wd; intro; rational. -apply cg_minus_wd; apply series_sum_wd; intro; rational. -intros e H1. -elim H; intros cont H'. -elim (H' _ H1); intros N HN. -exists N; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_wdl. -apply (HN m N H2 (le_n N) x H0). -apply AbsIR_wd; unfold fun_seq_part_sum in |- *. -simpl in |- *. -unfold seq_part_sum in |- *; apply cg_minus_wd; apply Sum0_wd; intros; - rational. + eapply eq_transitive_unfolded. + 2: apply series_sum_minus with (x := fun n : nat => + Part _ _ (contin_imp_inc _ _ _ _ (contF n) x (ProjIR1 Hx'))) (y := fun n : nat => + Part _ _ (contin_imp_inc _ _ _ _ (contG n) x (ProjIR2 Hx'))) (H := H1). + apply series_sum_wd; intro; rational. + apply cg_minus_wd; apply series_sum_wd; intro; rational. + intros e H1. + elim H; intros cont H'. + elim (H' _ H1); intros N HN. + exists N; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_wdl. + apply (HN m N H2 (le_n N) x H0). + apply AbsIR_wd; unfold fun_seq_part_sum in |- *. + simpl in |- *. + unfold seq_part_sum in |- *; apply cg_minus_wd; apply Sum0_wd; intros; rational. Qed. (** @@ -418,76 +388,53 @@ Variable H : PartIR. Hypothesis contH : Continuous_I Hab H. Lemma conv_fun_series_scal : fun_series_convergent _ _ Hab (fun n => H{*}f n). -elim convF; intros contF convF'. -set (H' := fun n : nat => Continuous_I_mult _ _ _ _ _ contH (contF n)) in *; - exists H'. -cut (forall n : nat, Continuous_I Hab (fun_seq_part_sum f n)); - [ intro H0 | Contin ]. -cut (forall n : nat, Continuous_I Hab (H{*}fun_seq_part_sum f n)); - [ intro H1 | Contin ]. -unfold I in |- *; - apply Cauchy_fun_seq_wd with (fun n : nat => H{*}fun_seq_part_sum f n) H1. -2: apply - fun_Cauchy_prop_mult - with - (f := fun n : nat => H) - (contf := fun n : nat => contH) - (g := fun_seq_part_sum f) - (contg := H0). -intro; FEQ. -apply contin_imp_inc; Contin. -simpl in |- *. -unfold seq_part_sum in |- *. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -2: apply Sum0_comm_scal' with (s := fun m : nat => f m x (ProjIR2 Hx m)). -apply Sum0_wd; intros; rational. -apply fun_Cauchy_prop_const. -apply - Cauchy_fun_seq_wd - with - (f := fun_seq_part_sum f) - (contf := fun_seq_part_sum_cont _ _ _ _ contF). -2: assumption. -intro; apply Feq_reflexive; Included. +Proof. + elim convF; intros contF convF'. + set (H' := fun n : nat => Continuous_I_mult _ _ _ _ _ contH (contF n)) in *; exists H'. + cut (forall n : nat, Continuous_I Hab (fun_seq_part_sum f n)); [ intro H0 | Contin ]. + cut (forall n : nat, Continuous_I Hab (H{*}fun_seq_part_sum f n)); [ intro H1 | Contin ]. + unfold I in |- *; apply Cauchy_fun_seq_wd with (fun n : nat => H{*}fun_seq_part_sum f n) H1. + 2: apply fun_Cauchy_prop_mult with (f := fun n : nat => H) (contf := fun n : nat => contH) + (g := fun_seq_part_sum f) (contg := H0). + intro; FEQ. + apply contin_imp_inc; Contin. + simpl in |- *. + unfold seq_part_sum in |- *. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + 2: apply Sum0_comm_scal' with (s := fun m : nat => f m x (ProjIR2 Hx m)). + apply Sum0_wd; intros; rational. + apply fun_Cauchy_prop_const. + apply Cauchy_fun_seq_wd with (f := fun_seq_part_sum f) + (contf := fun_seq_part_sum_cont _ _ _ _ contF). + 2: assumption. + intro; apply Feq_reflexive; Included. Qed. Lemma Fun_Series_Sum_scal : forall H' : fun_series_convergent _ _ Hab (fun n => H{*}f n), Feq I (Fun_Series_Sum H') (H{*}Fun_Series_Sum convF). -elim convF; intros contF convF'. -intros. -unfold I in |- *; FEQ. try rename X into H0. -cut - (convergent - (fun n : nat => - Part H x (ProjIR1 Hx') [*] - f n x (contin_imp_inc _ _ _ _ (contF n) _ (ProjIR2 Hx')))). intro H1. -apply - eq_transitive_unfolded - with - (series_sum - (fun n : nat => - Part H x (ProjIR1 Hx') [*] - f n x (contin_imp_inc _ _ _ _ (contF n) _ (ProjIR2 Hx'))) H1). -2: simpl in |- *; - apply - series_sum_mult_scal - with - (x := fun n : nat => - f n x (contin_imp_inc _ _ _ _ (contF n) _ (ProjIR2 Hx'))). -simpl in |- *; unfold series_sum in |- *. -apply Lim_wd'; intros; simpl in |- *. -unfold seq_part_sum in |- *; apply Sum0_wd; intros; rational. -intros e H1. -elim H'; intros H'' H'''. -elim (H''' _ H1); intros N HN. -exists N; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_wdl. -apply (HN m N H2 (le_n N) x Hx). -apply AbsIR_wd; simpl in |- *. -unfold seq_part_sum in |- *; apply cg_minus_wd; apply Sum0_wd; intros; - rational. +Proof. + elim convF; intros contF convF'. + intros. + unfold I in |- *; FEQ. try rename X into H0. + cut (convergent (fun n : nat => Part H x (ProjIR1 Hx') [*] + f n x (contin_imp_inc _ _ _ _ (contF n) _ (ProjIR2 Hx')))). intro H1. + apply eq_transitive_unfolded with (series_sum (fun n : nat => Part H x (ProjIR1 Hx') [*] + f n x (contin_imp_inc _ _ _ _ (contF n) _ (ProjIR2 Hx'))) H1). + 2: simpl in |- *; apply series_sum_mult_scal with (x := fun n : nat => + f n x (contin_imp_inc _ _ _ _ (contF n) _ (ProjIR2 Hx'))). + simpl in |- *; unfold series_sum in |- *. + apply Lim_wd'; intros; simpl in |- *. + unfold seq_part_sum in |- *; apply Sum0_wd; intros; rational. + intros e H1. + elim H'; intros H'' H'''. + elim (H''' _ H1); intros N HN. + exists N; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_wdl. + apply (HN m N H2 (le_n N) x Hx). + apply AbsIR_wd; simpl in |- *. + unfold seq_part_sum in |- *; apply cg_minus_wd; apply Sum0_wd; intros; rational. Qed. End Operations. @@ -504,51 +451,39 @@ Variable f : nat -> PartIR. Hypothesis convF : fun_series_convergent _ _ Hab f. Lemma conv_fun_series_inv : fun_series_convergent _ _ Hab (fun n => {--} (f n)). -elim convF; intros contF convF'. -exists (fun n : nat => Continuous_I_inv _ _ _ _ (contF n)). -cut (forall n : nat, Continuous_I Hab {--} (fun_seq_part_sum f n)). intro H. -apply - Cauchy_fun_seq_wd - with (f := fun n : nat => {--} (fun_seq_part_sum f n)) (contf := H). -2: apply fun_Cauchy_prop_inv with (fun_seq_part_sum_cont _ _ _ _ contF). -intro; FEQ. -apply contin_imp_inc; Contin. -simpl in |- *; unfold seq_part_sum in |- *. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply inv_Sum0. -apply Sum0_wd; intro; rational. -assumption. -Contin. +Proof. + elim convF; intros contF convF'. + exists (fun n : nat => Continuous_I_inv _ _ _ _ (contF n)). + cut (forall n : nat, Continuous_I Hab {--} (fun_seq_part_sum f n)). intro H. + apply Cauchy_fun_seq_wd with (f := fun n : nat => {--} (fun_seq_part_sum f n)) (contf := H). + 2: apply fun_Cauchy_prop_inv with (fun_seq_part_sum_cont _ _ _ _ contF). + intro; FEQ. + apply contin_imp_inc; Contin. + simpl in |- *; unfold seq_part_sum in |- *. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply inv_Sum0. + apply Sum0_wd; intro; rational. + assumption. + Contin. Qed. Lemma Fun_Series_Sum_inv : forall H : fun_series_convergent _ _ Hab (fun n => {--} (f n)), Feq I (Fun_Series_Sum H) {--} (Fun_Series_Sum convF). -intros. -FEQ. try rename X into H0. -cut - (convergent - (fun n : nat => - [--] (f n x (contin_imp_inc _ _ _ _ (ProjT1 convF n) x Hx')))). intro H1. -simpl in |- *; apply eq_transitive_unfolded with (series_sum _ H1). -2: apply - series_sum_inv - with - (x := fun n : nat => - f n x (contin_imp_inc _ _ _ _ (ProjT1 convF n) x Hx')). -unfold series_sum in |- *; apply Lim_wd'; intros; simpl in |- *. -unfold seq_part_sum in |- *; apply Sum0_wd; intros. -rational. -apply - conv_series_inv - with - (x := fun n : nat => - f n x (contin_imp_inc _ _ _ _ (ProjT1 convF n) x Hx')). -apply - fun_series_conv_imp_conv - with - (Hab := Hab) - (Hx := fun n : nat => contin_imp_inc _ _ _ _ (ProjT1 convF n) x Hx'); - assumption. +Proof. + intros. + FEQ. try rename X into H0. + cut (convergent (fun n : nat => + [--] (f n x (contin_imp_inc _ _ _ _ (ProjT1 convF n) x Hx')))). intro H1. + simpl in |- *; apply eq_transitive_unfolded with (series_sum _ H1). + 2: apply series_sum_inv with (x := fun n : nat => + f n x (contin_imp_inc _ _ _ _ (ProjT1 convF n) x Hx')). + unfold series_sum in |- *; apply Lim_wd'; intros; simpl in |- *. + unfold seq_part_sum in |- *; apply Sum0_wd; intros. + rational. + apply conv_series_inv with (x := fun n : nat => + f n x (contin_imp_inc _ _ _ _ (ProjT1 convF n) x Hx')). + apply fun_series_conv_imp_conv with (Hab := Hab) + (Hx := fun n : nat => contin_imp_inc _ _ _ _ (ProjT1 convF n) x Hx'); assumption. Qed. End More_Operations. @@ -570,57 +505,54 @@ series. Lemma Fun_Series_Sum_char' : forall contf H, Feq (Compact Hab) (Fun_Series_Sum convF) (Cauchy_fun_seq_Lim _ _ Hab (fun_seq_part_sum f) contf H). -intros. -FEQ. -simpl in |- *; unfold series_sum in |- *. -apply Lim_wd'; simpl in |- *; intros. -unfold seq_part_sum in |- *; apply Sum0_wd; intros; algebra. +Proof. + intros. + FEQ. + simpl in |- *; unfold series_sum in |- *. + apply Lim_wd'; simpl in |- *; intros. + unfold seq_part_sum in |- *; apply Sum0_wd; intros; algebra. Qed. Lemma fun_series_conv : forall H H', conv_fun_seq' a b Hab (fun_seq_part_sum f) (Fun_Series_Sum convF) H H'. -intros. -inversion_clear convF. try rename X into H0. -apply - conv_fun_seq'_wdr - with - (contf := fun_seq_part_sum_cont _ _ _ _ x) - (contF := Cauchy_cont_Lim _ _ _ _ _ H0). -2: apply Cauchy_conv_fun_seq'. -apply Feq_symmetric; apply Fun_Series_Sum_char'. +Proof. + intros. + inversion_clear convF. try rename X into H0. + apply conv_fun_seq'_wdr with (contf := fun_seq_part_sum_cont _ _ _ _ x) + (contF := Cauchy_cont_Lim _ _ _ _ _ H0). + 2: apply Cauchy_conv_fun_seq'. + apply Feq_symmetric; apply Fun_Series_Sum_char'. Qed. Lemma Fun_Series_Sum_cont : Continuous_I Hab (Fun_Series_Sum convF). -intros. -inversion_clear convF. try rename X into H. -eapply Continuous_I_wd. -apply Feq_symmetric; - apply - (Fun_Series_Sum_char' (fun n : nat => fun_seq_part_sum_cont _ _ _ _ x n) H). -Contin. +Proof. + intros. + inversion_clear convF. try rename X into H. + eapply Continuous_I_wd. + apply Feq_symmetric; apply + (Fun_Series_Sum_char' (fun n : nat => fun_seq_part_sum_cont _ _ _ _ x n) H). + Contin. Qed. Lemma Fun_Series_Sum_char : Feq (Compact Hab) (Cauchy_fun_seq_Lim _ _ Hab (fun_seq_part_sum f) _ (ProjT2 convF)) (Fun_Series_Sum convF). -intros. -FEQ. -simpl in |- *. -unfold series_sum in |- *; apply Lim_wd'. -intro; simpl in |- *. -unfold seq_part_sum in |- *; apply Sum0_wd; intros; algebra. +Proof. + intros. + FEQ. + simpl in |- *. + unfold series_sum in |- *; apply Lim_wd'. + intro; simpl in |- *. + unfold seq_part_sum in |- *; apply Sum0_wd; intros; algebra. Qed. Lemma Fun_Series_Sum_as_Lim : forall Hf H', conv_fun_seq' _ _ Hab (fun_seq_part_sum f) (Fun_Series_Sum convF) Hf H'. -intros. -apply - conv_fun_seq'_wdr - with - (fun_seq_part_sum_cont _ _ _ _ (ProjT1 convF)) - (Cauchy_fun_seq_Lim _ _ _ _ _ (ProjT2 convF)) - (Cauchy_cont_Lim _ _ _ _ _ (ProjT2 convF)). -apply Fun_Series_Sum_char. -apply Cauchy_conv_fun_seq'. +Proof. + intros. + apply conv_fun_seq'_wdr with (fun_seq_part_sum_cont _ _ _ _ (ProjT1 convF)) + (Cauchy_fun_seq_Lim _ _ _ _ _ (ProjT2 convF)) (Cauchy_cont_Lim _ _ _ _ _ (ProjT2 convF)). + apply Fun_Series_Sum_char. + apply Cauchy_conv_fun_seq'. Qed. End Other_Results. @@ -647,137 +579,112 @@ Hypothesis contF : forall n : nat, Continuous_I Hab (f n). Lemma fun_str_comparison : forall g, fun_series_convergent _ _ Hab g -> {k : nat | forall n, k <= n -> forall x, I x -> forall Hx Hx', AbsIR (f n x Hx) [<=] g n x Hx'} -> fun_series_convergent _ _ Hab f. -set (H0 := contF) in *. -intros g H H1. -elim H1; intros k Hk. -exists H0. -apply Cauchy_fun_seq2_seq. -intros e H2. -elim H; intros contG convG. -cut - {N : nat | - k < N /\ - (forall m : nat, - N <= m -> - forall x : IR, - I x -> - forall Hx Hx', - AbsSmall e - (Part (fun_seq_part_sum g m) x Hx[-]Part (fun_seq_part_sum g N) x Hx'))}. intro H3. -elim H3; clear H3. -intros N HN; elim HN; clear HN; intros HN' HN. -exists N; intros. -assert - (H' := - fun n : nat => - contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ contG n)). -apply - leEq_transitive - with - (Part (fun_seq_part_sum g m) x (H' m x Hx) [-] - Part (fun_seq_part_sum g N) x (H' N x Hx)). -cut (forall n : nat, included (Compact Hab) (Dom (FAbs (f n)))). intro H4. -cut (Dom (FSum N (pred m) (fun n : nat => FRestr (H4 n))) x). intro H5. -apply - leEq_transitive - with (Part (FSum N (pred m) (fun n : nat => FRestr (H4 n))) x H5). -cut - (Dom - (FSum N (pred m) (fun n : nat => FRestr (contin_imp_inc _ _ _ _ (H0 n)))) - x). intro H6. -apply - leEq_wdl - with - (AbsIR - (Part - (FSum N (pred m) - (fun n : nat => FRestr (contin_imp_inc _ _ _ _ (H0 n)))) x H6)). -Opaque Frestr. -simpl in |- *. -Transparent Frestr. -eapply leEq_wdr. -apply triangle_SumIR. -rewrite <- (S_pred m k); auto; apply lt_le_trans with N; auto. -apply Sum_wd; intros. -Opaque FAbs. -simpl in |- *. -Transparent FAbs. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -apply FAbs_char with (Hx' := contin_imp_inc _ _ _ _ (contF i) x Hx). -apply AbsIR_wd; rational. -apply AbsIR_wd; apply eq_symmetric_unfolded. -cut (Dom (fun_seq_part_sum f m{-}fun_seq_part_sum f N) x). intro H7. -Opaque fun_seq_part_sum. -apply eq_transitive_unfolded with (Part _ _ H7). -simpl in |- *; rational. -unfold Frestr in |- *. -apply Feq_imp_eq with I. -apply Feq_transitive with (FSum N (pred m) f). -unfold I in |- *; apply fun_seq_part_sum_n; auto with arith. -apply le_lt_trans with k; [ idtac | apply lt_le_trans with N ]; - auto with arith. -FEQ. -unfold I in |- *; apply contin_imp_inc; Contin. -simpl in |- *. -red in |- *; intros; auto. -simpl in |- *. -apply Sum_wd; intros; rational. -auto. -split; simpl in |- *. -apply (contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ H0 m)); auto. -apply (contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ H0 N)); auto. -simpl in |- *; auto. -cut (Dom (FSum N (pred m) g) x). intro H6. -apply leEq_wdr with (Part _ _ H6). -apply FSum_resp_leEq. -rewrite <- (S_pred m k); auto; apply lt_le_trans with N; auto. -intros. -Opaque FAbs. -simpl in |- *. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; - apply FAbs_char with (Hx' := contin_imp_inc _ _ _ _ (contF i) x0 (HxF i)). -apply Hk. -apply le_trans with N; auto with arith. -simpl in HxF. -apply (HxF 0). -cut (Dom (fun_seq_part_sum g m{-}fun_seq_part_sum g N) x). intro H7. -apply eq_symmetric_unfolded. -apply eq_transitive_unfolded with (Part _ _ H7). -simpl in |- *; rational. -apply Feq_imp_eq with I. -unfold I in |- *; apply fun_seq_part_sum_n; auto with arith. -apply le_lt_trans with k; [ idtac | apply lt_le_trans with N ]; - auto with arith. -auto. -split; simpl in |- *. -apply (contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ contG m)); auto. -apply (contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ contG N)); auto. -simpl in |- *; intro; apply (contin_imp_inc _ _ _ _ (contG n)); auto. -Transparent FAbs. -simpl in |- *; auto. -Opaque FAbs. -unfold I in |- *; simpl in |- *; Included. -eapply leEq_transitive. -apply leEq_AbsIR. -apply AbsSmall_imp_AbsIR. -apply HN; assumption. -elim (convG _ H2). -intros N HN; exists (S (max N k)). -cut (N <= max N k); [ intro | apply le_max_l ]. -cut (k <= max N k); [ intro | apply le_max_r ]. -split. -auto with arith. -intros m H5 x H6 Hx Hx'. -apply AbsIR_imp_AbsSmall. -cut (N <= m); [ intro | apply le_trans with (max N k); auto with arith ]. -eapply leEq_wdl. -Transparent fun_seq_part_sum. -simpl in Hx'. -apply (HN m _ H7 (le_S _ _ H3) x H6). -Opaque fun_seq_part_sum. -apply AbsIR_wd; rational. +Proof. + set (H0 := contF) in *. + intros g H H1. + elim H1; intros k Hk. + exists H0. + apply Cauchy_fun_seq2_seq. + intros e H2. + elim H; intros contG convG. + cut {N : nat | k < N /\ (forall m : nat, N <= m -> forall x : IR, I x -> forall Hx Hx', AbsSmall e + (Part (fun_seq_part_sum g m) x Hx[-]Part (fun_seq_part_sum g N) x Hx'))}. intro H3. + elim H3; clear H3. + intros N HN; elim HN; clear HN; intros HN' HN. + exists N; intros. + assert (H' := fun n : nat => contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ contG n)). + apply leEq_transitive with (Part (fun_seq_part_sum g m) x (H' m x Hx) [-] + Part (fun_seq_part_sum g N) x (H' N x Hx)). + cut (forall n : nat, included (Compact Hab) (Dom (FAbs (f n)))). intro H4. + cut (Dom (FSum N (pred m) (fun n : nat => FRestr (H4 n))) x). intro H5. + apply leEq_transitive with (Part (FSum N (pred m) (fun n : nat => FRestr (H4 n))) x H5). + cut (Dom (FSum N (pred m) (fun n : nat => FRestr (contin_imp_inc _ _ _ _ (H0 n)))) x). intro H6. + apply leEq_wdl with (AbsIR (Part (FSum N (pred m) + (fun n : nat => FRestr (contin_imp_inc _ _ _ _ (H0 n)))) x H6)). + Opaque Frestr. + simpl in |- *. + Transparent Frestr. + eapply leEq_wdr. + apply triangle_SumIR. + rewrite <- (S_pred m k); auto; apply lt_le_trans with N; auto. + apply Sum_wd; intros. + Opaque FAbs. + simpl in |- *. + Transparent FAbs. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply FAbs_char with (Hx' := contin_imp_inc _ _ _ _ (contF i) x Hx). + apply AbsIR_wd; rational. + apply AbsIR_wd; apply eq_symmetric_unfolded. + cut (Dom (fun_seq_part_sum f m{-}fun_seq_part_sum f N) x). intro H7. + Opaque fun_seq_part_sum. + apply eq_transitive_unfolded with (Part _ _ H7). + simpl in |- *; rational. + unfold Frestr in |- *. + apply Feq_imp_eq with I. + apply Feq_transitive with (FSum N (pred m) f). + unfold I in |- *; apply fun_seq_part_sum_n; auto with arith. + apply le_lt_trans with k; [ idtac | apply lt_le_trans with N ]; auto with arith. + FEQ. + unfold I in |- *; apply contin_imp_inc; Contin. + simpl in |- *. + red in |- *; intros; auto. + simpl in |- *. + apply Sum_wd; intros; rational. + auto. + split; simpl in |- *. + apply (contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ H0 m)); auto. + apply (contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ H0 N)); auto. + simpl in |- *; auto. + cut (Dom (FSum N (pred m) g) x). intro H6. + apply leEq_wdr with (Part _ _ H6). + apply FSum_resp_leEq. + rewrite <- (S_pred m k); auto; apply lt_le_trans with N; auto. + intros. + Opaque FAbs. + simpl in |- *. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; + apply FAbs_char with (Hx' := contin_imp_inc _ _ _ _ (contF i) x0 (HxF i)). + apply Hk. + apply le_trans with N; auto with arith. + simpl in HxF. + apply (HxF 0). + cut (Dom (fun_seq_part_sum g m{-}fun_seq_part_sum g N) x). intro H7. + apply eq_symmetric_unfolded. + apply eq_transitive_unfolded with (Part _ _ H7). + simpl in |- *; rational. + apply Feq_imp_eq with I. + unfold I in |- *; apply fun_seq_part_sum_n; auto with arith. + apply le_lt_trans with k; [ idtac | apply lt_le_trans with N ]; auto with arith. + auto. + split; simpl in |- *. + apply (contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ contG m)); auto. + apply (contin_imp_inc _ _ _ _ (fun_seq_part_sum_cont _ _ _ _ contG N)); auto. + simpl in |- *; intro; apply (contin_imp_inc _ _ _ _ (contG n)); auto. + Transparent FAbs. + simpl in |- *; auto. + Opaque FAbs. + unfold I in |- *; simpl in |- *; Included. + eapply leEq_transitive. + apply leEq_AbsIR. + apply AbsSmall_imp_AbsIR. + apply HN; assumption. + elim (convG _ H2). + intros N HN; exists (S (max N k)). + cut (N <= max N k); [ intro | apply le_max_l ]. + cut (k <= max N k); [ intro | apply le_max_r ]. + split. + auto with arith. + intros m H5 x H6 Hx Hx'. + apply AbsIR_imp_AbsSmall. + cut (N <= m); [ intro | apply le_trans with (max N k); auto with arith ]. + eapply leEq_wdl. + Transparent fun_seq_part_sum. + simpl in Hx'. + apply (HN m _ H7 (le_S _ _ H3) x H6). + Opaque fun_seq_part_sum. + apply AbsIR_wd; rational. Qed. Transparent FAbs. @@ -785,88 +692,81 @@ Transparent FAbs. Lemma fun_comparison : forall g, fun_series_convergent _ _ Hab g -> (forall n x, I x -> forall Hx Hx', AbsIR (f n x Hx) [<=] g n x Hx') -> fun_series_convergent _ _ Hab f. -intros g H H0. -apply fun_str_comparison with g; auto. -exists 0; intros; apply H0; auto. +Proof. + intros g H H0. + apply fun_str_comparison with g; auto. + exists 0; intros; apply H0; auto. Qed. Lemma abs_imp_conv : fun_series_abs_convergent _ _ Hab f -> fun_series_convergent _ _ Hab f. -intro H. -apply fun_comparison with (fun n : nat => FAbs (f n)). -apply H. -intros; apply eq_imp_leEq; apply eq_symmetric_unfolded; apply FAbs_char. +Proof. + intro H. + apply fun_comparison with (fun n : nat => FAbs (f n)). + apply H. + intros; apply eq_imp_leEq; apply eq_symmetric_unfolded; apply FAbs_char. Qed. Lemma fun_ratio_test_conv : {N : nat | {c : IR | c [<] One | Zero [<=] c /\ (forall x, I x -> forall n, N <= n -> forall Hx Hx', AbsIR (f (S n) x Hx') [<=] c[*]AbsIR (f n x Hx))}} -> fun_series_convergent _ _ Hab f. -intro H. -elim H; clear H; intros N H. -elim H; clear H; intros c Hc1 H. -elim H; clear H; intros H0c H. -cut - (forall x : IR, - I x -> - forall n : nat, - N <= n -> - forall Hx Hx', AbsIR (f n x Hx') [<=] AbsIR (f N x Hx) [*]c[^] (n - N)). -intro H0. -apply - fun_str_comparison with (fun n : nat => FAbs (f N) {*} [-C-] (c[^] (n - N))). -2: exists N; intros. -2: eapply leEq_wdr. -2: apply H0 with (Hx' := Hx) (Hx := ProjIR1 (ProjIR1 Hx')); auto with arith. -Opaque FAbs. -2: simpl in |- *; apply mult_wd; - [ apply eq_symmetric_unfolded; apply FAbs_char | algebra ]. -apply conv_fun_series_scal with (f := fun n : nat => [-C-] (c[^] (n - N))). -apply conv_fun_const_series with (x := fun n : nat => c[^] (n - N)). -apply join_series with (power_series c). -apply power_series_conv. -apply AbsIR_less. -assumption. -apply less_leEq_trans with Zero. -rstepr ([--]Zero:IR). -apply inv_resp_less. -apply pos_one. -assumption. -exists N. -exists 0. -intro. -rewrite plus_comm; rewrite Minus.minus_plus. -algebra. -Contin. -intros x H0 n; induction n as [| n Hrecn]. -intro. -cut (N = 0); [ intro | auto with arith ]. -rewrite H2. -intros. -apply eq_imp_leEq. -simpl in |- *. -astepl (AbsIR (Part _ _ Hx') [*]One); apply mult_wdl; apply AbsIR_wd; - algebra. -intro. -elim (le_lt_eq_dec _ _ H1); intro. -intros; - apply - leEq_transitive - with (c[*]AbsIR (f n x (contin_imp_inc _ _ _ _ (contF n) x H0))). -apply H; auto with arith. -apply leEq_wdr with (AbsIR (f N x Hx) [*]c[^] (n - N) [*]c). -rstepr (c[*] (AbsIR (Part _ _ Hx) [*]c[^] (n - N))). -apply mult_resp_leEq_lft. -apply Hrecn; auto with arith. -assumption. -rewrite <- minus_Sn_m. -simpl in |- *; rational. -auto with arith. -rewrite b0; intros. -rewrite <- minus_n_n. -apply eq_imp_leEq. -simpl in |- *; eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply mult_one. -apply AbsIR_wd; algebra. +Proof. + intro H. + elim H; clear H; intros N H. + elim H; clear H; intros c Hc1 H. + elim H; clear H; intros H0c H. + cut (forall x : IR, I x -> forall n : nat, N <= n -> + forall Hx Hx', AbsIR (f n x Hx') [<=] AbsIR (f N x Hx) [*]c[^] (n - N)). + intro H0. + apply fun_str_comparison with (fun n : nat => FAbs (f N) {*} [-C-] (c[^] (n - N))). + 2: exists N; intros. + 2: eapply leEq_wdr. + 2: apply H0 with (Hx' := Hx) (Hx := ProjIR1 (ProjIR1 Hx')); auto with arith. + Opaque FAbs. + 2: simpl in |- *; apply mult_wd; [ apply eq_symmetric_unfolded; apply FAbs_char | algebra ]. + apply conv_fun_series_scal with (f := fun n : nat => [-C-] (c[^] (n - N))). + apply conv_fun_const_series with (x := fun n : nat => c[^] (n - N)). + apply join_series with (power_series c). + apply power_series_conv. + apply AbsIR_less. + assumption. + apply less_leEq_trans with Zero. + rstepr ([--]Zero:IR). + apply inv_resp_less. + apply pos_one. + assumption. + exists N. + exists 0. + intro. + rewrite plus_comm; rewrite Minus.minus_plus. + algebra. + Contin. + intros x H0 n; induction n as [| n Hrecn]. + intro. + cut (N = 0); [ intro | auto with arith ]. + rewrite H2. + intros. + apply eq_imp_leEq. + simpl in |- *. + astepl (AbsIR (Part _ _ Hx') [*]One); apply mult_wdl; apply AbsIR_wd; algebra. + intro. + elim (le_lt_eq_dec _ _ H1); intro. + intros; apply leEq_transitive with (c[*]AbsIR (f n x (contin_imp_inc _ _ _ _ (contF n) x H0))). + apply H; auto with arith. + apply leEq_wdr with (AbsIR (f N x Hx) [*]c[^] (n - N) [*]c). + rstepr (c[*] (AbsIR (Part _ _ Hx) [*]c[^] (n - N))). + apply mult_resp_leEq_lft. + apply Hrecn; auto with arith. + assumption. + rewrite <- minus_Sn_m. + simpl in |- *; rational. + auto with arith. + rewrite b0; intros. + rewrite <- minus_n_n. + apply eq_imp_leEq. + simpl in |- *; eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply mult_one. + apply AbsIR_wd; algebra. Qed. End Convergence_Criteria. diff --git a/ftc/FunctSums.v b/ftc/FunctSums.v index f1cb58a77..3a5b5d7c3 100644 --- a/ftc/FunctSums.v +++ b/ftc/FunctSums.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing FSum0 %\ensuremath{\sum_0}% #∑0# *) (** printing FSum %\ensuremath{\sum}% #∑# *) @@ -59,37 +59,31 @@ $\sum_{i=m}^nf_i$#the sum of fm through fn# *) Definition FSum0 (n : nat) (f : nat -> PartIR) : PartIR. -intros. -apply - Build_PartFunct - with - (fun x : IR => forall n : nat, Dom (f n) x) - (fun (x : IR) (Hx : forall n : nat, Dom (f n) x) => - Sum0 n (fun n : nat => Part (f n) x (Hx n))). -intros x y H H0 n0. -apply (dom_wd _ (f n0) x). -apply H. -assumption. -intros x y Hx Hy H. -elim (Sum0_strext' _ _ _ _ H); intros i Hi. -apply pfstrx with (f i) (Hx i) (Hy i); assumption. +Proof. + intros. + apply Build_PartFunct with (fun x : IR => forall n : nat, Dom (f n) x) + (fun (x : IR) (Hx : forall n : nat, Dom (f n) x) => Sum0 n (fun n : nat => Part (f n) x (Hx n))). + intros x y H H0 n0. + apply (dom_wd _ (f n0) x). + apply H. + assumption. + intros x y Hx Hy H. + elim (Sum0_strext' _ _ _ _ H); intros i Hi. + apply pfstrx with (f i) (Hx i) (Hy i); assumption. Defined. Definition FSum (m n : nat) (f : nat -> PartIR) : PartIR. -intros. -apply - Build_PartFunct - with - (fun x : IR => forall n : nat, Dom (f n) x) - (fun (x : IR) (Hx : forall n : nat, Dom (f n) x) => - Sum m n (fun n : nat => Part (f n) x (Hx n))). -intros x y H H0 n0. -apply (dom_wd _ (f n0) x). -apply H. -assumption. -intros x y Hx Hy H. -elim (Sum_strext' _ _ _ _ _ H); intros i Hi. -apply pfstrx with (f i) (Hx i) (Hy i); assumption. +Proof. + intros. + apply Build_PartFunct with (fun x : IR => forall n : nat, Dom (f n) x) + (fun (x : IR) (Hx : forall n : nat, Dom (f n) x) => Sum m n (fun n : nat => Part (f n) x (Hx n))). + intros x y H H0 n0. + apply (dom_wd _ (f n0) x). + apply H. + assumption. + intros x y Hx Hy H. + elim (Sum_strext' _ _ _ _ _ H); intros i Hi. + apply pfstrx with (f i) (Hx i) (Hy i); assumption. Defined. (** @@ -104,146 +98,161 @@ those results. Lemma FSum_FSum0 : forall m n (f : nat -> PartIR) x Hx Hx' Hx'', FSum m n f x Hx [=] FSum0 (S n) f x Hx'[-]FSum0 m f x Hx''. -intros. -simpl in |- *; unfold Sum, Sum1 in |- *; simpl in |- *. -apply cg_minus_wd; try apply bin_op_wd_unfolded; try apply Sum0_wd; intros; - algebra. +Proof. + intros. + simpl in |- *; unfold Sum, Sum1 in |- *; simpl in |- *. + apply cg_minus_wd; try apply bin_op_wd_unfolded; try apply Sum0_wd; intros; algebra. Qed. Lemma FSum0_wd : forall m (f g : nat -> PartIR), (forall x HxF HxG i, f i x (HxF i) [=] g i x (HxG i)) -> forall x HxF HxG, FSum0 m f x HxF [=] FSum0 m g x HxG. -intros. -simpl in |- *. -apply Sum0_wd. -intros; simpl in |- *; algebra. +Proof. + intros. + simpl in |- *. + apply Sum0_wd. + intros; simpl in |- *; algebra. Qed. Lemma FSum_one : forall n (f : nat -> PartIR) x Hx Hx', FSum n n f x Hx' [=] f n x Hx. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -apply Sum_one. -simpl in |- *; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + apply Sum_one. + simpl in |- *; rational. Qed. Lemma FSum_FSum : forall l m n (f : nat -> PartIR) x Hx Hx' Hx'', FSum l m f x Hx[+]FSum (S m) n f x Hx' [=] FSum l n f x Hx''. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply Sum_Sum with (l := l) (m := m). -apply bin_op_wd_unfolded; apply Sum_wd; intros; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply Sum_Sum with (l := l) (m := m). + apply bin_op_wd_unfolded; apply Sum_wd; intros; rational. Qed. Lemma FSum_first : forall m n (f : nat -> PartIR) x Hx Hx' Hx'', FSum m n f x Hx [=] f m x Hx'[+]FSum (S m) n f x Hx''. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -apply Sum_first. -apply bin_op_wd_unfolded; try apply Sum_wd; intros; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + apply Sum_first. + apply bin_op_wd_unfolded; try apply Sum_wd; intros; rational. Qed. Lemma FSum_last : forall m n (f : nat -> PartIR) x Hx Hx' Hx'', FSum m (S n) f x Hx [=] FSum m n f x Hx'[+]f (S n) x Hx''. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -apply Sum_last. -apply bin_op_wd_unfolded; try apply Sum_wd; intros; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + apply Sum_last. + apply bin_op_wd_unfolded; try apply Sum_wd; intros; rational. Qed. Lemma FSum_last' : forall m n (f : nat -> PartIR) x Hx Hx' Hx'', 0 < n -> FSum m n f x Hx [=] FSum m (pred n) f x Hx'[+]f n x Hx''. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -apply Sum_last'. -assumption. -apply bin_op_wd_unfolded; try apply Sum_wd; intros; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + apply Sum_last'. + assumption. + apply bin_op_wd_unfolded; try apply Sum_wd; intros; rational. Qed. Lemma FSum_wd : forall m n (f g : nat -> PartIR), (forall x HxF HxG i, f i x (HxF i) [=] g i x (HxG i)) -> forall x HxF HxG, FSum m n f x HxF [=] FSum m n g x HxG. -intros. -simpl in |- *. -apply Sum_wd. -algebra. +Proof. + intros. + simpl in |- *. + apply Sum_wd. + algebra. Qed. Lemma FSum_plus_FSum : forall (f g : nat -> PartIR) m n x Hx HxF HxG, FSum m n (fun i => f i{+}g i) x Hx [=] FSum m n f x HxF[+]FSum m n g x HxG. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply Sum_plus_Sum. -apply Sum_wd; intros; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply Sum_plus_Sum. + apply Sum_wd; intros; rational. Qed. Lemma inv_FSum : forall (f : nat -> PartIR) m n x Hx Hx', FSum m n (fun i => {--} (f i)) x Hx [=] [--] (FSum m n f x Hx'). -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply inv_Sum. -apply Sum_wd; intros; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply inv_Sum. + apply Sum_wd; intros; rational. Qed. Lemma FSum_minus_FSum : forall (f g : nat -> PartIR) m n x Hx HxF HxG, FSum m n (fun i => f i{-}g i) x Hx [=] FSum m n f x HxF[-]FSum m n g x HxG. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply Sum_minus_Sum. -apply Sum_wd; intros; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply Sum_minus_Sum. + apply Sum_wd; intros; rational. Qed. Lemma FSum_wd' : forall m n, m <= S n -> forall f g : nat -> PartIR, (forall x HxF HxG i, m <= i -> i <= n -> f i x (HxF i) [=] g i x (HxG i)) -> forall x HxF HxG, FSum m n f x HxF [=] FSum m n g x HxG. -intros. -simpl in |- *. -apply Sum_wd'; try assumption. -algebra. +Proof. + intros. + simpl in |- *. + apply Sum_wd'; try assumption. + algebra. Qed. Lemma FSum_resp_less : forall (f g : nat -> PartIR) m n, m <= n -> (forall x HxF HxG i, m <= i -> i <= n -> f i x (HxF i) [<] g i x (HxG i)) -> forall x HxF HxG, FSum m n f x HxF [<] FSum m n g x HxG. -intros f g m n H H0 x HxF HxG. -simpl in |- *. -apply Sum_resp_less; try assumption. -intros; apply H0; assumption. +Proof. + intros f g m n H H0 x HxF HxG. + simpl in |- *. + apply Sum_resp_less; try assumption. + intros; apply H0; assumption. Qed. Lemma FSum_resp_leEq : forall (f g : nat -> PartIR) m n, m <= S n -> (forall x HxF HxG i, m <= i -> i <= n -> f i x (HxF i) [<=] g i x (HxG i)) -> forall x HxF HxG, FSum m n f x HxF [<=] FSum m n g x HxG. -intros f g m n H H0 x HxF HxG. -simpl in |- *. -apply Sum_resp_leEq; try assumption. -intros; apply H0; assumption. +Proof. + intros f g m n H H0 x HxF HxG. + simpl in |- *. + apply Sum_resp_leEq; try assumption. + intros; apply H0; assumption. Qed. Lemma FSum_comm_scal : forall (f : nat -> PartIR) c m n x Hx Hx', FSum m n (fun i => f i{*} [-C-]c) x Hx [=] (FSum m n f{*} [-C-]c) x Hx'. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply (Sum_comm_scal (fun n : nat => f n x (ProjIR1 Hx' n)) c m n). -apply Sum_wd; intros; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply (Sum_comm_scal (fun n : nat => f n x (ProjIR1 Hx' n)) c m n). + apply Sum_wd; intros; rational. Qed. Lemma FSum_comm_scal' : forall (f : nat -> PartIR) c m n x Hx Hx', FSum m n (fun i => [-C-]c{*}f i) x Hx [=] ( [-C-]c{*}FSum m n f) x Hx'. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply (Sum_comm_scal' (fun n : nat => f n x (ProjIR2 Hx' n)) c m n). -apply Sum_wd; intros; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply (Sum_comm_scal' (fun n : nat => f n x (ProjIR2 Hx' n)) c m n). + apply Sum_wd; intros; rational. Qed. (** @@ -265,27 +274,29 @@ This operator is well defined, as expected. Lemma FSumx_wd : forall n (f g : forall i, i < n -> PartIR), (forall i Hi x HxF HxG, f i Hi x HxF [=] g i Hi x HxG) -> forall x HxF HxG, FSumx n f x HxF [=] FSumx n g x HxG. -intro; case n. -intros; simpl in |- *; algebra. -clear n. -simple induction n. -intros; simpl in |- *; algebra. -clear n; intro. -cut {p : nat | S n = p}; [ intro H | exists (S n); auto ]. -elim H; intros p Hp. -rewrite Hp; intros. -simpl in |- *. -apply bin_op_wd_unfolded. -apply H0. -intros; apply H1. -apply H1. +Proof. + intro; case n. + intros; simpl in |- *; algebra. + clear n. + simple induction n. + intros; simpl in |- *; algebra. + clear n; intro. + cut {p : nat | S n = p}; [ intro H | exists (S n); auto ]. + elim H; intros p Hp. + rewrite Hp; intros. + simpl in |- *. + apply bin_op_wd_unfolded. + apply H0. + intros; apply H1. + apply H1. Qed. Lemma FSumx_wd' : forall (P : IR -> CProp) n (f g : forall i, i < n -> PartIR), (forall i H H', Feq P (f i H) (g i H')) -> Feq P (FSumx n f) (FSumx n g). -intros; induction n as [| n Hrecn]. -simpl in |- *; apply Feq_reflexive; apply included_IR. -simpl in |- *; apply Feq_plus; auto. +Proof. + intros; induction n as [| n Hrecn]. + simpl in |- *; apply Feq_reflexive; apply included_IR. + simpl in |- *; apply Feq_plus; auto. Qed. (** @@ -310,51 +321,54 @@ Under these assumptions, we can characterize the domain and the value of the sum Lemma FSumx_pred : forall n (f : forall i, i < n -> PartIR), ext_fun_seq' f -> forall x, Dom (FSumx n f) x -> forall i Hi, Dom (f i Hi) x. -intros n f H x H0 i Hi; red in H; induction n as [| n Hrecn]. -elimtype False; inversion Hi. -elim (le_lt_eq_dec _ _ Hi); intro. -cut (i < n); [ intro | auto with arith ]. -set (g := fun i Hi => f i (lt_S _ _ Hi)) in *. -apply H with i (lt_S _ _ H1) x. -auto. -algebra. -change (Dom (g i H1) x) in |- *. -apply Hrecn. -unfold g in |- *; intros. -apply H with i0 (lt_S i0 n Hi0) x0; auto. -inversion_clear H0; assumption. -elim H0; intros H1 H2; clear H0 H1. -apply H with n (lt_n_Sn n) x; auto. -symmetry in |- *; auto. -algebra. +Proof. + intros n f H x H0 i Hi; red in H; induction n as [| n Hrecn]. + elimtype False; inversion Hi. + elim (le_lt_eq_dec _ _ Hi); intro. + cut (i < n); [ intro | auto with arith ]. + set (g := fun i Hi => f i (lt_S _ _ Hi)) in *. + apply H with i (lt_S _ _ H1) x. + auto. + algebra. + change (Dom (g i H1) x) in |- *. + apply Hrecn. + unfold g in |- *; intros. + apply H with i0 (lt_S i0 n Hi0) x0; auto. + inversion_clear H0; assumption. + elim H0; intros H1 H2; clear H0 H1. + apply H with n (lt_n_Sn n) x; auto. + symmetry in |- *; auto. + algebra. Qed. Lemma FSumx_pred' : forall n (f : forall i, i < n -> PartIR), ext_fun_seq' f -> forall x, (forall i Hi, Dom (f i Hi) x) -> Dom (FSumx n f) x. -intros n f H x H0; induction n as [| n Hrecn]. -simpl in |- *; auto. -split. -apply Hrecn. -red in |- *; intros. -red in H. -exact (H _ _ H1 _ _ _ _ H2 X). -intros; auto. -apply H0. +Proof. + intros n f H x H0; induction n as [| n Hrecn]. + simpl in |- *; auto. + split. + apply Hrecn. + red in |- *; intros. + red in H. + exact (H _ _ H1 _ _ _ _ H2 X). + intros; auto. + apply H0. Qed. Lemma FSumx_char : forall n f x Hx Hf, FSumx n f x Hx [=] Sumx (fun i Hi => f i Hi x (FSumx_pred n f Hf x Hx i Hi)). -intro; induction n as [| n Hrecn]. -algebra. -intros; simpl in |- *. -apply bin_op_wd_unfolded; algebra. -cut (ext_fun_seq' (fun i Hi => f i (lt_S i n Hi))). -intro H. -eapply eq_transitive_unfolded. -apply Hrecn with (Hf := H). -apply Sumx_wd; intros; simpl in |- *; algebra. -intros i j H H0 H' x0 y H1 H2. -apply Hf with i (lt_S i n H0) x0; auto. +Proof. + intro; induction n as [| n Hrecn]. + algebra. + intros; simpl in |- *. + apply bin_op_wd_unfolded; algebra. + cut (ext_fun_seq' (fun i Hi => f i (lt_S i n Hi))). + intro H. + eapply eq_transitive_unfolded. + apply Hrecn with (Hf := H). + apply Sumx_wd; intros; simpl in |- *; algebra. + intros i j H H0 H' x0 y H1 H2. + apply Hf with i (lt_S i n H0) x0; auto. Qed. (** @@ -362,90 +376,90 @@ As we did for arbitrary groups, it is often useful to rewrite this sums as ordin *) Definition FSumx_to_FSum n : (forall i, i < n -> PartIR) -> nat -> PartIR. -intros n f i. -elim (le_lt_dec n i); intro. -apply ( [-C-]Zero:PartIR). -apply (f i b). +Proof. + intros n f i. + elim (le_lt_dec n i); intro. + apply ( [-C-]Zero:PartIR). + apply (f i b). Defined. Lemma FSumx_lt : forall n (f : forall i, i < n -> PartIR), ext_fun_seq f -> forall i Hi x Hx Hx', FSumx_to_FSum n f i x Hx [=] f i Hi x Hx'. -do 6 intro. -unfold FSumx_to_FSum in |- *. -elim (le_lt_dec n i); intro; simpl in |- *. -elimtype False; apply (le_not_lt n i); auto. -intros; apply H; auto. -algebra. +Proof. + do 6 intro. + unfold FSumx_to_FSum in |- *. + elim (le_lt_dec n i); intro; simpl in |- *. + elimtype False; apply (le_not_lt n i); auto. + intros; apply H; auto. + algebra. Qed. Lemma FSumx_le : forall n (f : forall i, i < n -> PartIR), ext_fun_seq f -> forall i x Hx, n <= i -> FSumx_to_FSum n f i x Hx [=] Zero. -do 5 intro. -unfold FSumx_to_FSum in |- *. -elim (le_lt_dec n i); intro; simpl in |- *. -intro; algebra. -intros; elimtype False; apply (le_not_lt n i); auto. +Proof. + do 5 intro. + unfold FSumx_to_FSum in |- *. + elim (le_lt_dec n i); intro; simpl in |- *. + intro; algebra. + intros; elimtype False; apply (le_not_lt n i); auto. Qed. Lemma FSum_FSumx_to_FSum : forall n (f : forall i, i < S n -> PartIR), ext_fun_seq f -> ext_fun_seq' f -> forall x Hx Hx', FSum 0 n (FSumx_to_FSum _ f) x Hx [=] FSumx _ f x Hx'. -simple induction n. -intros; simpl in |- *. -eapply eq_transitive_unfolded. -apply Sum_one. -simpl in |- *. -cut (0 < 1); [ intro | apply lt_n_Sn ]. -astepr (Part (f 0 (lt_n_Sn 0)) x (ProjIR2 Hx')). -apply FSumx_lt; assumption. -clear n; intros n H f H0 H1 x Hx Hx'. -simpl in |- *. -eapply eq_transitive_unfolded. -apply Sum_last. -apply bin_op_wd_unfolded. -set (g := fun i (l : i < S n) => f i (lt_S _ _ l)) in *. -cut (ext_fun_seq g); intros. -cut (ext_fun_seq' g). -intro H3. -astepr - (FSumx n (fun i (l : i < n) => g i (lt_S _ _ l)) x - (ProjIR1 (ProjIR1 Hx')) [+]g n (lt_n_Sn n) x (ProjIR2 (ProjIR1 Hx'))). -cut (Dom (FSumx _ g) x). -intro H4; cut (forall m : nat, Dom (FSumx_to_FSum (S n) g m) x). -intro Hx''. -simpl in H. -apply - eq_transitive_unfolded - with (Sum 0 n (fun m : nat => FSumx_to_FSum (S n) g m x (Hx'' m))). -2: apply H with (f := g); try assumption. -apply Sum_wd'. -auto with arith. -intros. -cut (i < S (S n)); [ intro | auto with arith ]. -apply eq_transitive_unfolded with (f i H7 x (FSumx_pred _ _ H1 x Hx' i H7)). -apply FSumx_lt; assumption. -cut (i < S n); [ intro | auto with arith ]. -apply eq_transitive_unfolded with (g i H8 x (FSumx_pred _ _ H3 x H4 i H8)). -2: apply eq_symmetric_unfolded; apply FSumx_lt; assumption. -unfold g in |- *; apply H0; auto. -algebra. -intro. -simpl in Hx. -generalize (Hx m); clear H4 H3 H2 Hx. -unfold FSumx_to_FSum in |- *. -elim (le_lt_dec (S n) m); elim (le_lt_dec (S (S n)) m); do 2 intro; - simpl in |- *; intro. -auto. -auto. -unfold g in |- *; apply FSumx_pred with (n := S (S n)); assumption. -unfold g in |- *; apply FSumx_pred with (n := S (S n)); assumption. -simpl in Hx'. -unfold g in |- *; inversion_clear Hx'; intros; assumption. -unfold g in |- *; red in |- *; intros. -red in H1; apply H1 with i (lt_S _ _ Hi) x0; auto. -unfold g in |- *; red in |- *; intros. -red in H0; apply H0; auto. -apply FSumx_lt; auto. +Proof. + simple induction n. + intros; simpl in |- *. + eapply eq_transitive_unfolded. + apply Sum_one. + simpl in |- *. + cut (0 < 1); [ intro | apply lt_n_Sn ]. + astepr (Part (f 0 (lt_n_Sn 0)) x (ProjIR2 Hx')). + apply FSumx_lt; assumption. + clear n; intros n H f H0 H1 x Hx Hx'. + simpl in |- *. + eapply eq_transitive_unfolded. + apply Sum_last. + apply bin_op_wd_unfolded. + set (g := fun i (l : i < S n) => f i (lt_S _ _ l)) in *. + cut (ext_fun_seq g); intros. + cut (ext_fun_seq' g). + intro H3. + astepr (FSumx n (fun i (l : i < n) => g i (lt_S _ _ l)) x + (ProjIR1 (ProjIR1 Hx')) [+]g n (lt_n_Sn n) x (ProjIR2 (ProjIR1 Hx'))). + cut (Dom (FSumx _ g) x). + intro H4; cut (forall m : nat, Dom (FSumx_to_FSum (S n) g m) x). + intro Hx''. + simpl in H. + apply eq_transitive_unfolded with (Sum 0 n (fun m : nat => FSumx_to_FSum (S n) g m x (Hx'' m))). + 2: apply H with (f := g); try assumption. + apply Sum_wd'. + auto with arith. + intros. + cut (i < S (S n)); [ intro | auto with arith ]. + apply eq_transitive_unfolded with (f i H7 x (FSumx_pred _ _ H1 x Hx' i H7)). + apply FSumx_lt; assumption. + cut (i < S n); [ intro | auto with arith ]. + apply eq_transitive_unfolded with (g i H8 x (FSumx_pred _ _ H3 x H4 i H8)). + 2: apply eq_symmetric_unfolded; apply FSumx_lt; assumption. + unfold g in |- *; apply H0; auto. + algebra. + intro. + simpl in Hx. + generalize (Hx m); clear H4 H3 H2 Hx. + unfold FSumx_to_FSum in |- *. + elim (le_lt_dec (S n) m); elim (le_lt_dec (S (S n)) m); do 2 intro; simpl in |- *; intro. + auto. + auto. + unfold g in |- *; apply FSumx_pred with (n := S (S n)); assumption. + unfold g in |- *; apply FSumx_pred with (n := S (S n)); assumption. + simpl in Hx'. + unfold g in |- *; inversion_clear Hx'; intros; assumption. + unfold g in |- *; red in |- *; intros. + red in H1; apply H1 with i (lt_S _ _ Hi) x0; auto. + unfold g in |- *; red in |- *; intros. + red in H0; apply H0; auto. + apply FSumx_lt; auto. Qed. (** @@ -453,62 +467,65 @@ Some useful lemmas follow. *) Lemma FSum0_0 : forall P f, (forall n, included P (Dom (f n))) -> Feq P [-C-]Zero (FSum0 0 f). -intros P f H. -FEQ. -simpl in |- *. -red in |- *; intros; apply (H n); auto. +Proof. + intros P f H. + FEQ. + simpl in |- *. + red in |- *; intros; apply (H n); auto. Qed. Lemma FSum0_S : forall P f n, (forall m, included P (Dom (f m))) -> Feq P (FSum0 n f{+}f n) (FSum0 (S n) f). -intros P f n H. -FEQ. -apply included_FPlus; auto. -simpl in |- *; red in |- *; intros. -apply (H n0); auto. -simpl in |- *. -red in |- *; intros; apply (H n0); auto. -simpl in |- *; apply bin_op_wd_unfolded; algebra. -apply Sum0_wd; algebra. +Proof. + intros P f n H. + FEQ. + apply included_FPlus; auto. + simpl in |- *; red in |- *; intros. + apply (H n0); auto. + simpl in |- *. + red in |- *; intros; apply (H n0); auto. + simpl in |- *; apply bin_op_wd_unfolded; algebra. + apply Sum0_wd; algebra. Qed. Lemma FSum_0 : forall P f n, (forall i, included P (Dom (f i))) -> Feq P (f n) (FSum n n f). -intros P f n H. -FEQ. -simpl in |- *. -red in |- *; intros; apply (H n0); auto. -simpl in |- *. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -apply Sum_one. -algebra. +Proof. + intros P f n H. + FEQ. + simpl in |- *. + red in |- *; intros; apply (H n0); auto. + simpl in |- *. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply Sum_one. + algebra. Qed. Lemma FSum_S : forall P f m n, (forall i, included P (Dom (f i))) -> Feq P (FSum m n f{+}f (S n)) (FSum m (S n) f). -intros P f m n H. -apply eq_imp_Feq. -apply included_FPlus; auto. -simpl in |- *. -red in |- *; intros; apply (H n0); auto. -simpl in |- *. -red in |- *; intros; apply (H n0); auto. -intros; simpl in |- *; apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -apply Sum_last. -algebra. +Proof. + intros P f m n H. + apply eq_imp_Feq. + apply included_FPlus; auto. + simpl in |- *. + red in |- *; intros; apply (H n0); auto. + simpl in |- *. + red in |- *; intros; apply (H n0); auto. + intros; simpl in |- *; apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply Sum_last. + algebra. Qed. Lemma FSum_FSum0' : forall P f m n, (forall i, included P (Dom (f i))) -> Feq P (FSum m n f) (FSum0 (S n) f{-}FSum0 m f). -intros P f m n H. -apply eq_imp_Feq. -red in |- *; intros; intro; apply (H n0); auto. -apply included_FMinus; red in |- *; intros; intro; apply (H n0); auto. -intros. -apply - eq_transitive_unfolded - with (Part _ _ (ProjIR1 Hx') [-]FSum0 m f _ (ProjIR2 Hx')). -apply FSum_FSum0. -simpl in |- *; rational. +Proof. + intros P f m n H. + apply eq_imp_Feq. + red in |- *; intros; intro; apply (H n0); auto. + apply included_FMinus; red in |- *; intros; intro; apply (H n0); auto. + intros. + apply eq_transitive_unfolded with (Part _ _ (ProjIR1 Hx') [-]FSum0 m f _ (ProjIR2 Hx')). + apply FSum_FSum0. + simpl in |- *; rational. Qed. diff --git a/ftc/Integral.v b/ftc/Integral.v index 7b80dfed4..4755024f1 100644 --- a/ftc/Integral.v +++ b/ftc/Integral.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export RefLemma. @@ -48,17 +48,15 @@ Let Sumx_wd_weird : forall (f : forall i : nat, i < n -> IR) (g : forall i : nat, i < m -> IR), (forall H, g 0 H [=] Zero) -> (forall (i : nat) H H', f i H [=] g (S i) H') -> Sumx f [=] Sumx g. -intro; induction n as [| n Hrecn]. -do 2 intro. -rewrite H. -intros; simpl in |- *; apply eq_symmetric_unfolded. -astepr (g 0 (lt_n_Sn 0)); algebra. -do 2 intro; rewrite H; intros. -astepl - (Sumx (fun (i : nat) (Hi : i < n) => f i (lt_S _ _ Hi)) [+]f n (lt_n_Sn n)). -Step_final - (Sumx (fun (i : nat) (Hi : i < S n) => g i (lt_S _ _ Hi)) [+] - g (S n) (lt_n_Sn (S n))). +Proof. + intro; induction n as [| n Hrecn]. + do 2 intro. + rewrite H. + intros; simpl in |- *; apply eq_symmetric_unfolded. + astepr (g 0 (lt_n_Sn 0)); algebra. + do 2 intro; rewrite H; intros. + astepl (Sumx (fun (i : nat) (Hi : i < n) => f i (lt_S _ _ Hi)) [+]f n (lt_n_Sn n)). + Step_final (Sumx (fun (i : nat) (Hi : i < S n) => g i (lt_S _ _ Hi)) [+] g (S n) (lt_n_Sn (S n))). Qed. Lemma Sumx_weird_lemma : @@ -72,41 +70,36 @@ Lemma Sumx_weird_lemma : (forall (i : nat) Hi Hi', f1 i Hi [=] f3 i Hi') -> (forall (i : nat) Hi Hi', f2 i Hi [=] f3 (S (n + i)) Hi') -> (forall Hi, f3 n Hi [=] Zero) -> Sumx f1[+]Sumx f2 [=] Sumx f3. -intros n m. -induction m as [| m Hrecm]. -intros l Hl. -simpl in Hl; rewrite Hl; intros f1 f2 f3 Hf1 Hf2 Hf3 Hf1_f3 Hf2_f3 Hf3_f3. -astepl (Sumx f1[+]Zero). -simpl in |- *; apply bin_op_wd_unfolded. -apply Sumx_wd; intros; apply Hf1_f3. -apply eq_symmetric_unfolded; apply Hf3_f3. -set (l' := S m + n) in *. -intros l Hl. -rewrite Hl; intros f1 f2 f3 Hf1 Hf2 Hf3 Hf1_f3 Hf2_f3 Hf3_f3. -apply - eq_transitive_unfolded - with - (Sumx f1[+]Sumx (fun (i : nat) (Hi : i < m) => f2 i (lt_S _ _ Hi)) [+] - f2 m (lt_n_Sn m)). -simpl in |- *; algebra. -astepr - (Sumx (fun (i : nat) (Hi : i < l') => f3 i (lt_S _ _ Hi)) [+] - f3 l' (lt_n_Sn l')). -apply bin_op_wd_unfolded. -apply Hrecm. -unfold l' in |- *; auto. -assumption. -red in |- *; intros; apply Hf2; auto. -red in |- *; intros; apply Hf3; auto. -red in |- *; intros; apply Hf1_f3. -red in |- *; intros; apply Hf2_f3. -red in |- *; intros; apply Hf3_f3. -unfold l' at 1 in |- *. -cut (S (n + m) < S l'); - [ intro | unfold l' in |- *; simpl in |- *; rewrite plus_comm; auto ]. -apply eq_transitive_unfolded with (f3 _ H). -apply Hf2_f3. -apply Hf3; simpl in |- *; auto with arith. +Proof. + intros n m. + induction m as [| m Hrecm]. + intros l Hl. + simpl in Hl; rewrite Hl; intros f1 f2 f3 Hf1 Hf2 Hf3 Hf1_f3 Hf2_f3 Hf3_f3. + astepl (Sumx f1[+]Zero). + simpl in |- *; apply bin_op_wd_unfolded. + apply Sumx_wd; intros; apply Hf1_f3. + apply eq_symmetric_unfolded; apply Hf3_f3. + set (l' := S m + n) in *. + intros l Hl. + rewrite Hl; intros f1 f2 f3 Hf1 Hf2 Hf3 Hf1_f3 Hf2_f3 Hf3_f3. + apply eq_transitive_unfolded with + (Sumx f1[+]Sumx (fun (i : nat) (Hi : i < m) => f2 i (lt_S _ _ Hi)) [+] f2 m (lt_n_Sn m)). + simpl in |- *; algebra. + astepr (Sumx (fun (i : nat) (Hi : i < l') => f3 i (lt_S _ _ Hi)) [+] f3 l' (lt_n_Sn l')). + apply bin_op_wd_unfolded. + apply Hrecm. + unfold l' in |- *; auto. + assumption. + red in |- *; intros; apply Hf2; auto. + red in |- *; intros; apply Hf3; auto. + red in |- *; intros; apply Hf1_f3. + red in |- *; intros; apply Hf2_f3. + red in |- *; intros; apply Hf3_f3. + unfold l' at 1 in |- *. + cut (S (n + m) < S l'); [ intro | unfold l' in |- *; simpl in |- *; rewrite plus_comm; auto ]. + apply eq_transitive_unfolded with (f3 _ H). + apply Hf2_f3. + apply Hf3; simpl in |- *; auto with arith. Qed. End Lemmas. @@ -142,78 +135,67 @@ Let contF' := contin_prop _ _ _ _ contF. Section Darboux_Sum. Definition integral_seq : nat -> IR. -intro n. -apply Even_Partition_Sum with a b Hab F (S n). -assumption. -auto. +Proof. + intro n. + apply Even_Partition_Sum with a b Hab F (S n). + assumption. + auto. Defined. Lemma Cauchy_Darboux_Seq : Cauchy_prop integral_seq. -red in |- *; intros e He. -set - (e' := - e[/] _[//]mult_resp_ap_zero _ _ _ (two_ap_zero _) (max_one_ap_zero (b[-]a))) - in *. -cut (Zero [<] e'). -intro He'. -set (d := proj1_sig2T _ _ _ (contF' e' He')) in *. -generalize (proj2b_sig2T _ _ _ (contF' e' He')); - generalize (proj2a_sig2T _ _ _ (contF' e' He')); fold d in |- *; - intros H0 H1. -set (N := ProjT1 (Archimedes (b[-]a[/] _[//]pos_ap_zero _ _ H0))) in *. -exists N; intros. -apply AbsIR_imp_AbsSmall. -apply leEq_transitive with (Two[*]e'[*] (b[-]a)). -rstepr (e'[*] (b[-]a) [+]e'[*] (b[-]a)). -unfold integral_seq in |- *. -elim (even_partition_refinement _ _ Hab _ _ (O_S m) (O_S N)). -intros w Hw. -elim Hw; clear Hw; intros Hw H2 H3. -unfold Even_Partition_Sum in |- *. -unfold I in |- *; - apply - second_refinement_lemma - with - (a := a) - (b := b) - (F := F) - (contF := contF) - (Q := Even_Partition Hab w Hw) - (He := He') - (He' := He'). -assumption. -assumption. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply even_partition_Mesh. -apply shift_div_leEq. -apply pos_nring_S. -apply shift_leEq_mult' with (pos_ap_zero _ _ H0). -assumption. -apply leEq_transitive with (nring (R:=IR) N). -exact (ProjT2 (Archimedes (b[-]a[/] d[//]pos_ap_zero _ _ H0))). -apply nring_leEq; apply le_S; assumption. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply even_partition_Mesh. -apply shift_div_leEq. -apply pos_nring_S. -apply shift_leEq_mult' with (pos_ap_zero _ _ H0). -assumption. -apply leEq_transitive with (nring (R:=IR) N). -exact (ProjT2 (Archimedes (b[-]a[/] d[//]pos_ap_zero _ _ H0))). -apply nring_leEq; apply le_n_Sn. -unfold e' in |- *. -rstepl (e[*] (b[-]a) [/] _[//]max_one_ap_zero (b[-]a)). -apply shift_div_leEq. -apply pos_max_one. -apply mult_resp_leEq_lft. -apply lft_leEq_Max. -apply less_leEq; assumption. -unfold e' in |- *. -apply div_resp_pos. -apply mult_resp_pos. -apply pos_two. -apply pos_max_one. -assumption. +Proof. + red in |- *; intros e He. + set (e' := e[/] _[//]mult_resp_ap_zero _ _ _ (two_ap_zero _) (max_one_ap_zero (b[-]a))) in *. + cut (Zero [<] e'). + intro He'. + set (d := proj1_sig2T _ _ _ (contF' e' He')) in *. + generalize (proj2b_sig2T _ _ _ (contF' e' He')); + generalize (proj2a_sig2T _ _ _ (contF' e' He')); fold d in |- *; intros H0 H1. + set (N := ProjT1 (Archimedes (b[-]a[/] _[//]pos_ap_zero _ _ H0))) in *. + exists N; intros. + apply AbsIR_imp_AbsSmall. + apply leEq_transitive with (Two[*]e'[*] (b[-]a)). + rstepr (e'[*] (b[-]a) [+]e'[*] (b[-]a)). + unfold integral_seq in |- *. + elim (even_partition_refinement _ _ Hab _ _ (O_S m) (O_S N)). + intros w Hw. + elim Hw; clear Hw; intros Hw H2 H3. + unfold Even_Partition_Sum in |- *. + unfold I in |- *; apply second_refinement_lemma with (a := a) (b := b) (F := F) (contF := contF) + (Q := Even_Partition Hab w Hw) (He := He') (He' := He'). + assumption. + assumption. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply even_partition_Mesh. + apply shift_div_leEq. + apply pos_nring_S. + apply shift_leEq_mult' with (pos_ap_zero _ _ H0). + assumption. + apply leEq_transitive with (nring (R:=IR) N). + exact (ProjT2 (Archimedes (b[-]a[/] d[//]pos_ap_zero _ _ H0))). + apply nring_leEq; apply le_S; assumption. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply even_partition_Mesh. + apply shift_div_leEq. + apply pos_nring_S. + apply shift_leEq_mult' with (pos_ap_zero _ _ H0). + assumption. + apply leEq_transitive with (nring (R:=IR) N). + exact (ProjT2 (Archimedes (b[-]a[/] d[//]pos_ap_zero _ _ H0))). + apply nring_leEq; apply le_n_Sn. + unfold e' in |- *. + rstepl (e[*] (b[-]a) [/] _[//]max_one_ap_zero (b[-]a)). + apply shift_div_leEq. + apply pos_max_one. + apply mult_resp_leEq_lft. + apply lft_leEq_Max. + apply less_leEq; assumption. + unfold e' in |- *. + apply div_resp_pos. + apply mult_resp_pos. + apply pos_two. + apply pos_max_one. + assumption. Qed. Definition integral := Lim (Build_CauchySeq _ _ Cauchy_Darboux_Seq). @@ -253,79 +235,64 @@ Hypothesis HfP' : nat_less_n_fun fP. Hypothesis incF : included (Compact Hab) (Dom F). Lemma partition_Sum_conv_integral : AbsIR (Partition_Sum HfP incF[-]integral) [<=] e[*] (b[-]a). -apply - leEq_wdl - with (AbsIR (Partition_Sum HfP (contin_imp_inc _ _ _ _ contF) [-]integral)). -apply - leEq_wdl - with - (AbsIR - (Lim (Cauchy_const (Partition_Sum HfP (contin_imp_inc _ _ _ _ contF))) [-] - integral)). -2: apply AbsIR_wd; apply cg_minus_wd; - [ apply eq_symmetric_unfolded; apply Lim_const | algebra ]. -unfold integral in |- *. -apply - leEq_wdl - with - (AbsIR - (Lim - (Build_CauchySeq _ _ - (Cauchy_minus - (Cauchy_const - (Partition_Sum HfP (contin_imp_inc _ _ _ _ contF))) - (Build_CauchySeq _ _ Cauchy_Darboux_Seq))))). -2: apply AbsIR_wd; apply Lim_minus. -eapply leEq_wdl. -2: apply Lim_abs. -astepr (Zero[+]e[*] (b[-]a)); apply shift_leEq_plus; apply approach_zero_weak. -intros e' He'. -set (ee := e'[/] _[//]max_one_ap_zero (b[-]a)) in *. -apply leEq_transitive with (ee[*] (b[-]a)). -cut (Zero [<] ee). -intro Hee. -set (d' := proj1_sig2T _ _ _ (contF' _ Hee)) in *. -generalize (proj2b_sig2T _ _ _ (contF' _ Hee)); - generalize (proj2a_sig2T _ _ _ (contF' _ Hee)); fold d' in |- *; - intros Hd' Hd'0. -elim (Archimedes (b[-]a[/] _[//]pos_ap_zero _ _ Hd')); intros k Hk. -apply shift_minus_leEq. -eapply leEq_wdr. -2: apply cag_commutes_unfolded. -apply str_seq_leEq_so_Lim_leEq. -exists k; simpl in |- *; intros. -unfold integral_seq, Even_Partition_Sum in |- *. -apply refinement_lemma with contF He Hee. -assumption. -fold d' in |- *. -eapply less_wdl. -2: apply eq_symmetric_unfolded; apply even_partition_Mesh. -apply shift_div_less. -apply pos_nring_S. -apply shift_less_mult' with (pos_ap_zero _ _ Hd'). -assumption. -apply leEq_less_trans with (nring (R:=IR) k). -assumption. -apply nring_less; auto with arith. -assumption. -red in |- *; do 3 intro. -rewrite H0; intros; simpl in |- *; algebra. -unfold ee in |- *; apply div_resp_pos. -apply pos_max_one. -assumption. -unfold ee in |- *. -rstepl (e'[*] (b[-]a[/] _[//]max_one_ap_zero (b[-]a))). -rstepr (e'[*]One). -apply mult_resp_leEq_lft. -apply shift_div_leEq. -apply pos_max_one. -astepr (Max (b[-]a) One); apply lft_leEq_Max. -apply less_leEq; assumption. -apply AbsIR_wd; apply cg_minus_wd. -unfold Partition_Sum in |- *. -apply Sumx_wd; intros. -algebra. -algebra. + apply leEq_wdl with (AbsIR (Partition_Sum HfP (contin_imp_inc _ _ _ _ contF) [-]integral)). +Proof. + apply leEq_wdl with (AbsIR (Lim (Cauchy_const (Partition_Sum HfP (contin_imp_inc _ _ _ _ contF))) [-] + integral)). + 2: apply AbsIR_wd; apply cg_minus_wd; [ apply eq_symmetric_unfolded; apply Lim_const | algebra ]. + unfold integral in |- *. + apply leEq_wdl with (AbsIR (Lim (Build_CauchySeq _ _ (Cauchy_minus (Cauchy_const + (Partition_Sum HfP (contin_imp_inc _ _ _ _ contF))) (Build_CauchySeq _ _ Cauchy_Darboux_Seq))))). + 2: apply AbsIR_wd; apply Lim_minus. + eapply leEq_wdl. + 2: apply Lim_abs. + astepr (Zero[+]e[*] (b[-]a)); apply shift_leEq_plus; apply approach_zero_weak. + intros e' He'. + set (ee := e'[/] _[//]max_one_ap_zero (b[-]a)) in *. + apply leEq_transitive with (ee[*] (b[-]a)). + cut (Zero [<] ee). + intro Hee. + set (d' := proj1_sig2T _ _ _ (contF' _ Hee)) in *. + generalize (proj2b_sig2T _ _ _ (contF' _ Hee)); + generalize (proj2a_sig2T _ _ _ (contF' _ Hee)); fold d' in |- *; intros Hd' Hd'0. + elim (Archimedes (b[-]a[/] _[//]pos_ap_zero _ _ Hd')); intros k Hk. + apply shift_minus_leEq. + eapply leEq_wdr. + 2: apply cag_commutes_unfolded. + apply str_seq_leEq_so_Lim_leEq. + exists k; simpl in |- *; intros. + unfold integral_seq, Even_Partition_Sum in |- *. + apply refinement_lemma with contF He Hee. + assumption. + fold d' in |- *. + eapply less_wdl. + 2: apply eq_symmetric_unfolded; apply even_partition_Mesh. + apply shift_div_less. + apply pos_nring_S. + apply shift_less_mult' with (pos_ap_zero _ _ Hd'). + assumption. + apply leEq_less_trans with (nring (R:=IR) k). + assumption. + apply nring_less; auto with arith. + assumption. + red in |- *; do 3 intro. + rewrite H0; intros; simpl in |- *; algebra. + unfold ee in |- *; apply div_resp_pos. + apply pos_max_one. + assumption. + unfold ee in |- *. + rstepl (e'[*] (b[-]a[/] _[//]max_one_ap_zero (b[-]a))). + rstepr (e'[*]One). + apply mult_resp_leEq_lft. + apply shift_div_leEq. + apply pos_max_one. + astepr (Max (b[-]a) One); apply lft_leEq_Max. + apply less_leEq; assumption. + apply AbsIR_wd; apply cg_minus_wd. + unfold Partition_Sum in |- *. + apply Sumx_wd; intros. + algebra. + algebra. Qed. End Integral_Thm. @@ -354,171 +321,143 @@ Hypothesis contG : Continuous_I Hab G. Lemma integral_strext : Integral F contF [#] Integral G contG -> {x : IR | I x | forall Hx Hx', F x Hx [#] G x Hx'}. -intro H. -unfold integral in H. -elim (Lim_ap_imp_seq_ap' _ _ H); intros N HN; clear H. -simpl in HN. -unfold integral_seq, Even_Partition_Sum, Partition_Sum in HN. -set - (f' := - fun (i : nat) (H : i < S N) => - Part F _ - (contin_imp_inc _ _ _ _ contF _ - (compact_partition_lemma _ _ Hab _ (O_S N) _ (lt_le_weak _ _ H))) [*] - (Even_Partition Hab _ (O_S N) _ H[-] - Even_Partition Hab _ (O_S N) i (lt_le_weak _ _ H))) - in *. -set - (g' := - fun (i : nat) (H : i < S N) => - Part G _ - (contin_imp_inc _ _ _ _ contG _ - (compact_partition_lemma _ _ Hab _ (O_S N) _ (lt_le_weak _ _ H))) [*] - (Even_Partition Hab _ (O_S N) _ H[-] - Even_Partition Hab _ (O_S N) i (lt_le_weak _ _ H))) - in *. -cut (nat_less_n_fun f'); intros. -cut (nat_less_n_fun g'); intros. -cut (Sumx f' [#] Sumx g'). intros H1. -elim (Sumx_strext _ _ _ _ H H0 H1). -intros n Hn. -elim Hn; clear Hn; intros Hn H'. -exists (a[+]nring n[*] (b[-]a[/] nring _[//]nring_ap_zero' _ _ (O_S N))). -unfold I in |- *; apply compact_partition_lemma; auto. -apply lt_le_weak; assumption. -intros. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H'); clear H'; intro. -eapply ap_wdl_unfolded. -eapply ap_wdr_unfolded. -apply a0. -algebra. -algebra. -elimtype False; generalize b0; exact (ap_irreflexive_unfolded _ _). -eapply ap_wdl_unfolded. -eapply ap_wdr_unfolded. -apply HN. -unfold g', Partition_imp_points in |- *; apply Sumx_wd; intros; simpl in |- *; - rational. -unfold f', Partition_imp_points in |- *; apply Sumx_wd; intros; simpl in |- *; - rational. -do 3 intro. -rewrite H0; unfold g' in |- *; intros; algebra. -do 3 intro. -rewrite H; unfold f' in |- *; intros; algebra. +Proof. + intro H. + unfold integral in H. + elim (Lim_ap_imp_seq_ap' _ _ H); intros N HN; clear H. + simpl in HN. + unfold integral_seq, Even_Partition_Sum, Partition_Sum in HN. + set (f' := fun (i : nat) (H : i < S N) => Part F _ (contin_imp_inc _ _ _ _ contF _ + (compact_partition_lemma _ _ Hab _ (O_S N) _ (lt_le_weak _ _ H))) [*] + (Even_Partition Hab _ (O_S N) _ H[-] Even_Partition Hab _ (O_S N) i (lt_le_weak _ _ H))) in *. + set (g' := fun (i : nat) (H : i < S N) => Part G _ (contin_imp_inc _ _ _ _ contG _ + (compact_partition_lemma _ _ Hab _ (O_S N) _ (lt_le_weak _ _ H))) [*] + (Even_Partition Hab _ (O_S N) _ H[-] Even_Partition Hab _ (O_S N) i (lt_le_weak _ _ H))) in *. + cut (nat_less_n_fun f'); intros. + cut (nat_less_n_fun g'); intros. + cut (Sumx f' [#] Sumx g'). intros H1. + elim (Sumx_strext _ _ _ _ H H0 H1). + intros n Hn. + elim Hn; clear Hn; intros Hn H'. + exists (a[+]nring n[*] (b[-]a[/] nring _[//]nring_ap_zero' _ _ (O_S N))). + unfold I in |- *; apply compact_partition_lemma; auto. + apply lt_le_weak; assumption. + intros. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H'); clear H'; intro. + eapply ap_wdl_unfolded. + eapply ap_wdr_unfolded. + apply a0. + algebra. + algebra. + elimtype False; generalize b0; exact (ap_irreflexive_unfolded _ _). + eapply ap_wdl_unfolded. + eapply ap_wdr_unfolded. + apply HN. + unfold g', Partition_imp_points in |- *; apply Sumx_wd; intros; simpl in |- *; rational. + unfold f', Partition_imp_points in |- *; apply Sumx_wd; intros; simpl in |- *; rational. + do 3 intro. + rewrite H0; unfold g' in |- *; intros; algebra. + do 3 intro. + rewrite H; unfold f' in |- *; intros; algebra. Qed. Lemma integral_strext' : forall c d Hcd HF1 HF2, integral a b Hab F HF1 [#] integral c d Hcd F HF2 -> a [#] c or b [#] d. -intros c d Hcd HF1 HF2 H. -clear contF contG. -unfold integral in H. -elim (Lim_strext _ _ H). -clear H; intros N HN. -simpl in HN. -unfold integral_seq, Even_Partition_Sum, Partition_Sum in HN. -set - (f1 := - fun (i : nat) (Hi : i < S N) => - Part _ _ - (contin_imp_inc _ _ _ _ HF1 _ - (Pts_part_lemma _ _ _ _ _ _ - (Partition_imp_points_1 _ _ _ _ (Even_Partition Hab _ (O_S N))) i - Hi)) [*] - (Even_Partition Hab _ (O_S N) _ Hi[-] - Even_Partition Hab _ (O_S N) _ (lt_le_weak _ _ Hi))) - in *. -set - (f2 := - fun (i : nat) (Hi : i < S N) => - Part _ _ - (contin_imp_inc _ _ _ _ HF2 _ - (Pts_part_lemma _ _ _ _ _ _ - (Partition_imp_points_1 _ _ _ _ (Even_Partition Hcd _ (O_S N))) i - Hi)) [*] - (Even_Partition Hcd _ (O_S N) _ Hi[-] - Even_Partition Hcd _ (O_S N) _ (lt_le_weak _ _ Hi))) - in *. -cut (nat_less_n_fun f1); intros. -cut (nat_less_n_fun f2); intros. -elim (Sumx_strext _ _ _ _ H H0 HN). -clear H0 H HN; intros i Hi. -elim Hi; clear Hi; intros Hi Hi'. -unfold f1, f2 in Hi'; clear f1 f2. -elim (bin_op_strext_unfolded _ _ _ _ _ _ Hi'); clear Hi'; intro. -assert (H := pfstrx _ _ _ _ _ _ a0). -clear a0; simpl in H. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H); clear H; intro. -left; auto. -elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. -elimtype False; generalize a0; apply ap_irreflexive_unfolded. -elim (div_strext _ _ _ _ _ _ _ b0); clear b0; intro. -elim (cg_minus_strext _ _ _ _ _ a0); clear a0; intro. -right; auto. -left; auto. -elimtype False; generalize b0; apply ap_irreflexive_unfolded. -elim (cg_minus_strext _ _ _ _ _ b0); clear b0; intro. -simpl in a0. -elim (bin_op_strext_unfolded _ _ _ _ _ _ a0); clear a0; intro. -left; auto. -elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. -elimtype False; generalize a0; apply ap_irreflexive_unfolded. -elim (div_strext _ _ _ _ _ _ _ b0); clear b0; intro. -elim (cg_minus_strext _ _ _ _ _ a0); clear a0; intro. -right; auto. -left; auto. -elimtype False; generalize b0; apply ap_irreflexive_unfolded. -elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. -left; auto. -elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. -elimtype False; generalize a0; apply ap_irreflexive_unfolded. -elim (div_strext _ _ _ _ _ _ _ b0); clear b0; intro. -elim (cg_minus_strext _ _ _ _ _ a0); clear a0; intro. -right; auto. -left; auto. -elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. -elimtype False; generalize a0; apply ap_irreflexive_unfolded. -elimtype False; generalize b0; apply ap_irreflexive_unfolded. -red in |- *. -do 3 intro. -rewrite H0; clear H0; intros. -unfold f2 in |- *. -algebra. -red in |- *. -do 3 intro. -rewrite H; clear H; intros. -unfold f1 in |- *. -algebra. +Proof. + intros c d Hcd HF1 HF2 H. + clear contF contG. + unfold integral in H. + elim (Lim_strext _ _ H). + clear H; intros N HN. + simpl in HN. + unfold integral_seq, Even_Partition_Sum, Partition_Sum in HN. + set (f1 := fun (i : nat) (Hi : i < S N) => Part _ _ (contin_imp_inc _ _ _ _ HF1 _ + (Pts_part_lemma _ _ _ _ _ _ (Partition_imp_points_1 _ _ _ _ (Even_Partition Hab _ (O_S N))) i + Hi)) [*] (Even_Partition Hab _ (O_S N) _ Hi[-] + Even_Partition Hab _ (O_S N) _ (lt_le_weak _ _ Hi))) in *. + set (f2 := fun (i : nat) (Hi : i < S N) => Part _ _ (contin_imp_inc _ _ _ _ HF2 _ + (Pts_part_lemma _ _ _ _ _ _ (Partition_imp_points_1 _ _ _ _ (Even_Partition Hcd _ (O_S N))) i + Hi)) [*] (Even_Partition Hcd _ (O_S N) _ Hi[-] + Even_Partition Hcd _ (O_S N) _ (lt_le_weak _ _ Hi))) in *. + cut (nat_less_n_fun f1); intros. + cut (nat_less_n_fun f2); intros. + elim (Sumx_strext _ _ _ _ H H0 HN). + clear H0 H HN; intros i Hi. + elim Hi; clear Hi; intros Hi Hi'. + unfold f1, f2 in Hi'; clear f1 f2. + elim (bin_op_strext_unfolded _ _ _ _ _ _ Hi'); clear Hi'; intro. + assert (H := pfstrx _ _ _ _ _ _ a0). + clear a0; simpl in H. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H); clear H; intro. + left; auto. + elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. + elimtype False; generalize a0; apply ap_irreflexive_unfolded. + elim (div_strext _ _ _ _ _ _ _ b0); clear b0; intro. + elim (cg_minus_strext _ _ _ _ _ a0); clear a0; intro. + right; auto. + left; auto. + elimtype False; generalize b0; apply ap_irreflexive_unfolded. + elim (cg_minus_strext _ _ _ _ _ b0); clear b0; intro. + simpl in a0. + elim (bin_op_strext_unfolded _ _ _ _ _ _ a0); clear a0; intro. + left; auto. + elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. + elimtype False; generalize a0; apply ap_irreflexive_unfolded. + elim (div_strext _ _ _ _ _ _ _ b0); clear b0; intro. + elim (cg_minus_strext _ _ _ _ _ a0); clear a0; intro. + right; auto. + left; auto. + elimtype False; generalize b0; apply ap_irreflexive_unfolded. + elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. + left; auto. + elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. + elimtype False; generalize a0; apply ap_irreflexive_unfolded. + elim (div_strext _ _ _ _ _ _ _ b0); clear b0; intro. + elim (cg_minus_strext _ _ _ _ _ a0); clear a0; intro. + right; auto. + left; auto. + elim (bin_op_strext_unfolded _ _ _ _ _ _ b0); clear b0; intro. + elimtype False; generalize a0; apply ap_irreflexive_unfolded. + elimtype False; generalize b0; apply ap_irreflexive_unfolded. + red in |- *. + do 3 intro. + rewrite H0; clear H0; intros. + unfold f2 in |- *. + algebra. + red in |- *. + do 3 intro. + rewrite H; clear H; intros. + unfold f1 in |- *. + algebra. Qed. Lemma integral_wd : Feq (Compact Hab) F G -> Integral F contF [=] Integral G contG. -intro H. -apply not_ap_imp_eq. -intro H0. -elim (integral_strext H0). -intros x H1 H2. -elim H; intros H3 H4. -inversion_clear H4. -generalize - (H2 (contin_imp_inc _ _ _ _ contF x H1) (contin_imp_inc _ _ _ _ contG x H1)). -apply eq_imp_not_ap. -auto. +Proof. + intro H. + apply not_ap_imp_eq. + intro H0. + elim (integral_strext H0). + intros x H1 H2. + elim H; intros H3 H4. + inversion_clear H4. + generalize (H2 (contin_imp_inc _ _ _ _ contF x H1) (contin_imp_inc _ _ _ _ contG x H1)). + apply eq_imp_not_ap. + auto. Qed. Lemma integral_wd' : forall a' b' Hab' contF', a [=] a' -> b [=] b' -> Integral F contF [=] integral a' b' Hab' F contF'. -intros. -unfold integral in |- *. -apply Lim_wd'. -intro; simpl in |- *. -unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. -apply Sumx_wd; intros; apply mult_wd. -apply pfwdef; simpl in |- *; algebra. -simpl in |- *. -repeat first - [ apply cg_minus_wd - | apply bin_op_wd_unfolded - | apply mult_wd - | apply div_wd ]; algebra. +Proof. + intros. + unfold integral in |- *. + apply Lim_wd'. + intro; simpl in |- *. + unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. + apply Sumx_wd; intros; apply mult_wd. + apply pfwdef; simpl in |- *; algebra. + simpl in |- *. + repeat first [ apply cg_minus_wd | apply bin_op_wd_unfolded | apply mult_wd + | apply div_wd ]; algebra. Qed. End Well_Definedness. @@ -532,22 +471,20 @@ The integral is a linear and monotonous function; in order to prove these facts *) Lemma integral_one : forall H, Integral ( [-C-] One) H [=] b[-]a. -intro. -unfold integral in |- *. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply Lim_const. -apply Lim_wd'. -intro; simpl in |- *. -unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. -eapply eq_transitive_unfolded. -apply - Mengolli_Sum - with - (f := fun (i : nat) (Hi : i <= S n) => Even_Partition Hab _ (O_S n) i Hi). -red in |- *; intros. -apply prf1; auto. -intros; simpl in |- *; rational. -apply cg_minus_wd; [ apply finish | apply start ]. +Proof. + intro. + unfold integral in |- *. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply Lim_const. + apply Lim_wd'. + intro; simpl in |- *. + unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. + eapply eq_transitive_unfolded. + apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= S n) => Even_Partition Hab _ (O_S n) i Hi). + red in |- *; intros. + apply prf1; auto. + intros; simpl in |- *; rational. + apply cg_minus_wd; [ apply finish | apply start ]. Qed. Variables F G : PartIR. @@ -555,57 +492,59 @@ Hypothesis contF : Continuous_I Hab F. Hypothesis contG : Continuous_I Hab G. Lemma integral_comm_scal : forall (c : IR) Hf', Integral (c{**}F) Hf' [=] c[*]Integral F contF. -intros. -apply eq_transitive_unfolded with (Lim (Cauchy_const c) [*]Integral F contF); - unfold integral in |- *. -eapply eq_transitive_unfolded. -2: apply Lim_mult. -apply Lim_wd'; intro; simpl in |- *. -unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. -eapply eq_transitive_unfolded. -2: apply Sumx_comm_scal'. -apply Sumx_wd; intros; simpl in |- *; rational. -apply mult_wdl. -apply eq_symmetric_unfolded; apply Lim_const. +Proof. + intros. + apply eq_transitive_unfolded with (Lim (Cauchy_const c) [*]Integral F contF); + unfold integral in |- *. + eapply eq_transitive_unfolded. + 2: apply Lim_mult. + apply Lim_wd'; intro; simpl in |- *. + unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. + eapply eq_transitive_unfolded. + 2: apply Sumx_comm_scal'. + apply Sumx_wd; intros; simpl in |- *; rational. + apply mult_wdl. + apply eq_symmetric_unfolded; apply Lim_const. Qed. Lemma integral_plus : forall Hfg, Integral (F{+}G) Hfg [=] Integral F contF[+]Integral G contG. -intros. -unfold integral in |- *. -eapply eq_transitive_unfolded. -2: apply Lim_plus. -apply Lim_wd'; intro; simpl in |- *. -unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply Sumx_plus_Sumx. -apply Sumx_wd; intros; simpl in |- *; rational. +Proof. + intros. + unfold integral in |- *. + eapply eq_transitive_unfolded. + 2: apply Lim_plus. + apply Lim_wd'; intro; simpl in |- *. + unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply Sumx_plus_Sumx. + apply Sumx_wd; intros; simpl in |- *; rational. Qed. Transparent Even_Partition. Lemma integral_empty : a [=] b -> Integral F contF [=] Zero. -intros. -unfold integral in |- *. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply Lim_const. -apply Lim_wd'. -intros; simpl in |- *. -unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. -apply - eq_transitive_unfolded with (Sumx (fun (i : nat) (H : i < S n) => ZeroR)). -apply Sumx_wd; intros; simpl in |- *. -eapply eq_transitive_unfolded. -apply dist_2a. -apply x_minus_x. -apply mult_wdr. -apply bin_op_wd_unfolded. -algebra. -astepl (nring (S i) [*] (b[-]b[/] _[//]nring_ap_zero' _ _ (O_S n))). -astepr (nring i[*] (b[-]b[/] _[//]nring_ap_zero' _ _ (O_S n))). -rational. -eapply eq_transitive_unfolded. -apply sumx_const. -algebra. +Proof. + intros. + unfold integral in |- *. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply Lim_const. + apply Lim_wd'. + intros; simpl in |- *. + unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. + apply eq_transitive_unfolded with (Sumx (fun (i : nat) (H : i < S n) => ZeroR)). + apply Sumx_wd; intros; simpl in |- *. + eapply eq_transitive_unfolded. + apply dist_2a. + apply x_minus_x. + apply mult_wdr. + apply bin_op_wd_unfolded. + algebra. + astepl (nring (S i) [*] (b[-]b[/] _[//]nring_ap_zero' _ _ (O_S n))). + astepr (nring i[*] (b[-]b[/] _[//]nring_ap_zero' _ _ (O_S n))). + rational. + eapply eq_transitive_unfolded. + apply sumx_const. + algebra. Qed. End Linearity_and_Monotonicity. @@ -629,30 +568,32 @@ Let h := alpha{**}F{+}beta{**}G. Hypothesis contH : Continuous_I Hab h. Lemma linear_integral : Integral h contH [=] alpha[*]Integral F contF[+]beta[*]Integral G contG. -assert (H : Continuous_I Hab (alpha{**}F)). Contin. -assert (H0 : Continuous_I Hab (beta{**}G)). Contin. -apply eq_transitive_unfolded with (Integral _ H[+]Integral _ H0). -unfold h in |- *. -apply integral_plus. -apply bin_op_wd_unfolded; apply integral_comm_scal. +Proof. + assert (H : Continuous_I Hab (alpha{**}F)). Contin. + assert (H0 : Continuous_I Hab (beta{**}G)). Contin. + apply eq_transitive_unfolded with (Integral _ H[+]Integral _ H0). + unfold h in |- *. + apply integral_plus. + apply bin_op_wd_unfolded; apply integral_comm_scal. Qed. Lemma monotonous_integral : (forall x, I x -> forall Hx Hx', F x Hx [<=] G x Hx') -> Integral F contF [<=] Integral G contG. -intros. -unfold integral in |- *. -apply Lim_leEq_Lim. -intro n; simpl in |- *. -unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. -apply Sumx_resp_leEq; intros i Hi. -apply mult_resp_leEq_rht. -apply H. -Opaque nring. -unfold I, Partition_imp_points in |- *; simpl in |- *. -apply compact_partition_lemma; auto with arith. -apply leEq_transitive with (AntiMesh (Even_Partition Hab (S n) (O_S n))). -apply AntiMesh_nonneg. -apply AntiMesh_lemma. +Proof. + intros. + unfold integral in |- *. + apply Lim_leEq_Lim. + intro n; simpl in |- *. + unfold integral_seq, Even_Partition_Sum, Partition_Sum in |- *. + apply Sumx_resp_leEq; intros i Hi. + apply mult_resp_leEq_rht. + apply H. + Opaque nring. + unfold I, Partition_imp_points in |- *; simpl in |- *. + apply compact_partition_lemma; auto with arith. + apply leEq_transitive with (AntiMesh (Even_Partition Hab (S n) (O_S n))). + apply AntiMesh_nonneg. + apply AntiMesh_lemma. Qed. Transparent nring. @@ -670,34 +611,37 @@ As corollaries we can calculate integrals of group operations applied to functio *) Lemma integral_const : forall c H, Integral ( [-C-]c)H [=] c[*] (b[-]a). -intros. -assert (H0 : Continuous_I Hab (c{**}[-C-]One)). Contin. -apply eq_transitive_unfolded with (Integral _ H0). -apply integral_wd; FEQ. -eapply eq_transitive_unfolded. -apply integral_comm_scal with (contF := Continuous_I_const a b Hab One). -apply mult_wdr. -apply integral_one. +Proof. + intros. + assert (H0 : Continuous_I Hab (c{**}[-C-]One)). Contin. + apply eq_transitive_unfolded with (Integral _ H0). + apply integral_wd; FEQ. + eapply eq_transitive_unfolded. + apply integral_comm_scal with (contF := Continuous_I_const a b Hab One). + apply mult_wdr. + apply integral_one. Qed. Lemma integral_minus : forall H, Integral (F{-}G) H [=] Integral F contF[-]Integral G contG. -intro. -assert (H0 : Continuous_I Hab (One{**}F{+}[--]One{**}G)). Contin. -apply eq_transitive_unfolded with (Integral _ H0). -apply integral_wd; FEQ. -eapply eq_transitive_unfolded. -apply linear_integral with (contF := contF) (contG := contG). -rational. +Proof. + intro. + assert (H0 : Continuous_I Hab (One{**}F{+}[--]One{**}G)). Contin. + apply eq_transitive_unfolded with (Integral _ H0). + apply integral_wd; FEQ. + eapply eq_transitive_unfolded. + apply linear_integral with (contF := contF) (contG := contG). + rational. Qed. Lemma integral_inv : forall H, Integral ( {--}F) H [=] [--] (Integral F contF). -intro. -assert (H0 : Continuous_I Hab (Zero{**}F{+}[--]One{**}F)). Contin. -apply eq_transitive_unfolded with (Integral _ H0). -apply integral_wd; FEQ. -eapply eq_transitive_unfolded. -apply linear_integral with (contF := contF) (contG := contF). -rational. +Proof. + intro. + assert (H0 : Continuous_I Hab (Zero{**}F{+}[--]One{**}F)). Contin. + apply eq_transitive_unfolded with (Integral _ H0). + apply integral_wd; FEQ. + eapply eq_transitive_unfolded. + apply linear_integral with (contF := contF) (contG := contF). + rational. Qed. (** @@ -705,37 +649,40 @@ We can also bound integrals by bounding the integrated functions. *) Lemma lb_integral : forall c, (forall x, I x -> forall Hx, c [<=] F x Hx) -> c[*] (b[-]a) [<=] Integral F contF. -intros. -apply leEq_wdl with (Integral _ (Continuous_I_const a b Hab c)). -2: apply integral_const. -apply monotonous_integral. -simpl in |- *; auto. +Proof. + intros. + apply leEq_wdl with (Integral _ (Continuous_I_const a b Hab c)). + 2: apply integral_const. + apply monotonous_integral. + simpl in |- *; auto. Qed. Lemma ub_integral : forall c, (forall x, I x -> forall Hx, F x Hx [<=] c) -> Integral F contF [<=] c[*] (b[-]a). -intros. -apply leEq_wdr with (Integral _ (Continuous_I_const a b Hab c)). -2: apply integral_const. -apply monotonous_integral. -simpl in |- *; auto. +Proof. + intros. + apply leEq_wdr with (Integral _ (Continuous_I_const a b Hab c)). + 2: apply integral_const. + apply monotonous_integral. + simpl in |- *; auto. Qed. Lemma integral_leEq_norm : AbsIR (Integral F contF) [<=] Norm_Funct contF[*] (b[-]a). -simpl in |- *; unfold ABSIR in |- *. -apply Max_leEq. -apply ub_integral. -intros; eapply leEq_transitive. -apply leEq_AbsIR. -unfold I in |- *; apply norm_bnd_AbsIR; assumption. -astepr ( [--][--] (Norm_Funct contF[*] (b[-]a))). -astepr ( [--] ( [--] (Norm_Funct contF) [*] (b[-]a))). -apply inv_resp_leEq. -apply lb_integral. -intros; astepr ( [--][--] (Part F x Hx)). -apply inv_resp_leEq. -eapply leEq_transitive. -apply inv_leEq_AbsIR. -unfold I in |- *; apply norm_bnd_AbsIR; assumption. +Proof. + simpl in |- *; unfold ABSIR in |- *. + apply Max_leEq. + apply ub_integral. + intros; eapply leEq_transitive. + apply leEq_AbsIR. + unfold I in |- *; apply norm_bnd_AbsIR; assumption. + astepr ( [--][--] (Norm_Funct contF[*] (b[-]a))). + astepr ( [--] ( [--] (Norm_Funct contF) [*] (b[-]a))). + apply inv_resp_leEq. + apply lb_integral. + intros; astepr ( [--][--] (Part F x Hx)). + apply inv_resp_leEq. + eapply leEq_transitive. + apply inv_leEq_AbsIR. + unfold I in |- *; apply norm_bnd_AbsIR; assumption. Qed. End Corollaries. @@ -782,120 +729,130 @@ Variable Q : Partition Hcb m. (* begin hide *) Lemma partition_join_aux : forall i n m, n < i -> i <= S (n + m) -> i - S n <= m. -intros; omega. +Proof. + intros; omega. Qed. (* end hide *) Definition partition_join_fun : forall i, i <= S (n + m) -> IR. -intros. -elim (le_lt_dec i n); intros. -apply (P i a0). -cut (i - S n <= m); [ intro | apply partition_join_aux; assumption ]. -apply (Q _ H0). +Proof. + intros. + elim (le_lt_dec i n); intros. + apply (P i a0). + cut (i - S n <= m); [ intro | apply partition_join_aux; assumption ]. + apply (Q _ H0). Defined. (* begin hide *) Lemma pjf_1 : forall (i : nat) Hi Hi', partition_join_fun i Hi [=] P i Hi'. -intros; unfold partition_join_fun in |- *. -elim le_lt_dec; intro; simpl in |- *. -apply prf1; auto. -elimtype False; apply le_not_lt with i n; auto. +Proof. + intros; unfold partition_join_fun in |- *. + elim le_lt_dec; intro; simpl in |- *. + apply prf1; auto. + elimtype False; apply le_not_lt with i n; auto. Qed. Lemma pjf_2 : forall (i : nat) Hi, i = n -> partition_join_fun i Hi [=] c. -intros; unfold partition_join_fun in |- *. -generalize Hi; clear Hi. -rewrite H; clear H; intro. -elim le_lt_dec; intro; simpl in |- *. -apply finish. -elimtype False; apply lt_irrefl with n; auto. +Proof. + intros; unfold partition_join_fun in |- *. + generalize Hi; clear Hi. + rewrite H; clear H; intro. + elim le_lt_dec; intro; simpl in |- *. + apply finish. + elimtype False; apply lt_irrefl with n; auto. Qed. Lemma pjf_2' : forall (i : nat) Hi, i = S n -> partition_join_fun i Hi [=] c. -intros; unfold partition_join_fun in |- *. -generalize Hi; clear Hi. -rewrite H; clear H; intro. -elim le_lt_dec; intro; simpl in |- *. -elimtype False; apply (le_Sn_n _ a0). -cut (forall H, Q (n - n) H [=] c); auto. -cut (n - n = 0); [ intro | auto with arith ]. -rewrite H; intros; apply start. +Proof. + intros; unfold partition_join_fun in |- *. + generalize Hi; clear Hi. + rewrite H; clear H; intro. + elim le_lt_dec; intro; simpl in |- *. + elimtype False; apply (le_Sn_n _ a0). + cut (forall H, Q (n - n) H [=] c); auto. + cut (n - n = 0); [ intro | auto with arith ]. + rewrite H; intros; apply start. Qed. Lemma pjf_3 : forall (i j : nat) Hi Hj, n < i -> j = i - S n -> partition_join_fun i Hi [=] Q j Hj. -intros; unfold partition_join_fun in |- *. -generalize Hj; rewrite H0; clear Hj; intros. -elim le_lt_dec; intro; simpl in |- *. -elimtype False; apply le_not_lt with i n; auto. -apply prf1; auto. +Proof. + intros; unfold partition_join_fun in |- *. + generalize Hj; rewrite H0; clear Hj; intros. + elim le_lt_dec; intro; simpl in |- *. + elimtype False; apply le_not_lt with i n; auto. + apply prf1; auto. Qed. Lemma partition_join_prf1 : forall i j : nat, i = j -> forall Hi Hj, partition_join_fun i Hi [=] partition_join_fun j Hj. -intros. -unfold partition_join_fun in |- *. -elim (le_lt_dec i n); elim (le_lt_dec j n); intros; simpl in |- *. -apply prf1; auto. -elimtype False; apply le_not_lt with i n. -assumption. -rewrite H; assumption. -elimtype False; apply le_not_lt with j n. -assumption. -rewrite <- H; assumption. -apply prf1; auto. +Proof. + intros. + unfold partition_join_fun in |- *. + elim (le_lt_dec i n); elim (le_lt_dec j n); intros; simpl in |- *. + apply prf1; auto. + elimtype False; apply le_not_lt with i n. + assumption. + rewrite H; assumption. + elimtype False; apply le_not_lt with j n. + assumption. + rewrite <- H; assumption. + apply prf1; auto. Qed. Lemma partition_join_prf2 : forall (i : nat) H H', partition_join_fun i H [<=] partition_join_fun (S i) H'. -intros. -unfold partition_join_fun in |- *. -elim (le_lt_dec i n); elim (le_lt_dec (S i) n); intros; simpl in |- *. -apply prf2. -cut (n = i); [ intro | apply le_antisym; auto with arith ]. -change (P i a0 [<=] Q (S i - S n) (partition_join_aux _ _ _ b0 H')) in |- *. -generalize H' a0 b0; clear H' a0 b0. -rewrite <- H0; intros. -apply eq_imp_leEq. -apply eq_transitive_unfolded with c. -apply finish. -apply eq_transitive_unfolded with (Q 0 (le_O_n _)). -apply eq_symmetric_unfolded; apply start. -apply prf1; auto with arith. -elimtype False; apply le_not_lt with n i; auto with arith. -cut (i - n = S (i - S n)); [ intro | omega ]. -cut (S (i - S n) <= m); [ intro | omega ]. -apply leEq_wdr with (Q _ H1). -apply prf2. -apply prf1; auto. +Proof. + intros. + unfold partition_join_fun in |- *. + elim (le_lt_dec i n); elim (le_lt_dec (S i) n); intros; simpl in |- *. + apply prf2. + cut (n = i); [ intro | apply le_antisym; auto with arith ]. + change (P i a0 [<=] Q (S i - S n) (partition_join_aux _ _ _ b0 H')) in |- *. + generalize H' a0 b0; clear H' a0 b0. + rewrite <- H0; intros. + apply eq_imp_leEq. + apply eq_transitive_unfolded with c. + apply finish. + apply eq_transitive_unfolded with (Q 0 (le_O_n _)). + apply eq_symmetric_unfolded; apply start. + apply prf1; auto with arith. + elimtype False; apply le_not_lt with n i; auto with arith. + cut (i - n = S (i - S n)); [ intro | omega ]. + cut (S (i - S n) <= m); [ intro | omega ]. + apply leEq_wdr with (Q _ H1). + apply prf2. + apply prf1; auto. Qed. Lemma partition_join_start : forall H, partition_join_fun 0 H [=] a. -intro. -unfold partition_join_fun in |- *. -elim (le_lt_dec 0 n); intro; simpl in |- *. -apply start. -elimtype False; apply (lt_n_O _ b0). +Proof. + intro. + unfold partition_join_fun in |- *. + elim (le_lt_dec 0 n); intro; simpl in |- *. + apply start. + elimtype False; apply (lt_n_O _ b0). Qed. Lemma partition_join_finish : forall H, partition_join_fun (S (n + m)) H [=] b. -intro. -unfold partition_join_fun in |- *. -elim le_lt_dec; intro; simpl in |- *. -elimtype False; apply le_Sn_n with n; apply le_trans with (S (n + m)); - auto with arith. -apply eq_transitive_unfolded with (Q _ (le_n _)). -apply prf1; auto with arith. -apply finish. +Proof. + intro. + unfold partition_join_fun in |- *. + elim le_lt_dec; intro; simpl in |- *. + elimtype False; apply le_Sn_n with n; apply le_trans with (S (n + m)); auto with arith. + apply eq_transitive_unfolded with (Q _ (le_n _)). + apply prf1; auto with arith. + apply finish. Qed. Definition partition_join : Partition Hab (S (n + m)). -intros. -apply Build_Partition with partition_join_fun. -exact partition_join_prf1. -exact partition_join_prf2. -exact partition_join_start. -exact partition_join_finish. +Proof. + intros. + apply Build_Partition with partition_join_fun. + exact partition_join_prf1. + exact partition_join_prf2. + exact partition_join_start. + exact partition_join_finish. Defined. (* end hide *) @@ -914,226 +871,225 @@ Hypothesis HfQ' : nat_less_n_fun fQ. (* begin hide *) Lemma partition_join_aux' : forall i n m, n < i -> i < S (n + m) -> i - S n < m. -intros; omega. +Proof. + intros; omega. Qed. (* end hide *) Definition partition_join_pts : forall i, i < S (n + m) -> IR. -intros. -elim (le_lt_dec i n); intros. -elim (le_lt_eq_dec _ _ a0); intro. -apply (fP i a1). -apply c. -cut (i - S n < m); [ intro | apply partition_join_aux'; assumption ]. -apply (fQ _ H0). +Proof. + intros. + elim (le_lt_dec i n); intros. + elim (le_lt_eq_dec _ _ a0); intro. + apply (fP i a1). + apply c. + cut (i - S n < m); [ intro | apply partition_join_aux'; assumption ]. + apply (fQ _ H0). Defined. (* begin hide *) Lemma pjp_1 : forall (i : nat) Hi Hi', partition_join_pts i Hi [=] fP i Hi'. -intros; unfold partition_join_pts in |- *. -elim le_lt_dec; intro; simpl in |- *. -elim le_lt_eq_dec; intro; simpl in |- *. -algebra. -elimtype False; rewrite b0 in Hi'; apply (lt_irrefl _ Hi'). -elimtype False; apply le_not_lt with i n; auto with arith. +Proof. + intros; unfold partition_join_pts in |- *. + elim le_lt_dec; intro; simpl in |- *. + elim le_lt_eq_dec; intro; simpl in |- *. + algebra. + elimtype False; rewrite b0 in Hi'; apply (lt_irrefl _ Hi'). + elimtype False; apply le_not_lt with i n; auto with arith. Qed. Lemma pjp_2 : forall (i : nat) Hi, i = n -> partition_join_pts i Hi [=] c. -intros; unfold partition_join_pts in |- *. -elim le_lt_dec; intro; simpl in |- *. -elim le_lt_eq_dec; intro; simpl in |- *. -elimtype False; rewrite H in a1; apply (lt_irrefl _ a1). -algebra. -elimtype False; rewrite H in b0; apply (lt_irrefl _ b0). +Proof. + intros; unfold partition_join_pts in |- *. + elim le_lt_dec; intro; simpl in |- *. + elim le_lt_eq_dec; intro; simpl in |- *. + elimtype False; rewrite H in a1; apply (lt_irrefl _ a1). + algebra. + elimtype False; rewrite H in b0; apply (lt_irrefl _ b0). Qed. Lemma pjp_3 : forall (i : nat) Hi Hi', n < i -> partition_join_pts i Hi [=] fQ (i - S n) Hi'. -intros; unfold partition_join_pts in |- *. -elim le_lt_dec; intro; simpl in |- *. -elimtype False; apply le_not_lt with i n; auto. -cut (fQ _ (partition_join_aux' _ _ _ b0 Hi) [=] fQ _ Hi'). -2: apply HfQ'; auto. -algebra. +Proof. + intros; unfold partition_join_pts in |- *. + elim le_lt_dec; intro; simpl in |- *. + elimtype False; apply le_not_lt with i n; auto. + cut (fQ _ (partition_join_aux' _ _ _ b0 Hi) [=] fQ _ Hi'). + 2: apply HfQ'; auto. + algebra. Qed. (* end hide *) Lemma partition_join_Pts_in_partition : Points_in_Partition partition_join partition_join_pts. -red in |- *; intros. -rename Hi into H. -cut - (forall H', - compact (partition_join i (lt_le_weak _ _ H)) (partition_join (S i) H) H' - (partition_join_pts i H)); auto. -unfold partition_join in |- *; simpl in |- *. -unfold partition_join_fun in |- *. -elim le_lt_dec; elim le_lt_dec; intros; simpl in |- *. -elim (le_lt_eq_dec _ _ a1); intro. -elim (HfP _ a2); intros. -apply compact_wd with (fP i a2). -2: apply eq_symmetric_unfolded; apply pjp_1. -split. -eapply leEq_wdl. -apply a3. -apply prf1; auto. -eapply leEq_wdr. -apply b0. -apply prf1; auto. -elimtype False; clear H'; rewrite b0 in a0; apply (le_Sn_n _ a0). -cut (i = n); [ intro | clear H'; apply le_antisym; auto with arith ]. -generalize H a0 b0 H'; clear H' a0 b0 H; rewrite H0; intros. -apply compact_wd with c. -2: apply eq_symmetric_unfolded; apply pjp_2; auto. -split. -apply eq_imp_leEq; apply finish. -apply eq_imp_leEq; apply eq_symmetric_unfolded. -cut (forall H, Q (n - n) H [=] c); auto. -cut (n - n = 0); [ intro | auto with arith ]. -rewrite H1; intros; apply start. -elimtype False; apply le_not_lt with n i; auto with arith. -elim (HfQ _ (partition_join_aux' _ _ _ b1 H)); intros. -apply compact_wd with (fQ _ (partition_join_aux' _ _ _ b1 H)). -2: apply eq_symmetric_unfolded; apply pjp_3; assumption. -split. -eapply leEq_wdl. -apply a0. -apply prf1; auto. -eapply leEq_wdr. -apply b2. -apply prf1; rewrite minus_Sn_m; auto with arith. +Proof. + red in |- *; intros. + rename Hi into H. + cut (forall H', compact (partition_join i (lt_le_weak _ _ H)) (partition_join (S i) H) H' + (partition_join_pts i H)); auto. + unfold partition_join in |- *; simpl in |- *. + unfold partition_join_fun in |- *. + elim le_lt_dec; elim le_lt_dec; intros; simpl in |- *. + elim (le_lt_eq_dec _ _ a1); intro. + elim (HfP _ a2); intros. + apply compact_wd with (fP i a2). + 2: apply eq_symmetric_unfolded; apply pjp_1. + split. + eapply leEq_wdl. + apply a3. + apply prf1; auto. + eapply leEq_wdr. + apply b0. + apply prf1; auto. + elimtype False; clear H'; rewrite b0 in a0; apply (le_Sn_n _ a0). + cut (i = n); [ intro | clear H'; apply le_antisym; auto with arith ]. + generalize H a0 b0 H'; clear H' a0 b0 H; rewrite H0; intros. + apply compact_wd with c. + 2: apply eq_symmetric_unfolded; apply pjp_2; auto. + split. + apply eq_imp_leEq; apply finish. + apply eq_imp_leEq; apply eq_symmetric_unfolded. + cut (forall H, Q (n - n) H [=] c); auto. + cut (n - n = 0); [ intro | auto with arith ]. + rewrite H1; intros; apply start. + elimtype False; apply le_not_lt with n i; auto with arith. + elim (HfQ _ (partition_join_aux' _ _ _ b1 H)); intros. + apply compact_wd with (fQ _ (partition_join_aux' _ _ _ b1 H)). + 2: apply eq_symmetric_unfolded; apply pjp_3; assumption. + split. + eapply leEq_wdl. + apply a0. + apply prf1; auto. + eapply leEq_wdr. + apply b2. + apply prf1; rewrite minus_Sn_m; auto with arith. Qed. Lemma partition_join_Pts_wd : forall i j, i = j -> forall Hi Hj, partition_join_pts i Hi [=] partition_join_pts j Hj. -intros. -elim (le_lt_dec i n); intro. -elim (le_lt_eq_dec _ _ a0); intro. -cut (j < n); [ intro | rewrite <- H; assumption ]. -eapply eq_transitive_unfolded. -apply pjp_1 with (Hi' := a1). -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply pjp_1 with (Hi' := H0). -apply HfP'; auto. -cut (j = n); [ intro | rewrite <- H; assumption ]. -eapply eq_transitive_unfolded. -apply pjp_2; auto. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply pjp_2; auto. -algebra. -cut (n < j); [ intro | rewrite <- H; assumption ]. -cut (i - S n < m); [ intro | omega ]. -cut (j - S n < m); [ intro | omega ]. -eapply eq_transitive_unfolded. -apply pjp_3 with (Hi' := H1); assumption. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply pjp_3 with (Hi' := H2); assumption. -apply HfQ'; auto. +Proof. + intros. + elim (le_lt_dec i n); intro. + elim (le_lt_eq_dec _ _ a0); intro. + cut (j < n); [ intro | rewrite <- H; assumption ]. + eapply eq_transitive_unfolded. + apply pjp_1 with (Hi' := a1). + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply pjp_1 with (Hi' := H0). + apply HfP'; auto. + cut (j = n); [ intro | rewrite <- H; assumption ]. + eapply eq_transitive_unfolded. + apply pjp_2; auto. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply pjp_2; auto. + algebra. + cut (n < j); [ intro | rewrite <- H; assumption ]. + cut (i - S n < m); [ intro | omega ]. + cut (j - S n < m); [ intro | omega ]. + eapply eq_transitive_unfolded. + apply pjp_3 with (Hi' := H1); assumption. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply pjp_3 with (Hi' := H2); assumption. + apply HfQ'; auto. Qed. Lemma partition_join_Sum_lemma : - Partition_Sum HfP (contin_imp_inc _ _ _ _ Hac') [+] Partition_Sum HfQ (contin_imp_inc _ _ _ _ Hcb') [=] + Partition_Sum HfP (contin_imp_inc _ _ _ _ Hac') [+] Partition_Sum HfQ (contin_imp_inc _ _ _ _ Hcb') [=] Partition_Sum partition_join_Pts_in_partition (contin_imp_inc _ _ _ _ Hab'). -unfold Partition_Sum in |- *; apply Sumx_weird_lemma. -auto with arith. -Opaque partition_join. -red in |- *; intros; apply mult_wd; algebra; apply cg_minus_wd; apply prf1; - auto. -red in |- *; intros; apply mult_wd; algebra; apply cg_minus_wd; apply prf1; - auto. -red in |- *; intros; apply mult_wd; try apply cg_minus_wd; try apply pfwdef; - algebra. -apply partition_join_Pts_wd; auto. -apply prf1; auto. -apply prf1; auto. -Transparent partition_join. -intros; apply mult_wd. -apply pfwdef; apply eq_symmetric_unfolded; apply pjp_1. -apply cg_minus_wd; simpl in |- *. -unfold partition_join_fun in |- *; elim le_lt_dec; simpl in |- *; intro; - [ apply prf1; auto - | elimtype False; apply le_not_lt with n i; auto with arith ]. -unfold partition_join_fun in |- *; elim le_lt_dec; simpl in |- *; intro; - [ apply prf1; auto - | elimtype False; apply le_not_lt with i n; auto with arith ]. -intros; apply mult_wd. -apply pfwdef. -cut (i = S (n + i) - S n); [ intro | omega ]. -generalize Hi; clear Hi; rewrite {1 2} H; intro. -apply eq_symmetric_unfolded; apply pjp_3; auto with arith. -apply cg_minus_wd; simpl in |- *. -Opaque minus. -unfold partition_join, partition_join_fun in |- *. -elim le_lt_dec; simpl in |- *; intro. -elimtype False; apply le_Sn_n with n; eapply le_trans. -2: apply a0. -auto with arith. -Transparent minus. -apply prf1; transitivity (S (n + i) - n); auto with arith. -Opaque minus. -unfold partition_join, partition_join_fun in |- *. -elim le_lt_dec; simpl in |- *; intro. -elimtype False; apply le_Sn_n with n; eapply le_trans. -2: apply a0. -auto with arith. -Transparent minus. -apply prf1; transitivity (n + i - n); auto with arith. -intro; apply x_mult_zero. -astepr (partition_join _ Hi[-]partition_join _ Hi). -apply cg_minus_wd. -algebra. -unfold partition_join in |- *; simpl in |- *. -apply eq_transitive_unfolded with c; unfold partition_join_fun in |- *; - elim le_lt_dec; simpl in |- *. -intro; apply finish. -intro; elimtype False; apply (lt_irrefl _ b0). -intro; elimtype False; apply (le_Sn_n _ a0). -intro; apply eq_symmetric_unfolded. -apply eq_transitive_unfolded with (Q _ (le_O_n _)). -apply prf1; auto with arith. -apply start. +Proof. + unfold Partition_Sum in |- *; apply Sumx_weird_lemma. + auto with arith. + Opaque partition_join. + red in |- *; intros; apply mult_wd; algebra; apply cg_minus_wd; apply prf1; auto. + red in |- *; intros; apply mult_wd; algebra; apply cg_minus_wd; apply prf1; auto. + red in |- *; intros; apply mult_wd; try apply cg_minus_wd; try apply pfwdef; algebra. + apply partition_join_Pts_wd; auto. + apply prf1; auto. + apply prf1; auto. + Transparent partition_join. + intros; apply mult_wd. + apply pfwdef; apply eq_symmetric_unfolded; apply pjp_1. + apply cg_minus_wd; simpl in |- *. + unfold partition_join_fun in |- *; elim le_lt_dec; simpl in |- *; intro; [ apply prf1; auto + | elimtype False; apply le_not_lt with n i; auto with arith ]. + unfold partition_join_fun in |- *; elim le_lt_dec; simpl in |- *; intro; [ apply prf1; auto + | elimtype False; apply le_not_lt with i n; auto with arith ]. + intros; apply mult_wd. + apply pfwdef. + cut (i = S (n + i) - S n); [ intro | omega ]. + generalize Hi; clear Hi; rewrite {1 2} H; intro. + apply eq_symmetric_unfolded; apply pjp_3; auto with arith. + apply cg_minus_wd; simpl in |- *. + Opaque minus. + unfold partition_join, partition_join_fun in |- *. + elim le_lt_dec; simpl in |- *; intro. + elimtype False; apply le_Sn_n with n; eapply le_trans. + 2: apply a0. + auto with arith. + Transparent minus. + apply prf1; transitivity (S (n + i) - n); auto with arith. + Opaque minus. + unfold partition_join, partition_join_fun in |- *. + elim le_lt_dec; simpl in |- *; intro. + elimtype False; apply le_Sn_n with n; eapply le_trans. + 2: apply a0. + auto with arith. + Transparent minus. + apply prf1; transitivity (n + i - n); auto with arith. + intro; apply x_mult_zero. + astepr (partition_join _ Hi[-]partition_join _ Hi). + apply cg_minus_wd. + algebra. + unfold partition_join in |- *; simpl in |- *. + apply eq_transitive_unfolded with c; unfold partition_join_fun in |- *; + elim le_lt_dec; simpl in |- *. + intro; apply finish. + intro; elimtype False; apply (lt_irrefl _ b0). + intro; elimtype False; apply (le_Sn_n _ a0). + intro; apply eq_symmetric_unfolded. + apply eq_transitive_unfolded with (Q _ (le_O_n _)). + apply prf1; auto with arith. + apply start. Qed. Lemma partition_join_mesh : Mesh partition_join [<=] Max (Mesh P) (Mesh Q). -unfold Mesh at 1 in |- *. -apply maxlist_leEq. -apply length_Part_Mesh_List. -apply lt_O_Sn. -intros x H. -elim (Part_Mesh_List_lemma _ _ _ _ _ _ H); intros i Hi. -elim Hi; clear Hi; intros Hi Hi'. -elim Hi'; clear Hi'; intros Hi' Hx. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply Hx. -unfold partition_join in |- *; simpl in |- *. -unfold partition_join_fun in |- *. -elim le_lt_dec; intro; simpl in |- *. -elim le_lt_dec; intro; simpl in |- *. -eapply leEq_transitive. -apply Mesh_lemma. -apply lft_leEq_Max. -elimtype False; apply le_not_lt with i n; auto with arith. -elim le_lt_dec; intro; simpl in |- *. -cut (i = n); [ intro | apply le_antisym; auto with arith ]. -generalize a0 b0 Hi'; clear Hx Hi Hi' a0 b0. -rewrite H0; intros. -apply leEq_wdl with ZeroR. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply Mesh_nonneg. -astepl (c[-]c). -apply eq_symmetric_unfolded; apply cg_minus_wd. -cut (forall H, Q (n - n) H [=] c); auto. -cut (n - n = 0); [ intro | auto with arith ]. -rewrite H1; intros; apply start. -apply finish. -cut (i - n = S (i - S n)); [ intro | omega ]. -cut - (forall H, - Q (i - n) H[-]Q _ (partition_join_aux _ _ _ b1 Hi) [<=] Max (Mesh P) (Mesh Q)); - auto. -rewrite H0; intros; eapply leEq_transitive. -apply Mesh_lemma. -apply rht_leEq_Max. +Proof. + unfold Mesh at 1 in |- *. + apply maxlist_leEq. + apply length_Part_Mesh_List. + apply lt_O_Sn. + intros x H. + elim (Part_Mesh_List_lemma _ _ _ _ _ _ H); intros i Hi. + elim Hi; clear Hi; intros Hi Hi'. + elim Hi'; clear Hi'; intros Hi' Hx. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Hx. + unfold partition_join in |- *; simpl in |- *. + unfold partition_join_fun in |- *. + elim le_lt_dec; intro; simpl in |- *. + elim le_lt_dec; intro; simpl in |- *. + eapply leEq_transitive. + apply Mesh_lemma. + apply lft_leEq_Max. + elimtype False; apply le_not_lt with i n; auto with arith. + elim le_lt_dec; intro; simpl in |- *. + cut (i = n); [ intro | apply le_antisym; auto with arith ]. + generalize a0 b0 Hi'; clear Hx Hi Hi' a0 b0. + rewrite H0; intros. + apply leEq_wdl with ZeroR. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply Mesh_nonneg. + astepl (c[-]c). + apply eq_symmetric_unfolded; apply cg_minus_wd. + cut (forall H, Q (n - n) H [=] c); auto. + cut (n - n = 0); [ intro | auto with arith ]. + rewrite H1; intros; apply start. + apply finish. + cut (i - n = S (i - S n)); [ intro | omega ]. + cut (forall H, Q (i - n) H[-]Q _ (partition_join_aux _ _ _ b1 Hi) [<=] Max (Mesh P) (Mesh Q)); auto. + rewrite H0; intros; eapply leEq_transitive. + apply Mesh_lemma. + apply rht_leEq_Max. Qed. End Partition_Join. @@ -1143,153 +1099,132 @@ With these results in mind, the following is a trivial consequence: *) Lemma integral_plus_integral : integral _ _ Hac _ Hac'[+]integral _ _ Hcb _ Hcb' [=] Integral _ Hab'. -unfold integral at 1 2 in |- *. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply Lim_plus. -apply cg_inv_unique_2. -apply AbsIR_approach_zero. -intros e' He'. -set (e := e'[/] _[//]max_one_ap_zero (b[-]a)) in *. -cut (Zero [<] e). -intro He. -set (d := proj1_sig2T _ _ _ (contin_prop _ _ _ _ Hab' e He)) in *. -generalize (proj2b_sig2T _ _ _ (contin_prop _ _ _ _ Hab' e He)); - generalize (proj2a_sig2T _ _ _ (contin_prop _ _ _ _ Hab' e He)). -fold d in |- *; intros Hd Haux. -clear Haux. -apply leEq_transitive with (e[*] (b[-]a)). -elim (Archimedes (b[-]c[/] _[//]pos_ap_zero _ _ Hd)); intros n1 Hn1. -elim (Archimedes (c[-]a[/] _[//]pos_ap_zero _ _ Hd)); intros n2 Hn2. -apply - leEq_wdl - with - (Lim - (Build_CauchySeq _ _ - (Cauchy_abs - (Build_CauchySeq _ _ - (Cauchy_plus - (Build_CauchySeq _ _ - (Cauchy_plus - (Build_CauchySeq _ _ - (Cauchy_Darboux_Seq _ _ Hac _ Hac')) - (Build_CauchySeq _ _ - (Cauchy_Darboux_Seq _ _ Hcb _ Hcb')))) - (Cauchy_const [--] (Integral _ Hab'))))))). -apply str_seq_leEq_so_Lim_leEq. -set (p := max n1 n2) in *; exists p; intros. -astepl - (AbsIR - (integral_seq _ _ Hac _ Hac' i[+]integral_seq _ _ Hcb _ Hcb' i[-] - Integral _ Hab')). -unfold integral_seq, Even_Partition_Sum in |- *. -set (EP1 := Even_Partition Hac (S i) (O_S i)) in *. -set (EP2 := Even_Partition Hcb (S i) (O_S i)) in *. -set (P := partition_join _ _ EP1 EP2) in *. -cut (nat_less_n_fun (Partition_imp_points _ _ _ _ EP1)); - [ intro | apply Partition_imp_points_2 ]. -cut (nat_less_n_fun (Partition_imp_points _ _ _ _ EP2)); - [ intro | apply Partition_imp_points_2 ]. -apply - leEq_wdl - with - (AbsIR - (Partition_Sum - (partition_join_Pts_in_partition _ _ _ _ _ - (Partition_imp_points_1 _ _ _ _ EP1) H0 _ - (Partition_imp_points_1 _ _ _ _ EP2) H1) - (contin_imp_inc _ _ _ _ Hab') [-]Integral _ Hab')). -apply partition_Sum_conv_integral with He; fold d in |- *. -eapply leEq_less_trans. -apply partition_join_mesh. -apply Max_less. -unfold EP1 in |- *; eapply less_wdl. -2: apply eq_symmetric_unfolded; apply even_partition_Mesh. -apply swap_div with (pos_ap_zero _ _ Hd). -apply pos_nring_S. -assumption. -apply leEq_less_trans with (nring (R:=IR) n2). -assumption. -apply nring_less. -apply le_lt_trans with p. -unfold p in |- *; apply le_max_r. -auto with arith. -unfold EP2 in |- *; eapply less_wdl. -2: apply eq_symmetric_unfolded; apply even_partition_Mesh. -apply swap_div with (pos_ap_zero _ _ Hd). -apply pos_nring_S. -assumption. -apply leEq_less_trans with (nring (R:=IR) n1). -assumption. -apply nring_less. -apply le_lt_trans with p. -unfold p in |- *; apply le_max_l. -auto with arith. -red in |- *; do 3 intro. -rewrite H2; clear H2; intros. -apply partition_join_Pts_wd; auto. -apply AbsIR_wd. -apply cg_minus_wd. -2: algebra. -apply eq_symmetric_unfolded. -unfold Partition_Sum in |- *; apply Sumx_weird_lemma. -auto. -red in |- *; do 3 intro. -rewrite H2; clear H2; intros; algebra. -red in |- *; do 3 intro. -rewrite H2; clear H2; intros; algebra. -red in |- *; do 3 intro. -rewrite H2; clear H2; intros; algebra. -Opaque Even_Partition. -intros; apply mult_wd. -apply pfwdef; unfold partition_join_pts in |- *. -elim le_lt_dec; intro; simpl in |- *. -elim le_lt_eq_dec; intro; simpl in |- *. -apply Partition_imp_points_2; auto. -elimtype False; rewrite b0 in Hi; apply (lt_irrefl _ Hi). -elimtype False; apply le_not_lt with i0 (S i); auto with arith. -apply cg_minus_wd; simpl in |- *. -apply eq_symmetric_unfolded; apply pjf_1. -apply eq_symmetric_unfolded; apply pjf_1. -intros; apply mult_wd. -apply pfwdef; unfold Partition_imp_points in |- *. -unfold partition_join_pts in |- *. -elim le_lt_dec; intro; simpl in |- *. -elim le_lt_eq_dec; intro; simpl in |- *. -elimtype False; apply le_Sn_n with (S i); eapply le_trans. -2: apply a0. -auto with arith. -elimtype False; apply lt_irrefl with (S i); pattern (S i) at 2 in |- *; - rewrite <- b0; auto with arith. -unfold Partition_imp_points in |- *; apply prf1. -auto with arith. -apply cg_minus_wd; simpl in |- *. -apply eq_symmetric_unfolded; apply pjf_3; [ auto with arith | omega ]. -apply eq_symmetric_unfolded; apply pjf_3; auto with arith. -intro; apply x_mult_zero. -astepr (c[-]c). -apply cg_minus_wd. -simpl in |- *; apply pjf_2'; auto. -simpl in |- *; apply pjf_2; auto. -eapply eq_transitive_unfolded. -apply Lim_abs. -apply AbsIR_wd. -unfold cg_minus in |- *. -eapply eq_transitive_unfolded. -apply Lim_plus. -apply bin_op_wd_unfolded. -algebra. -apply eq_symmetric_unfolded; apply Lim_const. -unfold e in |- *. -rstepl (e'[*] (b[-]a) [/] _[//]max_one_ap_zero (b[-]a)). -apply shift_div_leEq. -apply pos_max_one. -apply mult_resp_leEq_lft. -apply lft_leEq_Max. -apply less_leEq; assumption. -unfold e in |- *. -apply div_resp_pos. -apply pos_max_one. -assumption. +Proof. + unfold integral at 1 2 in |- *. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply Lim_plus. + apply cg_inv_unique_2. + apply AbsIR_approach_zero. + intros e' He'. + set (e := e'[/] _[//]max_one_ap_zero (b[-]a)) in *. + cut (Zero [<] e). + intro He. + set (d := proj1_sig2T _ _ _ (contin_prop _ _ _ _ Hab' e He)) in *. + generalize (proj2b_sig2T _ _ _ (contin_prop _ _ _ _ Hab' e He)); + generalize (proj2a_sig2T _ _ _ (contin_prop _ _ _ _ Hab' e He)). + fold d in |- *; intros Hd Haux. + clear Haux. + apply leEq_transitive with (e[*] (b[-]a)). + elim (Archimedes (b[-]c[/] _[//]pos_ap_zero _ _ Hd)); intros n1 Hn1. + elim (Archimedes (c[-]a[/] _[//]pos_ap_zero _ _ Hd)); intros n2 Hn2. + apply leEq_wdl with (Lim (Build_CauchySeq _ _ (Cauchy_abs (Build_CauchySeq _ _ (Cauchy_plus + (Build_CauchySeq _ _ (Cauchy_plus (Build_CauchySeq _ _ (Cauchy_Darboux_Seq _ _ Hac _ Hac')) + (Build_CauchySeq _ _ (Cauchy_Darboux_Seq _ _ Hcb _ Hcb')))) + (Cauchy_const [--] (Integral _ Hab'))))))). + apply str_seq_leEq_so_Lim_leEq. + set (p := max n1 n2) in *; exists p; intros. + astepl (AbsIR (integral_seq _ _ Hac _ Hac' i[+]integral_seq _ _ Hcb _ Hcb' i[-] Integral _ Hab')). + unfold integral_seq, Even_Partition_Sum in |- *. + set (EP1 := Even_Partition Hac (S i) (O_S i)) in *. + set (EP2 := Even_Partition Hcb (S i) (O_S i)) in *. + set (P := partition_join _ _ EP1 EP2) in *. + cut (nat_less_n_fun (Partition_imp_points _ _ _ _ EP1)); [ intro | apply Partition_imp_points_2 ]. + cut (nat_less_n_fun (Partition_imp_points _ _ _ _ EP2)); [ intro | apply Partition_imp_points_2 ]. + apply leEq_wdl with (AbsIR (Partition_Sum (partition_join_Pts_in_partition _ _ _ _ _ + (Partition_imp_points_1 _ _ _ _ EP1) H0 _ (Partition_imp_points_1 _ _ _ _ EP2) H1) + (contin_imp_inc _ _ _ _ Hab') [-]Integral _ Hab')). + apply partition_Sum_conv_integral with He; fold d in |- *. + eapply leEq_less_trans. + apply partition_join_mesh. + apply Max_less. + unfold EP1 in |- *; eapply less_wdl. + 2: apply eq_symmetric_unfolded; apply even_partition_Mesh. + apply swap_div with (pos_ap_zero _ _ Hd). + apply pos_nring_S. + assumption. + apply leEq_less_trans with (nring (R:=IR) n2). + assumption. + apply nring_less. + apply le_lt_trans with p. + unfold p in |- *; apply le_max_r. + auto with arith. + unfold EP2 in |- *; eapply less_wdl. + 2: apply eq_symmetric_unfolded; apply even_partition_Mesh. + apply swap_div with (pos_ap_zero _ _ Hd). + apply pos_nring_S. + assumption. + apply leEq_less_trans with (nring (R:=IR) n1). + assumption. + apply nring_less. + apply le_lt_trans with p. + unfold p in |- *; apply le_max_l. + auto with arith. + red in |- *; do 3 intro. + rewrite H2; clear H2; intros. + apply partition_join_Pts_wd; auto. + apply AbsIR_wd. + apply cg_minus_wd. + 2: algebra. + apply eq_symmetric_unfolded. + unfold Partition_Sum in |- *; apply Sumx_weird_lemma. + auto. + red in |- *; do 3 intro. + rewrite H2; clear H2; intros; algebra. + red in |- *; do 3 intro. + rewrite H2; clear H2; intros; algebra. + red in |- *; do 3 intro. + rewrite H2; clear H2; intros; algebra. + Opaque Even_Partition. + intros; apply mult_wd. + apply pfwdef; unfold partition_join_pts in |- *. + elim le_lt_dec; intro; simpl in |- *. + elim le_lt_eq_dec; intro; simpl in |- *. + apply Partition_imp_points_2; auto. + elimtype False; rewrite b0 in Hi; apply (lt_irrefl _ Hi). + elimtype False; apply le_not_lt with i0 (S i); auto with arith. + apply cg_minus_wd; simpl in |- *. + apply eq_symmetric_unfolded; apply pjf_1. + apply eq_symmetric_unfolded; apply pjf_1. + intros; apply mult_wd. + apply pfwdef; unfold Partition_imp_points in |- *. + unfold partition_join_pts in |- *. + elim le_lt_dec; intro; simpl in |- *. + elim le_lt_eq_dec; intro; simpl in |- *. + elimtype False; apply le_Sn_n with (S i); eapply le_trans. + 2: apply a0. + auto with arith. + elimtype False; apply lt_irrefl with (S i); pattern (S i) at 2 in |- *; + rewrite <- b0; auto with arith. + unfold Partition_imp_points in |- *; apply prf1. + auto with arith. + apply cg_minus_wd; simpl in |- *. + apply eq_symmetric_unfolded; apply pjf_3; [ auto with arith | omega ]. + apply eq_symmetric_unfolded; apply pjf_3; auto with arith. + intro; apply x_mult_zero. + astepr (c[-]c). + apply cg_minus_wd. + simpl in |- *; apply pjf_2'; auto. + simpl in |- *; apply pjf_2; auto. + eapply eq_transitive_unfolded. + apply Lim_abs. + apply AbsIR_wd. + unfold cg_minus in |- *. + eapply eq_transitive_unfolded. + apply Lim_plus. + apply bin_op_wd_unfolded. + algebra. + apply eq_symmetric_unfolded; apply Lim_const. + unfold e in |- *. + rstepl (e'[*] (b[-]a) [/] _[//]max_one_ap_zero (b[-]a)). + apply shift_div_leEq. + apply pos_max_one. + apply mult_resp_leEq_lft. + apply lft_leEq_Max. + apply less_leEq; assumption. + unfold e in |- *. + apply div_resp_pos. + apply pos_max_one. + assumption. Qed. End Integral_Sum. @@ -1305,268 +1240,257 @@ The following are simple consequences of this result and of previous ones. Lemma integral_less_norm : forall a b Hab (F : PartIR) contF, let N := Norm_Funct contF in a [<] b -> forall x, Compact Hab x -> forall Hx, AbsIR (F x Hx) [<] N -> AbsIR (integral a b Hab F contF) [<] N[*] (b[-]a). -(* begin hide *) -intros a b Hab F contF N Hless x H Hx H0. -set (e := (N[-]AbsIR (F x Hx)) [/]TwoNZ) in *. -cut (Zero [<] e); intros. -2: unfold e in |- *; apply pos_div_two; apply shift_less_minus. -2: astepl (AbsIR (F x Hx)); auto. -elim (contin_prop _ _ _ _ contF e); auto. -intros d H2 H3. -set (mid1 := Max a (x[-]d)) in *. -set (mid2 := Min b (x[+]d)) in *. -cut (a [<=] mid1); [ intro leEq1 | unfold mid1 in |- *; apply lft_leEq_Max ]. -cut (mid1 [<=] mid2); - [ intro leEq2 - | unfold mid1, mid2 in |- *; inversion_clear H; apply leEq_transitive with x ]. -2: apply Max_leEq; auto. -2: apply less_leEq; apply shift_minus_less. -2: apply shift_less_plus'; astepl ZeroR; auto. -2: apply leEq_Min; auto. -2: apply less_leEq; apply shift_less_plus'. -2: astepl ZeroR; auto. -cut (mid2 [<=] b); [ intro leEq3 | unfold mid2 in |- *; apply Min_leEq_lft ]. -cut (Continuous_I leEq1 F). -cut (Continuous_I leEq2 F). -cut (Continuous_I leEq3 F). -intros cont3 cont2 cont1. -cut (Continuous_I (leEq_transitive _ _ _ _ leEq1 leEq2) F). intro H4. -apply - less_wdl - with - (AbsIR - (integral _ _ _ _ cont1[+]integral _ _ _ _ cont2[+] - integral _ _ _ _ cont3)). -2: apply AbsIR_wd. -2: apply - eq_transitive_unfolded - with (integral _ _ _ _ H4[+]integral _ _ _ _ cont3). -2: apply bin_op_wd_unfolded. -2: apply integral_plus_integral. -2: algebra. -2: apply integral_plus_integral. -rstepr (N[*] (mid1[-]a) [+]N[*] (mid2[-]mid1) [+]N[*] (b[-]mid2)). -eapply leEq_less_trans. -apply triangle_IR. -apply plus_resp_less_leEq. -eapply leEq_less_trans. -apply triangle_IR. -apply plus_resp_leEq_less. -eapply leEq_transitive. -apply integral_leEq_norm. -unfold N in |- *; apply mult_resp_leEq_rht. -2: apply shift_leEq_minus; astepl a; auto. -apply included_imp_norm_leEq. -apply included_compact. -apply compact_inc_lft. -split. -unfold mid1 in |- *; apply lft_leEq_Max. -apply leEq_transitive with mid2; auto. -2: eapply leEq_transitive. -2: apply integral_leEq_norm. -2: unfold N in |- *; apply mult_resp_leEq_rht. -3: apply shift_leEq_minus; astepl mid2; auto. -2: apply included_imp_norm_leEq. -2: apply included_compact. -2: split. -2: apply leEq_transitive with mid1; auto. -2: auto. -2: apply compact_inc_rht. -eapply leEq_less_trans. -apply integral_leEq_norm. -apply mult_resp_less. -apply leEq_less_trans with (N[-]e). -2: apply shift_minus_less; apply shift_less_plus'. -2: astepl ZeroR; auto. -apply leEq_Norm_Funct; intros y Hy Hy'. -apply leEq_wdr with (AbsIR (F x Hx) [+]e). -2: unfold e in |- *; rational. -apply AbsIR_bnd_AbsIR. -apply H3; auto. -cut (included (Compact leEq2) (Compact Hab)); auto. -apply included_compact. -split; auto. -apply leEq_transitive with mid2; auto. -split; auto. -apply leEq_transitive with mid1; auto. -cut (x[-]d [<=] x[+]d). intro H5. -apply compact_bnd_AbsIR with H5. -cut (included (Compact leEq2) (Compact H5)); auto. -apply included_compact; unfold mid1, mid2 in |- *; split. -apply rht_leEq_Max. -apply leEq_transitive with mid2; auto. -unfold mid2 in |- *; apply Min_leEq_rht. -apply leEq_transitive with mid1; auto. -unfold mid1 in |- *; apply rht_leEq_Max. -apply Min_leEq_rht. -apply leEq_transitive with x. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; auto. -apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; auto. -unfold mid2, mid1 in |- *. -astepl (x[-]x). -unfold cg_minus at 1 2 in |- *. -inversion_clear H. -elim (less_cotransitive_unfolded _ _ _ Hless x); intro. -apply plus_resp_leEq_less. -apply leEq_Min; auto. -apply shift_leEq_plus'; astepl ZeroR; apply less_leEq; auto. -apply inv_resp_less; apply Max_less; auto. -apply shift_minus_less; apply shift_less_plus'. -astepl ZeroR; auto. -apply plus_resp_less_leEq. -apply less_Min; auto. -apply shift_less_plus'; astepl ZeroR; auto. -apply inv_resp_leEq; apply Max_leEq; auto. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; auto. -apply included_imp_contin with a b Hab; auto. -apply included_compact. -apply compact_inc_lft. -split; auto. -apply leEq_transitive with mid1; auto. -apply included_imp_contin with a b Hab; auto. -apply included_compact. -split; auto. -apply leEq_transitive with mid1; auto. -apply compact_inc_rht. -apply included_imp_contin with a b Hab; auto. -apply included_compact. -split; auto. -apply leEq_transitive with mid2; auto. -split; auto. -apply leEq_transitive with mid1; auto. -apply included_imp_contin with a b Hab; auto. -apply included_compact. -apply compact_inc_lft. -split; auto. -apply leEq_transitive with mid2; auto. +Proof. + (* begin hide *) + intros a b Hab F contF N Hless x H Hx H0. + set (e := (N[-]AbsIR (F x Hx)) [/]TwoNZ) in *. + cut (Zero [<] e); intros. + 2: unfold e in |- *; apply pos_div_two; apply shift_less_minus. + 2: astepl (AbsIR (F x Hx)); auto. + elim (contin_prop _ _ _ _ contF e); auto. + intros d H2 H3. + set (mid1 := Max a (x[-]d)) in *. + set (mid2 := Min b (x[+]d)) in *. + cut (a [<=] mid1); [ intro leEq1 | unfold mid1 in |- *; apply lft_leEq_Max ]. + cut (mid1 [<=] mid2); [ intro leEq2 + | unfold mid1, mid2 in |- *; inversion_clear H; apply leEq_transitive with x ]. + 2: apply Max_leEq; auto. + 2: apply less_leEq; apply shift_minus_less. + 2: apply shift_less_plus'; astepl ZeroR; auto. + 2: apply leEq_Min; auto. + 2: apply less_leEq; apply shift_less_plus'. + 2: astepl ZeroR; auto. + cut (mid2 [<=] b); [ intro leEq3 | unfold mid2 in |- *; apply Min_leEq_lft ]. + cut (Continuous_I leEq1 F). + cut (Continuous_I leEq2 F). + cut (Continuous_I leEq3 F). + intros cont3 cont2 cont1. + cut (Continuous_I (leEq_transitive _ _ _ _ leEq1 leEq2) F). intro H4. + apply less_wdl with (AbsIR (integral _ _ _ _ cont1[+]integral _ _ _ _ cont2[+] + integral _ _ _ _ cont3)). + 2: apply AbsIR_wd. + 2: apply eq_transitive_unfolded with (integral _ _ _ _ H4[+]integral _ _ _ _ cont3). + 2: apply bin_op_wd_unfolded. + 2: apply integral_plus_integral. + 2: algebra. + 2: apply integral_plus_integral. + rstepr (N[*] (mid1[-]a) [+]N[*] (mid2[-]mid1) [+]N[*] (b[-]mid2)). + eapply leEq_less_trans. + apply triangle_IR. + apply plus_resp_less_leEq. + eapply leEq_less_trans. + apply triangle_IR. + apply plus_resp_leEq_less. + eapply leEq_transitive. + apply integral_leEq_norm. + unfold N in |- *; apply mult_resp_leEq_rht. + 2: apply shift_leEq_minus; astepl a; auto. + apply included_imp_norm_leEq. + apply included_compact. + apply compact_inc_lft. + split. + unfold mid1 in |- *; apply lft_leEq_Max. + apply leEq_transitive with mid2; auto. + 2: eapply leEq_transitive. + 2: apply integral_leEq_norm. + 2: unfold N in |- *; apply mult_resp_leEq_rht. + 3: apply shift_leEq_minus; astepl mid2; auto. + 2: apply included_imp_norm_leEq. + 2: apply included_compact. + 2: split. + 2: apply leEq_transitive with mid1; auto. + 2: auto. + 2: apply compact_inc_rht. + eapply leEq_less_trans. + apply integral_leEq_norm. + apply mult_resp_less. + apply leEq_less_trans with (N[-]e). + 2: apply shift_minus_less; apply shift_less_plus'. + 2: astepl ZeroR; auto. + apply leEq_Norm_Funct; intros y Hy Hy'. + apply leEq_wdr with (AbsIR (F x Hx) [+]e). + 2: unfold e in |- *; rational. + apply AbsIR_bnd_AbsIR. + apply H3; auto. + cut (included (Compact leEq2) (Compact Hab)); auto. + apply included_compact. + split; auto. + apply leEq_transitive with mid2; auto. + split; auto. + apply leEq_transitive with mid1; auto. + cut (x[-]d [<=] x[+]d). intro H5. + apply compact_bnd_AbsIR with H5. + cut (included (Compact leEq2) (Compact H5)); auto. + apply included_compact; unfold mid1, mid2 in |- *; split. + apply rht_leEq_Max. + apply leEq_transitive with mid2; auto. + unfold mid2 in |- *; apply Min_leEq_rht. + apply leEq_transitive with mid1; auto. + unfold mid1 in |- *; apply rht_leEq_Max. + apply Min_leEq_rht. + apply leEq_transitive with x. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; auto. + apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; auto. + unfold mid2, mid1 in |- *. + astepl (x[-]x). + unfold cg_minus at 1 2 in |- *. + inversion_clear H. + elim (less_cotransitive_unfolded _ _ _ Hless x); intro. + apply plus_resp_leEq_less. + apply leEq_Min; auto. + apply shift_leEq_plus'; astepl ZeroR; apply less_leEq; auto. + apply inv_resp_less; apply Max_less; auto. + apply shift_minus_less; apply shift_less_plus'. + astepl ZeroR; auto. + apply plus_resp_less_leEq. + apply less_Min; auto. + apply shift_less_plus'; astepl ZeroR; auto. + apply inv_resp_leEq; apply Max_leEq; auto. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; auto. + apply included_imp_contin with a b Hab; auto. + apply included_compact. + apply compact_inc_lft. + split; auto. + apply leEq_transitive with mid1; auto. + apply included_imp_contin with a b Hab; auto. + apply included_compact. + split; auto. + apply leEq_transitive with mid1; auto. + apply compact_inc_rht. + apply included_imp_contin with a b Hab; auto. + apply included_compact. + split; auto. + apply leEq_transitive with mid2; auto. + split; auto. + apply leEq_transitive with mid1; auto. + apply included_imp_contin with a b Hab; auto. + apply included_compact. + apply compact_inc_lft. + split; auto. + apply leEq_transitive with mid2; auto. Qed. (* end hide *) Lemma integral_gt_zero : forall a b Hab (F : PartIR) contF, let N := Norm_Funct contF in a [<] b -> forall x, Compact Hab x -> forall Hx, Zero [<] F x Hx -> (forall x, Compact Hab x -> forall Hx, Zero [<=] F x Hx) -> Zero [<] integral a b Hab F contF. -(* begin hide *) -intros a b Hab F contF N Hless x H Hx H0. -set (e := F x Hx [/]TwoNZ) in *. -cut (Zero [<] e). intros H1 H2. -2: unfold e in |- *; apply pos_div_two; auto. -elim (contin_prop _ _ _ _ contF e); auto. -intros d H3 H4. -set (mid1 := Max a (x[-]d)) in *. -set (mid2 := Min b (x[+]d)) in *. -cut (a [<=] mid1); [ intro leEq1 | unfold mid1 in |- *; apply lft_leEq_Max ]. -cut (mid1 [<=] mid2); - [ intro leEq2 - | unfold mid1, mid2 in |- *; inversion_clear H; apply leEq_transitive with x ]. -2: apply Max_leEq; auto. -2: apply less_leEq; apply shift_minus_less. -2: apply shift_less_plus'; astepl ZeroR; auto. -2: apply leEq_Min; auto. -2: apply less_leEq; apply shift_less_plus'. -2: astepl ZeroR; auto. -cut (mid2 [<=] b); [ intro leEq3 | unfold mid2 in |- *; apply Min_leEq_lft ]. -cut (Continuous_I leEq1 F). -cut (Continuous_I leEq2 F). -cut (Continuous_I leEq3 F). -intros cont3 cont2 cont1. -cut (Continuous_I (leEq_transitive _ _ _ _ leEq1 leEq2) F). intro H5. -apply - less_wdr - with - (integral _ _ _ _ cont1[+]integral _ _ _ _ cont2[+]integral _ _ _ _ cont3). -2: apply - eq_transitive_unfolded - with (integral _ _ _ _ H5[+]integral _ _ _ _ cont3). -2: apply bin_op_wd_unfolded. -2: apply integral_plus_integral. -2: algebra. -2: apply integral_plus_integral. -rstepl (Zero[*] (mid1[-]a) [+]Zero[*] (mid2[-]mid1) [+]Zero[*] (b[-]mid2)). -apply plus_resp_less_leEq. -apply plus_resp_leEq_less. -apply lb_integral. -intros x0 H6 Hx0. -apply H2. -inversion_clear H6; split; auto. -apply leEq_transitive with mid1; auto. -apply leEq_transitive with mid2; auto. -apply less_leEq_trans with (F x Hx [/]TwoNZ[*] (mid2[-]mid1)). -apply mult_resp_less. -apply pos_div_two; auto. -apply shift_less_minus; astepl mid1. -elim (less_cotransitive_unfolded _ _ _ Hless x); intro; unfold mid1, mid2 in |- *. -apply less_leEq_trans with x. -apply Max_less. -auto. -apply shift_minus_less; apply shift_less_plus'. -astepl ZeroR; auto. -apply leEq_Min. -inversion_clear H; auto. -apply less_leEq; apply shift_less_plus'. -astepl ZeroR; auto. -apply leEq_less_trans with x. -apply Max_leEq. -inversion_clear H; auto. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; auto. -apply less_Min. -auto. -apply shift_less_plus'. -astepl ZeroR; auto. -apply lb_integral. -intros x0 H6 Hx0. -rstepl (F x Hx[-]F x Hx [/]TwoNZ). -apply shift_minus_leEq; apply shift_leEq_plus'. -fold e in |- *; eapply leEq_transitive; [ apply leEq_AbsIR | apply H4 ]. -auto. -inversion_clear H6; split; auto. -apply leEq_transitive with mid1; auto. -apply leEq_transitive with mid2; auto. -cut (x[-]d [<=] x[+]d); intros. -apply compact_bnd_AbsIR with H7. -cut (included (Compact leEq2) (Compact H7)); auto. -apply included_compact; unfold mid1, mid2 in |- *; split. -apply rht_leEq_Max. -apply leEq_transitive with mid2; auto. -unfold mid2 in |- *; apply Min_leEq_rht. -apply leEq_transitive with mid1; auto. -unfold mid1 in |- *; apply rht_leEq_Max. -apply Min_leEq_rht. -apply leEq_transitive with x. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; auto. -apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; auto. -apply lb_integral. -intros x0 H6 Hx0. -apply H2. -inversion_clear H6; split; auto. -apply leEq_transitive with mid1; auto. -apply leEq_transitive with mid2; auto. -apply included_imp_contin with a b Hab; auto. -apply included_compact. -apply compact_inc_lft. -split; auto. -apply leEq_transitive with mid1; auto. -apply included_imp_contin with a b Hab; auto. -apply included_compact. -split; auto. -apply leEq_transitive with mid1; auto. -apply compact_inc_rht. -apply included_imp_contin with a b Hab; auto. -apply included_compact. -split; auto. -apply leEq_transitive with mid2; auto. -split; auto. -apply leEq_transitive with mid1; auto. -apply included_imp_contin with a b Hab; auto. -apply included_compact. -apply compact_inc_lft. -split; auto. -apply leEq_transitive with mid2; auto. +Proof. + (* begin hide *) + intros a b Hab F contF N Hless x H Hx H0. + set (e := F x Hx [/]TwoNZ) in *. + cut (Zero [<] e). intros H1 H2. + 2: unfold e in |- *; apply pos_div_two; auto. + elim (contin_prop _ _ _ _ contF e); auto. + intros d H3 H4. + set (mid1 := Max a (x[-]d)) in *. + set (mid2 := Min b (x[+]d)) in *. + cut (a [<=] mid1); [ intro leEq1 | unfold mid1 in |- *; apply lft_leEq_Max ]. + cut (mid1 [<=] mid2); [ intro leEq2 + | unfold mid1, mid2 in |- *; inversion_clear H; apply leEq_transitive with x ]. + 2: apply Max_leEq; auto. + 2: apply less_leEq; apply shift_minus_less. + 2: apply shift_less_plus'; astepl ZeroR; auto. + 2: apply leEq_Min; auto. + 2: apply less_leEq; apply shift_less_plus'. + 2: astepl ZeroR; auto. + cut (mid2 [<=] b); [ intro leEq3 | unfold mid2 in |- *; apply Min_leEq_lft ]. + cut (Continuous_I leEq1 F). + cut (Continuous_I leEq2 F). + cut (Continuous_I leEq3 F). + intros cont3 cont2 cont1. + cut (Continuous_I (leEq_transitive _ _ _ _ leEq1 leEq2) F). intro H5. + apply less_wdr with (integral _ _ _ _ cont1[+]integral _ _ _ _ cont2[+]integral _ _ _ _ cont3). + 2: apply eq_transitive_unfolded with (integral _ _ _ _ H5[+]integral _ _ _ _ cont3). + 2: apply bin_op_wd_unfolded. + 2: apply integral_plus_integral. + 2: algebra. + 2: apply integral_plus_integral. + rstepl (Zero[*] (mid1[-]a) [+]Zero[*] (mid2[-]mid1) [+]Zero[*] (b[-]mid2)). + apply plus_resp_less_leEq. + apply plus_resp_leEq_less. + apply lb_integral. + intros x0 H6 Hx0. + apply H2. + inversion_clear H6; split; auto. + apply leEq_transitive with mid1; auto. + apply leEq_transitive with mid2; auto. + apply less_leEq_trans with (F x Hx [/]TwoNZ[*] (mid2[-]mid1)). + apply mult_resp_less. + apply pos_div_two; auto. + apply shift_less_minus; astepl mid1. + elim (less_cotransitive_unfolded _ _ _ Hless x); intro; unfold mid1, mid2 in |- *. + apply less_leEq_trans with x. + apply Max_less. + auto. + apply shift_minus_less; apply shift_less_plus'. + astepl ZeroR; auto. + apply leEq_Min. + inversion_clear H; auto. + apply less_leEq; apply shift_less_plus'. + astepl ZeroR; auto. + apply leEq_less_trans with x. + apply Max_leEq. + inversion_clear H; auto. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; auto. + apply less_Min. + auto. + apply shift_less_plus'. + astepl ZeroR; auto. + apply lb_integral. + intros x0 H6 Hx0. + rstepl (F x Hx[-]F x Hx [/]TwoNZ). + apply shift_minus_leEq; apply shift_leEq_plus'. + fold e in |- *; eapply leEq_transitive; [ apply leEq_AbsIR | apply H4 ]. + auto. + inversion_clear H6; split; auto. + apply leEq_transitive with mid1; auto. + apply leEq_transitive with mid2; auto. + cut (x[-]d [<=] x[+]d); intros. + apply compact_bnd_AbsIR with H7. + cut (included (Compact leEq2) (Compact H7)); auto. + apply included_compact; unfold mid1, mid2 in |- *; split. + apply rht_leEq_Max. + apply leEq_transitive with mid2; auto. + unfold mid2 in |- *; apply Min_leEq_rht. + apply leEq_transitive with mid1; auto. + unfold mid1 in |- *; apply rht_leEq_Max. + apply Min_leEq_rht. + apply leEq_transitive with x. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; auto. + apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; auto. + apply lb_integral. + intros x0 H6 Hx0. + apply H2. + inversion_clear H6; split; auto. + apply leEq_transitive with mid1; auto. + apply leEq_transitive with mid2; auto. + apply included_imp_contin with a b Hab; auto. + apply included_compact. + apply compact_inc_lft. + split; auto. + apply leEq_transitive with mid1; auto. + apply included_imp_contin with a b Hab; auto. + apply included_compact. + split; auto. + apply leEq_transitive with mid1; auto. + apply compact_inc_rht. + apply included_imp_contin with a b Hab; auto. + apply included_compact. + split; auto. + apply leEq_transitive with mid2; auto. + split; auto. + apply leEq_transitive with mid1; auto. + apply included_imp_contin with a b Hab; auto. + apply included_compact. + apply compact_inc_lft. + split; auto. + apply leEq_transitive with mid2; auto. Qed. (* end hide *) diff --git a/ftc/IntegrationRules.v b/ftc/IntegrationRules.v index fb3383128..448740c90 100644 --- a/ftc/IntegrationRules.v +++ b/ftc/IntegrationRules.v @@ -46,8 +46,8 @@ Lemma IntegrationBySubstition : (HFc0d0: Continuous_I Hc0d0 F), Integral HFG[=]Integral HF. Proof. -intros. -assert(X1:=leEq_less_or_equal _ _ _ Hab). + intros. + assert(X1:=leEq_less_or_equal _ _ _ Hab). apply not_ap_imp_eq. intros X0. apply X1. @@ -55,144 +55,141 @@ assert(X1:=leEq_less_or_equal _ _ _ Hab). intros X1. revert X0. apply (eq_imp_not_ap). -destruct X1 as [X1|X1]. - assert(X:=leEq_less_or_equal _ _ _ Hc0d0). - apply not_ap_imp_eq. - intros X0. - apply X. - clear X. - intros X. - revert X0. - apply (eq_imp_not_ap). - destruct X as [X|X]. - set (J:=clcr c0 d0). - assert (HFJ:Continuous J F). - eapply (Continuous_Int J Hc0d0 Hc0d0); apply HFc0d0. - assert (Jc0:J c0). - split. - apply leEq_reflexive. - assumption. - set (F0:=([-S-]HFJ) _ Jc0). - assert (dF : Derivative J X F0 F). - unfold F0; apply FTC1. - apply eq_symmetric. - assert (HF':Continuous_I (Min_leEq_Max (G a HGa) (G b HGb)) F). - Contin. - apply eq_transitive with (Integral HF'). - apply Integral_wd'; apply eq_reflexive. - set (FGx:=Derivative_imp_inc J X F0 F dF). - assert (JGa:J (G a HGa)). - destruct HGF as [HGF0 HGF1]. - change (Compact Hc0d0 (G a HGa)). - apply HGF1. - apply compact_Min_lft. - assert (JGb:J (G b HGb)). + destruct X1 as [X1|X1]. + assert(X:=leEq_less_or_equal _ _ _ Hc0d0). + apply not_ap_imp_eq. + intros X0. + apply X. + clear X. + intros X. + revert X0. + apply (eq_imp_not_ap). + destruct X as [X|X]. + set (J:=clcr c0 d0). + assert (HFJ:Continuous J F). + eapply (Continuous_Int J Hc0d0 Hc0d0); apply HFc0d0. + assert (Jc0:J c0). + split. + apply leEq_reflexive. + assumption. + set (F0:=([-S-]HFJ) _ Jc0). + assert (dF : Derivative J X F0 F). + unfold F0; apply FTC1. + apply eq_symmetric. + assert (HF':Continuous_I (Min_leEq_Max (G a HGa) (G b HGb)) F). + Contin. + apply eq_transitive with (Integral HF'). + apply Integral_wd'; apply eq_reflexive. + set (FGx:=Derivative_imp_inc J X F0 F dF). + assert (JGa:J (G a HGa)). + destruct HGF as [HGF0 HGF1]. + change (Compact Hc0d0 (G a HGa)). + apply HGF1. + apply compact_Min_lft. + assert (JGb:J (G b HGb)). + destruct HGF as [HGF0 HGF1]. + change (Compact Hc0d0 (G b HGb)). + apply HGF1. + apply compact_Min_rht. + apply eq_transitive with ((F0 (G b HGb) (FGx _ JGb))[-](F0 (G a HGa) (FGx _ JGa))). + unfold FGx. + apply Barrow. + apply HFJ. + apply eq_symmetric. + assert (HFG':Continuous_I (Min_leEq_Max a b) ((F[o]G){*}G')). + Contin. + apply eq_transitive with (Integral HFG'). + apply Integral_wd'; apply eq_reflexive. + set (I:=clcr (Min a b) (Max a b)). + assert (dFG:Derivative I X1 (F0[o]G) ((F[o]G){*}G')). + apply (Derivative_Int I Hab X1 X1). + assert (dF0 : Derivative_I X F0 F). + apply (Int_Derivative J Hc0d0 X). + assumption. + eapply Derivative_I_comp. + eapply (included_imp_deriv _ _ Hcd). + apply Habcd. + apply HGG'. + apply dF0. + destruct HGF as [HGF0 HGF1]. + split. + Included. + exact HGF1. + set (HFGx := Derivative_imp_inc I X1 _ _ dFG). + stepr (((F0[o]G) b (HFGx b (compact_Min_rht _ _ Hab)))[-] + ((F0[o]G) a (HFGx a (compact_Min_lft _ _ Hab)))). + unfold HFGx. + apply Barrow. + eapply (Continuous_Int I Hab Hab). + apply HFG. + generalize (HFGx a (compact_Min_lft a b Hab)) (HFGx b (compact_Min_rht a b Hab)). + generalize (FGx (G b HGb) JGb) (FGx (G a HGa) JGa). + generalize F0 G HGb HGa. + clear -a b. + intros F G p1 p2 p3 p4 p5 p6. + simpl. + algebra. + assert (Y:G a HGa[=]G b HGb). destruct HGF as [HGF0 HGF1]. - change (Compact Hc0d0 (G b HGb)). - apply HGF1. - apply compact_Min_rht. - apply eq_transitive with ((F0 (G b HGb) (FGx _ JGb))[-](F0 (G a HGa) (FGx _ JGa))). - unfold FGx. - apply Barrow. - apply HFJ. - apply eq_symmetric. - assert (HFG':Continuous_I (Min_leEq_Max a b) ((F[o]G){*}G')). + apply leEq_imp_eq. + apply leEq_transitive with d0. + destruct (HGF1 _ HGa (compact_Min_lft _ _ Hab)); assumption. + stepl c0 by assumption. + destruct (HGF1 _ HGb (compact_Min_rht _ _ Hab)); assumption. + apply leEq_transitive with d0. + destruct (HGF1 _ HGb (compact_Min_rht _ _ Hab)); assumption. + stepl c0 by assumption. + destruct (HGF1 _ HGa (compact_Min_lft _ _ Hab)); assumption. + stepl (Zero:IR). + apply eq_symmetric; apply Integral_empty. + assumption. + assert (Z:(Continuous_I Hab [-C-]Zero)). Contin. - apply eq_transitive with (Integral HFG'). - apply Integral_wd'; apply eq_reflexive. - set (I:=clcr (Min a b) (Max a b)). - assert (dFG:Derivative I X1 (F0[o]G) ((F[o]G){*}G')). - apply (Derivative_Int I Hab X1 X1). - assert (dF0 : Derivative_I X F0 F). - apply (Int_Derivative J Hc0d0 X). - assumption. - eapply Derivative_I_comp. - eapply (included_imp_deriv _ _ Hcd). - apply Habcd. - apply HGG'. - apply dF0. - destruct HGF as [HGF0 HGF1]. - split. - Included. - exact HGF1. - set (HFGx := Derivative_imp_inc I X1 _ _ dFG). - stepr (((F0[o]G) b (HFGx b (compact_Min_rht _ _ Hab)))[-] - ((F0[o]G) a (HFGx a (compact_Min_lft _ _ Hab)))). - unfold HFGx. - apply Barrow. - eapply (Continuous_Int I Hab Hab). - apply HFG. - generalize (HFGx a (compact_Min_lft a b Hab)) (HFGx b (compact_Min_rht a b Hab)). - generalize (FGx (G b HGb) JGb) (FGx (G a HGa) JGa). - generalize F0 G HGb HGa. - clear -a b. - intros F G p1 p2 p3 p4 p5 p6. + stepr (Integral Z). + rstepl (Zero[*](b[-]a)). + apply eq_symmetric. + apply Integral_const. + apply Integral_wd. + FEQ. simpl. - algebra. - - assert (Y:G a HGa[=]G b HGb). + simpl in Hx'. + apply eq_symmetric. + apply x_mult_zero. + change (Zero:IR) with ([-C-]Zero x CI). + apply Feq_imp_eq with (I:=Compact (less_leEq _ _ _ X1)); auto. + apply Derivative_I_unique with G. + eapply included_imp_deriv;[|apply HGG']. + auto. + apply Derivative_I_wdl with ([-C-](G a HGa)); [|apply Derivative_I_const]. + FEQ. + eapply included_trans. + apply Habcd. + eapply derivative_imp_inc. + apply HGG'. destruct HGF as [HGF0 HGF1]. + simpl. apply leEq_imp_eq. apply leEq_transitive with d0. - destruct (HGF1 _ HGa (compact_Min_lft _ _ Hab)); assumption. + destruct (HGF1 _ HGa (compact_Min_lft _ _ Hab)); assumption. stepl c0 by assumption. - destruct (HGF1 _ HGb (compact_Min_rht _ _ Hab)); assumption. + destruct (HGF1 _ Hx'0 X2); assumption. apply leEq_transitive with d0. - destruct (HGF1 _ HGb (compact_Min_rht _ _ Hab)); assumption. + destruct (HGF1 _ Hx'0 X2); assumption. stepl c0 by assumption. destruct (HGF1 _ HGa (compact_Min_lft _ _ Hab)); assumption. - stepl (Zero:IR). - apply eq_symmetric; apply Integral_empty. + assert (Hab':a[=]b). + apply not_ap_imp_eq. + intros X0. + apply (eq_imp_not_ap _ _ _ X1). + apply less_imp_ap. + apply ap_imp_Min_less_Max. + assumption. + apply eq_transitive with (Zero:IR). + apply Integral_empty. assumption. - assert (Z:(Continuous_I Hab [-C-]Zero)). - Contin. - stepr (Integral Z). - rstepl (Zero[*](b[-]a)). - apply eq_symmetric. - apply Integral_const. - apply Integral_wd. - FEQ. - simpl. - simpl in Hx'. apply eq_symmetric. - apply x_mult_zero. - change (Zero:IR) with ([-C-]Zero x CI). - apply Feq_imp_eq with (I:=Compact (less_leEq _ _ _ X1)); auto. - apply Derivative_I_unique with G. - eapply included_imp_deriv;[|apply HGG']. - auto. - apply Derivative_I_wdl with ([-C-](G a HGa)); - [|apply Derivative_I_const]. - FEQ. - eapply included_trans. - apply Habcd. - eapply derivative_imp_inc. - apply HGG'. - destruct HGF as [HGF0 HGF1]. - simpl. - apply leEq_imp_eq. - apply leEq_transitive with d0. - destruct (HGF1 _ HGa (compact_Min_lft _ _ Hab)); assumption. - stepl c0 by assumption. - destruct (HGF1 _ Hx'0 X2); assumption. - apply leEq_transitive with d0. - destruct (HGF1 _ Hx'0 X2); assumption. - stepl c0 by assumption. - destruct (HGF1 _ HGa (compact_Min_lft _ _ Hab)); assumption. - -assert (Hab':a[=]b). - apply not_ap_imp_eq. - intros X0. - apply (eq_imp_not_ap _ _ _ X1). - apply less_imp_ap. - apply ap_imp_Min_less_Max. - assumption. -apply eq_transitive with (Zero:IR). apply Integral_empty. - assumption. -apply eq_symmetric. -apply Integral_empty. -algebra. + algebra. Qed. (** This lemma is a special instance of substituion that ties @@ -208,82 +205,104 @@ Lemma IntegrationSubs01 : forall a b (HF: Continuous_I Hab F), (b[-]a)[*]integral _ _ _ _ HFG[=]Integral HF. Proof. -intros. -assert (HFG0:Continuous_I (a:=Zero) (b:=One) H01 ((b[-]a){**}(F[o][-C-](b[-]a){*}FId{+}[-C-]a))). - Contin. -stepr (integral _ _ _ _ HFG0). + intros. + assert (HFG0:Continuous_I (a:=Zero) (b:=One) H01 ((b[-]a){**}(F[o][-C-](b[-]a){*}FId{+}[-C-]a))). + Contin. + stepr (integral _ _ _ _ HFG0). + apply eq_symmetric. + apply integral_comm_scal. + assert (HFG1:Continuous_I (a:=Zero) (b:=One) H01 ((F[o][-C-](b[-]a){*}FId{+}[-C-]a){*}[-C-](b[-]a))). + Contin. + stepr (integral _ _ _ _ HFG1). + apply integral_wd. + FEQ. + assert (H01':Min Zero One[<=]Max Zero One). + apply Min_leEq_Max. + assert (HFG2:Continuous_I H01' ((F[o][-C-](b[-]a){*}FId{+}[-C-]a){*}[-C-](b[-]a))). + apply (included_imp_contin _ _ H01). + apply included2_compact. + apply compact_inc_lft. + apply compact_inc_rht. + assumption. + stepr (Integral HFG2). + apply eq_symmetric. + apply Integral_integral. + clear - H01. + set (G:=[-C-](b[-]a){*}FId{+}[-C-]a) in *. + assert (HG0 : Dom G Zero). + repeat constructor. + assert (HG1 : Dom G One). + repeat constructor. + assert (Hab':Min (G Zero HG0) (G One HG1)[<=]Max (G Zero HG0) (G One HG1)). + apply Min_leEq_Max. + assert (HF':Continuous_I Hab' F). + apply (included_imp_contin _ _ Hab). + unfold G. + apply included2_compact. + apply (compact_wd _ _ Hab a). + apply compact_Min_lft. + simpl. + rational. + apply (compact_wd _ _ Hab b). + apply compact_Min_rht. + simpl. + rational. + assumption. + stepl (Integral HF'). + apply Integral_wd'; simpl; rational. apply eq_symmetric. - apply integral_comm_scal. -assert (HFG1:Continuous_I (a:=Zero) (b:=One) H01 ((F[o][-C-](b[-]a){*}FId{+}[-C-]a){*}[-C-](b[-]a))). - Contin. -stepr (integral _ _ _ _ HFG1). - apply integral_wd. - FEQ. -assert (H01':Min Zero One[<=]Max Zero One). - apply Min_leEq_Max. -assert (HFG2:Continuous_I H01' ((F[o][-C-](b[-]a){*}FId{+}[-C-]a){*}[-C-](b[-]a))). - apply (included_imp_contin _ _ H01). + assert (X:included (Compact H01') (Compact (less_leEq _ _ _ (pos_one IR)))). apply included2_compact. apply compact_inc_lft. apply compact_inc_rht. - assumption. -stepr (Integral HFG2). - apply eq_symmetric. - apply Integral_integral. -clear - H01. -set (G:=[-C-](b[-]a){*}FId{+}[-C-]a) in *. -assert (HG0 : Dom G Zero). - repeat constructor. -assert (HG1 : Dom G One). - repeat constructor. -assert (Hab':Min (G Zero HG0) (G One HG1)[<=]Max (G Zero HG0) (G One HG1)). - apply Min_leEq_Max. -assert (HF':Continuous_I Hab' F). - apply (included_imp_contin _ _ Hab). + eapply (IntegrationBySubstition). + apply X. + unfold G. + New_Deriv. + apply Feq_reflexive. + repeat constructor. + apply (included_Feq (Compact (less_leEq IR Zero One (pos_one IR))) realline). + repeat constructor. + FEQ. + split. + apply contin_imp_inc. + apply HF'. + intros x Hx [H0 H1]. + assert (H0':Zero[<=]x). + stepl (Min Zero One);[assumption|]. + apply leEq_imp_Min_is_lft. + apply (less_leEq _ _ _ (pos_one IR)). + assert (H1':x[<=]One). + stepr (Max Zero One);[assumption|]. + apply leEq_imp_Max_is_rht. + apply (less_leEq _ _ _ (pos_one IR)). unfold G. - apply included2_compact. - apply (compact_wd _ _ Hab a). - apply compact_Min_lft. - simpl. - rational. - apply (compact_wd _ _ Hab b). - apply compact_Min_rht. simpl. - rational. - assumption. -stepl (Integral HF'). - apply Integral_wd'; - simpl; rational. -apply eq_symmetric. -assert (X:included (Compact H01') (Compact (less_leEq _ _ _ (pos_one IR)))). - apply included2_compact. - apply compact_inc_lft. - apply compact_inc_rht. -eapply (IntegrationBySubstition). - apply X. - unfold G. - New_Deriv. - apply Feq_reflexive. - repeat constructor. - apply (included_Feq (Compact (less_leEq IR Zero One (pos_one IR))) realline). - repeat constructor. - FEQ. - split. - apply contin_imp_inc. - apply HF'. - intros x Hx [H0 H1]. - assert (H0':Zero[<=]x). - stepl (Min Zero One);[assumption|]. - apply leEq_imp_Min_is_lft. - apply (less_leEq _ _ _ (pos_one IR)). - assert (H1':x[<=]One). - stepr (Max Zero One);[assumption|]. - apply leEq_imp_Max_is_rht. - apply (less_leEq _ _ _ (pos_one IR)). - unfold G. - simpl. - split. - stepl (Min a b) by (apply MIN_wd;rational). + split. + stepl (Min a b) by (apply MIN_wd;rational). + assert (Z:=leEq_or_leEq _ a b). + rewrite leEq_def. + intros Z0. + apply Z. + clear Z. + intros Z. + revert Z0. + change (Not ((b[-]a)[*]x[+]a[<]Min a b)). + rewrite <- leEq_def. + destruct Z. + stepl a by (apply eq_symmetric; apply leEq_imp_Min_is_lft; auto). + apply shift_leEq_plus. + rstepl (Zero:IR). + apply mult_resp_nonneg; auto. + apply shift_leEq_lft. + assumption. + stepl (Min b a) by apply Min_comm. + stepl b by (apply eq_symmetric; apply leEq_imp_Min_is_lft; auto). + apply shift_leEq_plus. + apply shift_leEq_rht. + rstepr ((a[-]b)[*](One[-]x)). + apply mult_resp_nonneg; apply shift_leEq_lft; assumption. + stepr (Max a b) by (apply MAX_wd;rational). assert (Z:=leEq_or_leEq _ a b). rewrite leEq_def. intros Z0. @@ -291,51 +310,22 @@ eapply (IntegrationBySubstition). clear Z. intros Z. revert Z0. - change (Not ((b[-]a)[*]x[+]a[<]Min a b)). + change (Not (Max a b[<](b[-]a)[*]x[+]a)). rewrite <- leEq_def. destruct Z. - stepl a by - (apply eq_symmetric; apply leEq_imp_Min_is_lft; auto). - apply shift_leEq_plus. - rstepl (Zero:IR). - apply mult_resp_nonneg; auto. - apply shift_leEq_lft. - assumption. - stepl (Min b a) by apply Min_comm. - stepl b by (apply eq_symmetric; apply leEq_imp_Min_is_lft; auto). - apply shift_leEq_plus. - apply shift_leEq_rht. - rstepr ((a[-]b)[*](One[-]x)). - apply mult_resp_nonneg; - apply shift_leEq_lft; - assumption. - stepr (Max a b) by (apply MAX_wd;rational). - assert (Z:=leEq_or_leEq _ a b). - rewrite leEq_def. - intros Z0. - apply Z. - clear Z. - intros Z. - revert Z0. - change (Not (Max a b[<](b[-]a)[*]x[+]a)). - rewrite <- leEq_def. - destruct Z. - stepr b by (apply eq_symmetric; apply leEq_imp_Max_is_rht; auto). + stepr b by (apply eq_symmetric; apply leEq_imp_Max_is_rht; auto). + apply shift_plus_leEq. + apply shift_leEq_rht. + rstepr ((b[-]a)[*](One[-]x)). + apply mult_resp_nonneg; apply shift_leEq_lft; assumption. + stepr (Max b a) by apply Max_comm. + stepr a by (apply eq_symmetric; apply leEq_imp_Max_is_rht; auto). apply shift_plus_leEq. + rstepr (Zero:IR). apply shift_leEq_rht. - rstepr ((b[-]a)[*](One[-]x)). - apply mult_resp_nonneg; - apply shift_leEq_lft; - assumption. - stepr (Max b a) by apply Max_comm. - stepr a by - (apply eq_symmetric; apply leEq_imp_Max_is_rht; auto). - apply shift_plus_leEq. - rstepr (Zero:IR). - apply shift_leEq_rht. - rstepr ((a[-]b)[*]x). - apply mult_resp_nonneg; auto. - apply shift_leEq_lft. + rstepr ((a[-]b)[*]x). + apply mult_resp_nonneg; auto. + apply shift_leEq_lft. + assumption. assumption. -assumption. -Qed. \ No newline at end of file +Qed. diff --git a/ftc/IntervalFunct.v b/ftc/IntervalFunct.v index 1fd876449..b0fb53d98 100644 --- a/ftc/IntervalFunct.v +++ b/ftc/IntervalFunct.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export PartFunEquality. @@ -80,8 +80,9 @@ Constant and identity functions are defined. Variable c : IR. Lemma IConst_strext : forall x y : subset I, c [#] c -> x [#] y. -intros x y H. -elim (ap_irreflexive_unfolded _ c H). +Proof. + intros x y H. + elim (ap_irreflexive_unfolded _ c H). Qed. Definition IConst := Build_CSetoid_fun _ _ (fun x => c) IConst_strext. @@ -89,7 +90,8 @@ Definition IConst := Build_CSetoid_fun _ _ (fun x => c) IConst_strext. End Const. Lemma IId_strext : forall x y : subset I, scs_elem _ _ x [#] scs_elem _ _ y -> x [#] y. -intros x y; case x; case y; intros; algebra. +Proof. + intros x y; case x; case y; intros; algebra. Qed. Definition IId := Build_CSetoid_fun _ _ _ IId_strext. @@ -99,33 +101,34 @@ Next, we define addition, algebraic inverse, subtraction and product of function *) Lemma IPlus_strext : forall x y : subset I, f x[+]g x [#] f y[+]g y -> x [#] y. -intros x y H. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intro H0; - exact (csf_strext_unfolded _ _ _ _ _ H0). +Proof. + intros x y H. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intro H0; exact (csf_strext_unfolded _ _ _ _ _ H0). Qed. Definition IPlus := Build_CSetoid_fun _ _ (fun x => f x[+]g x) IPlus_strext. Lemma IInv_strext : forall x y : subset I, [--] (f x) [#] [--] (f y) -> x [#] y. -intros x y H. -generalize (un_op_strext_unfolded _ _ _ _ H); intro H0. -exact (csf_strext_unfolded _ _ _ _ _ H0). +Proof. + intros x y H. + generalize (un_op_strext_unfolded _ _ _ _ H); intro H0. + exact (csf_strext_unfolded _ _ _ _ _ H0). Qed. Definition IInv := Build_CSetoid_fun _ _ (fun x => [--] (f x)) IInv_strext. Lemma IMinus_strext : forall x y : subset I, f x[-]g x [#] f y[-]g y -> x [#] y. -intros x y H. -elim (cg_minus_strext _ _ _ _ _ H); intro H0; - exact (csf_strext_unfolded _ _ _ _ _ H0). +Proof. + intros x y H. + elim (cg_minus_strext _ _ _ _ _ H); intro H0; exact (csf_strext_unfolded _ _ _ _ _ H0). Qed. Definition IMinus := Build_CSetoid_fun _ _ (fun x => f x[-]g x) IMinus_strext. Lemma IMult_strext : forall x y : subset I, f x[*]g x [#] f y[*]g y -> x [#] y. -intros x y H. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intro H0; - exact (csf_strext_unfolded _ _ _ _ _ H0). +Proof. + intros x y H. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H); intro H0; exact (csf_strext_unfolded _ _ _ _ _ H0). Qed. Definition IMult := Build_CSetoid_fun _ _ (fun x => f x[*]g x) IMult_strext. @@ -139,9 +142,10 @@ Exponentiation to a natural power [n] is also useful. Variable n : nat. Lemma INth_strext : forall x y : subset I, f x[^]n [#] f y[^]n -> x [#] y. -intros. -apply csf_strext_unfolded with (IR:CSetoid) f. -apply nexp_strext with n; assumption. +Proof. + intros. + apply csf_strext_unfolded with (IR:CSetoid) f. + apply nexp_strext with n; assumption. Qed. Definition INth := Build_CSetoid_fun _ _ (fun x => f x[^]n) INth_strext. @@ -159,18 +163,19 @@ Hypothesis Hg : forall x : subset I, g x [#] Zero. (* end show *) Lemma IRecip_strext : forall x y : subset I, (One[/] g x[//]Hg x) [#] (One[/] g y[//]Hg y) -> x [#] y. -intros x y H. -elim (div_strext _ _ _ _ _ _ _ H); intro H0. -elim (ap_irreflexive_unfolded _ _ H0). -exact (csf_strext_unfolded _ _ _ _ _ H0). +Proof. + intros x y H. + elim (div_strext _ _ _ _ _ _ _ H); intro H0. + elim (ap_irreflexive_unfolded _ _ H0). + exact (csf_strext_unfolded _ _ _ _ _ H0). Qed. Definition IRecip := Build_CSetoid_fun _ _ (fun x => One[/] g x[//]Hg x) IRecip_strext. Lemma IDiv_strext : forall x y : subset I, (f x[/] g x[//]Hg x) [#] (f y[/] g y[//]Hg y) -> x [#] y. -intros x y H. -elim (div_strext _ _ _ _ _ _ _ H); intro H0; - exact (csf_strext_unfolded _ _ _ _ _ H0). +Proof. + intros x y H. + elim (div_strext _ _ _ _ _ _ _ H); intro H0; exact (csf_strext_unfolded _ _ _ _ _ H0). Qed. Definition IDiv := Build_CSetoid_fun _ _ (fun x => f x[/] g x[//]Hg x) IDiv_strext. @@ -182,18 +187,19 @@ Absolute value will also be needed at some point. *) Lemma IAbs_strext : forall x y : subset I, AbsIR (f x) [#] AbsIR (f y) -> x [#] y. -intros x y H. -apply csf_strext_unfolded with (IR:CSetoid) f. -simpl in H; unfold ABSIR in H; elim (bin_op_strext_unfolded _ _ _ _ _ _ H). -auto. -intro; apply un_op_strext_unfolded with (cg_inv (c:=IR)); assumption. +Proof. + intros x y H. + apply csf_strext_unfolded with (IR:CSetoid) f. + simpl in H; unfold ABSIR in H; elim (bin_op_strext_unfolded _ _ _ _ _ _ H). + auto. + intro; apply un_op_strext_unfolded with (cg_inv (c:=IR)); assumption. Qed. Definition IAbs := Build_CSetoid_fun _ _ (fun x => AbsIR (f x)) IAbs_strext. End Operations. -(** +(** The set of these functions form a ring with relation to the operations of sum and multiplication. As they actually form a set, this fact can be proved in Coq for this class of functions; unfortunately, due to a @@ -232,9 +238,10 @@ Hypothesis Hfg : forall x : subset I, I' (f x). Lemma IComp_strext : forall x y : subset I, g (Build_subcsetoid_crr _ _ _ (Hfg x)) [#] g (Build_subcsetoid_crr _ _ _ (Hfg y)) -> x [#] y. -intros x y H. -apply csf_strext_unfolded with (IR:CSetoid) f. -exact (csf_strext_unfolded _ _ _ _ _ H). +Proof. + intros x y H. + apply csf_strext_unfolded with (IR:CSetoid) f. + exact (csf_strext_unfolded _ _ _ _ _ H). Qed. Definition IComp := Build_CSetoid_fun _ _ diff --git a/ftc/MoreFunSeries.v b/ftc/MoreFunSeries.v index 5e9857008..f63e0fdbe 100644 --- a/ftc/MoreFunSeries.v +++ b/ftc/MoreFunSeries.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export FunctSeries. Require Export MoreFunctions. @@ -90,50 +90,43 @@ The equivalences between these definitions still hold. *) Lemma conv_Cauchy_fun_seq'_IR : conv_fun_seq'_IR -> Cauchy_fun_seq_IR. -intro H. -red in |- *; red in H. -intros. -apply - conv_Cauchy_fun_seq' with F (included_imp_Continuous _ _ contF _ _ _ Hinc); - auto. +Proof. + intro H. + red in |- *; red in H. + intros. + apply conv_Cauchy_fun_seq' with F (included_imp_Continuous _ _ contF _ _ _ Hinc); auto. Qed. Lemma Cauchy_fun_seq_seq2_IR : Cauchy_fun_seq_IR -> Cauchy_fun_seq2_IR. -intro H. -red in |- *; red in H. -intros. -apply Cauchy_fun_seq_seq2; auto. +Proof. + intro H. + red in |- *; red in H. + intros. + apply Cauchy_fun_seq_seq2; auto. Qed. Lemma Cauchy_fun_seq2_seq_IR : Cauchy_fun_seq2_IR -> Cauchy_fun_seq_IR. -intro H. -red in |- *; red in H. -intros. -apply Cauchy_fun_seq2_seq; auto. +Proof. + intro H. + red in |- *; red in H. + intros. + apply Cauchy_fun_seq2_seq; auto. Qed. Lemma Cauchy_fun_real_IR : Cauchy_fun_seq_IR -> forall x Hx, Cauchy_prop (fun n => Part _ _ (Continuous_imp_inc _ _ (contf n) x Hx)). -intros H x Hx. -red in H. -cut (included (compact_single x) J). intro H0. -set - (contf' := - fun i : nat => - included_imp_Continuous J (f i) (contf i) _ _ (leEq_reflexive _ x) H0) - in *. -apply - Cauchy_prop_wd - with - (fun n : nat => - Part (f n) x - ((fun i : nat => - contin_imp_inc _ _ (leEq_reflexive _ x) (f i) (contf' i)) n x - (compact_single_prop x))). -apply Cauchy_fun_real. -unfold contf' in |- *; simpl in |- *; apply H. -intro; simpl in |- *; algebra. -apply compact_single_iprop; auto. +Proof. + intros H x Hx. + red in H. + cut (included (compact_single x) J). intro H0. + set (contf' := fun i : nat => included_imp_Continuous J (f i) (contf i) _ _ (leEq_reflexive _ x) H0) + in *. + apply Cauchy_prop_wd with (fun n : nat => Part (f n) x ((fun i : nat => + contin_imp_inc _ _ (leEq_reflexive _ x) (f i) (contf' i)) n x (compact_single_prop x))). + apply Cauchy_fun_real. + unfold contf' in |- *; simpl in |- *; apply H. + intro; simpl in |- *; algebra. + apply compact_single_iprop; auto. Qed. End Definitions. @@ -153,26 +146,25 @@ Hypothesis conv : Cauchy_fun_seq_IR J f contf. (* end show *) Definition Cauchy_fun_seq_Lim_IR : PartIR. -apply - Build_PartFunct - with - (pfpfun := fun (x : IR) (Hx : J x) => - Lim (Build_CauchySeq _ _ (Cauchy_fun_real_IR _ _ _ conv x Hx))). -apply iprop_wd. -intros x y Hx Hy H. -elim (Lim_strext _ _ H). -intros n Hn. -simpl in Hn. -exact (pfstrx _ _ _ _ _ _ Hn). +Proof. + apply Build_PartFunct with (pfpfun := fun (x : IR) (Hx : J x) => + Lim (Build_CauchySeq _ _ (Cauchy_fun_real_IR _ _ _ conv x Hx))). + apply iprop_wd. + intros x y Hx Hy H. + elim (Lim_strext _ _ H). + intros n Hn. + simpl in Hn. + exact (pfstrx _ _ _ _ _ _ Hn). Defined. Lemma Cauchy_fun_seq_Lim_char : forall a b Hab (Hinc : included (Compact Hab) J), Feq (Compact Hab) Cauchy_fun_seq_Lim_IR (Cauchy_fun_seq_Lim _ _ _ _ _ (conv a b Hab Hinc)). -intros. -FEQ. -simpl in |- *. -apply Lim_wd'; intros; simpl in |- *; algebra. +Proof. + intros. + FEQ. + simpl in |- *. + apply Lim_wd'; intros; simpl in |- *; algebra. Qed. End More_Definitions. @@ -198,26 +190,28 @@ Hypotheses contF contF0 : Continuous J F. Lemma conv_fun_seq'_wd_IR : conv_fun_seq'_IR _ _ _ contf contF -> conv_fun_seq'_IR _ _ _ contf0 contF0. -intro H. -red in |- *; intros. -eapply conv_fun_seq'_wd. -apply (H a b Hab Hinc). + intro H. + red in |- *; intros. + eapply conv_fun_seq'_wd. + apply (H a b Hab Hinc). Qed. Lemma Cauchy_fun_seq2_wd_IR : Cauchy_fun_seq2_IR _ _ contf -> Cauchy_fun_seq2_IR _ _ contf0. -intro H. -red in |- *; intros. -eapply Cauchy_fun_seq2_wd. -apply (H a b Hab Hinc). +Proof. + intro H. + red in |- *; intros. + eapply Cauchy_fun_seq2_wd. + apply (H a b Hab Hinc). Qed. Lemma conv_fun_seq_wd_IR : conv_fun_seq_IR _ _ contf -> conv_fun_seq_IR _ _ contf0. -intro H. -red in |- *; intros. -eapply conv_fun_seq_wd. -apply (H a b Hab Hinc). +Proof. + intro H. + red in |- *; intros. + eapply conv_fun_seq_wd. + apply (H a b Hab Hinc). Qed. End Irrelevance_of_Proofs. @@ -236,16 +230,14 @@ Hypotheses contg contg0 : forall n : nat, Continuous J (g n). Lemma Cauchy_conv_fun_seq'_IR : forall H contf', conv_fun_seq'_IR _ _ (Cauchy_fun_seq_Lim_IR _ _ contf H) contf contf'. -intros. -red in |- *; intros. -eapply conv_fun_seq'_wdr. -apply Feq_symmetric. -apply (Cauchy_fun_seq_Lim_char J f contf H a b Hab Hinc). -apply - Cauchy_conv_fun_seq' - with - (H := H a b Hab Hinc) - (contf' := Cauchy_cont_Lim _ _ _ _ _ (H a b Hab Hinc)). +Proof. + intros. + red in |- *; intros. + eapply conv_fun_seq'_wdr. + apply Feq_symmetric. + apply (Cauchy_fun_seq_Lim_char J f contf H a b Hab Hinc). + apply Cauchy_conv_fun_seq' with (H := H a b Hab Hinc) + (contf' := Cauchy_cont_Lim _ _ _ _ _ (H a b Hab Hinc)). Qed. Variables F G : PartIR. @@ -256,60 +248,67 @@ Hypotheses contG contG0 : Continuous J G. Lemma conv_fun_seq'_wdl_IR : (forall n, Feq J (f n) (g n)) -> conv_fun_seq'_IR _ _ _ contf contF -> conv_fun_seq'_IR _ _ _ contg contF0. -intros H H0 a b Hab Hinc. -eapply conv_fun_seq'_wdl with (f := f). -2: apply (H0 a b Hab Hinc). -intro; elim (H n); intros. -inversion_clear b0. -apply eq_imp_Feq; Included. +Proof. + intros H H0 a b Hab Hinc. + eapply conv_fun_seq'_wdl with (f := f). + 2: apply (H0 a b Hab Hinc). + intro; elim (H n); intros. + inversion_clear b0. + apply eq_imp_Feq; Included. Qed. Lemma conv_fun_seq'_wdr_IR : Feq J F G -> conv_fun_seq'_IR _ _ _ contf contF -> conv_fun_seq'_IR _ _ _ contf0 contG. -intros H H0 a b Hab Hinc. -eapply conv_fun_seq'_wdr with (F := F). -2: apply (H0 a b Hab Hinc). -apply included_Feq with J; auto. +Proof. + intros H H0 a b Hab Hinc. + eapply conv_fun_seq'_wdr with (F := F). + 2: apply (H0 a b Hab Hinc). + apply included_Feq with J; auto. Qed. Lemma conv_fun_seq'_wdl'_IR : (forall n, Feq J (f n) (g n)) -> conv_fun_seq'_IR _ _ _ contf contF -> conv_fun_seq'_IR _ _ _ contg contF. -intros H H0 a b Hab Hinc. -eapply conv_fun_seq'_wdl' with (f := f); auto. -intro; elim (H n); intros. -inversion_clear b0. -apply eq_imp_Feq; Included. +Proof. + intros H H0 a b Hab Hinc. + eapply conv_fun_seq'_wdl' with (f := f); auto. + intro; elim (H n); intros. + inversion_clear b0. + apply eq_imp_Feq; Included. Qed. Lemma conv_fun_seq'_wdr'_IR : Feq J F G -> conv_fun_seq'_IR _ _ _ contf contF -> conv_fun_seq'_IR _ _ _ contf contG. -intros H H0 a b Hab Hinc. -eapply conv_fun_seq'_wdr' with (F := F). -2: apply (H0 a b Hab Hinc). -apply included_Feq with J; auto. +Proof. + intros H H0 a b Hab Hinc. + eapply conv_fun_seq'_wdr' with (F := F). + 2: apply (H0 a b Hab Hinc). + apply included_Feq with J; auto. Qed. Lemma Cauchy_cont_Lim_IR : forall H, Continuous J (Cauchy_fun_seq_Lim_IR _ _ contf H). -intros. -split; Included. -intros a b Hab H0; eapply Continuous_I_wd. -apply Feq_symmetric. -apply (Cauchy_fun_seq_Lim_char J f contf H a b Hab H0). -Contin. +Proof. + intros. + split; Included. + intros a b Hab H0; eapply Continuous_I_wd. + apply Feq_symmetric. + apply (Cauchy_fun_seq_Lim_char J f contf H a b Hab H0). + Contin. Qed. Lemma Cauchy_conv_fun_seq_IR : Cauchy_fun_seq_IR _ _ contf -> conv_fun_seq_IR _ _ contf. -intros H a b Hab Hinc. -eapply Cauchy_conv_fun_seq. -apply (H a b Hab Hinc). +Proof. + intros H a b Hab Hinc. + eapply Cauchy_conv_fun_seq. + apply (H a b Hab Hinc). Qed. Lemma conv_Cauchy_fun_seq_IR : conv_fun_seq_IR _ _ contf -> Cauchy_fun_seq_IR _ _ contf. -intros H a b Hab Hinc. -eapply conv_Cauchy_fun_seq. -apply (H a b Hab Hinc). +Proof. + intros H a b Hab Hinc. + eapply conv_Cauchy_fun_seq. + apply (H a b Hab Hinc). Qed. End More_Properties. @@ -332,40 +331,39 @@ Hypothesis contg : forall n : nat, Continuous J (g n). Lemma FLim_unique_IR : forall F G HF HG, conv_fun_seq'_IR J f F contf HF -> conv_fun_seq'_IR J f G contf HG -> Feq J F G. -intros F G HF HG H H0. -apply included_Feq'. -intros a b Hab H1. -apply - FLim_unique - with - f - (fun n : nat => included_imp_Continuous _ _ (contf n) _ _ _ H1) - (included_imp_Continuous _ _ HF _ _ _ H1) - (included_imp_Continuous _ _ HG _ _ _ H1); auto. +Proof. + intros F G HF HG H H0. + apply included_Feq'. + intros a b Hab H1. + apply FLim_unique with f (fun n : nat => included_imp_Continuous _ _ (contf n) _ _ _ H1) + (included_imp_Continuous _ _ HF _ _ _ H1) (included_imp_Continuous _ _ HG _ _ _ H1); auto. Qed. Lemma Cauchy_fun_seq_wd_IR : (forall n, Feq J (f n) (g n)) -> Cauchy_fun_seq_IR _ _ contf -> Cauchy_fun_seq_IR _ _ contg. -intros H H0 a b Hab Hinc. -eapply Cauchy_fun_seq_wd with (f := f). -2: apply (H0 a b Hab Hinc). -intro; apply included_Feq with J; auto. +Proof. + intros H H0 a b Hab Hinc. + eapply Cauchy_fun_seq_wd with (f := f). + 2: apply (H0 a b Hab Hinc). + intro; apply included_Feq with J; auto. Qed. Lemma fun_Lim_seq_const_IR : forall H contH contH', conv_fun_seq'_IR J (fun n => H) H contH contH'. -exists 0; intros. -eapply leEq_wdl. -2: eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply AbsIRz_isz. -apply less_leEq; assumption. -apply AbsIR_wd; rational. +Proof. + exists 0; intros. + eapply leEq_wdl. + 2: eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply AbsIRz_isz. + apply less_leEq; assumption. + apply AbsIR_wd; rational. Qed. Lemma fun_Cauchy_prop_const_IR : forall H (contH:Continuous J H), Cauchy_fun_seq_IR J (fun n => H) (fun n => contH). -intros. -apply conv_Cauchy_fun_seq'_IR with H (contH). -apply fun_Lim_seq_const_IR. +Proof. + intros. + apply conv_Cauchy_fun_seq'_IR with H (contH). + apply fun_Lim_seq_const_IR. Qed. Variables F G : PartIR. @@ -379,29 +377,32 @@ Hypothesis convG : conv_fun_seq'_IR _ _ _ contg contG. Lemma fun_Lim_seq_plus'_IR : forall H H', conv_fun_seq'_IR J (fun n => f n{+}g n) (F{+}G) H H'. -intros. -red in |- *; intros. -eapply fun_Lim_seq_plus'. -apply (convF a b Hab Hinc). -apply (convG a b Hab Hinc). +Proof. + intros. + red in |- *; intros. + eapply fun_Lim_seq_plus'. + apply (convF a b Hab Hinc). + apply (convG a b Hab Hinc). Qed. Lemma fun_Lim_seq_minus'_IR : forall H H', conv_fun_seq'_IR J (fun n => f n{-}g n) (F{-}G) H H'. -intros. -red in |- *; intros. -eapply fun_Lim_seq_minus'. -apply (convF a b Hab Hinc). -apply (convG a b Hab Hinc). +Proof. + intros. + red in |- *; intros. + eapply fun_Lim_seq_minus'. + apply (convF a b Hab Hinc). + apply (convG a b Hab Hinc). Qed. Lemma fun_Lim_seq_mult'_IR : forall H H', conv_fun_seq'_IR J (fun n => f n{*}g n) (F{*}G) H H'. -intros. -red in |- *; intros. -eapply fun_Lim_seq_mult'. -apply (convF a b Hab Hinc). -apply (convG a b Hab Hinc). +Proof. + intros. + red in |- *; intros. + eapply fun_Lim_seq_mult'. + apply (convF a b Hab Hinc). + apply (convG a b Hab Hinc). Qed. End Algebraic_Properties. @@ -425,118 +426,94 @@ Hypothesis Hg : Cauchy_fun_seq_IR _ _ contg. Lemma fun_Lim_seq_plus_IR : forall H H', conv_fun_seq'_IR J (fun n => f n{+}g n) (Cauchy_fun_seq_Lim_IR _ _ _ Hf{+}Cauchy_fun_seq_Lim_IR _ _ _ Hg) H H'. -intros. -red in |- *; intros. -cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hf a b Hab Hinc))); - [ intro H0 | Contin ]. -cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hg a b Hab Hinc))); - [ intro H1 | Contin ]. -eapply conv_fun_seq'_wdr with (contF := Continuous_I_plus _ _ _ _ _ H0 H1). -apply Feq_symmetric; apply Feq_plus; apply Cauchy_fun_seq_Lim_char. -apply - fun_Lim_seq_plus - with - (Hf := Hf a b Hab Hinc) - (Hg := Hg a b Hab Hinc) - (H := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc). +Proof. + intros. + red in |- *; intros. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hf a b Hab Hinc))); [ intro H0 | Contin ]. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hg a b Hab Hinc))); [ intro H1 | Contin ]. + eapply conv_fun_seq'_wdr with (contF := Continuous_I_plus _ _ _ _ _ H0 H1). + apply Feq_symmetric; apply Feq_plus; apply Cauchy_fun_seq_Lim_char. + apply fun_Lim_seq_plus with (Hf := Hf a b Hab Hinc) (Hg := Hg a b Hab Hinc) + (H := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc). Qed. Lemma fun_Cauchy_prop_plus : forall H, Cauchy_fun_seq_IR J (fun n => f n{+}g n) H. -intro. -cut - (Continuous J - (Cauchy_fun_seq_Lim_IR _ _ _ Hf{+}Cauchy_fun_seq_Lim_IR _ _ _ Hg)); - [ intro H0 | Contin ]. -apply - conv_Cauchy_fun_seq'_IR - with (Cauchy_fun_seq_Lim_IR _ _ _ Hf{+}Cauchy_fun_seq_Lim_IR _ _ _ Hg) H0. -apply fun_Lim_seq_plus_IR. +Proof. + intro. + cut (Continuous J (Cauchy_fun_seq_Lim_IR _ _ _ Hf{+}Cauchy_fun_seq_Lim_IR _ _ _ Hg)); + [ intro H0 | Contin ]. + apply conv_Cauchy_fun_seq'_IR + with (Cauchy_fun_seq_Lim_IR _ _ _ Hf{+}Cauchy_fun_seq_Lim_IR _ _ _ Hg) H0. + apply fun_Lim_seq_plus_IR. Qed. Lemma fun_Lim_seq_inv_IR : forall H H', conv_fun_seq'_IR J (fun n => {--} (f n)) {--} (Cauchy_fun_seq_Lim_IR _ _ _ Hf) H H'. -intros. -red in |- *; intros. -cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hf a b Hab Hinc))); - [ intro H0 | Contin ]. -intros. -eapply conv_fun_seq'_wdr with (contF := Continuous_I_inv _ _ _ _ H0). -apply Feq_symmetric; apply Feq_inv; apply Cauchy_fun_seq_Lim_char. -apply - fun_Lim_seq_inv - with - (Hf := Hf a b Hab Hinc) - (H := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc). +Proof. + intros. + red in |- *; intros. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hf a b Hab Hinc))); [ intro H0 | Contin ]. + intros. + eapply conv_fun_seq'_wdr with (contF := Continuous_I_inv _ _ _ _ H0). + apply Feq_symmetric; apply Feq_inv; apply Cauchy_fun_seq_Lim_char. + apply fun_Lim_seq_inv with (Hf := Hf a b Hab Hinc) + (H := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc). Qed. Lemma fun_Cauchy_prop_inv : forall H, Cauchy_fun_seq_IR J (fun n => {--} (f n)) H. -intro. -cut (Continuous J {--} (Cauchy_fun_seq_Lim_IR _ _ _ Hf)); - [ intro H0 | Contin ]. -apply conv_Cauchy_fun_seq'_IR with ( {--} (Cauchy_fun_seq_Lim_IR _ _ _ Hf)) H0. -apply fun_Lim_seq_inv_IR. +Proof. + intro. + cut (Continuous J {--} (Cauchy_fun_seq_Lim_IR _ _ _ Hf)); [ intro H0 | Contin ]. + apply conv_Cauchy_fun_seq'_IR with ( {--} (Cauchy_fun_seq_Lim_IR _ _ _ Hf)) H0. + apply fun_Lim_seq_inv_IR. Qed. Lemma fun_Lim_seq_minus_IR : forall H H', conv_fun_seq'_IR J (fun n => f n{-}g n) (Cauchy_fun_seq_Lim_IR _ _ _ Hf{-}Cauchy_fun_seq_Lim_IR _ _ _ Hg) H H'. -intros. -red in |- *; intros. -cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hf a b Hab Hinc))); - [ intro H0 | Contin ]. -cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hg a b Hab Hinc))); - [ intro H1 | Contin ]. -intros. -eapply conv_fun_seq'_wdr with (contF := Continuous_I_minus _ _ _ _ _ H0 H1). -apply Feq_symmetric; apply Feq_minus; apply Cauchy_fun_seq_Lim_char. -apply - fun_Lim_seq_minus - with - (Hf := Hf a b Hab Hinc) - (Hg := Hg a b Hab Hinc) - (H := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc). +Proof. + intros. + red in |- *; intros. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hf a b Hab Hinc))); [ intro H0 | Contin ]. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hg a b Hab Hinc))); [ intro H1 | Contin ]. + intros. + eapply conv_fun_seq'_wdr with (contF := Continuous_I_minus _ _ _ _ _ H0 H1). + apply Feq_symmetric; apply Feq_minus; apply Cauchy_fun_seq_Lim_char. + apply fun_Lim_seq_minus with (Hf := Hf a b Hab Hinc) (Hg := Hg a b Hab Hinc) + (H := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc). Qed. Lemma fun_Cauchy_prop_minus : forall H, Cauchy_fun_seq_IR J (fun n => f n{-}g n) H. -intro. -cut - (Continuous J - (Cauchy_fun_seq_Lim_IR _ _ _ Hf{-}Cauchy_fun_seq_Lim_IR _ _ _ Hg)); - [ intro H0 | Contin ]. -apply - conv_Cauchy_fun_seq'_IR - with (Cauchy_fun_seq_Lim_IR _ _ _ Hf{-}Cauchy_fun_seq_Lim_IR _ _ _ Hg) H0. -apply fun_Lim_seq_minus_IR. +Proof. + intro. + cut (Continuous J (Cauchy_fun_seq_Lim_IR _ _ _ Hf{-}Cauchy_fun_seq_Lim_IR _ _ _ Hg)); + [ intro H0 | Contin ]. + apply conv_Cauchy_fun_seq'_IR + with (Cauchy_fun_seq_Lim_IR _ _ _ Hf{-}Cauchy_fun_seq_Lim_IR _ _ _ Hg) H0. + apply fun_Lim_seq_minus_IR. Qed. Lemma fun_Lim_seq_mult_IR : forall H H', conv_fun_seq'_IR J (fun n => f n{*}g n) (Cauchy_fun_seq_Lim_IR _ _ _ Hf{*}Cauchy_fun_seq_Lim_IR _ _ _ Hg) H H'. -intros. -red in |- *; intros. -cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hf a b Hab Hinc))); - [ intro H0 | Contin ]. -cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hg a b Hab Hinc))); - [ intro H1 | Contin ]. -intros. -eapply conv_fun_seq'_wdr with (contF := Continuous_I_mult _ _ _ _ _ H0 H1). -apply Feq_symmetric; apply Feq_mult; apply Cauchy_fun_seq_Lim_char. -apply - fun_Lim_seq_mult - with - (Hf := Hf a b Hab Hinc) - (Hg := Hg a b Hab Hinc) - (H := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc). +Proof. + intros. + red in |- *; intros. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hf a b Hab Hinc))); [ intro H0 | Contin ]. + cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (Hg a b Hab Hinc))); [ intro H1 | Contin ]. + intros. + eapply conv_fun_seq'_wdr with (contF := Continuous_I_mult _ _ _ _ _ H0 H1). + apply Feq_symmetric; apply Feq_mult; apply Cauchy_fun_seq_Lim_char. + apply fun_Lim_seq_mult with (Hf := Hf a b Hab Hinc) (Hg := Hg a b Hab Hinc) + (H := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc). Qed. Lemma fun_Cauchy_prop_mult : forall H, Cauchy_fun_seq_IR J (fun n => f n{*}g n) H. -intro. -cut - (Continuous J - (Cauchy_fun_seq_Lim_IR _ _ _ Hf{*}Cauchy_fun_seq_Lim_IR _ _ _ Hg)); - [ intro H0 | Contin ]. -apply - conv_Cauchy_fun_seq'_IR - with (Cauchy_fun_seq_Lim_IR _ _ _ Hf{*}Cauchy_fun_seq_Lim_IR _ _ _ Hg) H0. -apply fun_Lim_seq_mult_IR. +Proof. + intro. + cut (Continuous J (Cauchy_fun_seq_Lim_IR _ _ _ Hf{*}Cauchy_fun_seq_Lim_IR _ _ _ Hg)); + [ intro H0 | Contin ]. + apply conv_Cauchy_fun_seq'_IR + with (Cauchy_fun_seq_Lim_IR _ _ _ Hf{*}Cauchy_fun_seq_Lim_IR _ _ _ Hg) H0. + apply fun_Lim_seq_mult_IR. Qed. End More_Algebraic_Properties. @@ -554,21 +531,22 @@ Definition seq_to_funseq (x : nat -> IR) n : PartIR := [-C-] (x n). Lemma funseq_conv : forall J x y, nonvoid J -> conv_fun_seq'_IR J (seq_to_funseq x) [-C-]y (fun n => Continuous_const _ _) (Continuous_const _ _) -> Cauchy_Lim_prop2 x y. -intros J x y H H0 eps H1. -elim (nonvoid_point J H); intros x0 Hx0. -cut (included (compact_single x0) J). -2: apply compact_single_iprop; auto. -intro H2. -elim (H0 _ _ (leEq_reflexive _ _) H2 eps). -intros N HN. -exists N; intros. -simpl in HN. -apply AbsIR_imp_AbsSmall. -apply HN with x0. -auto. -fold (compact_single x0) in |- *. -apply compact_single_prop. -auto. +Proof. + intros J x y H H0 eps H1. + elim (nonvoid_point J H); intros x0 Hx0. + cut (included (compact_single x0) J). + 2: apply compact_single_iprop; auto. + intro H2. + elim (H0 _ _ (leEq_reflexive _ _) H2 eps). + intros N HN. + exists N; intros. + simpl in HN. + apply AbsIR_imp_AbsSmall. + apply HN with x0. + auto. + fold (compact_single x0) in |- *. + apply compact_single_prop. + auto. Qed. (** @@ -578,48 +556,49 @@ Another interesting fact: if a sequence of constant functions converges then it Lemma fun_const_Lim : forall J f F contf contF, proper J -> conv_fun_seq'_IR J f F contf contF -> (forall n, {c : IR | Feq J (f n) [-C-]c}) -> {c : IR | Feq J F [-C-]c}. -intros J f F contf contF pJ H H0. -set (incF := Continuous_imp_inc _ _ contF) in *. -set (incf := fun n : nat => Continuous_imp_inc _ _ (contf n)) in *. -elim (nonvoid_point _ (proper_nonvoid _ pJ)); intros x0 Hx0. -exists (Part F x0 (incF x0 Hx0)). -FEQ. rename X into H1. -simpl in |- *. -apply cg_inv_unique_2; apply AbsIR_approach_zero. -intros e H2. -cut (included (Compact (Min_leEq_Max x x0)) J). -2: apply included_interval; auto. -intro Hinc. -elim (H _ _ _ Hinc _ (pos_div_two _ _ H2)); intros N HN. -set (Fx := Part _ _ Hx) in *. -set (Fa := Part _ _ (incF x0 Hx0)) in *. -set (fx := Part _ _ (incf N x H1)) in *. -set (fa := Part _ _ (incf N x0 Hx0)) in *. -apply leEq_wdl with (AbsIR (Fx[-]fx[+] (fx[-]fa) [+] (fa[-]Fa))). -2: apply AbsIR_wd; rational. -rstepr (e [/]TwoNZ[+]Zero[+]e [/]TwoNZ). -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -eapply leEq_wdl. -2: apply AbsIR_minus. -eapply leEq_wdl. -apply (HN N (le_n N) x (compact_Min_lft _ _ _)). -unfold Fx, fx in |- *; apply AbsIR_wd; rational. -elim (H0 N); intros c Hc. -apply eq_imp_leEq. -eapply eq_transitive_unfolded. -2: apply AbsIRz_isz. -elim Hc; clear Hc; intros H5 H3. -elim H3; clear H3; intros H6 H4. -apply AbsIR_wd; unfold fx, fa in |- *; astepr (c[-]c). -apply cg_minus_wd; simpl in H4; apply H4; auto. -eapply leEq_wdl. -apply (HN N (le_n N) x0 (compact_Min_rht _ _ _)). -unfold Fa, fa in |- *; apply AbsIR_wd; rational. +Proof. + intros J f F contf contF pJ H H0. + set (incF := Continuous_imp_inc _ _ contF) in *. + set (incf := fun n : nat => Continuous_imp_inc _ _ (contf n)) in *. + elim (nonvoid_point _ (proper_nonvoid _ pJ)); intros x0 Hx0. + exists (Part F x0 (incF x0 Hx0)). + FEQ. rename X into H1. + simpl in |- *. + apply cg_inv_unique_2; apply AbsIR_approach_zero. + intros e H2. + cut (included (Compact (Min_leEq_Max x x0)) J). + 2: apply included_interval; auto. + intro Hinc. + elim (H _ _ _ Hinc _ (pos_div_two _ _ H2)); intros N HN. + set (Fx := Part _ _ Hx) in *. + set (Fa := Part _ _ (incF x0 Hx0)) in *. + set (fx := Part _ _ (incf N x H1)) in *. + set (fa := Part _ _ (incf N x0 Hx0)) in *. + apply leEq_wdl with (AbsIR (Fx[-]fx[+] (fx[-]fa) [+] (fa[-]Fa))). + 2: apply AbsIR_wd; rational. + rstepr (e [/]TwoNZ[+]Zero[+]e [/]TwoNZ). + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + eapply leEq_wdl. + 2: apply AbsIR_minus. + eapply leEq_wdl. + apply (HN N (le_n N) x (compact_Min_lft _ _ _)). + unfold Fx, fx in |- *; apply AbsIR_wd; rational. + elim (H0 N); intros c Hc. + apply eq_imp_leEq. + eapply eq_transitive_unfolded. + 2: apply AbsIRz_isz. + elim Hc; clear Hc; intros H5 H3. + elim H3; clear H3; intros H6 H4. + apply AbsIR_wd; unfold fx, fa in |- *; astepr (c[-]c). + apply cg_minus_wd; simpl in H4; apply H4; auto. + eapply leEq_wdl. + apply (HN N (le_n N) x0 (compact_Min_rht _ _ _)). + unfold Fa, fa in |- *; apply AbsIR_wd; rational. Qed. End Other. @@ -642,11 +621,12 @@ Definition fun_series_convergent_IR := forall a b Hab (Hinc : included (Compact Lemma fun_series_conv_imp_conv_IR : fun_series_convergent_IR -> forall x, J x -> forall Hx, convergent (fun n : nat => f n x (Hx n)). -intros H x H0 Hx. -apply fun_series_conv_imp_conv with (Hab := leEq_reflexive _ x). -apply H. -fold (compact_single x) in |- *; apply compact_single_iprop; auto. -apply compact_single_prop. +Proof. + intros H x H0 Hx. + apply fun_series_conv_imp_conv with (Hab := leEq_reflexive _ x). + apply H. + fold (compact_single x) in |- *; apply compact_single_iprop; auto. + apply compact_single_prop. Qed. (* begin show *) @@ -654,11 +634,12 @@ Hypothesis H : fun_series_convergent_IR. (* end show *) Lemma fun_series_inc_IR : forall x, J x -> forall n, Dom (f n) x. -intros x H0 n. -elim (H _ _ (leEq_reflexive _ x) (compact_single_iprop J x H0)). -intros contF CauchyF. -apply (contin_imp_inc _ _ _ _ (contF n)). -apply compact_single_prop. +Proof. + intros x H0 n. + elim (H _ _ (leEq_reflexive _ x) (compact_single_iprop J x H0)). + intros contF CauchyF. + apply (contin_imp_inc _ _ _ _ (contF n)). + apply compact_single_prop. Qed. (** Assume [h(x)] is the pointwise series of [f(x)] *) @@ -671,26 +652,29 @@ Let h (x : IR) (Hx : J x) := series_sum _ (* end hide *) Lemma FSeries_Sum_strext_IR : forall x y Hx Hy, h x Hx [#] h y Hy -> x [#] y. -unfold h in |- *; clear h; intros x y Hx Hy H0. -unfold series_sum in H0. -elim (Lim_strext _ _ H0); intros N HN. -simpl in HN; unfold seq_part_sum in HN. -elim (Sum0_strext _ _ _ _ HN); intros. -exact (pfstrx _ _ _ _ _ _ q). +Proof. + unfold h in |- *; clear h; intros x y Hx Hy H0. + unfold series_sum in H0. + elim (Lim_strext _ _ H0); intros N HN. + simpl in HN; unfold seq_part_sum in HN. + elim (Sum0_strext _ _ _ _ HN); intros. + exact (pfstrx _ _ _ _ _ _ q). Qed. Definition FSeries_Sum : PartIR. -apply Build_PartFunct with (pfpfun := h). -apply iprop_wd. -exact FSeries_Sum_strext_IR. +Proof. + apply Build_PartFunct with (pfpfun := h). + apply iprop_wd. + exact FSeries_Sum_strext_IR. Defined. Lemma FSeries_Sum_char : forall a b Hab (Hinc : included (Compact Hab) J), Feq (Compact Hab) FSeries_Sum (Fun_Series_Sum (H a b Hab Hinc)). -intros; FEQ. -simpl in |- *; Included. -simpl in |- *; unfold h in |- *. -apply series_sum_wd; intros; algebra. +Proof. + intros; FEQ. + simpl in |- *; Included. + simpl in |- *; unfold h in |- *. + apply series_sum_wd; intros; algebra. Qed. End Series_Definitions. @@ -722,56 +706,54 @@ Variable f : nat -> PartIR. Lemma FSeries_conv : forall (convF : fun_series_convergent_IR J f) H H', conv_fun_seq'_IR J (fun n => FSum0 n f) (FSeries_Sum convF) H H'. -intros. -red in |- *; intros. -elim (convF _ _ _ Hinc); intros Hcont Hconv. -apply - conv_fun_seq'_wdr - with - (f := fun n : nat => FSum0 n f) - (contf := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc) - (contF := Fun_Series_Sum_cont _ _ _ _ (convF _ _ _ Hinc)). -apply Feq_symmetric; apply FSeries_Sum_char. -apply - conv_fun_seq'_wdl - with - (f := fun_seq_part_sum f) - (contf := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc) - (contF := Fun_Series_Sum_cont _ _ _ _ (convF _ _ _ Hinc)). -intro; apply Feq_reflexive. -red in |- *; intros. -simpl in |- *; intros. -apply (contin_imp_inc _ _ _ _ (Hcont n0)); auto. -apply fun_series_conv. +Proof. + intros. + red in |- *; intros. + elim (convF _ _ _ Hinc); intros Hcont Hconv. + apply conv_fun_seq'_wdr with (f := fun n : nat => FSum0 n f) + (contf := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc) + (contF := Fun_Series_Sum_cont _ _ _ _ (convF _ _ _ Hinc)). + apply Feq_symmetric; apply FSeries_Sum_char. + apply conv_fun_seq'_wdl with (f := fun_seq_part_sum f) + (contf := fun n : nat => included_imp_Continuous _ _ (H n) _ _ _ Hinc) + (contF := Fun_Series_Sum_cont _ _ _ _ (convF _ _ _ Hinc)). + intro; apply Feq_reflexive. + red in |- *; intros. + simpl in |- *; intros. + apply (contin_imp_inc _ _ _ _ (Hcont n0)); auto. + apply fun_series_conv. Qed. Lemma convergent_imp_inc : fun_series_convergent_IR J f -> forall n, included J (Dom (f n)). -intros H n. -apply included_imp_inc. -intros a b Hab H0. -red in H. -elim (H _ _ _ H0); intros. -apply contin_imp_inc; auto. +Proof. + intros H n. + apply included_imp_inc. + intros a b Hab H0. + red in H. + elim (H _ _ _ H0); intros. + apply contin_imp_inc; auto. Qed. Lemma convergent_imp_Continuous : fun_series_convergent_IR J f -> forall n, Continuous J (f n). -intros H n. -split. -exact (convergent_imp_inc H n). -intros a b Hab H0; auto. -elim (H a b Hab H0); auto. +Proof. + intros H n. + split. + exact (convergent_imp_inc H n). + intros a b Hab H0; auto. + elim (H a b Hab H0); auto. Qed. Lemma Continuous_FSeries_Sum : forall H, Continuous J (FSeries_Sum (J:=J) (f:=f) H). -intros. -split; Included. -intros a b Hab H0. -eapply Continuous_I_wd. -apply Feq_symmetric; apply (FSeries_Sum_char _ _ H _ _ _ H0). -eapply Continuous_I_wd. -apply Fun_Series_Sum_char. -apply Cauchy_cont_Lim. +Proof. + intros. + split; Included. + intros a b Hab H0. + eapply Continuous_I_wd. + apply Feq_symmetric; apply (FSeries_Sum_char _ _ H _ _ _ H0). + eapply Continuous_I_wd. + apply Fun_Series_Sum_char. + apply Cauchy_cont_Lim. Qed. End Convergence_Results. @@ -791,40 +773,45 @@ Variable J : interval. Lemma conv_fun_const_series_IR : forall x : nat -> IR, convergent x -> fun_series_convergent_IR J (fun n => [-C-] (x n)). -intros. -red in |- *; intros. -apply conv_fun_const_series; auto. +Proof. + intros. + red in |- *; intros. + apply conv_fun_const_series; auto. Qed. Lemma fun_const_series_Sum_IR : forall y H (H' : fun_series_convergent_IR J (fun n => [-C-] (y n))) x Hx, FSeries_Sum H' x Hx [=] series_sum y H. -intros. -simpl in |- *. -apply series_sum_wd. -algebra. +Proof. + intros. + simpl in |- *. + apply series_sum_wd. + algebra. Qed. Lemma conv_zero_fun_series_IR : fun_series_convergent_IR J (fun n => [-C-]Zero). -apply conv_fun_const_series_IR with (x := fun n : nat => ZeroR). -apply conv_zero_series. +Proof. + apply conv_fun_const_series_IR with (x := fun n : nat => ZeroR). + apply conv_zero_series. Qed. -Lemma FSeries_Sum_zero_IR : forall (H : fun_series_convergent_IR J (fun n => [-C-]Zero)) +Lemma FSeries_Sum_zero_IR : forall (H : fun_series_convergent_IR J (fun n => [-C-]Zero)) x Hx, FSeries_Sum H x Hx [=] Zero. -intros. -simpl in |- *. -apply series_sum_zero. +Proof. + intros. + simpl in |- *. + apply series_sum_zero. Qed. Variables f g : nat -> PartIR. Lemma fun_series_convergent_wd_IR : (forall n, Feq J (f n) (g n)) -> fun_series_convergent_IR J f -> fun_series_convergent_IR J g. -intros. -red in |- *; intros. -apply fun_series_convergent_wd with f. -intros; apply included_Feq with J; auto. -auto. +Proof. + intros. + red in |- *; intros. + apply fun_series_convergent_wd with f. + intros; apply included_Feq with J; auto. + auto. Qed. (* begin show *) @@ -833,66 +820,69 @@ Hypothesis convG : fun_series_convergent_IR J g. (* end show *) Lemma FSeries_Sum_wd' : (forall n, Feq J (f n) (g n)) -> Feq J (FSeries_Sum convF) (FSeries_Sum convG). -intros H. -apply included_Feq'; intros a b Hab H0. -eapply Feq_transitive. -apply (FSeries_Sum_char _ _ convF a b Hab H0). -eapply Feq_transitive. -2: apply Feq_symmetric; apply (FSeries_Sum_char _ _ convG a b Hab H0). -apply Fun_Series_Sum_wd'. -intro; apply included_Feq with J; auto. +Proof. + intros H. + apply included_Feq'; intros a b Hab H0. + eapply Feq_transitive. + apply (FSeries_Sum_char _ _ convF a b Hab H0). + eapply Feq_transitive. + 2: apply Feq_symmetric; apply (FSeries_Sum_char _ _ convG a b Hab H0). + apply Fun_Series_Sum_wd'. + intro; apply included_Feq with J; auto. Qed. Lemma FSeries_Sum_plus_conv : fun_series_convergent_IR J (fun n => f n{+}g n). -red in |- *; intros. -apply conv_fun_series_plus; auto. +Proof. + red in |- *; intros. + apply conv_fun_series_plus; auto. Qed. Lemma FSeries_Sum_plus : forall H : fun_series_convergent_IR J (fun n => f n{+}g n), Feq J (FSeries_Sum H) (FSeries_Sum convF{+}FSeries_Sum convG). -intros. -apply included_Feq'; intros a b Hab H0. -eapply Feq_transitive. -apply (FSeries_Sum_char _ _ H a b Hab H0). -eapply Feq_transitive. -apply - Fun_Series_Sum_plus - with (convF := convF a b Hab H0) (convG := convG a b Hab H0). -apply Feq_symmetric; apply Feq_plus; apply FSeries_Sum_char. +Proof. + intros. + apply included_Feq'; intros a b Hab H0. + eapply Feq_transitive. + apply (FSeries_Sum_char _ _ H a b Hab H0). + eapply Feq_transitive. + apply Fun_Series_Sum_plus with (convF := convF a b Hab H0) (convG := convG a b Hab H0). + apply Feq_symmetric; apply Feq_plus; apply FSeries_Sum_char. Qed. Lemma FSeries_Sum_inv_conv : fun_series_convergent_IR J (fun n => {--} (f n)). -red in |- *; intros. -apply conv_fun_series_inv; auto. +Proof. + red in |- *; intros. + apply conv_fun_series_inv; auto. Qed. Lemma FSeries_Sum_inv : forall H : fun_series_convergent_IR J (fun n => {--} (f n)), Feq J (FSeries_Sum H) {--} (FSeries_Sum convF). -intros. -apply included_Feq'; intros a b Hab H0. -eapply Feq_transitive. -apply (FSeries_Sum_char _ _ H a b Hab H0). -eapply Feq_transitive. -apply Fun_Series_Sum_inv with (convF := convF a b Hab H0). -apply Feq_symmetric; apply Feq_inv; apply FSeries_Sum_char. +Proof. + intros. + apply included_Feq'; intros a b Hab H0. + eapply Feq_transitive. + apply (FSeries_Sum_char _ _ H a b Hab H0). + eapply Feq_transitive. + apply Fun_Series_Sum_inv with (convF := convF a b Hab H0). + apply Feq_symmetric; apply Feq_inv; apply FSeries_Sum_char. Qed. Lemma FSeries_Sum_minus_conv : fun_series_convergent_IR J (fun n => f n{-}g n). -red in |- *; intros. -apply conv_fun_series_minus; auto. +Proof. + red in |- *; intros. + apply conv_fun_series_minus; auto. Qed. Lemma FSeries_Sum_minus : forall H : fun_series_convergent_IR J (fun n => f n{-}g n), Feq J (FSeries_Sum H) (FSeries_Sum convF{-}FSeries_Sum convG). -intros. -apply included_Feq'; intros a b Hab H0. -eapply Feq_transitive. -apply (FSeries_Sum_char _ _ H a b Hab H0). -eapply Feq_transitive. -apply - Fun_Series_Sum_min - with (convF := convF a b Hab H0) (convG := convG a b Hab H0). -apply Feq_symmetric; apply Feq_minus; apply FSeries_Sum_char. +Proof. + intros. + apply included_Feq'; intros a b Hab H0. + eapply Feq_transitive. + apply (FSeries_Sum_char _ _ H a b Hab H0). + eapply Feq_transitive. + apply Fun_Series_Sum_min with (convF := convF a b Hab H0) (convG := convG a b Hab H0). + apply Feq_symmetric; apply Feq_minus; apply FSeries_Sum_char. Qed. (** @@ -905,29 +895,31 @@ Variable H : PartIR. Hypothesis contH : Continuous J H. Lemma FSeries_Sum_scal_conv : fun_series_convergent_IR J (fun n => H{*}f n). -red in |- *; intros. -apply conv_fun_series_scal; auto. -eapply included_imp_Continuous. -apply contH. -auto. +Proof. + red in |- *; intros. + apply conv_fun_series_scal; auto. + eapply included_imp_Continuous. + apply contH. + auto. Qed. Lemma FSeries_Sum_scal : forall H' : fun_series_convergent_IR J (fun n => H{*}f n), Feq J (FSeries_Sum H') (H{*}FSeries_Sum convF). -intros. -apply included_Feq'; intros a b Hab H0. -cut (Continuous_I Hab H). intro H1. -eapply Feq_transitive. -apply (FSeries_Sum_char _ _ H' a b Hab H0). -eapply Feq_transitive. -apply Fun_Series_Sum_scal with (convF := convF a b Hab H0). -auto. -apply Feq_symmetric; apply Feq_mult. -apply Feq_reflexive; Included. -apply FSeries_Sum_char. -eapply included_imp_Continuous. -apply contH. -auto. +Proof. + intros. + apply included_Feq'; intros a b Hab H0. + cut (Continuous_I Hab H). intro H1. + eapply Feq_transitive. + apply (FSeries_Sum_char _ _ H' a b Hab H0). + eapply Feq_transitive. + apply Fun_Series_Sum_scal with (convF := convF a b Hab H0). + auto. + apply Feq_symmetric; apply Feq_mult. + apply Feq_reflexive; Included. + apply FSeries_Sum_char. + eapply included_imp_Continuous. + apply contH. + auto. Qed. End Operations. @@ -948,42 +940,46 @@ Hypothesis contF : forall n, Continuous J (f n). Lemma fun_str_comparison_IR : forall g : nat -> PartIR, fun_series_convergent_IR J g -> {k : nat | forall n, k <= n -> forall x, J x -> forall Hx Hx', AbsIR (f n x Hx) [<=] g n x Hx'} -> fun_series_convergent_IR J f. -intros g H H0 a b Hab H1. -apply fun_str_comparison with g. -intro; apply included_imp_Continuous with J; auto. -auto. -elim H0; clear H0; intros k Hk. -exists k; intros. -apply Hk; auto. +Proof. + intros g H H0 a b Hab H1. + apply fun_str_comparison with g. + intro; apply included_imp_Continuous with J; auto. + auto. + elim H0; clear H0; intros k Hk. + exists k; intros. + apply Hk; auto. Qed. Lemma fun_comparison_IR : forall g : nat -> PartIR, fun_series_convergent_IR J g -> (forall n x, J x -> forall Hx Hx', AbsIR (f n x Hx) [<=] g n x Hx') -> fun_series_convergent_IR J f. -intros g H H0. -apply fun_str_comparison_IR with g; auto. -exists 0; intros; apply H0; auto. +Proof. + intros g H H0. + apply fun_str_comparison_IR with g; auto. + exists 0; intros; apply H0; auto. Qed. Lemma abs_imp_conv_IR : fun_series_abs_convergent_IR J f -> fun_series_convergent_IR J f. -intro H. -apply fun_comparison_IR with (fun n => FAbs (f n)). -apply H. -intros; apply eq_imp_leEq; apply eq_symmetric_unfolded; apply FAbs_char. +Proof. + intro H. + apply fun_comparison_IR with (fun n => FAbs (f n)). + apply H. + intros; apply eq_imp_leEq; apply eq_symmetric_unfolded; apply FAbs_char. Qed. Lemma fun_ratio_test_conv_IR : {N : nat | {c : IR | c [<] One | Zero [<=] c /\ (forall x, J x -> forall n, N <= n -> forall Hx Hx', AbsIR (f (S n) x Hx') [<=] c[*]AbsIR (f n x Hx))}} -> fun_series_convergent_IR J f. -intro H. -red in |- *; intros. -apply fun_ratio_test_conv. -intro; apply included_imp_Continuous with J; auto. -elim H; intros N HN. -elim HN; clear H HN; intros c Hc H. -inversion_clear H. -exists N; exists c; repeat split; auto. +Proof. + intro H. + red in |- *; intros. + apply fun_ratio_test_conv. + intro; apply included_imp_Continuous with J; auto. + elim H; intros N HN. + elim HN; clear H HN; intros c Hc H. + inversion_clear H. + exists N; exists c; repeat split; auto. Qed. End Convergence_Criteria. @@ -997,40 +993,40 @@ The geometric series converges on the open interval (-1, 1) Lemma fun_power_series_conv_IR : fun_series_convergent_IR (olor ([--]One) One) (fun (i:nat) => Fid IR{^}i). Proof. -intros a b Hab H. -apply fun_ratio_test_conv. - intros n. - Contin. -exists 0%nat. -exists (Max (AbsIR a) (AbsIR b)). - destruct (H a) as [Ha0 Ha1]. - split; assumption || apply leEq_reflexive. - destruct (H b) as [Hb0 Hb1]. - split; assumption || apply leEq_reflexive. - apply Max_less; apply AbsIR_less; assumption. -split. - eapply leEq_transitive. - apply AbsIR_nonneg. - apply lft_leEq_Max. -simpl. -intros x Hx n Hn _ _. -rstepr (ABSIR (nexp IR n x)[*]MAX (ABSIR a) (ABSIR b)). -change (AbsIR (nexp IR n x[*]x)[<=]AbsIR (nexp IR n x)[*]Max (AbsIR a) (AbsIR b)). -stepl (AbsIR (nexp IR n x)[*]AbsIR x) by apply eq_symmetric; apply AbsIR_resp_mult. -apply mult_resp_leEq_lft;[|apply AbsIR_nonneg]. -apply AbsSmall_imp_AbsIR. -destruct Hx. -split. - apply leEq_transitive with a;[|assumption]. - rstepr ([--][--]a). - apply inv_resp_leEq. - apply leEq_transitive with (AbsIR a). - apply inv_leEq_AbsIR. - apply lft_leEq_Max. -apply leEq_transitive with b;[assumption|]. -apply leEq_transitive with (AbsIR b). - apply leEq_AbsIR. -apply rht_leEq_Max. + intros a b Hab H. + apply fun_ratio_test_conv. + intros n. + Contin. + exists 0%nat. + exists (Max (AbsIR a) (AbsIR b)). + destruct (H a) as [Ha0 Ha1]. + split; assumption || apply leEq_reflexive. + destruct (H b) as [Hb0 Hb1]. + split; assumption || apply leEq_reflexive. + apply Max_less; apply AbsIR_less; assumption. + split. + eapply leEq_transitive. + apply AbsIR_nonneg. + apply lft_leEq_Max. + simpl. + intros x Hx n Hn _ _. + rstepr (ABSIR (nexp IR n x)[*]MAX (ABSIR a) (ABSIR b)). + change (AbsIR (nexp IR n x[*]x)[<=]AbsIR (nexp IR n x)[*]Max (AbsIR a) (AbsIR b)). + stepl (AbsIR (nexp IR n x)[*]AbsIR x) by apply eq_symmetric; apply AbsIR_resp_mult. + apply mult_resp_leEq_lft;[|apply AbsIR_nonneg]. + apply AbsSmall_imp_AbsIR. + destruct Hx. + split. + apply leEq_transitive with a;[|assumption]. + rstepr ([--][--]a). + apply inv_resp_leEq. + apply leEq_transitive with (AbsIR a). + apply inv_leEq_AbsIR. + apply lft_leEq_Max. + apply leEq_transitive with b;[assumption|]. + apply leEq_transitive with (AbsIR b). + apply leEq_AbsIR. + apply rht_leEq_Max. Qed. End Power_Series. @@ -1040,10 +1036,10 @@ Section Insert_Series. (** *** Translation -When working in particular with power series and Taylor series, it is -sometimes useful to ``shift'' all the terms in the series one position +When working in particular with power series and Taylor series, it is +sometimes useful to ``shift'' all the terms in the series one position forward, that is, replacing each $f_{i+1}$#fi+1# with -$f_i$#fi# and inserting the null function in the first +$f_i$#fi# and inserting the null function in the first position. This does not affect convergence or the sum of the series. *) @@ -1058,80 +1054,66 @@ Definition insert_series n : PartIR := end. Lemma insert_series_cont : forall n, Continuous J (insert_series n). -intro; elim n; intros. -simpl in |- *; apply Continuous_const. -simpl in |- *; apply convergent_imp_Continuous; auto. +Proof. + intro; elim n; intros. + simpl in |- *; apply Continuous_const. + simpl in |- *; apply convergent_imp_Continuous; auto. Qed. Lemma insert_series_sum_char : forall n x Hx Hx', fun_seq_part_sum f n x Hx [=] fun_seq_part_sum insert_series (S n) x Hx'. -intro; induction n as [| n Hrecn]. -intros; simpl in |- *; algebra. -intros; simpl in |- *; simpl in Hrecn; algebra. +Proof. + intro; induction n as [| n Hrecn]. + intros; simpl in |- *; algebra. + intros; simpl in |- *; simpl in Hrecn; algebra. Qed. Lemma insert_series_conv : fun_series_convergent_IR J insert_series. -intros a b Hab Hinc. -elim (convF _ _ _ Hinc); intros Hcont HCauchy. -exists - (fun n => - included_imp_Continuous _ _ (insert_series_cont n) _ _ _ Hinc). -intros e H. -elim (HCauchy e H); intros N HN. -exists (S N); do 4 intro. -cut (m = S (pred m)); - [ intro - | apply S_pred with 0; apply lt_le_trans with (S N); auto with arith ]. -cut (n = S (pred n)); - [ intro - | apply S_pred with 0; apply lt_le_trans with (S N); auto with arith ]. -generalize H0 H1; clear H1 H0. -rewrite H2; rewrite H3; clear H2 H3. -intros. -cut (N <= pred m); [ intro | auto with arith ]. -cut (N <= pred n); [ intro | auto with arith ]. -eapply leEq_wdl. -apply (HN _ _ H2 H3 x Hx). -apply AbsIR_wd. -apply cg_minus_wd; apply insert_series_sum_char. +Proof. + intros a b Hab Hinc. + elim (convF _ _ _ Hinc); intros Hcont HCauchy. + exists (fun n => included_imp_Continuous _ _ (insert_series_cont n) _ _ _ Hinc). + intros e H. + elim (HCauchy e H); intros N HN. + exists (S N); do 4 intro. + cut (m = S (pred m)); [ intro | apply S_pred with 0; apply lt_le_trans with (S N); auto with arith ]. + cut (n = S (pred n)); [ intro | apply S_pred with 0; apply lt_le_trans with (S N); auto with arith ]. + generalize H0 H1; clear H1 H0. + rewrite H2; rewrite H3; clear H2 H3. + intros. + cut (N <= pred m); [ intro | auto with arith ]. + cut (N <= pred n); [ intro | auto with arith ]. + eapply leEq_wdl. + apply (HN _ _ H2 H3 x Hx). + apply AbsIR_wd. + apply cg_minus_wd; apply insert_series_sum_char. Qed. Lemma insert_series_sum : Feq J (FSeries_Sum convF) (FSeries_Sum insert_series_conv). -set (contF := convergent_imp_Continuous _ _ convF) in *. -apply - FLim_unique_IR - with - (fun n => FSum0 n f) - (fun n => Continuous_Sum0 _ _ contF n) - (Continuous_FSeries_Sum _ _ convF) - (Continuous_FSeries_Sum _ _ insert_series_conv). -apply FSeries_conv. -red in |- *; intros. -assert - (convS := - FSeries_conv _ _ insert_series_conv - (Continuous_Sum0 _ _ insert_series_cont) - (Continuous_FSeries_Sum _ _ insert_series_conv) _ _ _ Hinc). -intros e H. -elim (convS e H); intros N HN. -clear convS; exists N; intros. -eapply leEq_wdl. -apply (HN (S n) (le_S _ _ H0) _ Hx). -apply AbsIR_wd; apply cg_minus_wd. -2: algebra. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -eapply eq_transitive_unfolded. -2: apply - (insert_series_sum_char n x - (contin_imp_inc _ _ _ _ - (included_imp_Continuous _ _ (Continuous_Sum0 _ _ contF n) _ _ _ - Hinc) _ Hx) - (contin_imp_inc _ _ _ _ - (included_imp_Continuous _ _ - (Continuous_Sum0 _ _ insert_series_cont (S n)) _ _ _ Hinc) _ Hx)). -unfold fun_seq_part_sum in |- *; algebra. -unfold fun_seq_part_sum in |- *; algebra. +Proof. + set (contF := convergent_imp_Continuous _ _ convF) in *. + apply FLim_unique_IR with (fun n => FSum0 n f) (fun n => Continuous_Sum0 _ _ contF n) + (Continuous_FSeries_Sum _ _ convF) (Continuous_FSeries_Sum _ _ insert_series_conv). + apply FSeries_conv. + red in |- *; intros. + assert (convS := FSeries_conv _ _ insert_series_conv (Continuous_Sum0 _ _ insert_series_cont) + (Continuous_FSeries_Sum _ _ insert_series_conv) _ _ _ Hinc). + intros e H. + elim (convS e H); intros N HN. + clear convS; exists N; intros. + eapply leEq_wdl. + apply (HN (S n) (le_S _ _ H0) _ Hx). + apply AbsIR_wd; apply cg_minus_wd. + 2: algebra. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + eapply eq_transitive_unfolded. + 2: apply (insert_series_sum_char n x (contin_imp_inc _ _ _ _ + (included_imp_Continuous _ _ (Continuous_Sum0 _ _ contF n) _ _ _ Hinc) _ Hx) + (contin_imp_inc _ _ _ _ (included_imp_Continuous _ _ + (Continuous_Sum0 _ _ insert_series_cont (S n)) _ _ _ Hinc) _ Hx)). + unfold fun_seq_part_sum in |- *; algebra. + unfold fun_seq_part_sum in |- *; algebra. Qed. End Insert_Series. diff --git a/ftc/MoreFunctions.v b/ftc/MoreFunctions.v index a0250a3b8..a262bd4fd 100644 --- a/ftc/MoreFunctions.v +++ b/ftc/MoreFunctions.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing FNorm %\ensuremath{\|\cdot\|_{\infty}}% *) @@ -62,7 +62,8 @@ Trivial stuff. *) Lemma Continuous_imp_inc : forall F, Continuous I F -> included I (Dom F). -intros F H; elim H; intros; auto. +Proof. + intros F H; elim H; intros; auto. Qed. (** @@ -75,9 +76,10 @@ Variable F : PartIR. Hypothesis contF : Continuous I F. Lemma continuous_compact : forall H, Continuous_I (a:=Lend cI) (b:=Rend cI) H F. -intros. -elim contF; intros incF contF'. -Contin. +Proof. + intros. + elim contF; intros incF contF'. + Contin. Qed. (* begin show *) @@ -85,47 +87,49 @@ Hypothesis Hinc : included I (Dom F). (* end show *) Lemma Continuous_I_imp_tb_image : totally_bounded (fun_image F I). -cut (Continuous_I (Lend_leEq_Rend _ cI) F). intro H. -elim (Continuous_I_imp_tb_image _ _ _ _ H); intros. -split; [ clear b | clear a ]. -elim a; intros x Hx. -elim Hx; intros y Hy. -elim Hy; clear a Hx Hy; intros Hy Hx. -elim Hx; clear Hx; intros Hy'' Hx. -exists x; exists y. -split. -exact (compact_interval_inc _ _ _ _ Hy). -auto. -intros e He. -elim (b e He); intros l H0 H1. -exists l; clear b; [ clear H1 | clear H0 ]. -intros x Hx. -elim (H0 x Hx); intros y Hy. -elim Hy; clear H0 Hy Hx; intros Hy Hx. -elim Hx; clear Hx; intros Hy' Hx. -exists y. -split. -exact (compact_interval_inc _ _ _ _ Hy). -auto. -intros x H0. -apply H1. -clear H1. -elim H0; intros y Hy. -elim Hy; clear H0 Hy; intros Hy Hx. -elim Hx; clear Hx; intros Hy' Hx. -exists y. -split. -exact (interval_compact_inc _ _ (Lend_leEq_Rend _ cI) _ Hy). -auto. -apply continuous_compact. +Proof. + cut (Continuous_I (Lend_leEq_Rend _ cI) F). intro H. + elim (Continuous_I_imp_tb_image _ _ _ _ H); intros. + split; [ clear b | clear a ]. + elim a; intros x Hx. + elim Hx; intros y Hy. + elim Hy; clear a Hx Hy; intros Hy Hx. + elim Hx; clear Hx; intros Hy'' Hx. + exists x; exists y. + split. + exact (compact_interval_inc _ _ _ _ Hy). + auto. + intros e He. + elim (b e He); intros l H0 H1. + exists l; clear b; [ clear H1 | clear H0 ]. + intros x Hx. + elim (H0 x Hx); intros y Hy. + elim Hy; clear H0 Hy Hx; intros Hy Hx. + elim Hx; clear Hx; intros Hy' Hx. + exists y. + split. + exact (compact_interval_inc _ _ _ _ Hy). + auto. + intros x H0. + apply H1. + clear H1. + elim H0; intros y Hy. + elim Hy; clear H0 Hy; intros Hy Hx. + elim Hx; clear Hx; intros Hy' Hx. + exists y. + split. + exact (interval_compact_inc _ _ (Lend_leEq_Rend _ cI) _ Hy). + auto. + apply continuous_compact. Qed. Definition FNorm := Norm_Funct (continuous_compact (Lend_leEq_Rend _ cI)). Lemma FNorm_bnd_AbsIR : forall x, I x -> forall Hx, AbsIR (F x Hx) [<=] FNorm. -intros; unfold FNorm in |- *. -apply norm_bnd_AbsIR. -apply interval_compact_inc; auto. +Proof. + intros; unfold FNorm in |- *. + apply norm_bnd_AbsIR. + apply interval_compact_inc; auto. Qed. End Basic_Results. @@ -143,17 +147,18 @@ Variable I : interval. Variables F G : PartIR. Lemma Continuous_wd : Feq I F G -> Continuous I F -> Continuous I G. -intros H H0. -elim H; intros incF H'. -elim H'; clear H H'; intros incG eqFG. -elim H0; clear H0; intros incF' contF. -split. -auto. -intros. -apply Continuous_I_wd with F. -FEQ. -simpl in |- *; algebra. -auto. +Proof. + intros H H0. + elim H; intros incF H'. + elim H'; clear H H'; intros incG eqFG. + elim H0; clear H0; intros incF' contF. + split. + auto. + intros. + apply Continuous_I_wd with F. + FEQ. + simpl in |- *; algebra. + auto. Qed. (* begin show *) @@ -163,82 +168,94 @@ Hypothesis contG : Continuous I G. Lemma included_imp_Continuous : forall a b Hab, included (compact a b Hab) I -> Continuous_I Hab F. -intros. -elim contF; auto. +Proof. + intros. + elim contF; auto. Qed. Lemma Included_imp_Continuous : forall J : interval, included J I -> Continuous J F. -intros J H. -split. -exact (included_trans _ _ _ _ H (Continuous_imp_inc _ _ contF)). -intros. -apply included_imp_Continuous; Included. +Proof. + intros J H. + split. + exact (included_trans _ _ _ _ H (Continuous_imp_inc _ _ contF)). + intros. + apply included_imp_Continuous; Included. Qed. Lemma Continuous_const : forall c : IR, Continuous I [-C-]c. -split; Contin. +Proof. + split; Contin. Qed. Lemma Continuous_id : Continuous I FId. -split; Contin. +Proof. + split; Contin. Qed. Lemma Continuous_plus : Continuous I (F{+}G). -elim contF; intros incF' contF'. -elim contG; intros incG' contG'. -split; Contin. +Proof. + elim contF; intros incF' contF'. + elim contG; intros incG' contG'. + split; Contin. Qed. Lemma Continuous_inv : Continuous I {--}F. -elim contF; intros incF' contF'. -split; Contin. +Proof. + elim contF; intros incF' contF'. + split; Contin. Qed. Lemma Continuous_minus : Continuous I (F{-}G). -elim contF; intros incF' contF'. -elim contG; intros incG' contG'. -split; Contin. +Proof. + elim contF; intros incF' contF'. + elim contG; intros incG' contG'. + split; Contin. Qed. Lemma Continuous_mult : Continuous I (F{*}G). -elim contF; intros incF' contF'. -elim contG; intros incG' contG'. -split; Contin. +Proof. + elim contF; intros incF' contF'. + elim contG; intros incG' contG'. + split; Contin. Qed. Lemma Continuous_nth : forall n : nat, Continuous I (F{^}n). -elim contF; intros incF' contF'. -split; Contin. +Proof. + elim contF; intros incF' contF'. + split; Contin. Qed. Lemma Continuous_scal : forall c : IR, Continuous I (c{**}F). -elim contF; intros incF' contF'. -split; Contin. +Proof. + elim contF; intros incF' contF'. + split; Contin. Qed. Lemma Continuous_abs : Continuous I (FAbs F). -elim contF; intros incF' contF'. -split; Contin. +Proof. + elim contF; intros incF' contF'. + split; Contin. Qed. Lemma Continuous_recip : bnd_away_zero_in_P G I -> Continuous I {1/}G. -intro H. -elim contG; intros incG' contG'. -cut (forall x : IR, I x -> forall Hx, G x Hx [#] Zero). intro H0. -split; Contin. -intros x H0 Hx. -apply bnd_imp_ap_zero with (Compact (leEq_reflexive _ x)); auto. -apply H; auto. -exact (compact_single_iprop I x H0). -exact (compact_single_prop x). +Proof. + intro H. + elim contG; intros incG' contG'. + cut (forall x : IR, I x -> forall Hx, G x Hx [#] Zero). intro H0. + split; Contin. + intros x H0 Hx. + apply bnd_imp_ap_zero with (Compact (leEq_reflexive _ x)); auto. + apply H; auto. + exact (compact_single_iprop I x H0). + exact (compact_single_prop x). Qed. Lemma Continuous_NRoot : forall n H, (forall x : IR, I x -> forall Hx, Zero[<=]F x Hx) -> Continuous I (FNRoot F n H). Proof. -intros n H. -elim contF; intros incF' contF'. -split; Contin. + intros n H. + elim contF; intros incF' contF'. + split; Contin. Qed. End Other_Results. @@ -260,17 +277,19 @@ Hypothesis contF : Continuous I F. Hypothesis contG : Continuous I G. Lemma Continuous_div : bnd_away_zero_in_P G I -> Continuous I (F{/}G). -intros. -apply Continuous_wd with (F{*}{1/}G). -FEQ. -Contin. +Proof. + intros. + apply Continuous_wd with (F{*}{1/}G). + FEQ. + Contin. Qed. Lemma FNorm_wd : Feq I F G -> FNorm I cI F contF [=] FNorm I cI G contG. -intro H; unfold FNorm in |- *; apply Norm_Funct_wd. -eapply included_Feq. -2: apply H. -Included. +Proof. + intro H; unfold FNorm in |- *; apply Norm_Funct_wd. + eapply included_Feq. + 2: apply H. + Included. Qed. End Corollaries. @@ -283,9 +302,10 @@ Variable I : interval. Lemma Continuous_Sumx : forall n (f : forall i, i < n -> PartIR), (forall i Hi, Continuous I (f i Hi)) -> Continuous I (FSumx n f). -intro; induction n as [| n Hrecn]; intros f contF. -simpl in |- *; Contin. -simpl in |- *; Contin. +Proof. + intro; induction n as [| n Hrecn]; intros f contF. + simpl in |- *; Contin. + simpl in |- *; Contin. Qed. (** @@ -297,21 +317,23 @@ Variable f : nat -> PartIR. Hypothesis contF : forall n : nat, Continuous I (f n). Lemma Continuous_Sum0 : forall n : nat, Continuous I (FSum0 n f). -intros. -induction n as [| n Hrecn]. -eapply Continuous_wd. -apply FSum0_0; Included. -Contin. -eapply Continuous_wd. -apply FSum0_S; Included. -Contin. +Proof. + intros. + induction n as [| n Hrecn]. + eapply Continuous_wd. + apply FSum0_0; Included. + Contin. + eapply Continuous_wd. + apply FSum0_S; Included. + Contin. Qed. Lemma Continuous_Sum : forall m n : nat, Continuous I (FSum m n f). -intros. -eapply Continuous_wd. -apply Feq_symmetric; apply FSum_FSum0'; Included. -apply Continuous_minus; apply Continuous_Sum0. +Proof. + intros. + eapply Continuous_wd. + apply Feq_symmetric; apply FSum_FSum0'; Included. + apply Continuous_minus; apply Continuous_Sum0. Qed. End Sums. @@ -335,85 +357,92 @@ Hypothesis pI : proper I. Variables F G H : PartIR. Lemma Derivative_wdl : Feq I F G -> Derivative I pI F H -> Derivative I pI G H. -intros H0 H1. -elim H0; intros incF H0'. -elim H0'; intros incG Heq. -elim H1; intros incF' H1'. -elim H1'; intros incH' derF. -split. -auto. -split. -auto. -intros; apply Derivative_I_wdl with F; auto. -apply included_Feq with I; auto. +Proof. + intros H0 H1. + elim H0; intros incF H0'. + elim H0'; intros incG Heq. + elim H1; intros incF' H1'. + elim H1'; intros incH' derF. + split. + auto. + split. + auto. + intros; apply Derivative_I_wdl with F; auto. + apply included_Feq with I; auto. Qed. Lemma Derivative_wdr : Feq I F G -> Derivative I pI H F -> Derivative I pI H G. -intros H0 H1. -elim H0; intros incF H0'. -elim H0'; intros incG Heq. -elim H1; intros incF' H1'. -elim H1'; intros incH' derF. -split. -auto. -split. -auto. -intros; apply Derivative_I_wdr with F; auto. -apply included_Feq with I; auto. +Proof. + intros H0 H1. + elim H0; intros incF H0'. + elim H0'; intros incG Heq. + elim H1; intros incF' H1'. + elim H1'; intros incH' derF. + split. + auto. + split. + auto. + intros; apply Derivative_I_wdr with F; auto. + apply included_Feq with I; auto. Qed. Lemma Derivative_unique : Derivative I pI F G -> Derivative I pI F H -> Feq I G H. -intros H0 H1. -elim H0; intros incF H0'. -elim H0'; intros incG derFG. -elim H1; intros incF' H1'. -elim H1'; intros incH derFH. -apply included_Feq''; intros. -auto. -unfold Hab'; apply Derivative_I_unique with F; Deriv. +Proof. + intros H0 H1. + elim H0; intros incF H0'. + elim H0'; intros incG derFG. + elim H1; intros incF' H1'. + elim H1'; intros incH derFH. + apply included_Feq''; intros. + auto. + unfold Hab'; apply Derivative_I_unique with F; Deriv. Qed. Lemma Derivative_imp_inc : Derivative I pI F G -> included I (Dom F). -intro H0. -inversion_clear H0; auto. +Proof. + intro H0. + inversion_clear H0; auto. Qed. Lemma Derivative_imp_inc' : Derivative I pI F G -> included I (Dom G). -intro H0. -elim H0; intros H1 H2. -inversion_clear H2; auto. +Proof. + intro H0. + elim H0; intros H1 H2. + inversion_clear H2; auto. Qed. Lemma Derivative_imp_Continuous : Derivative I pI F G -> Continuous I F. -intro H0. -elim H0; intros incF H'. -elim H'; intros incG derF. -clear H0 H'. -split. -Included. -intros a b Hab H0. -elim (compact_proper_in_interval _ _ _ Hab H0 pI); intros a' Ha. -elim Ha; clear Ha; intros b' Hb. -elim Hb; clear Hb; intros Hab' H2 H3. -apply included_imp_contin with (Hab := less_leEq _ _ _ Hab'). -auto. -apply deriv_imp_contin_I with Hab' G; auto. +Proof. + intro H0. + elim H0; intros incF H'. + elim H'; intros incG derF. + clear H0 H'. + split. + Included. + intros a b Hab H0. + elim (compact_proper_in_interval _ _ _ Hab H0 pI); intros a' Ha. + elim Ha; clear Ha; intros b' Hb. + elim Hb; clear Hb; intros Hab' H2 H3. + apply included_imp_contin with (Hab := less_leEq _ _ _ Hab'). + auto. + apply deriv_imp_contin_I with Hab' G; auto. Qed. Lemma Derivative_imp_Continuous' : Derivative I pI F G -> Continuous I G. -intro H0. -elim H0; intros incF H'. -elim H'; intros incG derF. -clear H0 H'. -split. - Included. -intros a b Hab H0. -elim (compact_proper_in_interval _ _ _ Hab H0 pI); intros a' Ha. -elim Ha; clear Ha; intros b' Hb. -elim Hb; clear Hb; intros Hab' H2 H3. -apply included_imp_contin with (Hab := less_leEq _ _ _ Hab'). -auto. -apply deriv_imp_contin'_I with Hab' F; auto. +Proof. + intro H0. + elim H0; intros incF H'. + elim H'; intros incG derF. + clear H0 H'. + split. + Included. + intros a b Hab H0. + elim (compact_proper_in_interval _ _ _ Hab H0 pI); intros a' Ha. + elim Ha; clear Ha; intros b' Hb. + elim Hb; clear Hb; intros Hab' H2 H3. + apply included_imp_contin with (Hab := less_leEq _ _ _ Hab'). + auto. + apply deriv_imp_contin'_I with Hab' F; auto. Qed. End Basic_Properties. @@ -439,109 +468,121 @@ Hypothesis derG : Derivative I pI G G'. Lemma included_imp_Derivative : forall a b Hab, included (Compact (less_leEq _ a b Hab)) I -> Derivative_I Hab F F'. -intros. -elim derF; intros incF H'. -elim H'; auto. +Proof. + intros. + elim derF; intros incF H'. + elim H'; auto. Qed. Lemma Included_imp_Derivative : forall J (pJ : proper J), included J I -> Derivative J pJ F F'. -intros J pJ H. -split. -exact (included_trans _ _ _ _ H (Derivative_imp_inc _ _ _ _ derF)). -split. -exact (included_trans _ _ _ _ H (Derivative_imp_inc' _ _ _ _ derF)). -intros. -apply included_imp_Derivative; Included. +Proof. + intros J pJ H. + split. + exact (included_trans _ _ _ _ H (Derivative_imp_inc _ _ _ _ derF)). + split. + exact (included_trans _ _ _ _ H (Derivative_imp_inc' _ _ _ _ derF)). + intros. + apply included_imp_Derivative; Included. Qed. Lemma Derivative_const : forall c : IR, Derivative I pI [-C-]c [-C-]Zero. -intros; split. -Included. -split; Deriv. +Proof. + intros; split. + Included. + split; Deriv. Qed. Lemma Derivative_id : Derivative I pI FId [-C-]One. -split. -Included. -split; Deriv. +Proof. + split. + Included. + split; Deriv. Qed. Lemma Derivative_plus : Derivative I pI (F{+}G) (F'{+}G'). -elim derF; intros incF H. -elim H; intros incF' derivF. -elim derG; intros incG H'. -elim H'; intros incG' derivG. -split. -Included. -split; Deriv. +Proof. + elim derF; intros incF H. + elim H; intros incF' derivF. + elim derG; intros incG H'. + elim H'; intros incG' derivG. + split. + Included. + split; Deriv. Qed. Lemma Derivative_inv : Derivative I pI {--}F {--}F'. -elim derF; intros incF H. -elim H; intros incF' derivF. -split. -Included. -split; Deriv. +Proof. + elim derF; intros incF H. + elim H; intros incF' derivF. + split. + Included. + split; Deriv. Qed. Lemma Derivative_minus : Derivative I pI (F{-}G) (F'{-}G'). -elim derF; intros incF H. -elim H; intros incF' derivF. -elim derG; intros incG H'. -elim H'; intros incG' derivG. -split. -Included. -split; Deriv. +Proof. + elim derF; intros incF H. + elim H; intros incF' derivF. + elim derG; intros incG H'. + elim H'; intros incG' derivG. + split. + Included. + split; Deriv. Qed. Lemma Derivative_mult : Derivative I pI (F{*}G) (F{*}G'{+}F'{*}G). -elim derF; intros incF H. -elim H; intros incF' derivF. -elim derG; intros incG H'. -elim H'; intros incG' derivG. -split. -Included. -split. -apply included_FPlus; Included. -Deriv. +Proof. + elim derF; intros incF H. + elim H; intros incF' derivF. + elim derG; intros incG H'. + elim H'; intros incG' derivG. + split. + Included. + split. + apply included_FPlus; Included. + Deriv. Qed. Lemma Derivative_scal : forall c : IR, Derivative I pI (c{**}F) (c{**}F'). -intro. -elim derF; intros incF H. -elim H; intros incF' derivF. -split. -Included. -split; Deriv. +Proof. + intro. + elim derF; intros incF H. + elim H; intros incF' derivF. + split. + Included. + split; Deriv. Qed. Lemma Derivative_poly : forall p, Derivative I pI (FPoly _ p) (FPoly _ (_D_ p)). -intro. -split. -Included. -split; Deriv. +Proof. + intro. + split. + Included. + split; Deriv. Qed. Lemma Derivative_nth : forall n, Derivative I pI (F{^}S n) (nring (S n) {**} (F'{*}F{^}n)). -elim derF; intros incF H. -elim H; intros incF' derivF. -split. -Included. -split; Deriv. +Proof. + elim derF; intros incF H. + elim H; intros incF' derivF. + split. + Included. + split; Deriv. Qed. Lemma Derivative_recip : bnd_away_zero_in_P G I -> Derivative I pI {1/}G {--} (G'{/}G{*}G). -elim derG; intros incG H'. -elim H'; intros incG' derivG. -clear derF derG H'. -intro. -cut (forall x : IR, I x -> forall Hx, Part G x Hx [#] Zero); intros. -cut (forall x : IR, I x -> forall Hx, (G{*}G) x Hx [#] Zero); intros. -split. -Included. -split; Deriv. -simpl in |- *; apply mult_resp_ap_zero; auto. -Included. +Proof. + elim derG; intros incG H'. + elim H'; intros incG' derivG. + clear derF derG H'. + intro. + cut (forall x : IR, I x -> forall Hx, Part G x Hx [#] Zero); intros. + cut (forall x : IR, I x -> forall Hx, (G{*}G) x Hx [#] Zero); intros. + split. + Included. + split; Deriv. + simpl in |- *; apply mult_resp_ap_zero; auto. + Included. Qed. End More_Results. @@ -561,21 +602,22 @@ Hypothesis Gbnd : bnd_away_zero_in_P G I. (* end show *) Lemma Derivative_div : Derivative I pI (F{/}G) ((F'{*}G{-}F{*}G') {/}G{*}G). -elim derF; intros incF Hf. -elim Hf; intros incF' Hf'. -elim derG; intros incG derivG. -elim derivG; intros incG' Hg'. -clear Hf derivG. -cut (forall x : IR, I x -> forall Hx, Part G x Hx [#] Zero); intros. -split. -Included. -split. -apply included_FDiv. -apply included_FMinus; Included. -Included. -intros; simpl in |- *; apply mult_resp_ap_zero; auto. -Deriv. -Included. +Proof. + elim derF; intros incF Hf. + elim Hf; intros incF' Hf'. + elim derG; intros incG derivG. + elim derivG; intros incG' Hg'. + clear Hf derivG. + cut (forall x : IR, I x -> forall Hx, Part G x Hx [#] Zero); intros. + split. + Included. + split. + apply included_FDiv. + apply included_FMinus; Included. + Included. + intros; simpl in |- *; apply mult_resp_ap_zero; auto. + Deriv. + Included. Qed. End More_Corollaries. @@ -587,9 +629,10 @@ Hypothesis pI : proper I. Lemma Derivative_Sumx : forall n (f f' : forall i, i < n -> PartIR), (forall i Hi Hi', Derivative I pI (f i Hi) (f' i Hi')) -> Derivative I pI (FSumx n f) (FSumx n f'). -intro; induction n as [| n Hrecn]; intros f f' derF. -simpl in |- *; apply Derivative_const; auto. -simpl in |- *; apply Derivative_plus; auto. +Proof. + intro; induction n as [| n Hrecn]; intros f f' derF. + simpl in |- *; apply Derivative_const; auto. + simpl in |- *; apply Derivative_plus; auto. Qed. (* begin show *) @@ -598,27 +641,29 @@ Hypothesis derF : forall n : nat, Derivative I pI (f n) (f' n). (* end show *) Lemma Derivative_Sum0 : forall n, Derivative I pI (FSum0 n f) (FSum0 n f'). -intros. -induction n as [| n Hrecn]. -eapply Derivative_wdl. -apply FSum0_0; Included. -eapply Derivative_wdr. -apply FSum0_0; Included. -apply Derivative_const. -eapply Derivative_wdl. -apply FSum0_S; Included. -eapply Derivative_wdr. -apply FSum0_S; Included. -apply Derivative_plus; auto. +Proof. + intros. + induction n as [| n Hrecn]. + eapply Derivative_wdl. + apply FSum0_0; Included. + eapply Derivative_wdr. + apply FSum0_0; Included. + apply Derivative_const. + eapply Derivative_wdl. + apply FSum0_S; Included. + eapply Derivative_wdr. + apply FSum0_S; Included. + apply Derivative_plus; auto. Qed. Lemma Derivative_Sum : forall m n, Derivative I pI (FSum m n f) (FSum m n f'). -intros. -eapply Derivative_wdl. -apply Feq_symmetric; apply FSum_FSum0'; Included. -eapply Derivative_wdr. -apply Feq_symmetric; apply FSum_FSum0'; Included. -apply Derivative_minus; apply Derivative_Sum0. +Proof. + intros. + eapply Derivative_wdl. + apply Feq_symmetric; apply FSum_FSum0'; Included. + eapply Derivative_wdr. + apply Feq_symmetric; apply FSum_FSum0'; Included. + apply Derivative_minus; apply Derivative_Sum0. Qed. End More_Sums. @@ -635,27 +680,30 @@ Variable I : interval. Hypothesis pI : proper I. Lemma Diffble_imp_inc : forall F, Diffble I pI F -> included I (Dom F). -intros F H. -inversion_clear H. -auto. +Proof. + intros F H. + inversion_clear H. + auto. Qed. Lemma Derivative_imp_Diffble : forall F F', Derivative I pI F F' -> Diffble I pI F. -intros F F' H. -elim H; intros incF H'. -elim H'; intros incF' derivF. -split; auto. -intros; apply deriv_imp_Diffble_I with F'; auto. +Proof. + intros F F' H. + elim H; intros incF H'. + elim H'; intros incF' derivF. + split; auto. + intros; apply deriv_imp_Diffble_I with F'; auto. Qed. Lemma Diffble_wd : forall F H, Feq I F H -> Diffble I pI F -> Diffble I pI H. -intros F H H0 H1. -elim H0; intros incF H2. -elim H2; intros incH eqFH. -inversion_clear H1. -split; auto. -intros; apply Diffble_I_wd with F; auto. -apply included_Feq with I; auto. +Proof. + intros F H H0 H1. + elim H0; intros incF H2. + elim H2; intros incH eqFH. + inversion_clear H1. + split; auto. + intros; apply Diffble_I_wd with F; auto. + apply included_Feq with I; auto. Qed. Variables F G : PartIR. @@ -670,88 +718,100 @@ Hypothesis diffG : Diffble I pI G. Lemma included_imp_Diffble : forall a b Hab, included (Compact (less_leEq _ a b Hab)) I -> Diffble_I Hab F. -intros. -elim diffF; auto. +Proof. + intros. + elim diffF; auto. Qed. Lemma Included_imp_Diffble : forall J (pJ : proper J), included J I -> Diffble J pJ F. -intros J pJ H. -split. -exact (included_trans _ _ _ _ H (Diffble_imp_inc _ diffF)). -intros; apply included_imp_Diffble; Included. +Proof. + intros J pJ H. + split. + exact (included_trans _ _ _ _ H (Diffble_imp_inc _ diffF)). + intros; apply included_imp_Diffble; Included. Qed. Lemma Diffble_const : forall c : IR, Diffble I pI [-C-]c. -intro. -split. -Included. -intros; apply Diffble_I_const. +Proof. + intro. + split. + Included. + intros; apply Diffble_I_const. Qed. Lemma Diffble_id : Diffble I pI FId. -split. -Included. -intros; apply Diffble_I_id. +Proof. + split. + Included. + intros; apply Diffble_I_id. Qed. Lemma Diffble_plus : Diffble I pI (F{+}G). -elim diffF; intros incF diffbleF. -elim diffG; intros incG diffbleG. -split. -Included. -intros; apply Diffble_I_plus; auto. +Proof. + elim diffF; intros incF diffbleF. + elim diffG; intros incG diffbleG. + split. + Included. + intros; apply Diffble_I_plus; auto. Qed. Lemma Diffble_inv : Diffble I pI {--}F. -elim diffF; intros incF diffbleF. -split. -Included. -intros; apply Diffble_I_inv; auto. +Proof. + elim diffF; intros incF diffbleF. + split. + Included. + intros; apply Diffble_I_inv; auto. Qed. Lemma Diffble_minus : Diffble I pI (F{-}G). -elim diffF; intros incF diffbleF. -elim diffG; intros incG diffbleG. -split. -Included. -intros; apply Diffble_I_minus; auto. +Proof. + elim diffF; intros incF diffbleF. + elim diffG; intros incG diffbleG. + split. + Included. + intros; apply Diffble_I_minus; auto. Qed. Lemma Diffble_mult : Diffble I pI (F{*}G). -elim diffF; intros incF diffbleF. -elim diffG; intros incG diffbleG. -split. -Included. -intros; apply Diffble_I_mult; auto. +Proof. + elim diffF; intros incF diffbleF. + elim diffG; intros incG diffbleG. + split. + Included. + intros; apply Diffble_I_mult; auto. Qed. Lemma Diffble_nth : forall n : nat, Diffble I pI (F{^}n). -elim diffF; intros incF diffbleF. -split. -Included. -intros; apply Diffble_I_nth; auto. +Proof. + elim diffF; intros incF diffbleF. + split. + Included. + intros; apply Diffble_I_nth; auto. Qed. Lemma Diffble_scal : forall c : IR, Diffble I pI (c{**}F). -elim diffF; intros incF diffbleF. -split. -Included. -intros; apply Diffble_I_scal; auto. +Proof. + elim diffF; intros incF diffbleF. + split. + Included. + intros; apply Diffble_I_scal; auto. Qed. Lemma Diffble_poly : forall p, Diffble I pI (FPoly _ p). -split. -Included. -intros; apply Diffble_I_poly; auto. +Proof. + split. + Included. + intros; apply Diffble_I_poly; auto. Qed. Lemma Diffble_recip : bnd_away_zero_in_P G I -> Diffble I pI {1/}G. -elim diffG; intros incG diffbleG Gbnd. -cut (forall x : IR, I x -> forall Hx, Part G x Hx [#] Zero); intros. -split. -Included. -intros; apply Diffble_I_recip; auto. -Included. +Proof. + elim diffG; intros incG diffbleG Gbnd. + cut (forall x : IR, I x -> forall Hx, Part G x Hx [#] Zero); intros. + split. + Included. + intros; apply Diffble_I_recip; auto. + Included. Qed. End Diffble_Basic_Properties. @@ -769,51 +829,55 @@ Hypothesis diffF : Diffble I pI F. Hypothesis diffG : Diffble I pI G. Lemma Diffble_div : bnd_away_zero_in_P G I -> Diffble I pI (F{/}G). -intro. -apply Diffble_wd with (F{*}{1/}G). -apply eq_imp_Feq. -apply included_FMult. -apply Diffble_imp_inc with pI; apply diffF. -apply included_FRecip. -apply Diffble_imp_inc with pI; apply diffG. -Included. -apply included_FDiv. -apply Diffble_imp_inc with pI; apply diffF. -apply Diffble_imp_inc with pI; apply diffG. -Included. -intros; simpl in |- *; rational. -apply Diffble_mult; auto. -apply Diffble_recip; auto. +Proof. + intro. + apply Diffble_wd with (F{*}{1/}G). + apply eq_imp_Feq. + apply included_FMult. + apply Diffble_imp_inc with pI; apply diffF. + apply included_FRecip. + apply Diffble_imp_inc with pI; apply diffG. + Included. + apply included_FDiv. + apply Diffble_imp_inc with pI; apply diffF. + apply Diffble_imp_inc with pI; apply diffG. + Included. + intros; simpl in |- *; rational. + apply Diffble_mult; auto. + apply Diffble_recip; auto. Qed. Lemma Diffble_Sum0 : forall f, (forall n, Diffble I pI (f n)) -> forall n, Diffble I pI (FSum0 n f). -intros f hypF n. -split. -intros x H n0. -elim (hypF n0); intros. -exact (a x H). -intros; apply Diffble_I_Sum0; auto. -intro; elim (hypF n0); auto. +Proof. + intros f hypF n. + split. + intros x H n0. + elim (hypF n0); intros. + exact (a x H). + intros; apply Diffble_I_Sum0; auto. + intro; elim (hypF n0); auto. Qed. Lemma Diffble_Sumx : forall n f, ext_fun_seq' f -> (forall i Hi, Diffble I pI (f i Hi)) -> Diffble I pI (FSumx n f). -intros n f Hgood hypF. -split. -red in |- *; intros. -apply FSumx_pred'; auto. -intros. -elim (hypF i Hi); auto. -intros; apply Diffble_I_Sumx. -intros i Hi; elim (hypF i Hi); auto. +Proof. + intros n f Hgood hypF. + split. + red in |- *; intros. + apply FSumx_pred'; auto. + intros. + elim (hypF i Hi); auto. + intros; apply Diffble_I_Sumx. + intros i Hi; elim (hypF i Hi); auto. Qed. Lemma Diffble_Sum : forall f, (forall n, Diffble I pI (f n)) -> forall m n, Diffble I pI (FSum m n f). -intros f hypF m n. -eapply Diffble_wd. -apply Feq_symmetric; apply FSum_FSum0'. -intro; apply Diffble_imp_inc with pI; auto. -apply Diffble_minus; apply Diffble_Sum0; auto. +Proof. + intros f hypF m n. + eapply Diffble_wd. + apply Feq_symmetric; apply FSum_FSum0'. + intro; apply Diffble_imp_inc with pI; auto. + apply Diffble_minus; apply Diffble_Sum0; auto. Qed. End Diffble_Corollaries. @@ -841,28 +905,29 @@ Variable F : PartIR. Hypothesis diffF : Diffble_n n I pI F. Definition N_Deriv_fun : forall x : IR, I x -> IR. -intros x H. -set (J := compact_in_interval I pI x H) in *. -elim diffF; intros incF diffbleF. -set (a := Lend (compact_compact_in_interval I pI x H)) in *. -set (b := Rend (compact_compact_in_interval I pI x H)) in *. -fold J in (value of a), (value of b). -cut (a [<] b). intro H0. -cut (Diffble_I_n H0 n F). intro H1. -apply (Part (n_deriv_I _ _ _ _ _ H1) x). -apply n_deriv_inc. -unfold a, b, J in |- *; apply iprop_compact_in_interval_inc2. -apply iprop_compact_in_interval. -apply diffbleF. -apply (included_trans _ (Compact (less_leEq IR a b H0)) J); unfold a, b, J in |- *; Included. -unfold a, b, J in |- *; apply proper_compact_in_interval'. +Proof. + intros x H. + set (J := compact_in_interval I pI x H) in *. + elim diffF; intros incF diffbleF. + set (a := Lend (compact_compact_in_interval I pI x H)) in *. + set (b := Rend (compact_compact_in_interval I pI x H)) in *. + fold J in (value of a), (value of b). + cut (a [<] b). intro H0. + cut (Diffble_I_n H0 n F). intro H1. + apply (Part (n_deriv_I _ _ _ _ _ H1) x). + apply n_deriv_inc. + unfold a, b, J in |- *; apply iprop_compact_in_interval_inc2. + apply iprop_compact_in_interval. + apply diffbleF. + apply (included_trans _ (Compact (less_leEq IR a b H0)) J); unfold a, b, J in |- *; Included. + unfold a, b, J in |- *; apply proper_compact_in_interval'. Defined. Lemma N_Deriv_char (* begin hide *) : forall x Hx H, - N_Deriv_fun x Hx [=] + N_Deriv_fun x Hx [=] Part (n_deriv_I _ _ (proper_compact_in_interval' _ _ _ _ @@ -874,131 +939,118 @@ Lemma N_Deriv_char (proper_compact_in_interval' _ _ _ _ (compact_compact_in_interval _ _ _ _))) _ (iprop_compact_in_interval _ _ _ _))). -intros. -unfold N_Deriv_fun in |- *. -elim diffF; intros; simpl in |- *. -apply n_deriv_I_wd'. -algebra. -apply iprop_compact_in_interval'. -apply iprop_compact_in_interval'. -apply b. -apply - included_trans - with - (Compact - (less_leEq _ _ _ - (proper_compact_in_interval' _ _ _ _ - (compact_compact_in_interval I pI x Hx)))). -2: Included. -intros x0 H0. -inversion_clear H0. -split. -eapply leEq_wdl. -apply H1. -eapply eq_transitive_unfolded. -apply Min_comm. -apply leEq_imp_Min_is_lft; apply eq_imp_leEq. -apply compact_in_interval_wd1; algebra. -eapply leEq_wdr. -apply H2. -apply leEq_imp_Max_is_rht; apply eq_imp_leEq. -apply compact_in_interval_wd2; algebra. +Proof. + intros. + unfold N_Deriv_fun in |- *. + elim diffF; intros; simpl in |- *. + apply n_deriv_I_wd'. + algebra. + apply iprop_compact_in_interval'. + apply iprop_compact_in_interval'. + apply b. + apply included_trans with (Compact (less_leEq _ _ _ (proper_compact_in_interval' _ _ _ _ + (compact_compact_in_interval I pI x Hx)))). + 2: Included. + intros x0 H0. + inversion_clear H0. + split. + eapply leEq_wdl. + apply H1. + eapply eq_transitive_unfolded. + apply Min_comm. + apply leEq_imp_Min_is_lft; apply eq_imp_leEq. + apply compact_in_interval_wd1; algebra. + eapply leEq_wdr. + apply H2. + apply leEq_imp_Max_is_rht; apply eq_imp_leEq. + apply compact_in_interval_wd2; algebra. Qed. (* end hide *) Lemma N_Deriv_strext : forall x y Hx Hy, N_Deriv_fun x Hx [#] N_Deriv_fun y Hy -> x [#] y. -intros x y Hx Hy H. -elim diffF; intros incF diffbleF. -cut - (Diffble_I_n - (proper_compact_in_interval2' _ _ _ _ _ _ - (compact_compact_in_interval2 I pI x y Hx Hy)) n F). intro H0. -cut - (Diffble_I_n - (proper_compact_in_interval' _ _ _ _ - (compact_compact_in_interval I pI x Hx)) n F). intro H1. -cut - (Diffble_I_n - (proper_compact_in_interval' _ _ _ _ - (compact_compact_in_interval I pI y Hy)) n F). intro H2. -cut (Dom (n_deriv_I _ _ _ _ _ H0) x). intro H3. -cut (Dom (n_deriv_I _ _ _ _ _ H0) y). intro H4. -apply pfstrx with (Hx := H3) (Hy := H4). -eapply ap_wdl_unfolded. -eapply ap_wdr_unfolded. -apply H. -eapply eq_transitive_unfolded. -apply (N_Deriv_char y Hy H2). -apply n_deriv_I_wd'. -algebra. -apply iprop_compact_in_interval_inc2; apply iprop_compact_in_interval. -apply iprop_compact_in_interval2_inc2; apply iprop_compact_in_interval2y. -apply - included_imp_diffble_n - with - (Hab' := proper_compact_in_interval2' _ _ _ _ _ _ - (compact_compact_in_interval2 I pI x y Hx Hy)). -2: apply H0. -red in |- *; intros z Hz. -inversion_clear Hz; split. -eapply leEq_wdl. -apply H5. -eapply eq_transitive_unfolded. -apply Min_comm. -apply leEq_imp_Min_is_lft. -apply compact_in_interval_y_lft. -eapply leEq_wdr. -apply H6. -apply leEq_imp_Max_is_rht. -apply compact_in_interval_y_rht. -eapply eq_transitive_unfolded. -apply (N_Deriv_char x Hx H1). -apply n_deriv_I_wd'. -algebra. -apply iprop_compact_in_interval_inc2; apply iprop_compact_in_interval. -apply iprop_compact_in_interval2_inc2; apply iprop_compact_in_interval2x. -apply - included_imp_diffble_n - with - (Hab' := proper_compact_in_interval2' _ _ _ _ _ _ - (compact_compact_in_interval2 I pI x y Hx Hy)). -2: apply H0. -red in |- *; intros z Hz. -inversion_clear Hz; split. -eapply leEq_wdl. -apply H5. -eapply eq_transitive_unfolded. -apply Min_comm. -apply leEq_imp_Min_is_lft. -apply compact_in_interval_x_lft. -eapply leEq_wdr. -apply H6. -apply leEq_imp_Max_is_rht. -apply compact_in_interval_x_rht. -apply n_deriv_inc. -apply iprop_compact_in_interval2_inc2; apply iprop_compact_in_interval2y. -apply n_deriv_inc. -apply iprop_compact_in_interval2_inc2; apply iprop_compact_in_interval2x. -apply diffbleF. -simpl in |- *; Included. -apply diffbleF. -simpl in |- *; Included. -apply diffbleF. -simpl in |- *; Included. +Proof. + intros x y Hx Hy H. + elim diffF; intros incF diffbleF. + cut (Diffble_I_n (proper_compact_in_interval2' _ _ _ _ _ _ + (compact_compact_in_interval2 I pI x y Hx Hy)) n F). intro H0. + cut (Diffble_I_n (proper_compact_in_interval' _ _ _ _ + (compact_compact_in_interval I pI x Hx)) n F). intro H1. + cut (Diffble_I_n (proper_compact_in_interval' _ _ _ _ + (compact_compact_in_interval I pI y Hy)) n F). intro H2. + cut (Dom (n_deriv_I _ _ _ _ _ H0) x). intro H3. + cut (Dom (n_deriv_I _ _ _ _ _ H0) y). intro H4. + apply pfstrx with (Hx := H3) (Hy := H4). + eapply ap_wdl_unfolded. + eapply ap_wdr_unfolded. + apply H. + eapply eq_transitive_unfolded. + apply (N_Deriv_char y Hy H2). + apply n_deriv_I_wd'. + algebra. + apply iprop_compact_in_interval_inc2; apply iprop_compact_in_interval. + apply iprop_compact_in_interval2_inc2; apply iprop_compact_in_interval2y. + apply included_imp_diffble_n with (Hab' := proper_compact_in_interval2' _ _ _ _ _ _ + (compact_compact_in_interval2 I pI x y Hx Hy)). + 2: apply H0. + red in |- *; intros z Hz. + inversion_clear Hz; split. + eapply leEq_wdl. + apply H5. + eapply eq_transitive_unfolded. + apply Min_comm. + apply leEq_imp_Min_is_lft. + apply compact_in_interval_y_lft. + eapply leEq_wdr. + apply H6. + apply leEq_imp_Max_is_rht. + apply compact_in_interval_y_rht. + eapply eq_transitive_unfolded. + apply (N_Deriv_char x Hx H1). + apply n_deriv_I_wd'. + algebra. + apply iprop_compact_in_interval_inc2; apply iprop_compact_in_interval. + apply iprop_compact_in_interval2_inc2; apply iprop_compact_in_interval2x. + apply included_imp_diffble_n with (Hab' := proper_compact_in_interval2' _ _ _ _ _ _ + (compact_compact_in_interval2 I pI x y Hx Hy)). + 2: apply H0. + red in |- *; intros z Hz. + inversion_clear Hz; split. + eapply leEq_wdl. + apply H5. + eapply eq_transitive_unfolded. + apply Min_comm. + apply leEq_imp_Min_is_lft. + apply compact_in_interval_x_lft. + eapply leEq_wdr. + apply H6. + apply leEq_imp_Max_is_rht. + apply compact_in_interval_x_rht. + apply n_deriv_inc. + apply iprop_compact_in_interval2_inc2; apply iprop_compact_in_interval2y. + apply n_deriv_inc. + apply iprop_compact_in_interval2_inc2; apply iprop_compact_in_interval2x. + apply diffbleF. + simpl in |- *; Included. + apply diffbleF. + simpl in |- *; Included. + apply diffbleF. + simpl in |- *; Included. Qed. Lemma N_Deriv_wd : forall x y Hx Hy, x [=] y -> N_Deriv_fun x Hx [=] N_Deriv_fun y Hy. -intros. -apply not_ap_imp_eq. intro H0. -cut (x [#] y). -apply eq_imp_not_ap; auto. -exact (N_Deriv_strext _ _ _ _ H0). +Proof. + intros. + apply not_ap_imp_eq. intro H0. + cut (x [#] y). + apply eq_imp_not_ap; auto. + exact (N_Deriv_strext _ _ _ _ H0). Qed. Definition N_Deriv : PartIR. -apply Build_PartFunct with (pfpfun := N_Deriv_fun). -apply iprop_wd. -exact N_Deriv_strext. +Proof. + apply Build_PartFunct with (pfpfun := N_Deriv_fun). + apply iprop_wd. + exact N_Deriv_strext. Defined. End Definitions. @@ -1010,176 +1062,188 @@ All the usual results hold. *) Lemma Diffble_n_wd : forall n F G, Feq I F G -> Diffble_n n I pI F -> Diffble_n n I pI G. -intros n F G H H0. -elim H; intros incF H1. -elim H1; intro incG. -split. -auto. -intros; apply Diffble_I_n_wd with F. -apply included_Feq with I; auto. -elim H0; auto. +Proof. + intros n F G H H0. + elim H; intros incF H1. + elim H1; intro incG. + split. + auto. + intros; apply Diffble_I_n_wd with F. + apply included_Feq with I; auto. + elim H0; auto. Qed. Lemma Derivative_n_wdr : forall n F G H, Feq I G H -> Derivative_n n I pI F G -> Derivative_n n I pI F H. -intros n F G H H0 H1. -elim H0; intros incG H2. -elim H2; intros incH Heq. -elim H1; intros incF H0'. -elim H0'; intros incG' derivF. -clear H2 H0'. -split; auto. -split; auto. -intros; apply Derivative_I_n_wdr with G. -apply included_Feq with I; auto. -auto. +Proof. + intros n F G H H0 H1. + elim H0; intros incG H2. + elim H2; intros incH Heq. + elim H1; intros incF H0'. + elim H0'; intros incG' derivF. + clear H2 H0'. + split; auto. + split; auto. + intros; apply Derivative_I_n_wdr with G. + apply included_Feq with I; auto. + auto. Qed. Lemma Derivative_n_wdl : forall n F G H, Feq I F G -> Derivative_n n I pI F H -> Derivative_n n I pI G H. -intros n F G H H0 H1. -elim H0; intros incG H2. -elim H2; intros incH Heq. -elim H1; intros incF H0'. -elim H0'; intros incG' derivF. -clear H2 H0'. -split; auto. -split; auto. -intros; apply Derivative_I_n_wdl with F. -apply included_Feq with I; auto. -auto. +Proof. + intros n F G H H0 H1. + elim H0; intros incG H2. + elim H2; intros incH Heq. + elim H1; intros incF H0'. + elim H0'; intros incG' derivF. + clear H2 H0'. + split; auto. + split; auto. + intros; apply Derivative_I_n_wdl with F. + apply included_Feq with I; auto. + auto. Qed. Lemma Derivative_n_unique : forall n F G H, Derivative_n n I pI F G -> Derivative_n n I pI F H -> Feq I G H. -intros n F G H H0 H1. -elim H0; intros incF H2. -elim H2; intros incG derivFG. -elim H1; intros incF' H3. -elim H3; intros incH derivFH. -FEQ. rename X into H4. -apply - Feq_imp_eq - with - (Compact - (less_leEq _ _ _ - (proper_compact_in_interval' _ _ _ _ - (compact_compact_in_interval I pI x H4)))). -apply Derivative_I_n_unique with n F. -apply derivFG. -simpl in |- *; Included. -apply derivFH. -simpl in |- *; Included. -apply interval_compact_inc. -apply iprop_compact_in_interval. +Proof. + intros n F G H H0 H1. + elim H0; intros incF H2. + elim H2; intros incG derivFG. + elim H1; intros incF' H3. + elim H3; intros incH derivFH. + FEQ. rename X into H4. + apply Feq_imp_eq with (Compact (less_leEq _ _ _ (proper_compact_in_interval' _ _ _ _ + (compact_compact_in_interval I pI x H4)))). + apply Derivative_I_n_unique with n F. + apply derivFG. + simpl in |- *; Included. + apply derivFH. + simpl in |- *; Included. + apply interval_compact_inc. + apply iprop_compact_in_interval. Qed. Lemma Diffble_n_imp_Diffble : forall n : nat, 0 < n -> forall F, Diffble_n n I pI F -> Diffble I pI F. -intros n H F H0. -elim H0; intros incF diffF. -split; auto. -intros; apply Diffble_I_n_imp_diffble with n; auto. +Proof. + intros n H F H0. + elim H0; intros incF diffF. + split; auto. + intros; apply Diffble_I_n_imp_diffble with n; auto. Qed. Lemma Derivative_n_imp_Diffble : forall n, 0 < n -> forall F F', Derivative_n n I pI F F' -> Diffble I pI F. -intros n H F F' H0. -elim H0; intros incF H1. -elim H1; intros incF' derivF. -split; auto. -intros; apply deriv_n_imp_diffble with n F'; auto. +Proof. + intros n H F F' H0. + elim H0; intros incF H1. + elim H1; intros incF' derivF. + split; auto. + intros; apply deriv_n_imp_diffble with n F'; auto. Qed. Lemma le_imp_Diffble_n : forall m n, m <= n -> forall F, Diffble_n n I pI F -> Diffble_n m I pI F. -intros m n H F H0. -elim H0; intros incF diffF. -split; auto. -intros; apply le_imp_Diffble_I with n; auto. +Proof. + intros m n H F H0. + elim H0; intros incF diffF. + split; auto. + intros; apply le_imp_Diffble_I with n; auto. Qed. Lemma Diffble_n_imp_le : forall n, 0 < n -> forall F F', Diffble_n n I pI F -> Derivative I pI F F' -> Diffble_n (pred n) I pI F'. -intros n H F F' H0 H1. -elim H0; intros incF diffF. -elim H1; intros incFa H2. -elim H2; intros incF' derivF. -split; auto. -intros; apply Diffble_I_imp_le with F; auto. +Proof. + intros n H F F' H0 H1. + elim H0; intros incF diffF. + elim H1; intros incFa H2. + elim H2; intros incF' derivF. + split; auto. + intros; apply Diffble_I_imp_le with F; auto. Qed. Lemma Diffble_n_imp_inc : forall n F, Diffble_n n I pI F -> included I (Dom F). -intros n F H. -inversion_clear H; auto. +Proof. + intros n F H. + inversion_clear H; auto. Qed. Lemma Derivative_n_imp_Diffble_n : forall n F F', Derivative_n n I pI F F' -> Diffble_n n I pI F. -intros n F F' H. -elim H; intros incF H1. -elim H1; intros incF' derivF. -split; auto. -intros; apply deriv_n_imp_Diffble_I_n with F'; auto. +Proof. + intros n F F' H. + elim H; intros incF H1. + elim H1; intros incF' derivF. + split; auto. + intros; apply deriv_n_imp_Diffble_I_n with F'; auto. Qed. Lemma Derivative_n_imp_inc : forall n F F', Derivative_n n I pI F F' -> included I (Dom F). -intros n F F' H. -inversion_clear H; auto. +Proof. + intros n F F' H. + inversion_clear H; auto. Qed. Lemma Derivative_n_imp_inc' : forall n F F', Derivative_n n I pI F F' -> included I (Dom F'). -intros. -inversion_clear X; inversion_clear X1; auto. +Proof. + intros. + inversion_clear X; inversion_clear X1; auto. Qed. Lemma included_imp_Derivative_n : forall n F F' a b Hab, Derivative_n n I pI F F' -> included (Compact (less_leEq _ a b Hab)) I -> Derivative_I_n Hab n F F'. -intros n F F' a b Hab H H0. -elim H; intros incF H1. -elim H1; auto. +Proof. + intros n F F' a b Hab H H0. + elim H; intros incF H1. + elim H1; auto. Qed. Lemma included_imp_Diffble_n : forall n F a b Hab, Diffble_n n I pI F -> included (Compact (less_leEq _ a b Hab)) I -> Diffble_I_n Hab n F. -intros. -elim X; auto. +Proof. + intros. + elim X; auto. Qed. Lemma Included_imp_Derivative_n : forall n (J : interval) pJ F F', included J I -> Derivative_n n I pI F F' -> Derivative_n n J pJ F F'. -intros n J pJ F F' H H0. -elim H0; clear H0; intros H1 H2. -elim H2; clear H2; intros H0 H3. -split. -Included. -split. -Included. -intros; apply H3. -Included. +Proof. + intros n J pJ F F' H H0. + elim H0; clear H0; intros H1 H2. + elim H2; clear H2; intros H0 H3. + split. + Included. + split. + Included. + intros; apply H3. + Included. Qed. Lemma Included_imp_Diffble_n : forall n (J : interval) pJ F, included J I -> Diffble_n n I pI F -> Diffble_n n J pJ F. -intros n J pJ F H H0. -elim H0; clear H0; intros H1 H2. -split. -Included. -intros; apply H2. -Included. +Proof. + intros n J pJ F H H0. + elim H0; clear H0; intros H1 H2. + split. + Included. + intros; apply H2. + Included. Qed. Lemma Derivative_n_plus : forall J pJ n m k F G H, Derivative_n m J pJ F G -> Derivative_n n J pJ G H -> k = m + n -> Derivative_n k J pJ F H. -intros J pJ n m k F G H H0 H1 H2. -elim H0; intros incF Hf. -elim Hf; intros incG derFG. -elim H1; intros incG' Hg. -elim Hg; intros incH derGH. -clear Hf Hg. -split; auto. -split; auto. -intros; apply Derivative_I_n_plus with n m G; auto. +Proof. + intros J pJ n m k F G H H0 H1 H2. + elim H0; intros incF Hf. + elim Hf; intros incG derFG. + elim H1; intros incG' Hg. + elim Hg; intros incH derGH. + clear Hf Hg. + split; auto. + split; auto. + intros; apply Derivative_I_n_plus with n m G; auto. Qed. End Basic_Results. @@ -1193,89 +1257,84 @@ Some new results hold, too: Lemma N_Deriv_Feq : forall n F diffF a b Hab H (incN : included (Compact (less_leEq _ _ _ Hab)) (Dom (N_Deriv n F diffF))), Feq (Compact (less_leEq _ _ _ Hab)) (N_Deriv n F diffF) (n_deriv_I a b Hab n F H). -intros. -FEQ. -apply n_deriv_inc. -simpl in |- *. -cut - (Diffble_I_n - (proper_compact_in_interval' _ _ _ _ - (compact_compact_in_interval I pI x Hx)) n F). intro H1. -eapply eq_transitive_unfolded. -apply (N_Deriv_char n F diffF x Hx H1). -apply n_deriv_I_wd'; auto. -algebra. -apply iprop_compact_in_interval_inc2; apply iprop_compact_in_interval. -apply included_imp_Diffble_n; auto. -apply included_interval'. -apply (included_compact_in_interval I pI x Hx). -apply - (iprop_compact_in_interval_inc1 _ _ _ _ - (compact_compact_in_interval I pI x Hx) - (Lend_leEq_Rend _ (compact_compact_in_interval I pI x Hx))). -apply compact_inc_lft. -apply (included_compact_in_interval I pI x Hx). -apply - (iprop_compact_in_interval_inc1 _ _ _ _ - (compact_compact_in_interval I pI x Hx) - (Lend_leEq_Rend _ (compact_compact_in_interval I pI x Hx))). -apply compact_inc_rht. -apply incN; apply compact_inc_lft. -apply incN; apply compact_inc_rht. -elim diffF; intros incF diffbleF. -apply diffbleF; auto. -eapply included_trans. -apply iprop_compact_in_interval_inc1. -Included. +Proof. + intros. + FEQ. + apply n_deriv_inc. + simpl in |- *. + cut (Diffble_I_n (proper_compact_in_interval' _ _ _ _ + (compact_compact_in_interval I pI x Hx)) n F). intro H1. + eapply eq_transitive_unfolded. + apply (N_Deriv_char n F diffF x Hx H1). + apply n_deriv_I_wd'; auto. + algebra. + apply iprop_compact_in_interval_inc2; apply iprop_compact_in_interval. + apply included_imp_Diffble_n; auto. + apply included_interval'. + apply (included_compact_in_interval I pI x Hx). + apply (iprop_compact_in_interval_inc1 _ _ _ _ (compact_compact_in_interval I pI x Hx) + (Lend_leEq_Rend _ (compact_compact_in_interval I pI x Hx))). + apply compact_inc_lft. + apply (included_compact_in_interval I pI x Hx). + apply (iprop_compact_in_interval_inc1 _ _ _ _ (compact_compact_in_interval I pI x Hx) + (Lend_leEq_Rend _ (compact_compact_in_interval I pI x Hx))). + apply compact_inc_rht. + apply incN; apply compact_inc_lft. + apply incN; apply compact_inc_rht. + elim diffF; intros incF diffbleF. + apply diffbleF; auto. + eapply included_trans. + apply iprop_compact_in_interval_inc1. + Included. Qed. Lemma N_Deriv_lemma : forall n F H, Derivative_n n I pI F (N_Deriv n F H). -intros. -elim H; intros incF diffF. -split; auto. -split; Included. -intros a b Hab H0. -cut (Diffble_I_n Hab n F). intro H1. 2: auto. -eapply Derivative_I_n_wdr. -apply Feq_symmetric; - apply (N_Deriv_Feq n F (CAnd_intro _ _ incF diffF) _ _ Hab H1 H0). -apply n_deriv_lemma. +Proof. + intros. + elim H; intros incF diffF. + split; auto. + split; Included. + intros a b Hab H0. + cut (Diffble_I_n Hab n F). intro H1. 2: auto. + eapply Derivative_I_n_wdr. + apply Feq_symmetric; apply (N_Deriv_Feq n F (CAnd_intro _ _ incF diffF) _ _ Hab H1 H0). + apply n_deriv_lemma. Qed. Lemma N_Deriv_S : forall n F H HS, Derivative I pI (N_Deriv n F H) (N_Deriv (S n) F HS). -intros n F H H'. -split; Included. -split; Included. -elim H; intros incF diffFn. -elim H'; intros incF' diffFSn. -intros a b Hab H0. -cut (Diffble_I_n Hab n F). intro H1. 2: auto. -cut (Diffble_I_n Hab (S n) F). intro H2. 2: auto. -eapply Derivative_I_wdl. -apply Feq_symmetric; - apply (N_Deriv_Feq n F (CAnd_intro _ _ incF diffFn) _ _ Hab H1 H0). -eapply Derivative_I_wdr. -apply Feq_symmetric; - apply (N_Deriv_Feq _ _ (CAnd_intro _ _ incF' diffFSn) _ _ Hab H2 H0). -apply n_Sn_deriv. +Proof. + intros n F H H'. + split; Included. + split; Included. + elim H; intros incF diffFn. + elim H'; intros incF' diffFSn. + intros a b Hab H0. + cut (Diffble_I_n Hab n F). intro H1. 2: auto. + cut (Diffble_I_n Hab (S n) F). intro H2. 2: auto. + eapply Derivative_I_wdl. + apply Feq_symmetric; apply (N_Deriv_Feq n F (CAnd_intro _ _ incF diffFn) _ _ Hab H1 H0). + eapply Derivative_I_wdr. + apply Feq_symmetric; apply (N_Deriv_Feq _ _ (CAnd_intro _ _ incF' diffFSn) _ _ Hab H2 H0). + apply n_Sn_deriv. Qed. Lemma N_Deriv_plus : forall m n F H H', Derivative_n m I pI (N_Deriv n F H) (N_Deriv (m + n) F H'). -intros. -split; Included. -split; Included. -intros a b Hab H0. -cut (Diffble_I_n Hab n F). intro H1. -cut (Diffble_I_n Hab (m + n) F). intro H2. -eapply Derivative_I_n_wdl. -apply Feq_symmetric; apply (N_Deriv_Feq n F H _ _ Hab H1 H0). -eapply Derivative_I_n_wdr. -apply Feq_symmetric; apply (N_Deriv_Feq _ _ H' _ _ Hab H2 H0). -apply n_deriv_plus. -elim H'; auto. -elim H; auto. +Proof. + intros. + split; Included. + split; Included. + intros a b Hab H0. + cut (Diffble_I_n Hab n F). intro H1. + cut (Diffble_I_n Hab (m + n) F). intro H2. + eapply Derivative_I_n_wdl. + apply Feq_symmetric; apply (N_Deriv_Feq n F H _ _ Hab H1 H0). + eapply Derivative_I_n_wdr. + apply Feq_symmetric; apply (N_Deriv_Feq _ _ H' _ _ Hab H2 H0). + apply n_deriv_plus. + elim H'; auto. + elim H; auto. Qed. (** @@ -1283,29 +1342,29 @@ Some useful characterization results. *) Lemma Derivative_n_O : forall F, included I (Dom F) -> Derivative_n 0 I pI F F. -intros. -split; Included. -split; Included. -intros. -red in |- *; apply Feq_reflexive; Included. +Proof. + intros. + split; Included. + split; Included. + intros. + red in |- *; apply Feq_reflexive; Included. Qed. Lemma Derivative_n_Sn : forall F n fn fSn, Derivative_n n I pI F fn -> Derivative_n (S n) I pI F fSn -> Derivative I pI fn fSn. -intros F n fn fSn H H0. -cut (Diffble_n n I pI F); - [ intro H1 | eapply Derivative_n_imp_Diffble_n; apply H ]. -cut (Diffble_n (S n) I pI F); - [ intro H2 | eapply Derivative_n_imp_Diffble_n; apply H0 ]. -apply Derivative_wdl with (N_Deriv _ _ H1). -apply Derivative_n_unique with n F. -apply N_Deriv_lemma. -auto. -apply Derivative_wdr with (N_Deriv _ _ H2). -apply Derivative_n_unique with (S n) F. -apply N_Deriv_lemma. -auto. -apply N_Deriv_S. +Proof. + intros F n fn fSn H H0. + cut (Diffble_n n I pI F); [ intro H1 | eapply Derivative_n_imp_Diffble_n; apply H ]. + cut (Diffble_n (S n) I pI F); [ intro H2 | eapply Derivative_n_imp_Diffble_n; apply H0 ]. + apply Derivative_wdl with (N_Deriv _ _ H1). + apply Derivative_n_unique with n F. + apply N_Deriv_lemma. + auto. + apply Derivative_wdr with (N_Deriv _ _ H2). + apply Derivative_n_unique with (S n) F. + apply N_Deriv_lemma. + auto. + apply N_Deriv_S. Qed. End More_Results. @@ -1323,10 +1382,11 @@ Hypothesis diffF : Diffble I pI F. (* end show *) Lemma Diffble_imp_Diffble_n : Diffble_n 1 I pI F. -elim diffF; intros incF diffbleF. -split; auto. -intros a b Hab H; exists (diffbleF a b Hab H). -simpl in |- *; Included. +Proof. + elim diffF; intros incF diffbleF. + split; auto. + intros a b Hab H; exists (diffbleF a b Hab H). + simpl in |- *; Included. Qed. Definition Deriv := N_Deriv 1 F Diffble_imp_Diffble_n. @@ -1340,16 +1400,14 @@ Section Corollaries. *) Lemma Deriv_lemma : forall F diffF, Derivative I pI F (Deriv F diffF). -intros; unfold Deriv in |- *. -apply - Derivative_wdl - with - (N_Deriv 0 F - (le_imp_Diffble_n 0 1 (le_n_Sn 0) F (Diffble_imp_Diffble_n _ diffF))). -apply Derivative_n_unique with 0 F. -apply N_Deriv_lemma. -apply Derivative_n_O; elim diffF; auto. -apply N_Deriv_S. +Proof. + intros; unfold Deriv in |- *. + apply Derivative_wdl with (N_Deriv 0 F + (le_imp_Diffble_n 0 1 (le_n_Sn 0) F (Diffble_imp_Diffble_n _ diffF))). + apply Derivative_n_unique with 0 F. + apply N_Deriv_lemma. + apply Derivative_n_O; elim diffF; auto. + apply N_Deriv_S. Qed. (** @@ -1357,53 +1415,57 @@ Some more interesting properties. *) Lemma Derivative_n_1 : forall F G, Derivative I pI F G -> Derivative_n 1 I pI F G. -intros F G H. -cut (Diffble I pI F). intro H0. -apply Derivative_n_wdr with (Deriv _ H0). -apply Derivative_unique with pI F. -apply Deriv_lemma. -auto. -unfold Deriv in |- *; apply N_Deriv_lemma. -apply Derivative_imp_Diffble with G; auto. +Proof. + intros F G H. + cut (Diffble I pI F). intro H0. + apply Derivative_n_wdr with (Deriv _ H0). + apply Derivative_unique with pI F. + apply Deriv_lemma. + auto. + unfold Deriv in |- *; apply N_Deriv_lemma. + apply Derivative_imp_Diffble with G; auto. Qed. Lemma Derivative_n_chain : forall F f, Feq I F (f 0) -> (forall n, Derivative I pI (f n) (f (S n))) -> forall n, Derivative_n n I pI F (f n). -intros F f H H0 n. -induction n as [| n Hrecn]. -apply Derivative_n_wdr with F. -auto. -apply Derivative_n_O. -elim H; auto. -apply Derivative_n_plus with 1 n (f n); auto. -apply Derivative_n_1; auto. -rewrite plus_comm; auto. +Proof. + intros F f H H0 n. + induction n as [| n Hrecn]. + apply Derivative_n_wdr with F. + auto. + apply Derivative_n_O. + elim H; auto. + apply Derivative_n_plus with 1 n (f n); auto. + apply Derivative_n_1; auto. + rewrite plus_comm; auto. Qed. Lemma Derivative_n_imp_Continuous : forall n F G, 0 < n -> Derivative_n n I pI F G -> Continuous I F. -intros n F G H H0. -cut (Diffble I pI F). intro H1. -apply Derivative_imp_Continuous with pI (Deriv _ H1). -apply Deriv_lemma. -apply Diffble_n_imp_Diffble with n; auto. -apply Derivative_n_imp_Diffble_n with G; auto. +Proof. + intros n F G H H0. + cut (Diffble I pI F). intro H1. + apply Derivative_imp_Continuous with pI (Deriv _ H1). + apply Deriv_lemma. + apply Diffble_n_imp_Diffble with n; auto. + apply Derivative_n_imp_Diffble_n with G; auto. Qed. Lemma Derivative_n_imp_Continuous' : forall n F G, 0 < n -> Derivative_n n I pI F G -> Continuous I G. -intros n F G H H0. -cut (Diffble_n (pred n) I pI F). intro H1. -apply Derivative_imp_Continuous' with pI (N_Deriv _ _ H1). -apply Derivative_wdr with (N_Deriv _ _ (Derivative_n_imp_Diffble_n _ _ _ H0)). -apply Derivative_n_unique with n F; auto; apply N_Deriv_lemma. -cut (n = S (pred n)); [ intro | apply S_pred with 0; auto ]. -generalize H0. -rewrite {1 3 4} H2. -intro; apply N_Deriv_S. -apply le_imp_Diffble_n with n. -auto with arith. -apply Derivative_n_imp_Diffble_n with G; auto. +Proof. + intros n F G H H0. + cut (Diffble_n (pred n) I pI F). intro H1. + apply Derivative_imp_Continuous' with pI (N_Deriv _ _ H1). + apply Derivative_wdr with (N_Deriv _ _ (Derivative_n_imp_Diffble_n _ _ _ H0)). + apply Derivative_n_unique with n F; auto; apply N_Deriv_lemma. + cut (n = S (pred n)); [ intro | apply S_pred with 0; auto ]. + generalize H0. + rewrite {1 3 4} H2. + intro; apply N_Deriv_S. + apply le_imp_Diffble_n with n. + auto with arith. + apply Derivative_n_imp_Diffble_n with G; auto. Qed. End Corollaries. diff --git a/ftc/MoreIntegrals.v b/ftc/MoreIntegrals.v index 69a3b3f29..b13435c55 100644 --- a/ftc/MoreIntegrals.v +++ b/ftc/MoreIntegrals.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Integral. Require Export MoreFunctions. @@ -50,7 +50,7 @@ arbitrary integration domains (that is, not requiring that the lower endpoint of integration be less or equal than the upper endpoint) and we prove the fundamental properties of the new operator. -%\begin{convention}% Let [a, b : IR] and assume that [F] and [G] are two +%\begin{convention}% Let [a, b : IR] and assume that [F] and [G] are two partial functions continuous in [[Min(a,b),Max(a,b)]]. %\end{convention}% @@ -63,21 +63,23 @@ Variables a b : IR. Hypothesis Hab : Min a b [<=] Max a b. Lemma compact_inc_Min_lft : forall H, included (compact (Min a b) a H) (Compact Hab). -intros. -apply included_compact; split. -apply leEq_reflexive. -apply Min_leEq_Max. -apply Min_leEq_lft. -apply lft_leEq_Max. +Proof. + intros. + apply included_compact; split. + apply leEq_reflexive. + apply Min_leEq_Max. + apply Min_leEq_lft. + apply lft_leEq_Max. Qed. Lemma compact_inc_Min_rht : forall H, included (compact (Min a b) b H) (Compact Hab). -intros. -apply included_compact; split. -apply leEq_reflexive. -apply Min_leEq_Max. -apply Min_leEq_rht. -apply rht_leEq_Max. +Proof. + intros. + apply included_compact; split. + apply leEq_reflexive. + apply Min_leEq_Max. + apply Min_leEq_rht. + apply rht_leEq_Max. Qed. End Lemmas. @@ -99,30 +101,33 @@ Variable F : PartIR. Hypothesis HF : Continuous_I Hab F. Lemma Integral_inc1 : Continuous_I (Min_leEq_lft a b) F. -eapply included_imp_contin with (Hab := Hab). -2: apply HF. -apply compact_inc_Min_lft. +Proof. + eapply included_imp_contin with (Hab := Hab). + 2: apply HF. + apply compact_inc_Min_lft. Qed. Lemma Integral_inc2 : Continuous_I (Min_leEq_rht a b) F. -eapply included_imp_contin with (Hab := Hab). -2: apply HF. -apply compact_inc_Min_rht. +Proof. + eapply included_imp_contin with (Hab := Hab). + 2: apply HF. + apply compact_inc_Min_rht. Qed. Definition Integral := integral _ _ (Min_leEq_rht a b) F Integral_inc2[-]integral _ _ (Min_leEq_lft a b) _ Integral_inc1. Lemma Integral_integral : forall Hab' HF', Integral [=] integral a b Hab' F HF'. -intros. -unfold Integral in |- *. -astepr (integral a b Hab' F HF'[-]Zero). -apply cg_minus_wd. -apply integral_wd'. -apply leEq_imp_Min_is_lft; assumption. -algebra. -apply integral_empty. -apply leEq_imp_Min_is_lft; assumption. +Proof. + intros. + unfold Integral in |- *. + astepr (integral a b Hab' F HF'[-]Zero). + apply cg_minus_wd. + apply integral_wd'. + apply leEq_imp_Min_is_lft; assumption. + algebra. + apply integral_empty. + apply leEq_imp_Min_is_lft; assumption. Qed. End Definitions. @@ -147,48 +152,51 @@ Hypothesis contG : Continuous_I Hab G. Lemma Integral_strext : Integral contF [#] Integral contG -> {x : IR | Compact Hab x | forall Hx Hx', Part F x Hx [#] Part G x Hx'}. -intro H. -unfold Integral in H. -elim (cg_minus_strext _ _ _ _ _ H); intro. -elim (integral_strext _ _ _ _ _ _ _ a0); intros. -exists x. -apply compact_inc_Min_rht with (H := Min_leEq_rht a b); assumption. -assumption. -elim (integral_strext _ _ _ _ _ _ _ b0); intros. -exists x. -apply compact_inc_Min_lft with (H := Min_leEq_lft a b); assumption. -assumption. +Proof. + intro H. + unfold Integral in H. + elim (cg_minus_strext _ _ _ _ _ H); intro. + elim (integral_strext _ _ _ _ _ _ _ a0); intros. + exists x. + apply compact_inc_Min_rht with (H := Min_leEq_rht a b); assumption. + assumption. + elim (integral_strext _ _ _ _ _ _ _ b0); intros. + exists x. + apply compact_inc_Min_lft with (H := Min_leEq_lft a b); assumption. + assumption. Qed. Lemma Integral_strext' : forall c d Hcd HF1 HF2, Integral (Hab:=Hab) (F:=F) HF1 [#] Integral (a:=c) (b:=d) (Hab:=Hcd) (F:=F) HF2 -> a [#] c or b [#] d. -intros c d Hcd HF1 HF2 H. -elim (cg_minus_strext _ _ _ _ _ H); clear H; intro H; - elim (integral_strext' _ _ _ _ _ _ _ _ _ H); clear H; - intro H. -elim (Min_strext_unfolded _ _ _ _ H); auto. -auto. -elim (Min_strext_unfolded _ _ _ _ H); auto. -auto. +Proof. + intros c d Hcd HF1 HF2 H. + elim (cg_minus_strext _ _ _ _ _ H); clear H; intro H; + elim (integral_strext' _ _ _ _ _ _ _ _ _ H); clear H; intro H. + elim (Min_strext_unfolded _ _ _ _ H); auto. + auto. + elim (Min_strext_unfolded _ _ _ _ H); auto. + auto. Qed. Lemma Integral_wd : Feq (Compact Hab) F G -> Integral contF [=] Integral contG. -intros; unfold Integral in |- *. -apply cg_minus_wd; apply integral_wd. -apply included_Feq with (Compact Hab). -apply compact_inc_Min_rht. -assumption. -apply included_Feq with (Compact Hab). -apply compact_inc_Min_lft. -assumption. +Proof. + intros; unfold Integral in |- *. + apply cg_minus_wd; apply integral_wd. + apply included_Feq with (Compact Hab). + apply compact_inc_Min_rht. + assumption. + apply included_Feq with (Compact Hab). + apply compact_inc_Min_lft. + assumption. Qed. Lemma Integral_wd' : forall a' b' Ha'b' contF', a [=] a' -> b [=] b' -> Integral contF [=] Integral (a:=a') (b:=b') (Hab:=Ha'b') (F:=F) contF'. -intros. -unfold Integral in |- *. -apply cg_minus_wd; apply integral_wd'; try apply bin_op_wd_unfolded; algebra. +Proof. + intros. + unfold Integral in |- *. + apply cg_minus_wd; apply integral_wd'; try apply bin_op_wd_unfolded; algebra. Qed. (** @@ -196,61 +204,65 @@ The integral is a linear operator. *) Lemma Integral_const : forall c (H : Continuous_I Hab [-C-]c), Integral H [=] c[*] (b[-]a). -intros. -unfold Integral in |- *. -rstepr (c[*] (b[-]Min a b) [-]c[*] (a[-]Min a b)). -apply cg_minus_wd; apply integral_const. +Proof. + intros. + unfold Integral in |- *. + rstepr (c[*] (b[-]Min a b) [-]c[*] (a[-]Min a b)). + apply cg_minus_wd; apply integral_const. Qed. Lemma Integral_comm_scal : forall c (H : Continuous_I Hab (c{**}F)), Integral H [=] c[*]Integral contF. -intros. -unfold Integral in |- *. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply dist_2a. -apply cg_minus_wd; apply integral_comm_scal. +Proof. + intros. + unfold Integral in |- *. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply dist_2a. + apply cg_minus_wd; apply integral_comm_scal. Qed. Lemma Integral_plus : forall H : Continuous_I Hab (F{+}G), Integral H [=] Integral contF[+]Integral contG. -intro. -unfold Integral in |- *. -cut (forall x y z w : IR, x[-]y[+] (z[-]w) [=] x[+]z[-] (y[+]w)); intros. -2: rational. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply H0. -apply cg_minus_wd; apply integral_plus. +Proof. + intro. + unfold Integral in |- *. + cut (forall x y z w : IR, x[-]y[+] (z[-]w) [=] x[+]z[-] (y[+]w)); intros. + 2: rational. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply H0. + apply cg_minus_wd; apply integral_plus. Qed. Lemma Integral_inv : forall H : Continuous_I Hab {--}F, Integral H [=] [--] (Integral contF). -intro. -unfold Integral in |- *. -cut (forall x y : IR, [--] (x[-]y) [=] [--]x[-][--]y); intros. -2: rational. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply H0. -apply cg_minus_wd; apply integral_inv. +Proof. + intro. + unfold Integral in |- *. + cut (forall x y : IR, [--] (x[-]y) [=] [--]x[-][--]y); intros. + 2: rational. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply H0. + apply cg_minus_wd; apply integral_inv. Qed. Lemma Integral_minus : forall H : Continuous_I Hab (F{-}G), Integral H [=] Integral contF[-]Integral contG. -intro. -unfold Integral in |- *. -cut (forall x y z w : IR, x[-]y[-] (z[-]w) [=] x[-]z[-] (y[-]w)); intros. -2: rational. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply H0. -apply cg_minus_wd; apply integral_minus. +Proof. + intro. + unfold Integral in |- *. + cut (forall x y z w : IR, x[-]y[-] (z[-]w) [=] x[-]z[-] (y[-]w)); intros. + 2: rational. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply H0. + apply cg_minus_wd; apply integral_minus. Qed. Lemma linear_Integral : forall alpha beta (H : Continuous_I Hab (alpha{**}F{+}beta{**}G)), Integral H [=] alpha[*]Integral contF[+]beta[*]Integral contG. -intros; unfold Integral in |- *. -cut - (forall x y z r s t : IR, - x[*] (y[-]z) [+]r[*] (s[-]t) [=] x[*]y[+]r[*]s[-] (x[*]z[+]r[*]t)). -2: intros; rational. -intro; eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply H0. -clear H0. -apply cg_minus_wd; apply linear_integral. +Proof. + intros; unfold Integral in |- *. + cut (forall x y z r s t : IR, x[*] (y[-]z) [+]r[*] (s[-]t) [=] x[*]y[+]r[*]s[-] (x[*]z[+]r[*]t)). + 2: intros; rational. + intro; eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply H0. + clear H0. + apply cg_minus_wd; apply linear_integral. Qed. (** @@ -258,12 +270,13 @@ If the endpoints are equal then the integral vanishes. *) Lemma Integral_empty : a [=] b -> Integral contF [=] Zero. -intros. -unfold Integral in |- *. -astepr (ZeroR[-]Zero). -apply cg_minus_wd; apply integral_empty. -astepr a; apply leEq_imp_Min_is_lft; apply eq_imp_leEq; assumption. -apply leEq_imp_Min_is_lft; apply eq_imp_leEq; assumption. +Proof. + intros. + unfold Integral in |- *. + astepr (ZeroR[-]Zero). + apply cg_minus_wd; apply integral_empty. + astepr a; apply leEq_imp_Min_is_lft; apply eq_imp_leEq; assumption. + apply leEq_imp_Min_is_lft; apply eq_imp_leEq; assumption. Qed. (** @@ -271,40 +284,36 @@ And the norm provides an upper bound for the absolute value of the integral. *) Lemma Integral_leEq_norm : AbsIR (Integral contF) [<=] Norm_Funct contF[*]AbsIR (b[-]a). -unfold Integral in |- *. -eapply leEq_transitive. -apply triangle_IR_minus. -apply - leEq_transitive - with (Norm_Funct contF[*] (b[-]Min a b) [+]Norm_Funct contF[*] (a[-]Min a b)). -apply plus_resp_leEq_both; - (eapply leEq_transitive; - [ apply integral_leEq_norm | apply mult_resp_leEq_rht ]). -apply leEq_Norm_Funct; intros. -apply norm_bnd_AbsIR; apply compact_inc_Min_rht with (H := Min_leEq_rht a b); - assumption. -apply shift_leEq_minus; astepl (Min a b); apply Min_leEq_rht. -apply leEq_Norm_Funct; intros. -apply norm_bnd_AbsIR; apply compact_inc_Min_lft with (H := Min_leEq_lft a b); - assumption. -apply shift_leEq_minus; astepl (Min a b); apply Min_leEq_lft. -eapply leEq_wdl. -2: apply ring_dist_unfolded. -apply mult_resp_leEq_lft. -2: apply positive_norm. -rstepl (a[+]b[-]Two[*]Min a b). -apply shift_minus_leEq; apply shift_leEq_plus'. -apply shift_leEq_mult' with (two_ap_zero IR). -apply pos_two. -apply leEq_Min. -apply shift_div_leEq. -apply pos_two. -apply shift_minus_leEq; apply shift_leEq_plus'. -rstepl (b[-]a); apply leEq_AbsIR. -apply shift_div_leEq. -apply pos_two. -apply shift_minus_leEq; apply shift_leEq_plus'. -rstepl ( [--] (b[-]a)); apply inv_leEq_AbsIR. +Proof. + unfold Integral in |- *. + eapply leEq_transitive. + apply triangle_IR_minus. + apply leEq_transitive with (Norm_Funct contF[*] (b[-]Min a b) [+]Norm_Funct contF[*] (a[-]Min a b)). + apply plus_resp_leEq_both; (eapply leEq_transitive; + [ apply integral_leEq_norm | apply mult_resp_leEq_rht ]). + apply leEq_Norm_Funct; intros. + apply norm_bnd_AbsIR; apply compact_inc_Min_rht with (H := Min_leEq_rht a b); assumption. + apply shift_leEq_minus; astepl (Min a b); apply Min_leEq_rht. + apply leEq_Norm_Funct; intros. + apply norm_bnd_AbsIR; apply compact_inc_Min_lft with (H := Min_leEq_lft a b); assumption. + apply shift_leEq_minus; astepl (Min a b); apply Min_leEq_lft. + eapply leEq_wdl. + 2: apply ring_dist_unfolded. + apply mult_resp_leEq_lft. + 2: apply positive_norm. + rstepl (a[+]b[-]Two[*]Min a b). + apply shift_minus_leEq; apply shift_leEq_plus'. + apply shift_leEq_mult' with (two_ap_zero IR). + apply pos_two. + apply leEq_Min. + apply shift_div_leEq. + apply pos_two. + apply shift_minus_leEq; apply shift_leEq_plus'. + rstepl (b[-]a); apply leEq_AbsIR. + apply shift_div_leEq. + apply pos_two. + apply shift_minus_leEq; apply shift_leEq_plus'. + rstepl ( [--] (b[-]a)); apply inv_leEq_AbsIR. Qed. End Properties_of_Integral. @@ -317,22 +326,22 @@ Two other ways of stating the addition law for domains. Lemma integral_plus_Integral : forall a b Hab F c Hac Hcb Hab' Hac' Hcb', integral c b Hcb F Hcb' [=] integral a b Hab F Hab'[-]integral a c Hac F Hac'. -intros. -rstepl - (integral a c Hac F Hac'[+]integral c b Hcb F Hcb'[-]integral a c Hac F Hac'). -apply cg_minus_wd. -apply integral_plus_integral. -algebra. +Proof. + intros. + rstepl (integral a c Hac F Hac'[+]integral c b Hcb F Hcb'[-]integral a c Hac F Hac'). + apply cg_minus_wd. + apply integral_plus_integral. + algebra. Qed. Lemma integral_plus_integral' : forall a b Hab F c Hac Hcb Hab' Hac' Hcb', integral a c Hac F Hac' [=] integral a b Hab F Hab'[-]integral c b Hcb F Hcb'. -intros. -rstepl - (integral a c Hac F Hac'[+]integral c b Hcb F Hcb'[-]integral c b Hcb F Hcb'). -apply cg_minus_wd. -apply integral_plus_integral. -algebra. +Proof. + intros. + rstepl (integral a c Hac F Hac'[+]integral c b Hcb F Hcb'[-]integral c b Hcb F Hcb'). + apply cg_minus_wd. + apply integral_plus_integral. + algebra. Qed. (** @@ -361,148 +370,165 @@ Hypothesis Habc : Continuous_I Habc' F. (* begin hide *) Let le_abc_ab : Min (Min a b) c [<=] Min a b. -apply Min_leEq_lft. +Proof. + apply Min_leEq_lft. Qed. Let le_abc_ac : Min (Min a b) c [<=] Min a c. -apply leEq_Min. -eapply leEq_transitive. -apply Min_leEq_lft. -apply Min_leEq_lft. -apply Min_leEq_rht. +Proof. + apply leEq_Min. + eapply leEq_transitive. + apply Min_leEq_lft. + apply Min_leEq_lft. + apply Min_leEq_rht. Qed. Let le_abc_cb : Min (Min a b) c [<=] Min c b. -apply leEq_Min. -apply Min_leEq_rht. -eapply leEq_transitive. -apply Min_leEq_lft. -apply Min_leEq_rht. +Proof. + apply leEq_Min. + apply Min_leEq_rht. + eapply leEq_transitive. + apply Min_leEq_lft. + apply Min_leEq_rht. Qed. Let le_abc_a : Min (Min a b) c [<=] a. -eapply leEq_transitive. -apply Min_leEq_lft. -apply Min_leEq_lft. +Proof. + eapply leEq_transitive. + apply Min_leEq_lft. + apply Min_leEq_lft. Qed. Let le_abc_b : Min (Min a b) c [<=] b. -eapply leEq_transitive. -apply Min_leEq_lft. -apply Min_leEq_rht. +Proof. + eapply leEq_transitive. + apply Min_leEq_lft. + apply Min_leEq_rht. Qed. Let le_abc_c : Min (Min a b) c [<=] c. -apply Min_leEq_rht. +Proof. + apply Min_leEq_rht. Qed. Let le_ab_a : Min a b [<=] a. -apply Min_leEq_lft. +Proof. + apply Min_leEq_lft. Qed. Let le_cb_c : Min c b [<=] c. -apply Min_leEq_lft. +Proof. + apply Min_leEq_lft. Qed. Let le_ac_a : Min a c [<=] a. -apply Min_leEq_lft. +Proof. + apply Min_leEq_lft. Qed. Let le_ab_b : Min a b [<=] b. -apply Min_leEq_rht. +Proof. + apply Min_leEq_rht. Qed. Let le_cb_b : Min c b [<=] b. -apply Min_leEq_rht. +Proof. + apply Min_leEq_rht. Qed. Let le_ac_c : Min a c [<=] c. -apply Min_leEq_rht. +Proof. + apply Min_leEq_rht. Qed. Let Habc_abc : Compact Habc' (Min (Min a b) c). -apply compact_inc_lft. +Proof. + apply compact_inc_lft. Qed. Let Habc_ab : Continuous_I le_abc_ab F. -apply included_imp_contin with (Hab := Habc'). -2: apply Habc. -apply included_compact; [ apply Habc_abc | split ]. -apply Min_leEq_lft. -eapply leEq_transitive. -apply Min_leEq_Max. -apply lft_leEq_Max. +Proof. + apply included_imp_contin with (Hab := Habc'). + 2: apply Habc. + apply included_compact; [ apply Habc_abc | split ]. + apply Min_leEq_lft. + eapply leEq_transitive. + apply Min_leEq_Max. + apply lft_leEq_Max. Qed. Let Habc_ac : Continuous_I le_abc_ac F. -apply included_imp_contin with (Hab := Habc'). -2: apply Habc. -apply included_compact; [ apply Habc_abc | split ]. -apply le_abc_ac. -eapply leEq_transitive. -apply Min_leEq_Max. -apply Max_leEq. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply lft_leEq_Max. -apply rht_leEq_Max. +Proof. + apply included_imp_contin with (Hab := Habc'). + 2: apply Habc. + apply included_compact; [ apply Habc_abc | split ]. + apply le_abc_ac. + eapply leEq_transitive. + apply Min_leEq_Max. + apply Max_leEq. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply lft_leEq_Max. + apply rht_leEq_Max. Qed. Let Habc_cb : Continuous_I le_abc_cb F. -apply included_imp_contin with (Hab := Habc'). -2: apply Habc. -apply included_compact; [ apply Habc_abc | split ]. -apply le_abc_cb. -eapply leEq_transitive. -2: apply rht_leEq_Max. -apply Min_leEq_lft. +Proof. + apply included_imp_contin with (Hab := Habc'). + 2: apply Habc. + apply included_compact; [ apply Habc_abc | split ]. + apply le_abc_cb. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + apply Min_leEq_lft. Qed. Let Habc_a : Continuous_I le_abc_a F. -apply included_imp_contin with (Hab := Habc'). -2: apply Habc. -apply included_compact; [ apply Habc_abc | split ]. -apply le_abc_a. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply lft_leEq_Max. +Proof. + apply included_imp_contin with (Hab := Habc'). + 2: apply Habc. + apply included_compact; [ apply Habc_abc | split ]. + apply le_abc_a. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply lft_leEq_Max. Qed. Let Habc_b : Continuous_I le_abc_b F. -apply included_imp_contin with (Hab := Habc'). -2: apply Habc. -apply included_compact; [ apply Habc_abc | split ]. -apply le_abc_b. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply rht_leEq_Max. +Proof. + apply included_imp_contin with (Hab := Habc'). + 2: apply Habc. + apply included_compact; [ apply Habc_abc | split ]. + apply le_abc_b. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply rht_leEq_Max. Qed. Let Habc_c : Continuous_I le_abc_c F. -apply included_imp_contin with (Hab := Habc'). -2: apply Habc. -apply included_compact; [ apply Habc_abc | split ]. -apply le_abc_c. -apply rht_leEq_Max. +Proof. + apply included_imp_contin with (Hab := Habc'). + 2: apply Habc. + apply included_compact; [ apply Habc_abc | split ]. + apply le_abc_c. + apply rht_leEq_Max. Qed. (* end hide *) Lemma Integral_plus_Integral : Integral Hab [=] Integral Hac[+]Integral Hcb. -unfold Integral in |- *. -apply - eq_transitive_unfolded - with - (integral _ _ le_abc_b _ Habc_b[-]integral _ _ le_abc_ab _ Habc_ab[-] +Proof. + unfold Integral in |- *. + apply eq_transitive_unfolded with + (integral _ _ le_abc_b _ Habc_b[-]integral _ _ le_abc_ab _ Habc_ab[-] (integral _ _ le_abc_a _ Habc_a[-]integral _ _ le_abc_ab _ Habc_ab)). -apply cg_minus_wd; apply integral_plus_Integral. -rstepl (integral _ _ le_abc_b _ Habc_b[-]integral _ _ le_abc_a _ Habc_a). -rstepl - (integral _ _ le_abc_c _ Habc_c[-]integral _ _ le_abc_ac _ Habc_ac[-] - (integral _ _ le_abc_a _ Habc_a[-]integral _ _ le_abc_ac _ Habc_ac) [+] - (integral _ _ le_abc_b _ Habc_b[-]integral _ _ le_abc_cb _ Habc_cb[-] - (integral _ _ le_abc_c _ Habc_c[-]integral _ _ le_abc_cb _ Habc_cb))). -apply eq_symmetric_unfolded; apply bin_op_wd_unfolded; apply cg_minus_wd; - apply integral_plus_Integral. + apply cg_minus_wd; apply integral_plus_Integral. + rstepl (integral _ _ le_abc_b _ Habc_b[-]integral _ _ le_abc_a _ Habc_a). + rstepl (integral _ _ le_abc_c _ Habc_c[-]integral _ _ le_abc_ac _ Habc_ac[-] + (integral _ _ le_abc_a _ Habc_a[-]integral _ _ le_abc_ac _ Habc_ac) [+] + (integral _ _ le_abc_b _ Habc_b[-]integral _ _ le_abc_cb _ Habc_cb[-] + (integral _ _ le_abc_c _ Habc_c[-]integral _ _ le_abc_cb _ Habc_cb))). + apply eq_symmetric_unfolded; apply bin_op_wd_unfolded; apply cg_minus_wd; + apply integral_plus_Integral. Qed. (** @@ -524,159 +550,151 @@ Hypothesis contF : Continuous_I Hab F. Lemma Integral_op : forall Hab' (contF' : Continuous_I (a:=Min b a) (b:=Max b a) Hab' F), Integral contF [=] [--] (Integral contF'). -intros. -apply cg_inv_unique'. -cut (Continuous_I (Min_leEq_Max a a) F). intro H. -apply eq_transitive_unfolded with (Integral H). -cut (Min (Min a a) b [<=] Max (Max a a) b); intros. -apply eq_symmetric_unfolded; apply Integral_plus_Integral with H0. -cut (included (Compact H0) (Compact Hab)). intro H1. -exact (included_imp_contin _ _ _ _ _ _ _ H1 contF). -apply included_compact. -split. -apply leEq_Min. -apply leEq_transitive with a. -apply Min_leEq_lft. -apply eq_imp_leEq; apply eq_symmetric_unfolded; apply Min_id. -apply Min_leEq_rht. -apply leEq_transitive with b. -apply Min_leEq_rht. -apply rht_leEq_Max. -split. -apply leEq_transitive with b. -apply Min_leEq_rht. -apply rht_leEq_Max. -apply Max_leEq. -apply leEq_wdl with a. -apply lft_leEq_Max. -apply eq_symmetric_unfolded; apply Max_id. -apply rht_leEq_Max. -apply leEq_transitive with b. -apply Min_leEq_rht. -apply rht_leEq_Max. -apply Integral_empty; algebra. -apply included_imp_contin with (Hab := Hab). -2: apply contF. -intros x H. -apply compact_wd with a. -split. -apply Min_leEq_lft. -apply lft_leEq_Max. -inversion_clear H. -apply leEq_imp_eq. -eapply leEq_wdl. -apply H0. -apply Min_id. -eapply leEq_wdr. -apply H1. -apply Max_id. +Proof. + intros. + apply cg_inv_unique'. + cut (Continuous_I (Min_leEq_Max a a) F). intro H. + apply eq_transitive_unfolded with (Integral H). + cut (Min (Min a a) b [<=] Max (Max a a) b); intros. + apply eq_symmetric_unfolded; apply Integral_plus_Integral with H0. + cut (included (Compact H0) (Compact Hab)). intro H1. + exact (included_imp_contin _ _ _ _ _ _ _ H1 contF). + apply included_compact. + split. + apply leEq_Min. + apply leEq_transitive with a. + apply Min_leEq_lft. + apply eq_imp_leEq; apply eq_symmetric_unfolded; apply Min_id. + apply Min_leEq_rht. + apply leEq_transitive with b. + apply Min_leEq_rht. + apply rht_leEq_Max. + split. + apply leEq_transitive with b. + apply Min_leEq_rht. + apply rht_leEq_Max. + apply Max_leEq. + apply leEq_wdl with a. + apply lft_leEq_Max. + apply eq_symmetric_unfolded; apply Max_id. + apply rht_leEq_Max. + apply leEq_transitive with b. + apply Min_leEq_rht. + apply rht_leEq_Max. + apply Integral_empty; algebra. + apply included_imp_contin with (Hab := Hab). + 2: apply contF. + intros x H. + apply compact_wd with a. + split. + apply Min_leEq_lft. + apply lft_leEq_Max. + inversion_clear H. + apply leEq_imp_eq. + eapply leEq_wdl. + apply H0. + apply Min_id. + eapply leEq_wdr. + apply H1. + apply Max_id. Qed. (** Finally, some miscellaneous results: *) Lemma Integral_less_norm : a [#] b -> forall x, Compact Hab x -> forall Hx, AbsIR (F x Hx) [<] Norm_Funct contF -> AbsIR (Integral contF) [<] Norm_Funct contF[*]AbsIR (b[-]a). -intros H x H0 Hx H1. -set (N := Norm_Funct contF) in *. -elim (ap_imp_less _ _ _ H); intro. -apply less_wdr with (N[*] (b[-]a)). -eapply less_wdl. -eapply less_leEq_trans. -apply - integral_less_norm - with - (contF := included_imp_contin _ _ _ _ _ _ _ - (compact_map2 a b (less_leEq _ _ _ a0) Hab) contF) - (Hx := Hx); auto. -apply compact_map1 with (Hab' := Hab); auto. -eapply less_leEq_trans. -apply H1. -unfold N in |- *; apply included_imp_norm_leEq. -apply compact_map1. -apply mult_resp_leEq_rht. -unfold N in |- *; apply included_imp_norm_leEq. -apply compact_map2. -apply shift_leEq_minus; apply less_leEq. -astepl a; auto. -apply AbsIR_wd; apply eq_symmetric_unfolded. -apply Integral_integral. -apply mult_wdr. -apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply shift_leEq_minus; apply less_leEq. -astepl a; auto. - -apply less_wdr with (N[*] (a[-]b)). -set (Hmin := Min_leEq_Max b a) in *. -cut (included (Compact Hmin) (Compact Hab)). -cut (included (Compact Hab) (Compact Hmin)). intros H2 H3. -cut (Continuous_I Hmin F). intro H4. -eapply less_wdl. -eapply less_leEq_trans. -apply - integral_less_norm - with - (contF := included_imp_contin _ _ _ _ _ _ _ - (compact_map2 _ _ (less_leEq _ _ _ b0) Hmin) H4) - (Hx := Hx); auto. -apply compact_map1 with (Hab' := Hmin); auto. -eapply less_leEq_trans. -apply H1. -unfold N in |- *; apply included_imp_norm_leEq. -eapply included_trans. -2: apply compact_map1 with (Hab' := Hmin). -apply H2. -apply mult_resp_leEq_rht. -unfold N in |- *; apply included_imp_norm_leEq. -eapply included_trans. -apply compact_map2 with (Hab' := Hmin). -apply H3. -apply shift_leEq_minus; apply less_leEq. -astepl b; auto. -eapply eq_transitive_unfolded. -apply AbsIR_inv. -apply AbsIR_wd; apply eq_symmetric_unfolded. -apply - eq_transitive_unfolded - with ( [--] (Integral (included_imp_contin _ _ _ _ _ _ _ H3 contF))). -apply Integral_op. -apply un_op_wd_unfolded. -apply Integral_integral. -apply included_imp_contin with (Hab := Hab); auto. -red in |- *; intros. -apply compact_wd' with (Hab := Hab). -apply Min_comm. -apply Max_comm. -auto. -red in |- *; intros. -apply compact_wd' with (Hab := Hmin). -apply Min_comm. -apply Max_comm. -auto. -apply mult_wdr. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply shift_leEq_minus; apply less_leEq. -astepl b; auto. -apply AbsIR_minus. +Proof. + intros H x H0 Hx H1. + set (N := Norm_Funct contF) in *. + elim (ap_imp_less _ _ _ H); intro. + apply less_wdr with (N[*] (b[-]a)). + eapply less_wdl. + eapply less_leEq_trans. + apply integral_less_norm with (contF := included_imp_contin _ _ _ _ _ _ _ + (compact_map2 a b (less_leEq _ _ _ a0) Hab) contF) (Hx := Hx); auto. + apply compact_map1 with (Hab' := Hab); auto. + eapply less_leEq_trans. + apply H1. + unfold N in |- *; apply included_imp_norm_leEq. + apply compact_map1. + apply mult_resp_leEq_rht. + unfold N in |- *; apply included_imp_norm_leEq. + apply compact_map2. + apply shift_leEq_minus; apply less_leEq. + astepl a; auto. + apply AbsIR_wd; apply eq_symmetric_unfolded. + apply Integral_integral. + apply mult_wdr. + apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply shift_leEq_minus; apply less_leEq. + astepl a; auto. + apply less_wdr with (N[*] (a[-]b)). + set (Hmin := Min_leEq_Max b a) in *. + cut (included (Compact Hmin) (Compact Hab)). + cut (included (Compact Hab) (Compact Hmin)). intros H2 H3. + cut (Continuous_I Hmin F). intro H4. + eapply less_wdl. + eapply less_leEq_trans. + apply integral_less_norm with (contF := included_imp_contin _ _ _ _ _ _ _ + (compact_map2 _ _ (less_leEq _ _ _ b0) Hmin) H4) (Hx := Hx); auto. + apply compact_map1 with (Hab' := Hmin); auto. + eapply less_leEq_trans. + apply H1. + unfold N in |- *; apply included_imp_norm_leEq. + eapply included_trans. + 2: apply compact_map1 with (Hab' := Hmin). + apply H2. + apply mult_resp_leEq_rht. + unfold N in |- *; apply included_imp_norm_leEq. + eapply included_trans. + apply compact_map2 with (Hab' := Hmin). + apply H3. + apply shift_leEq_minus; apply less_leEq. + astepl b; auto. + eapply eq_transitive_unfolded. + apply AbsIR_inv. + apply AbsIR_wd; apply eq_symmetric_unfolded. + apply eq_transitive_unfolded with ( [--] (Integral (included_imp_contin _ _ _ _ _ _ _ H3 contF))). + apply Integral_op. + apply un_op_wd_unfolded. + apply Integral_integral. + apply included_imp_contin with (Hab := Hab); auto. + red in |- *; intros. + apply compact_wd' with (Hab := Hab). + apply Min_comm. + apply Max_comm. + auto. + red in |- *; intros. + apply compact_wd' with (Hab := Hmin). + apply Min_comm. + apply Max_comm. + auto. + apply mult_wdr. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply shift_leEq_minus; apply less_leEq. + astepl b; auto. + apply AbsIR_minus. Qed. Lemma ub_Integral : a [#] b -> forall c, (forall x, Compact Hab x -> forall Hx, AbsIR (F x Hx) [<=] c) -> forall x, Compact Hab x -> forall Hx, AbsIR (F x Hx) [<] c -> AbsIR (Integral contF) [<] c[*]AbsIR (b[-]a). -intros H c H0 x H1 Hx H2. -set (N := Norm_Funct contF) in *. -cut (N [<=] c); intros. -elim (less_cotransitive_unfolded _ _ _ H2 N); intros. -apply less_leEq_trans with (N[*]AbsIR (b[-]a)). -unfold N in |- *; apply Integral_less_norm with x Hx; auto. -apply mult_resp_leEq_rht; auto. -apply AbsIR_nonneg. -apply leEq_less_trans with (N[*]AbsIR (b[-]a)). -unfold N in |- *; apply Integral_leEq_norm. -apply mult_resp_less; auto. -apply AbsIR_pos. -apply minus_ap_zero. -apply ap_symmetric_unfolded; auto. -unfold N in |- *; apply leEq_Norm_Funct; auto. +Proof. + intros H c H0 x H1 Hx H2. + set (N := Norm_Funct contF) in *. + cut (N [<=] c); intros. + elim (less_cotransitive_unfolded _ _ _ H2 N); intros. + apply less_leEq_trans with (N[*]AbsIR (b[-]a)). + unfold N in |- *; apply Integral_less_norm with x Hx; auto. + apply mult_resp_leEq_rht; auto. + apply AbsIR_nonneg. + apply leEq_less_trans with (N[*]AbsIR (b[-]a)). + unfold N in |- *; apply Integral_leEq_norm. + apply mult_resp_less; auto. + apply AbsIR_pos. + apply minus_ap_zero. + apply ap_symmetric_unfolded; auto. + unfold N in |- *; apply leEq_Norm_Funct; auto. Qed. End Corollaries. @@ -684,61 +702,55 @@ End Corollaries. Lemma Integral_ap_zero : forall a b Hab (F : PartIR) contF, a [#] b -> forall x, Compact Hab x -> forall Hx, Zero [<] F x Hx -> (forall x, Compact Hab x -> forall Hx, Zero [<=] F x Hx) -> Zero [<] AbsIR (Integral (a:=a) (b:=b) (Hab:=Hab) (F:=F) contF). -intros a b Hab F contF H x H0 Hx H1 H2. -elim (ap_imp_less _ _ _ H); intro. -eapply less_leEq_trans. -2: apply leEq_AbsIR. -eapply less_wdr. -2: apply eq_symmetric_unfolded. -2: apply - Integral_integral - with - (HF' := included_imp_contin _ _ _ _ _ _ _ - (compact_map2 a b (less_leEq _ _ _ a0) Hab) contF). -eapply integral_gt_zero with x Hx; auto. -exact (compact_map1 _ _ (less_leEq _ _ _ a0) Hab x H0). -intros x0 H3 Hx0; apply H2. -exact (compact_map2 _ _ (less_leEq _ _ _ a0) Hab _ H3). - -cut (included (Compact (Min_leEq_Max b a)) (Compact Hab)). -2: apply included_compact; split. -2: apply eq_imp_leEq; apply Min_comm. -2: apply leEq_transitive with a; [ apply Min_leEq_rht | apply lft_leEq_Max ]. -2: apply leEq_transitive with b; [ apply Min_leEq_rht | apply lft_leEq_Max ]. -2: apply eq_imp_leEq; apply Max_comm. -cut (included (Compact Hab) (Compact (Min_leEq_Max b a))). -2: apply included_compact; split. -2: apply eq_imp_leEq; apply Min_comm. -2: apply leEq_transitive with b; [ apply Min_leEq_rht | apply lft_leEq_Max ]. -2: apply leEq_transitive with a; [ apply Min_leEq_rht | apply lft_leEq_Max ]. -2: apply eq_imp_leEq; apply Max_comm. -intros H3 H4. -eapply less_leEq_trans. -2: apply inv_leEq_AbsIR. -eapply less_wdr. -2: apply - Integral_op with (contF := included_imp_contin _ _ _ _ _ _ _ H4 contF). -eapply less_wdr. -2: apply eq_symmetric_unfolded. -2: apply - Integral_integral - with - (HF' := included_imp_contin _ _ _ _ _ _ _ - (compact_map2 _ _ (less_leEq _ _ _ b0) (Min_leEq_Max b a)) - (included_imp_contin _ _ _ _ _ _ _ H4 contF)). -eapply integral_gt_zero with x Hx; auto. -exact (compact_map1 _ _ (less_leEq _ _ _ b0) (Min_leEq_Max b a) x (H3 x H0)). -intros x0 H5 Hx0; apply H2. -exact (H4 _ (compact_map2 _ _ (less_leEq _ _ _ b0) (Min_leEq_Max _ _) _ H5)). +Proof. + intros a b Hab F contF H x H0 Hx H1 H2. + elim (ap_imp_less _ _ _ H); intro. + eapply less_leEq_trans. + 2: apply leEq_AbsIR. + eapply less_wdr. + 2: apply eq_symmetric_unfolded. + 2: apply Integral_integral with (HF' := included_imp_contin _ _ _ _ _ _ _ + (compact_map2 a b (less_leEq _ _ _ a0) Hab) contF). + eapply integral_gt_zero with x Hx; auto. + exact (compact_map1 _ _ (less_leEq _ _ _ a0) Hab x H0). + intros x0 H3 Hx0; apply H2. + exact (compact_map2 _ _ (less_leEq _ _ _ a0) Hab _ H3). + cut (included (Compact (Min_leEq_Max b a)) (Compact Hab)). + 2: apply included_compact; split. + 2: apply eq_imp_leEq; apply Min_comm. + 2: apply leEq_transitive with a; [ apply Min_leEq_rht | apply lft_leEq_Max ]. + 2: apply leEq_transitive with b; [ apply Min_leEq_rht | apply lft_leEq_Max ]. + 2: apply eq_imp_leEq; apply Max_comm. + cut (included (Compact Hab) (Compact (Min_leEq_Max b a))). + 2: apply included_compact; split. + 2: apply eq_imp_leEq; apply Min_comm. + 2: apply leEq_transitive with b; [ apply Min_leEq_rht | apply lft_leEq_Max ]. + 2: apply leEq_transitive with a; [ apply Min_leEq_rht | apply lft_leEq_Max ]. + 2: apply eq_imp_leEq; apply Max_comm. + intros H3 H4. + eapply less_leEq_trans. + 2: apply inv_leEq_AbsIR. + eapply less_wdr. + 2: apply Integral_op with (contF := included_imp_contin _ _ _ _ _ _ _ H4 contF). + eapply less_wdr. + 2: apply eq_symmetric_unfolded. + 2: apply Integral_integral with (HF' := included_imp_contin _ _ _ _ _ _ _ + (compact_map2 _ _ (less_leEq _ _ _ b0) (Min_leEq_Max b a)) + (included_imp_contin _ _ _ _ _ _ _ H4 contF)). + eapply integral_gt_zero with x Hx; auto. + exact (compact_map1 _ _ (less_leEq _ _ _ b0) (Min_leEq_Max b a) x (H3 x H0)). + intros x0 H5 Hx0; apply H2. + exact (H4 _ (compact_map2 _ _ (less_leEq _ _ _ b0) (Min_leEq_Max _ _) _ H5)). Qed. Lemma Integral_eq_zero : forall a b Hab (F : PartIR) contF x, Compact Hab x -> (forall Hx, Zero [<] F x Hx) -> (forall x, Compact Hab x -> forall Hx, Zero [<=] F x Hx) -> Integral (a:=a) (b:=b) (Hab:=Hab) (F:=F) contF [=] Zero -> a [=] b. -intros a b Hab F contF x H X H0 H1. -apply not_ap_imp_eq; intro. -apply less_irreflexive_unfolded with (x := ZeroR). -apply less_wdr with (AbsIR (Integral contF)). -2: Step_final (AbsIR Zero). -apply Integral_ap_zero with x (contin_imp_inc _ _ _ _ contF x H); auto. +Proof. + intros a b Hab F contF x H X H0 H1. + apply not_ap_imp_eq; intro. + apply less_irreflexive_unfolded with (x := ZeroR). + apply less_wdr with (AbsIR (Integral contF)). + 2: Step_final (AbsIR Zero). + apply Integral_ap_zero with x (contin_imp_inc _ _ _ _ contF x H); auto. Qed. diff --git a/ftc/MoreIntervals.v b/ftc/MoreIntervals.v index 1896b1e62..8a3b858bc 100644 --- a/ftc/MoreIntervals.v +++ b/ftc/MoreIntervals.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export NthDerivative. @@ -199,31 +199,33 @@ Definition compact_ (I : interval) : CProp := (** Finite intervals have a left end and a right end. *) Definition left_end (I : interval) : finite I -> IR. -intro. -destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; rename X into H. -inversion H. -inversion H. -inversion H. -inversion H. -inversion H. -apply c. -apply c. -apply c. -apply c. +Proof. + intro. + destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; rename X into H. + inversion H. + inversion H. + inversion H. + inversion H. + inversion H. + apply c. + apply c. + apply c. + apply c. Defined. Definition right_end (I : interval) : finite I -> IR. -intro. -destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; rename X into H. -inversion H. -inversion H. -inversion H. -inversion H. -inversion H. -apply c0. -apply c0. -apply c0. -apply c0. +Proof. + intro. + destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; rename X into H. + inversion H. + inversion H. + inversion H. + inversion H. + inversion H. + apply c0. + apply c0. + apply c0. + apply c0. Defined. (** @@ -231,44 +233,46 @@ Some trivia: compact intervals are finite; proper intervals are nonvoid; an inte *) Lemma compact_finite : forall I : interval, compact_ I -> finite I. -intros; induction I as [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; - auto. + intros; induction I as [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; auto. Qed. Lemma proper_nonvoid : forall I : interval, proper I -> nonvoid I. -intro. -elim I; simpl in |- *; intros; auto. -apply less_leEq; auto. +Proof. + intro. + elim I; simpl in |- *; intros; auto. + apply less_leEq; auto. Qed. Lemma nonvoid_point : forall I : interval, nonvoid I -> {x : IR | I x}. -intro. -destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try rename X into H. -exists ZeroR; auto. -exists (c[+]One); apply less_plusOne. -exists (c[-]One); apply shift_minus_less; apply less_plusOne. -exists c; apply leEq_reflexive. -exists c; apply leEq_reflexive. -exists (c[+] (c0[-]c) [/]TwoNZ); split. -astepl (c[+]Zero); apply plus_resp_less_lft. -apply div_resp_pos. -apply pos_two. -apply shift_less_minus; astepl c; auto. -rstepr (c[+] (c0[-]c)). -apply plus_resp_less_lft. -apply pos_div_two'. -apply shift_less_minus; astepl c; auto. -exists c0; split; auto; apply leEq_reflexive. -exists c; split; auto; apply leEq_reflexive. -exists c; split; [ apply leEq_reflexive | auto ]. +Proof. + intro. + destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try rename X into H. + exists ZeroR; auto. + exists (c[+]One); apply less_plusOne. + exists (c[-]One); apply shift_minus_less; apply less_plusOne. + exists c; apply leEq_reflexive. + exists c; apply leEq_reflexive. + exists (c[+] (c0[-]c) [/]TwoNZ); split. + astepl (c[+]Zero); apply plus_resp_less_lft. + apply div_resp_pos. + apply pos_two. + apply shift_less_minus; astepl c; auto. + rstepr (c[+] (c0[-]c)). + apply plus_resp_less_lft. + apply pos_div_two'. + apply shift_less_minus; astepl c; auto. + exists c0; split; auto; apply leEq_reflexive. + exists c; split; auto; apply leEq_reflexive. + exists c; split; [ apply leEq_reflexive | auto ]. Qed. Lemma nonvoid_char : forall (I : interval) (x : IR), I x -> nonvoid I. -intro; induction I; simpl in |- *; intros x H; auto; inversion_clear H. -apply less_transitive_unfolded with x; auto. -apply less_leEq_trans with x; auto. -apply leEq_less_trans with x; auto. -apply leEq_transitive with x; auto. +Proof. + intro; induction I; simpl in |- *; intros x H; auto; inversion_clear H. + apply less_transitive_unfolded with x; auto. + apply less_leEq_trans with x; auto. + apply leEq_less_trans with x; auto. + apply leEq_transitive with x; auto. Qed. (** @@ -284,7 +288,8 @@ to the right end. *) Lemma Lend_leEq_Rend : forall I cI, Lend I cI [<=] Rend I cI. -intro; elim I; simpl in |- *; intros; try inversion cI; auto. +Proof. + intro; elim I; simpl in |- *; intros; try inversion cI; auto. Qed. (** @@ -293,43 +298,44 @@ Some nice characterizations of inclusion: Lemma compact_included : forall a b Hab (I : interval), I a -> I b -> included (compact a b Hab) I. -induction I; red in |- *; simpl in |- *; intros X X0 x X1; - try inversion_clear X; try inversion_clear X0; try inversion_clear X1. -auto. -apply less_leEq_trans with a; auto. -apply leEq_less_trans with b; auto. -apply leEq_transitive with a; auto. -apply leEq_transitive with b; auto. -split; [ apply less_leEq_trans with a | apply leEq_less_trans with b ]; auto. -split; [ apply less_leEq_trans with a | apply leEq_transitive with b ]; auto. -split; [ apply leEq_transitive with a | apply leEq_less_trans with b ]; auto. -split; [ apply leEq_transitive with a | apply leEq_transitive with b ]; auto. +Proof. + induction I; red in |- *; simpl in |- *; intros X X0 x X1; + try inversion_clear X; try inversion_clear X0; try inversion_clear X1. + auto. + apply less_leEq_trans with a; auto. + apply leEq_less_trans with b; auto. + apply leEq_transitive with a; auto. + apply leEq_transitive with b; auto. + split; [ apply less_leEq_trans with a | apply leEq_less_trans with b ]; auto. + split; [ apply less_leEq_trans with a | apply leEq_transitive with b ]; auto. + split; [ apply leEq_transitive with a | apply leEq_less_trans with b ]; auto. + split; [ apply leEq_transitive with a | apply leEq_transitive with b ]; auto. Qed. Lemma included_interval' : forall (I : interval) x y z w, I x -> I y -> I z -> I w -> forall H, included (compact (Min x z) (Max y w) H) I. -intros I x y z w; induction I; simpl in |- *; intros X X0 X1 X2 H; - red in |- *; intros t Ht; - inversion_clear Ht; simpl in |- *; try inversion_clear X; - try inversion_clear X0; try inversion_clear X1; try inversion_clear X2; - try split. -apply less_leEq_trans with (Min x z); try apply less_Min; auto. -apply leEq_less_trans with (Max y w); try apply Max_less; auto. -apply leEq_transitive with (Min x z); try apply leEq_Min; auto. -apply leEq_transitive with (Max y w); try apply Max_leEq; auto. -apply less_leEq_trans with (Min x z); try apply less_Min; auto. -apply leEq_less_trans with (Max y w); try apply Max_less; auto. -apply less_leEq_trans with (Min x z); try apply less_Min; auto. -apply leEq_transitive with (Max y w); try apply Max_leEq; auto. -apply leEq_transitive with (Min x z); try apply leEq_Min; auto. -apply leEq_less_trans with (Max y w); try apply Max_less; auto. -apply leEq_transitive with (Min x z); try apply leEq_Min; auto. -apply leEq_transitive with (Max y w); try apply Max_leEq; auto. +Proof. + intros I x y z w; induction I; simpl in |- *; intros X X0 X1 X2 H; red in |- *; intros t Ht; + inversion_clear Ht; simpl in |- *; try inversion_clear X; + try inversion_clear X0; try inversion_clear X1; try inversion_clear X2; try split. + apply less_leEq_trans with (Min x z); try apply less_Min; auto. + apply leEq_less_trans with (Max y w); try apply Max_less; auto. + apply leEq_transitive with (Min x z); try apply leEq_Min; auto. + apply leEq_transitive with (Max y w); try apply Max_leEq; auto. + apply less_leEq_trans with (Min x z); try apply less_Min; auto. + apply leEq_less_trans with (Max y w); try apply Max_less; auto. + apply less_leEq_trans with (Min x z); try apply less_Min; auto. + apply leEq_transitive with (Max y w); try apply Max_leEq; auto. + apply leEq_transitive with (Min x z); try apply leEq_Min; auto. + apply leEq_less_trans with (Max y w); try apply Max_less; auto. + apply leEq_transitive with (Min x z); try apply leEq_Min; auto. + apply leEq_transitive with (Max y w); try apply Max_leEq; auto. Qed. Lemma included_interval : forall (I : interval) x y, I x -> I y -> forall H, included (compact (Min x y) (Max x y) H) I. -intros; apply included_interval'; auto. +Proof. + intros; apply included_interval'; auto. Qed. (** @@ -338,12 +344,13 @@ A weirder inclusion result. Lemma included3_interval : forall (I : interval) x y z Hxyz, I x -> I y -> I z -> included (compact (Min (Min x y) z) (Max (Max x y) z) Hxyz) I. -intros I x y z Hxyz H H0 H1. -apply included_interval'; auto. -apply (included_interval I x y H H0 (Min_leEq_Max _ _)). -apply compact_inc_lft. -apply (included_interval I x y H H0 (Min_leEq_Max _ _)). -apply compact_inc_rht. +Proof. + intros I x y z Hxyz H H0 H1. + apply included_interval'; auto. + apply (included_interval I x y H H0 (Min_leEq_Max _ _)). + apply compact_inc_lft. + apply (included_interval I x y H H0 (Min_leEq_Max _ _)). + apply compact_inc_rht. Qed. (** @@ -351,25 +358,26 @@ Finally, all intervals are characterized by well defined predicates. *) Lemma iprop_wd : forall I : interval, pred_wd _ I. -induction I; unfold iprop in |- *; red in |- *; intros x y X X0; - try inversion_clear X; try inversion X0. -auto. -astepr x; auto. -astepl x; auto. -astepr x; auto. -astepl x; auto. -split. -astepr x; auto. -astepl x; auto. -split. -astepr x; auto. -astepl x; auto. -split. -astepr x; auto. -astepl x; auto. -split. -astepr x; auto. -astepl x; auto. +Proof. + induction I; unfold iprop in |- *; red in |- *; intros x y X X0; + try inversion_clear X; try inversion X0. + auto. + astepr x; auto. + astepl x; auto. + astepr x; auto. + astepl x; auto. + split. + astepr x; auto. + astepl x; auto. + split. + astepr x; auto. + astepl x; auto. + split. + astepr x; auto. + astepl x; auto. + split. + astepr x; auto. + astepl x; auto. Qed. End Intervals. @@ -406,19 +414,22 @@ This interval contains [x] and only (elements equal to) [x]; furthermore, for ev *) Lemma compact_single_prop : compact_single x. -split; apply leEq_reflexive. +Proof. + split; apply leEq_reflexive. Qed. Lemma compact_single_pt : forall y : IR, compact_single y -> x [=] y. -intros y H. -inversion_clear H; apply leEq_imp_eq; auto. +Proof. + intros y H. + inversion_clear H; apply leEq_imp_eq; auto. Qed. Lemma compact_single_inc : included compact_single P. -red in |- *; intros. -apply wdP with x. -auto. -apply compact_single_pt; auto. +Proof. + red in |- *; intros. + apply wdP with x. + auto. + apply compact_single_pt; auto. Qed. End Single_Compact_Interval. @@ -441,244 +452,263 @@ Section Proper_Compact_with_One_or_Two_Points. (* begin hide *) Let cip1' : forall c x : IR, c [<=] x -> x[-] (x[-]c) [/]TwoNZ [<=] x. -intros. -astepr (x[-]Zero). -unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq; apply shift_leEq_div. -apply pos_two. -apply shift_leEq_minus; rstepl c; auto. +Proof. + intros. + astepr (x[-]Zero). + unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq; apply shift_leEq_div. + apply pos_two. + apply shift_leEq_minus; rstepl c; auto. Qed. Let cip1'' : forall c x : IR, c [<] x -> x[-] (x[-]c) [/]TwoNZ [<] x. -intros. -astepr (x[-]Zero). -unfold cg_minus at 1 3 in |- *; apply plus_resp_less_lft. -apply inv_resp_less; apply shift_less_div. -apply pos_two. -apply shift_less_minus; rstepl c; auto. +Proof. + intros. + astepr (x[-]Zero). + unfold cg_minus at 1 3 in |- *; apply plus_resp_less_lft. + apply inv_resp_less; apply shift_less_div. + apply pos_two. + apply shift_less_minus; rstepl c; auto. Qed. Let cip1''' : forall c0 x : IR, x [<=] c0 -> x [<=] x[+] (c0[-]x) [/]TwoNZ. -intros. -astepl (x[+]Zero). -apply plus_resp_leEq_lft. -apply shift_leEq_div. -apply pos_two. -apply shift_leEq_minus; rstepl x; auto. +Proof. + intros. + astepl (x[+]Zero). + apply plus_resp_leEq_lft. + apply shift_leEq_div. + apply pos_two. + apply shift_leEq_minus; rstepl x; auto. Qed. Let cip1'''' : forall c0 x : IR, x [<] c0 -> x [<] x[+] (c0[-]x) [/]TwoNZ. -intros. -astepl (x[+]Zero). -apply plus_resp_less_lft. -apply shift_less_div. -apply pos_two. -apply shift_less_minus; rstepl x; auto. +Proof. + intros. + astepl (x[+]Zero). + apply plus_resp_less_lft. + apply shift_less_div. + apply pos_two. + apply shift_less_minus; rstepl x; auto. Qed. Let cip2 : forall c x x0 : IR, c [<=] x -> x[-] (x[-]c) [/]TwoNZ [<=] x0 -> c [<=] x0. -intros. -apply leEq_transitive with (c[+] (x[-]c) [/]TwoNZ). -astepl (c[+]Zero); apply plus_resp_leEq_lft. -apply shift_leEq_div. -apply pos_two. -apply shift_leEq_minus; rstepl c; auto. -eapply leEq_wdl. -apply H0. -rational. +Proof. + intros. + apply leEq_transitive with (c[+] (x[-]c) [/]TwoNZ). + astepl (c[+]Zero); apply plus_resp_leEq_lft. + apply shift_leEq_div. + apply pos_two. + apply shift_leEq_minus; rstepl c; auto. + eapply leEq_wdl. + apply H0. + rational. Qed. Let cip2' : forall c x x0 : IR, c [<] x -> x[-] (x[-]c) [/]TwoNZ [<=] x0 -> c [<] x0. -intros c x x0 H H0. -apply less_leEq_trans with (c[+] (x[-]c) [/]TwoNZ). -astepl (c[+]Zero); apply plus_resp_less_lft. -apply shift_less_div. -apply pos_two. -apply shift_less_minus; rstepl c; auto. -eapply leEq_wdl. -apply H0. -rational. +Proof. + intros c x x0 H H0. + apply less_leEq_trans with (c[+] (x[-]c) [/]TwoNZ). + astepl (c[+]Zero); apply plus_resp_less_lft. + apply shift_less_div. + apply pos_two. + apply shift_less_minus; rstepl c; auto. + eapply leEq_wdl. + apply H0. + rational. Qed. Let cip2'' : forall c x x0 : IR, c [<=] x -> x[-] (x[-]c) [/]TwoNZ [<] x0 -> c [<] x0. -intros c x x0 H H0. -apply leEq_less_trans with (c[+] (x[-]c) [/]TwoNZ). -astepl (c[+]Zero); apply plus_resp_leEq_lft. -apply shift_leEq_div. -apply pos_two. -apply shift_leEq_minus; rstepl c; auto. -eapply less_wdl. -apply H0. -rational. +Proof. + intros c x x0 H H0. + apply leEq_less_trans with (c[+] (x[-]c) [/]TwoNZ). + astepl (c[+]Zero); apply plus_resp_leEq_lft. + apply shift_leEq_div. + apply pos_two. + apply shift_leEq_minus; rstepl c; auto. + eapply less_wdl. + apply H0. + rational. Qed. Let cip2''' : forall c x x0 : IR, c [<] x -> x[-] (x[-]c) [/]TwoNZ [<] x0 -> c [<] x0. -intros c x x0 H H0. -apply cip2'' with x. -apply less_leEq; auto. -auto. +Proof. + intros c x x0 H H0. + apply cip2'' with x. + apply less_leEq; auto. + auto. Qed. Let cip3 : forall c0 x x0 : IR, x [<=] c0 -> x0 [<=] x[+] (c0[-]x) [/]TwoNZ -> x0 [<=] c0. -intros c0 x x0 H H0. -eapply leEq_transitive. -apply H0. -rstepl (c0[-] (c0[-]x) [/]TwoNZ). -astepr (c0[-]Zero); unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq. -apply shift_leEq_div. -apply pos_two. -apply shift_leEq_minus; rstepl x; auto. +Proof. + intros c0 x x0 H H0. + eapply leEq_transitive. + apply H0. + rstepl (c0[-] (c0[-]x) [/]TwoNZ). + astepr (c0[-]Zero); unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq. + apply shift_leEq_div. + apply pos_two. + apply shift_leEq_minus; rstepl x; auto. Qed. Let cip3' : forall c0 x x0 : IR, x [<] c0 -> x0 [<=] x[+] (c0[-]x) [/]TwoNZ -> x0 [<] c0. -intros c0 x x0 H H0. -eapply leEq_less_trans. -apply H0. -rstepl (c0[-] (c0[-]x) [/]TwoNZ). -astepr (c0[-]Zero); unfold cg_minus at 1 3 in |- *; apply plus_resp_less_lft. -apply inv_resp_less. -apply shift_less_div. -apply pos_two. -apply shift_less_minus; rstepl x; auto. +Proof. + intros c0 x x0 H H0. + eapply leEq_less_trans. + apply H0. + rstepl (c0[-] (c0[-]x) [/]TwoNZ). + astepr (c0[-]Zero); unfold cg_minus at 1 3 in |- *; apply plus_resp_less_lft. + apply inv_resp_less. + apply shift_less_div. + apply pos_two. + apply shift_less_minus; rstepl x; auto. Qed. Let cip3'' : forall c0 x x0 : IR, x [<=] c0 -> x0 [<] x[+] (c0[-]x) [/]TwoNZ -> x0 [<] c0. -intros c0 x x0 H H0. -eapply less_leEq_trans. -apply H0. -rstepl (c0[-] (c0[-]x) [/]TwoNZ). -astepr (c0[-]Zero); unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq. -apply shift_leEq_div. -apply pos_two. -apply shift_leEq_minus; rstepl x; auto. +Proof. + intros c0 x x0 H H0. + eapply less_leEq_trans. + apply H0. + rstepl (c0[-] (c0[-]x) [/]TwoNZ). + astepr (c0[-]Zero); unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq. + apply shift_leEq_div. + apply pos_two. + apply shift_leEq_minus; rstepl x; auto. Qed. Let cip3''' : forall c0 x x0 : IR, x [<] c0 -> x0 [<] x[+] (c0[-]x) [/]TwoNZ -> x0 [<] c0. -intros c0 x x0 H H0. -apply cip3'' with x; try apply less_leEq; auto. +Proof. + intros c0 x x0 H H0. + apply cip3'' with x; try apply less_leEq; auto. Qed. (* end hide *) Definition compact_in_interval I (pI : proper I) x (Hx : I x) : interval. -intros; destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros. -apply (clcr x (x[+]One)). -apply (clcr x (x[+]One)). -apply (clcr (x[-]One) x). -apply (clcr x (x[+]One)). -apply (clcr (x[-]One) x). -apply (clcr (x[-] (x[-]c) [/]TwoNZ) (x[+] (c0[-]x) [/]TwoNZ)). -apply (clcr (x[-] (x[-]c) [/]TwoNZ) (x[+] (c0[-]x) [/]TwoNZ)). -apply (clcr (x[-] (x[-]c) [/]TwoNZ) (x[+] (c0[-]x) [/]TwoNZ)). -apply (clcr c c0). +Proof. + intros; destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros. + apply (clcr x (x[+]One)). + apply (clcr x (x[+]One)). + apply (clcr (x[-]One) x). + apply (clcr x (x[+]One)). + apply (clcr (x[-]One) x). + apply (clcr (x[-] (x[-]c) [/]TwoNZ) (x[+] (c0[-]x) [/]TwoNZ)). + apply (clcr (x[-] (x[-]c) [/]TwoNZ) (x[+] (c0[-]x) [/]TwoNZ)). + apply (clcr (x[-] (x[-]c) [/]TwoNZ) (x[+] (c0[-]x) [/]TwoNZ)). + apply (clcr c c0). Defined. Lemma compact_compact_in_interval : forall I pI x Hx, compact_ (compact_in_interval I pI x Hx). -intro. -elim I; simpl in |- *; intros; try inversion_clear Hx; try apply ts; - apply less_leEq. -apply less_plusOne. -apply less_plusOne. -apply shift_minus_less; apply less_plusOne. -apply less_plusOne. -apply shift_minus_less; apply less_plusOne. -eapply less_transitive_unfolded; [ apply cip1'' | apply cip1'''' ]; auto. -eapply less_leEq_trans; [ apply cip1'' | apply cip1''' ]; auto. -eapply leEq_less_trans; [ apply cip1' | apply cip1'''' ]; auto. -auto. +Proof. + intro. + elim I; simpl in |- *; intros; try inversion_clear Hx; try apply ts; apply less_leEq. + apply less_plusOne. + apply less_plusOne. + apply shift_minus_less; apply less_plusOne. + apply less_plusOne. + apply shift_minus_less; apply less_plusOne. + eapply less_transitive_unfolded; [ apply cip1'' | apply cip1'''' ]; auto. + eapply less_leEq_trans; [ apply cip1'' | apply cip1''' ]; auto. + eapply leEq_less_trans; [ apply cip1' | apply cip1'''' ]; auto. + auto. Qed. Lemma proper_compact_in_interval : forall I pI x Hx, proper (compact_in_interval I pI x Hx). -intro. -elim I; simpl in |- *; intros; try inversion_clear Hx. -apply less_plusOne. -apply less_plusOne. -apply shift_minus_less; apply less_plusOne. -apply less_plusOne. -apply shift_minus_less; apply less_plusOne. -eapply less_transitive_unfolded; [ apply cip1'' | apply cip1'''' ]; auto. -eapply less_leEq_trans; [ apply cip1'' | apply cip1''' ]; auto. -eapply leEq_less_trans; [ apply cip1' | apply cip1'''' ]; auto. -auto. +Proof. + intro. + elim I; simpl in |- *; intros; try inversion_clear Hx. + apply less_plusOne. + apply less_plusOne. + apply shift_minus_less; apply less_plusOne. + apply less_plusOne. + apply shift_minus_less; apply less_plusOne. + eapply less_transitive_unfolded; [ apply cip1'' | apply cip1'''' ]; auto. + eapply less_leEq_trans; [ apply cip1'' | apply cip1''' ]; auto. + eapply leEq_less_trans; [ apply cip1' | apply cip1'''' ]; auto. + auto. Qed. Lemma proper_compact_in_interval' : forall I pI x Hx (H : compact_ (compact_in_interval I pI x Hx)), Lend H [<] Rend H. -do 4 intro. -cut (proper (compact_in_interval I pI x Hx)). -2: apply proper_compact_in_interval. -elim (compact_in_interval I pI x Hx); intros; try inversion H. -simpl in |- *; simpl in H; auto. +Proof. + do 4 intro. + cut (proper (compact_in_interval I pI x Hx)). + 2: apply proper_compact_in_interval. + elim (compact_in_interval I pI x Hx); intros; try inversion H. + simpl in |- *; simpl in H; auto. Qed. Lemma included_compact_in_interval : forall I pI x Hx, included (compact_in_interval I pI x Hx) I. -induction I; simpl in |- *; intros X x X0; try inversion_clear Hx; red in |- *; - simpl in |- *; intros x0 X1; try inversion_clear X; try inversion_clear X0; - try inversion_clear X1; auto. -apply less_leEq_trans with x; auto. -apply leEq_less_trans with x; auto. -apply leEq_transitive with x; auto. -apply leEq_transitive with x; auto. -split. -apply cip2' with x; auto. -apply cip3' with x; auto. -split. -apply cip2' with x; auto. -apply cip3 with x; auto. -split. -apply cip2 with x; auto. -apply cip3' with x; auto. +Proof. + induction I; simpl in |- *; intros X x X0; try inversion_clear Hx; red in |- *; + simpl in |- *; intros x0 X1; try inversion_clear X; try inversion_clear X0; + try inversion_clear X1; auto. + apply less_leEq_trans with x; auto. + apply leEq_less_trans with x; auto. + apply leEq_transitive with x; auto. + apply leEq_transitive with x; auto. + split. + apply cip2' with x; auto. + apply cip3' with x; auto. + split. + apply cip2' with x; auto. + apply cip3 with x; auto. + split. + apply cip2 with x; auto. + apply cip3' with x; auto. Qed. Lemma iprop_compact_in_interval : forall I pI x Hx, compact_in_interval I pI x Hx x. -intro. -elim I; simpl in |- *; intros; try inversion_clear Hx; split; auto; - try apply leEq_reflexive. -apply less_leEq; apply less_plusOne. -apply less_leEq; apply less_plusOne. -apply less_leEq; apply shift_minus_less; apply less_plusOne. -apply less_leEq; apply less_plusOne. -apply less_leEq; apply shift_minus_less; apply less_plusOne. -apply less_leEq; apply cip1''; auto. -apply less_leEq; apply cip1''''; auto. -apply less_leEq; apply cip1''; auto. -apply less_leEq; apply cip1''''; auto. +Proof. + intro. + elim I; simpl in |- *; intros; try inversion_clear Hx; split; auto; try apply leEq_reflexive. + apply less_leEq; apply less_plusOne. + apply less_leEq; apply less_plusOne. + apply less_leEq; apply shift_minus_less; apply less_plusOne. + apply less_leEq; apply less_plusOne. + apply less_leEq; apply shift_minus_less; apply less_plusOne. + apply less_leEq; apply cip1''; auto. + apply less_leEq; apply cip1''''; auto. + apply less_leEq; apply cip1''; auto. + apply less_leEq; apply cip1''''; auto. Qed. Lemma iprop_compact_in_interval' : forall I pI x Hx (H : compact_ (compact_in_interval I pI x Hx)) H', compact (Lend H) (Rend H) H' x. -do 4 intro. -cut (compact_in_interval I pI x Hx x). -2: apply iprop_compact_in_interval. -elim (compact_in_interval I pI x Hx); intros; try inversion H. -simpl in |- *; auto. +Proof. + do 4 intro. + cut (compact_in_interval I pI x Hx x). + 2: apply iprop_compact_in_interval. + elim (compact_in_interval I pI x Hx); intros; try inversion H. + simpl in |- *; auto. Qed. Lemma iprop_compact_in_interval_inc1 : forall I pI x Hx (H : compact_ (compact_in_interval I pI x Hx)) H', included (compact (Lend H) (Rend H) H') (compact_in_interval I pI x Hx). -do 4 intro. -elim (compact_in_interval I pI x Hx); intros; try inversion H. -unfold compact in |- *; simpl in |- *; Included. +Proof. + do 4 intro. + elim (compact_in_interval I pI x Hx); intros; try inversion H. + unfold compact in |- *; simpl in |- *; Included. Qed. Lemma iprop_compact_in_interval_inc2 : forall I pI x Hx (H : compact_ (compact_in_interval I pI x Hx)) H', included (compact_in_interval I pI x Hx) (compact (Lend H) (Rend H) H'). -do 4 intro. -elim (compact_in_interval I pI x Hx); intros; try inversion H. -unfold compact in |- *; simpl in |- *; Included. +Proof. + do 4 intro. + elim (compact_in_interval I pI x Hx); intros; try inversion H. + unfold compact in |- *; simpl in |- *; Included. Qed. (** @@ -692,14 +722,16 @@ Lemma compact_in_interval_wd1 : forall I pI x Hx y Hy (H : compact_ (compact_in_interval I pI x Hx)) (H' : compact_ (compact_in_interval I pI y Hy)), x [=] y -> Lend H [=] Lend H'. -intro I; elim I; simpl in |- *; intros; algebra. +Proof. + intro I; elim I; simpl in |- *; intros; algebra. Qed. Lemma compact_in_interval_wd2 : forall I pI x Hx y Hy (H : compact_ (compact_in_interval I pI x Hx)) (H' : compact_ (compact_in_interval I pI y Hy)), x [=] y -> Rend H [=] Rend H'. -intro I; elim I; simpl in |- *; intros; algebra. +Proof. + intro I; elim I; simpl in |- *; intros; algebra. Qed. (** @@ -707,254 +739,237 @@ We can make an analogous construction for two points. *) Definition compact_in_interval2 I (pI : proper I) x y : I x -> I y -> interval. -intros. -set (z1 := Min x y) in *. -set (z2 := Max x y) in *. -destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros. -apply (clcr z1 (z2[+]One)). -apply (clcr z1 (z2[+]One)). -apply (clcr (z1[-]One) z2). -apply (clcr z1 (z2[+]One)). -apply (clcr (z1[-]One) z2). -apply (clcr (z1[-] (z1[-]c) [/]TwoNZ) (z2[+] (c0[-]z2) [/]TwoNZ)). -apply (clcr (z1[-] (z1[-]c) [/]TwoNZ) (z2[+] (c0[-]z2) [/]TwoNZ)). -apply (clcr (z1[-] (z1[-]c) [/]TwoNZ) (z2[+] (c0[-]z2) [/]TwoNZ)). -apply (clcr c c0). +Proof. + intros. + set (z1 := Min x y) in *. + set (z2 := Max x y) in *. + destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros. + apply (clcr z1 (z2[+]One)). + apply (clcr z1 (z2[+]One)). + apply (clcr (z1[-]One) z2). + apply (clcr z1 (z2[+]One)). + apply (clcr (z1[-]One) z2). + apply (clcr (z1[-] (z1[-]c) [/]TwoNZ) (z2[+] (c0[-]z2) [/]TwoNZ)). + apply (clcr (z1[-] (z1[-]c) [/]TwoNZ) (z2[+] (c0[-]z2) [/]TwoNZ)). + apply (clcr (z1[-] (z1[-]c) [/]TwoNZ) (z2[+] (c0[-]z2) [/]TwoNZ)). + apply (clcr c c0). Defined. Lemma compact_compact_in_interval2 : forall I pI x y Hx Hy, compact_ (compact_in_interval2 I pI x y Hx Hy). -intro. -elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy; - try apply ts; apply less_leEq. -apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -apply shift_minus_less; apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -apply shift_minus_less; apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -eapply less_transitive_unfolded; - [ apply cip1'' - | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ]; - try apply less_Min; try apply Max_less; auto. -eapply less_leEq_trans; - [ apply cip1'' - | eapply leEq_transitive; [ apply Min_leEq_Max | apply cip1''' ] ]; - try apply less_Min; try apply Max_leEq; auto. -eapply leEq_less_trans; - [ apply cip1' - | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ]; - try apply leEq_Min; try apply Max_less; auto. -auto. +Proof. + intro. + elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy; + try apply ts; apply less_leEq. + apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ]. + apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ]. + apply shift_minus_less; apply leEq_less_trans with (Max x y); + [ apply Min_leEq_Max | apply less_plusOne ]. + apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ]. + apply shift_minus_less; apply leEq_less_trans with (Max x y); + [ apply Min_leEq_Max | apply less_plusOne ]. + eapply less_transitive_unfolded; [ apply cip1'' + | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ]; + try apply less_Min; try apply Max_less; auto. + eapply less_leEq_trans; [ apply cip1'' + | eapply leEq_transitive; [ apply Min_leEq_Max | apply cip1''' ] ]; + try apply less_Min; try apply Max_leEq; auto. + eapply leEq_less_trans; [ apply cip1' + | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ]; + try apply leEq_Min; try apply Max_less; auto. + auto. Qed. Lemma proper_compact_in_interval2 : forall I pI x y Hx Hy, proper (compact_in_interval2 I pI x y Hx Hy). -intro. -elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy. -apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -apply shift_minus_less; apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -apply shift_minus_less; apply leEq_less_trans with (Max x y); - [ apply Min_leEq_Max | apply less_plusOne ]. -eapply less_transitive_unfolded; - [ apply cip1'' - | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ]; - try apply less_Min; try apply Max_less; auto. -eapply less_leEq_trans; - [ apply cip1'' - | eapply leEq_transitive; [ apply Min_leEq_Max | apply cip1''' ] ]; - try apply less_Min; try apply Max_leEq; auto. -eapply leEq_less_trans; - [ apply cip1' - | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ]; - try apply leEq_Min; try apply Max_less; auto. -auto. +Proof. + intro. + elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy. + apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ]. + apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ]. + apply shift_minus_less; apply leEq_less_trans with (Max x y); + [ apply Min_leEq_Max | apply less_plusOne ]. + apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ]. + apply shift_minus_less; apply leEq_less_trans with (Max x y); + [ apply Min_leEq_Max | apply less_plusOne ]. + eapply less_transitive_unfolded; [ apply cip1'' + | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ]; + try apply less_Min; try apply Max_less; auto. + eapply less_leEq_trans; [ apply cip1'' + | eapply leEq_transitive; [ apply Min_leEq_Max | apply cip1''' ] ]; + try apply less_Min; try apply Max_leEq; auto. + eapply leEq_less_trans; [ apply cip1' + | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ]; + try apply leEq_Min; try apply Max_less; auto. + auto. Qed. Lemma proper_compact_in_interval2' : forall I pI x y Hx Hy H, - Lend (I:=compact_in_interval2 I pI x y Hx Hy) H [<] + Lend (I:=compact_in_interval2 I pI x y Hx Hy) H [<] Rend (I:=compact_in_interval2 I pI x y Hx Hy) H. -do 6 intro. -cut (proper (compact_in_interval2 I pI x y Hx Hy)). -2: apply proper_compact_in_interval2. -elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. -simpl in |- *; simpl in H; auto. +Proof. + do 6 intro. + cut (proper (compact_in_interval2 I pI x y Hx Hy)). + 2: apply proper_compact_in_interval2. + elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. + simpl in |- *; simpl in H; auto. Qed. Lemma included_compact_in_interval2 : forall I pI x y Hx Hy, included (compact_in_interval2 I pI x y Hx Hy) I. -induction I; simpl in |- *; intros; try inversion_clear Hx as (H,H0); - try inversion_clear Hy as (H1,H2); red in |- *; simpl in |- *; - intros x0 X; try inversion_clear X; auto. -apply less_leEq_trans with (Min x y); try apply less_Min; auto. -apply leEq_less_trans with (Max x y); try apply Max_less; auto. -apply leEq_transitive with (Min x y); try apply leEq_Min; auto. -apply leEq_transitive with (Max x y); try apply Max_leEq; auto. -split. -apply cip2' with (Min x y); try apply less_Min; auto. -apply cip3' with (Max x y); try apply Max_less; auto. -split. -apply cip2' with (Min x y); try apply less_Min; auto. -apply cip3 with (Max x y); try apply Max_leEq; auto. -split. -apply cip2 with (Min x y); try apply leEq_Min; auto. -apply cip3' with (Max x y); try apply Max_less; auto. +Proof. + induction I; simpl in |- *; intros; try inversion_clear Hx as (H,H0); + try inversion_clear Hy as (H1,H2); red in |- *; simpl in |- *; + intros x0 X; try inversion_clear X; auto. + apply less_leEq_trans with (Min x y); try apply less_Min; auto. + apply leEq_less_trans with (Max x y); try apply Max_less; auto. + apply leEq_transitive with (Min x y); try apply leEq_Min; auto. + apply leEq_transitive with (Max x y); try apply Max_leEq; auto. + split. + apply cip2' with (Min x y); try apply less_Min; auto. + apply cip3' with (Max x y); try apply Max_less; auto. + split. + apply cip2' with (Min x y); try apply less_Min; auto. + apply cip3 with (Max x y); try apply Max_leEq; auto. + split. + apply cip2 with (Min x y); try apply leEq_Min; auto. + apply cip3' with (Max x y); try apply Max_less; auto. Qed. Lemma iprop_compact_in_interval2x : forall I pI x y Hx Hy, compact_in_interval2 I pI x y Hx Hy x. -intro. -elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy; - split; auto; try apply Min_leEq_lft; try apply lft_leEq_Max. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply lft_leEq_Max | apply less_plusOne ]. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply lft_leEq_Max | apply less_plusOne ]. -apply less_leEq; apply shift_minus_less; apply leEq_less_trans with x; - [ apply Min_leEq_lft | apply less_plusOne ]. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply lft_leEq_Max | apply less_plusOne ]. -apply less_leEq; apply shift_minus_less; apply leEq_less_trans with x; - [ apply Min_leEq_lft | apply less_plusOne ]. -apply less_leEq; eapply less_leEq_trans; - [ apply cip1'' | apply Min_leEq_lft ]; try apply less_Min; - auto. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply lft_leEq_Max | apply cip1'''' ]; try apply Max_less; - auto. -apply less_leEq; eapply less_leEq_trans; - [ apply cip1'' | apply Min_leEq_lft ]; try apply less_Min; - auto. -apply leEq_transitive with (Max x y); [ apply lft_leEq_Max | apply cip1''' ]; - try apply Max_leEq; auto. -eapply leEq_transitive; [ apply cip1' | apply Min_leEq_lft ]; - try apply leEq_Min; auto. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply lft_leEq_Max | apply cip1'''' ]; try apply Max_less; - auto. +Proof. + intro. + elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy; + split; auto; try apply Min_leEq_lft; try apply lft_leEq_Max. + apply less_leEq; apply leEq_less_trans with (Max x y); [ apply lft_leEq_Max | apply less_plusOne ]. + apply less_leEq; apply leEq_less_trans with (Max x y); [ apply lft_leEq_Max | apply less_plusOne ]. + apply less_leEq; apply shift_minus_less; apply leEq_less_trans with x; + [ apply Min_leEq_lft | apply less_plusOne ]. + apply less_leEq; apply leEq_less_trans with (Max x y); [ apply lft_leEq_Max | apply less_plusOne ]. + apply less_leEq; apply shift_minus_less; apply leEq_less_trans with x; + [ apply Min_leEq_lft | apply less_plusOne ]. + apply less_leEq; eapply less_leEq_trans; [ apply cip1'' | apply Min_leEq_lft ]; try apply less_Min; + auto. + apply less_leEq; apply leEq_less_trans with (Max x y); + [ apply lft_leEq_Max | apply cip1'''' ]; try apply Max_less; auto. + apply less_leEq; eapply less_leEq_trans; [ apply cip1'' | apply Min_leEq_lft ]; try apply less_Min; + auto. + apply leEq_transitive with (Max x y); [ apply lft_leEq_Max | apply cip1''' ]; + try apply Max_leEq; auto. + eapply leEq_transitive; [ apply cip1' | apply Min_leEq_lft ]; try apply leEq_Min; auto. + apply less_leEq; apply leEq_less_trans with (Max x y); + [ apply lft_leEq_Max | apply cip1'''' ]; try apply Max_less; auto. Qed. Lemma iprop_compact_in_interval2y : forall I pI x y Hx Hy, compact_in_interval2 I pI x y Hx Hy y. -intro. -elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy; - split; auto; try apply Min_leEq_rht; try apply rht_leEq_Max. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply rht_leEq_Max | apply less_plusOne ]. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply rht_leEq_Max | apply less_plusOne ]. -apply less_leEq; apply shift_minus_less; apply leEq_less_trans with y; - [ apply Min_leEq_rht | apply less_plusOne ]. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply rht_leEq_Max | apply less_plusOne ]. -apply less_leEq; apply shift_minus_less; apply leEq_less_trans with y; - [ apply Min_leEq_rht | apply less_plusOne ]. -apply less_leEq; eapply less_leEq_trans; - [ apply cip1'' | apply Min_leEq_rht ]; try apply less_Min; - auto. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply rht_leEq_Max | apply cip1'''' ]; try apply Max_less; - auto. -apply less_leEq; eapply less_leEq_trans; - [ apply cip1'' | apply Min_leEq_rht ]; try apply less_Min; - auto. -apply leEq_transitive with (Max x y); [ apply rht_leEq_Max | apply cip1''' ]; - try apply Max_leEq; auto. -eapply leEq_transitive; [ apply cip1' | apply Min_leEq_rht ]; - try apply leEq_Min; auto. -apply less_leEq; apply leEq_less_trans with (Max x y); - [ apply rht_leEq_Max | apply cip1'''' ]; try apply Max_less; - auto. +Proof. + intro. + elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy; + split; auto; try apply Min_leEq_rht; try apply rht_leEq_Max. + apply less_leEq; apply leEq_less_trans with (Max x y); [ apply rht_leEq_Max | apply less_plusOne ]. + apply less_leEq; apply leEq_less_trans with (Max x y); [ apply rht_leEq_Max | apply less_plusOne ]. + apply less_leEq; apply shift_minus_less; apply leEq_less_trans with y; + [ apply Min_leEq_rht | apply less_plusOne ]. + apply less_leEq; apply leEq_less_trans with (Max x y); [ apply rht_leEq_Max | apply less_plusOne ]. + apply less_leEq; apply shift_minus_less; apply leEq_less_trans with y; + [ apply Min_leEq_rht | apply less_plusOne ]. + apply less_leEq; eapply less_leEq_trans; [ apply cip1'' | apply Min_leEq_rht ]; try apply less_Min; + auto. + apply less_leEq; apply leEq_less_trans with (Max x y); + [ apply rht_leEq_Max | apply cip1'''' ]; try apply Max_less; auto. + apply less_leEq; eapply less_leEq_trans; [ apply cip1'' | apply Min_leEq_rht ]; try apply less_Min; + auto. + apply leEq_transitive with (Max x y); [ apply rht_leEq_Max | apply cip1''' ]; + try apply Max_leEq; auto. + eapply leEq_transitive; [ apply cip1' | apply Min_leEq_rht ]; try apply leEq_Min; auto. + apply less_leEq; apply leEq_less_trans with (Max x y); + [ apply rht_leEq_Max | apply cip1'''' ]; try apply Max_less; auto. Qed. Lemma iprop_compact_in_interval2x' : forall I pI x y Hx Hy (H : compact_ (compact_in_interval2 I pI x y Hx Hy)) H', compact (Lend H) (Rend H) H' x. -do 6 intro. -cut (compact_in_interval2 I pI x y Hx Hy x). -2: apply iprop_compact_in_interval2x. -elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. -simpl in |- *; auto. +Proof. + do 6 intro. + cut (compact_in_interval2 I pI x y Hx Hy x). + 2: apply iprop_compact_in_interval2x. + elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. + simpl in |- *; auto. Qed. Lemma iprop_compact_in_interval2y' : forall I pI x y Hx Hy (H : compact_ (compact_in_interval2 I pI x y Hx Hy)) H', compact (Lend H) (Rend H) H' y. -do 6 intro. -cut (compact_in_interval2 I pI x y Hx Hy y). -2: apply iprop_compact_in_interval2y. -elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. -simpl in |- *; auto. +Proof. + do 6 intro. + cut (compact_in_interval2 I pI x y Hx Hy y). + 2: apply iprop_compact_in_interval2y. + elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. + simpl in |- *; auto. Qed. Lemma iprop_compact_in_interval2_inc1 : forall I pI x y Hx Hy (H : compact_ (compact_in_interval2 I pI x y Hx Hy)) H', included (compact (Lend H) (Rend H) H') (compact_in_interval2 I pI x y Hx Hy). -do 6 intro. -elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. -unfold compact in |- *; unfold iprop in |- *; simpl in |- *; Included. +Proof. + do 6 intro. + elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. + unfold compact in |- *; unfold iprop in |- *; simpl in |- *; Included. Qed. Lemma iprop_compact_in_interval2_inc2 : forall I pI x y Hx Hy (H : compact_ (compact_in_interval2 I pI x y Hx Hy)) H', included (compact_in_interval2 I pI x y Hx Hy) (compact (Lend H) (Rend H) H'). -do 6 intro. -elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. -unfold compact in |- *; unfold iprop in |- *; simpl in |- *; Included. +Proof. + do 6 intro. + elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H. + unfold compact in |- *; unfold iprop in |- *; simpl in |- *; Included. Qed. Lemma compact_in_interval_x_lft : forall I pI x y Hx Hy H H', - Lend (I:=compact_in_interval2 I pI x y Hx Hy) H [<=] + Lend (I:=compact_in_interval2 I pI x y Hx Hy) H [<=] Lend (I:=compact_in_interval I pI x Hx) H'. -intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply minus_resp_leEq; - try apply Min_leEq_lft; try apply leEq_reflexive; - (rstepl (c[+] (Min x y[-]c) [/]TwoNZ); rstepr (c[+] (x[-]c) [/]TwoNZ); - apply plus_resp_leEq_lft; apply div_resp_leEq; - [ apply pos_two | apply minus_resp_leEq; apply Min_leEq_lft ]). +Proof. + intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply minus_resp_leEq; + try apply Min_leEq_lft; try apply leEq_reflexive; + (rstepl (c[+] (Min x y[-]c) [/]TwoNZ); rstepr (c[+] (x[-]c) [/]TwoNZ); + apply plus_resp_leEq_lft; apply div_resp_leEq; + [ apply pos_two | apply minus_resp_leEq; apply Min_leEq_lft ]). Qed. Lemma compact_in_interval_y_lft : forall I pI x y Hx Hy H H', - Lend (I:=compact_in_interval2 I pI x y Hx Hy) H [<=] + Lend (I:=compact_in_interval2 I pI x y Hx Hy) H [<=] Lend (I:=compact_in_interval I pI y Hy) H'. -intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply minus_resp_leEq; - try apply Min_leEq_rht; try apply leEq_reflexive; - (rstepl (c[+] (Min x y[-]c) [/]TwoNZ); rstepr (c[+] (y[-]c) [/]TwoNZ); - apply plus_resp_leEq_lft; apply div_resp_leEq; - [ apply pos_two | apply minus_resp_leEq; apply Min_leEq_rht ]). +Proof. + intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply minus_resp_leEq; + try apply Min_leEq_rht; try apply leEq_reflexive; + (rstepl (c[+] (Min x y[-]c) [/]TwoNZ); rstepr (c[+] (y[-]c) [/]TwoNZ); + apply plus_resp_leEq_lft; apply div_resp_leEq; + [ apply pos_two | apply minus_resp_leEq; apply Min_leEq_rht ]). Qed. Lemma compact_in_interval_x_rht : forall I pI x y Hx Hy H H', - Rend (I:=compact_in_interval I pI x Hx) H [<=] + Rend (I:=compact_in_interval I pI x Hx) H [<=] Rend (I:=compact_in_interval2 I pI x y Hx Hy) H'. -intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply plus_resp_leEq; - try apply lft_leEq_Max; try apply leEq_reflexive; - (rstepl (c0[-] (c0[-]x) [/]TwoNZ); rstepr (c0[-] (c0[-]Max x y) [/]TwoNZ); - unfold cg_minus in |- *; apply plus_resp_leEq_lft; - apply inv_resp_leEq; apply div_resp_leEq; - [ apply pos_two - | apply plus_resp_leEq_lft; apply inv_resp_leEq; apply lft_leEq_Max ]). +Proof. + intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply plus_resp_leEq; + try apply lft_leEq_Max; try apply leEq_reflexive; + (rstepl (c0[-] (c0[-]x) [/]TwoNZ); rstepr (c0[-] (c0[-]Max x y) [/]TwoNZ); + unfold cg_minus in |- *; apply plus_resp_leEq_lft; apply inv_resp_leEq; apply div_resp_leEq; + [ apply pos_two | apply plus_resp_leEq_lft; apply inv_resp_leEq; apply lft_leEq_Max ]). Qed. Lemma compact_in_interval_y_rht : forall I pI x y Hx Hy H H', - Rend (I:=compact_in_interval I pI y Hy) H [<=] + Rend (I:=compact_in_interval I pI y Hy) H [<=] Rend (I:=compact_in_interval2 I pI x y Hx Hy) H'. -intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply plus_resp_leEq; - try apply rht_leEq_Max; try apply leEq_reflexive; - (rstepl (c0[-] (c0[-]y) [/]TwoNZ); rstepr (c0[-] (c0[-]Max x y) [/]TwoNZ); - unfold cg_minus in |- *; apply plus_resp_leEq_lft; - apply inv_resp_leEq; apply div_resp_leEq; - [ apply pos_two - | apply plus_resp_leEq_lft; apply inv_resp_leEq; apply rht_leEq_Max ]). +Proof. + intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply plus_resp_leEq; + try apply rht_leEq_Max; try apply leEq_reflexive; + (rstepl (c0[-] (c0[-]y) [/]TwoNZ); rstepr (c0[-] (c0[-]Max x y) [/]TwoNZ); + unfold cg_minus in |- *; apply plus_resp_leEq_lft; apply inv_resp_leEq; apply div_resp_leEq; + [ apply pos_two | apply plus_resp_leEq_lft; apply inv_resp_leEq; apply rht_leEq_Max ]). Qed. End Proper_Compact_with_One_or_Two_Points. @@ -965,21 +980,23 @@ Compact intervals are exactly compact intervals(!). Lemma interval_compact_inc : forall I (cI : compact_ I) H, included I (compact (Lend cI) (Rend cI) H). -intros [| c| c| c| c| c c0| c c0| c c0| c c0];intros; try inversion cI. -generalize c c0 cI H; clear H cI c0 c. -simpl in |- *; intros a b Hab Hab'. -intros x H. -simpl in H. -inversion_clear H; split; auto. +Proof. + intros [| c| c| c| c| c c0| c c0| c c0| c c0];intros; try inversion cI. + generalize c c0 cI H; clear H cI c0 c. + simpl in |- *; intros a b Hab Hab'. + intros x H. + simpl in H. + inversion_clear H; split; auto. Qed. Lemma compact_interval_inc : forall I (cI : compact_ I) H, included (compact (Lend cI) (Rend cI) H) I. -intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. -generalize c c0 cI H; clear H cI c0 c. -simpl in |- *; intros a b Hab. -intros H x H0. -inversion_clear H0; split; auto. +Proof. + intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. + generalize c c0 cI H; clear H cI c0 c. + simpl in |- *; intros a b Hab. + intros H x H0. + inversion_clear H0; split; auto. Qed. (** @@ -992,25 +1009,21 @@ Lemma compact_proper_in_interval : forall (J : interval) a b Hab, included (compact a b Hab) J -> proper J -> {a' : IR | {b' : IR | {Hab' : _ | included (compact a' b' (less_leEq _ _ _ Hab')) J | included (Compact Hab) (Compact (less_leEq _ _ _ Hab'))}}}. -intros J a b Hab H H0. -exists - (Lend - (compact_compact_in_interval2 J H0 a b (H _ (compact_inc_lft _ _ Hab)) - (H _ (compact_inc_rht _ _ Hab)))). -exists - (Rend - (compact_compact_in_interval2 J H0 a b (H _ (compact_inc_lft _ _ Hab)) - (H _ (compact_inc_rht _ _ Hab)))). -exists - (proper_compact_in_interval2' _ _ _ _ _ _ - (compact_compact_in_interval2 J H0 a b (H _ (compact_inc_lft _ _ Hab)) - (H _ (compact_inc_rht _ _ Hab)))). -eapply included_trans. -apply compact_interval_inc. -apply included_compact_in_interval2. -apply included_compact. -apply iprop_compact_in_interval2x'. -apply iprop_compact_in_interval2y'. +Proof. + intros J a b Hab H H0. + exists (Lend (compact_compact_in_interval2 J H0 a b (H _ (compact_inc_lft _ _ Hab)) + (H _ (compact_inc_rht _ _ Hab)))). + exists (Rend (compact_compact_in_interval2 J H0 a b (H _ (compact_inc_lft _ _ Hab)) + (H _ (compact_inc_rht _ _ Hab)))). + exists (proper_compact_in_interval2' _ _ _ _ _ _ + (compact_compact_in_interval2 J H0 a b (H _ (compact_inc_lft _ _ Hab)) + (H _ (compact_inc_rht _ _ Hab)))). + eapply included_trans. + apply compact_interval_inc. + apply included_compact_in_interval2. + apply included_compact. + apply iprop_compact_in_interval2x'. + apply iprop_compact_in_interval2y'. Qed. End Compact_Constructions. @@ -1059,89 +1072,95 @@ In the case of compact intervals, this definitions collapse to the old ones. Lemma Continuous_Int : forall (I : interval) (cI : compact_ I) H (F : PartIR), Continuous_I (a:=Lend cI) (b:=Rend cI) H F -> Continuous I F. -intros I cI H F H0. -cut (included I (compact (Lend cI) (Rend cI) H)). -2: apply interval_compact_inc; auto. -cut (included (compact (Lend cI) (Rend cI) H) I). -2: apply compact_interval_inc; auto. -generalize cI H H0; clear H0 H cI. -destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. -generalize c c0 cI H H0 X X0; clear X0 X H0 H cI c0 c. -simpl in |- *; intros a b Hab Hab' contF inc1 inc2. -split. -apply included_trans with (Compact Hab'); Included. -intros. -apply included_imp_contin with (Hab := Hab'); Included. +Proof. + intros I cI H F H0. + cut (included I (compact (Lend cI) (Rend cI) H)). + 2: apply interval_compact_inc; auto. + cut (included (compact (Lend cI) (Rend cI) H) I). + 2: apply compact_interval_inc; auto. + generalize cI H H0; clear H0 H cI. + destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. + generalize c c0 cI H H0 X X0; clear X0 X H0 H cI c0 c. + simpl in |- *; intros a b Hab Hab' contF inc1 inc2. + split. + apply included_trans with (Compact Hab'); Included. + intros. + apply included_imp_contin with (Hab := Hab'); Included. Qed. Lemma Int_Continuous : forall (I : interval) (cI : compact_ I) H (F : PartIR), Continuous I F -> Continuous_I (a:=Lend cI) (b:=Rend cI) H F. -intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. -generalize c c0 cI H F X; clear X F H cI c0 c. -simpl in |- *; intros a b Hab Hab' F contF. -inversion_clear contF. -Contin. +Proof. + intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. + generalize c c0 cI H F X; clear X F H cI c0 c. + simpl in |- *; intros a b Hab Hab' F contF. + inversion_clear contF. + Contin. Qed. Lemma Derivative_Int : forall (I : interval) (cI : compact_ I) (pI : proper I) H (F F' : PartIR), Derivative_I (a:=Lend cI) (b:=Rend cI) H F F' -> Derivative I pI F F'. -do 4 intro. -cut (included I (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H))). -2: apply interval_compact_inc; auto. -cut (included (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H)) I). -2: apply compact_interval_inc; auto. -generalize cI pI H; clear H cI pI. -destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. -generalize c c0 cI pI H X X0 F F' X1; clear X1 F' F X0 X H pI cI c0 c. -simpl in |- *; intros a b Hab Hnonv Hab' inc1 inc2 F F' derF. -split. -apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included. -split. -apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included. -intros c d Hcd' Hinc. -apply included_imp_deriv with (Hab := Hab'); Included. +Proof. + do 4 intro. + cut (included I (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H))). + 2: apply interval_compact_inc; auto. + cut (included (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H)) I). + 2: apply compact_interval_inc; auto. + generalize cI pI H; clear H cI pI. + destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. + generalize c c0 cI pI H X X0 F F' X1; clear X1 F' F X0 X H pI cI c0 c. + simpl in |- *; intros a b Hab Hnonv Hab' inc1 inc2 F F' derF. + split. + apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included. + split. + apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included. + intros c d Hcd' Hinc. + apply included_imp_deriv with (Hab := Hab'); Included. Qed. Lemma Int_Derivative : forall (I : interval) (cI : compact_ I) (pI : proper I) H (F F' : PartIR), Derivative I pI F F' -> Derivative_I (a:=Lend cI) (b:=Rend cI) H F F'. -intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. -generalize c c0 cI pI H F F' X; clear X F' F H pI cI c0 c. -simpl in |- *; intros a b Hab Hnonv Hab' F F' derF. -elim derF; intros H H0. -elim H0; intros H1 H2. -Included. +Proof. + intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. + generalize c c0 cI pI H F F' X; clear X F' F H pI cI c0 c. + simpl in |- *; intros a b Hab Hnonv Hab' F F' derF. + elim derF; intros H H0. + elim H0; intros H1 H2. + Included. Qed. Lemma Diffble_Int : forall (I : interval) (cI : compact_ I) (pI : proper I) H (F : PartIR), Diffble_I (a:=Lend cI) (b:=Rend cI) H F -> Diffble I pI F. -do 4 intro. -cut (included I (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H))). -2: apply interval_compact_inc; auto. -cut (included (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H)) I). -2: apply compact_interval_inc; auto. -generalize cI pI H; clear H pI cI. -destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. -generalize c c0 cI pI H X X0 F X1; clear X1 F X0 X H pI cI c0 c. -simpl in |- *; intros a b Hab Hnonv Hab' inc1 inc2 F diffF. -red in |- *; simpl in |- *. -split. -apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included. -intros c d Hcd' Hinc. -apply included_imp_diffble with (Hab := Hab'); auto. +Proof. + do 4 intro. + cut (included I (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H))). + 2: apply interval_compact_inc; auto. + cut (included (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H)) I). + 2: apply compact_interval_inc; auto. + generalize cI pI H; clear H pI cI. + destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. + generalize c c0 cI pI H X X0 F X1; clear X1 F X0 X H pI cI c0 c. + simpl in |- *; intros a b Hab Hnonv Hab' inc1 inc2 F diffF. + red in |- *; simpl in |- *. + split. + apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included. + intros c d Hcd' Hinc. + apply included_imp_diffble with (Hab := Hab'); auto. Qed. Lemma Int_Diffble : forall (I : interval) (cI : compact_ I) (pI : proper I) H (F : PartIR), Diffble I pI F -> Diffble_I (a:=Lend cI) (b:=Rend cI) H F. -intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. -generalize c c0 cI pI H F X; clear X F H pI cI c0 c. -simpl in |- *; intros a b Hab Hnonv Hab' F diffF. -inversion_clear diffF. -Included. +Proof. + intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI. + generalize c c0 cI pI H F X; clear X F H pI cI c0 c. + simpl in |- *; intros a b Hab Hnonv Hab' F diffF. + inversion_clear diffF. + Included. Qed. End Reflexivity_Properties. @@ -1154,64 +1173,67 @@ Interestingly, inclusion and equality in an interval are also characterizable in Lemma included_imp_inc : forall (J : interval) P, (forall a b Hab, included (compact a b Hab) J -> included (compact a b Hab) P) -> included J P. -intros J P H x H0. -apply (H _ _ (leEq_reflexive _ _) (compact_single_iprop J x H0)). -apply compact_inc_lft. +Proof. + intros J P H x H0. + apply (H _ _ (leEq_reflexive _ _) (compact_single_iprop J x H0)). + apply compact_inc_lft. Qed. Lemma included_Feq'' : forall I F G, proper I -> (forall a b Hab (Hab':=(less_leEq _ a b Hab)), included (Compact Hab') I -> Feq (Compact Hab') F G) -> Feq I F G. -intros I F G H H0. -apply eq_imp_Feq. -intros x H1. -elim (compact_proper_in_interval I x x (leEq_reflexive _ x)); Included. -2: exact (compact_single_iprop I x H1). -intros a Ha. -elim Ha; clear Ha. -intros b Hb. -elim Hb; clear Hb. -intros Hab H2 H3. -elim (H0 _ _ _ H2); intros. -apply a0; apply H3; apply compact_single_prop. -intros x H1. -elim (compact_proper_in_interval I x x (leEq_reflexive _ x)); Included. -2: exact (compact_single_iprop I x H1). -intros a Ha. -elim Ha; clear Ha. -intros b Hb. -elim Hb; clear Hb. -intros Hab H2 H3. -elim (H0 _ _ _ H2); intros. -inversion_clear b0. -apply X; apply H3; apply compact_single_prop. -intros x H1 Hx Hx'. -elim (compact_proper_in_interval I x x (leEq_reflexive _ x)); Included. -2: exact (compact_single_iprop I x H1). -intros a Ha. -elim Ha; clear Ha. -intros b Hb. -elim Hb; clear Hb. -intros Hab H2 H3. -elim (H0 _ _ _ H2); intros. -inversion_clear b0. -apply H4; apply H3; apply compact_single_prop. +Proof. + intros I F G H H0. + apply eq_imp_Feq. + intros x H1. + elim (compact_proper_in_interval I x x (leEq_reflexive _ x)); Included. + 2: exact (compact_single_iprop I x H1). + intros a Ha. + elim Ha; clear Ha. + intros b Hb. + elim Hb; clear Hb. + intros Hab H2 H3. + elim (H0 _ _ _ H2); intros. + apply a0; apply H3; apply compact_single_prop. + intros x H1. + elim (compact_proper_in_interval I x x (leEq_reflexive _ x)); Included. + 2: exact (compact_single_iprop I x H1). + intros a Ha. + elim Ha; clear Ha. + intros b Hb. + elim Hb; clear Hb. + intros Hab H2 H3. + elim (H0 _ _ _ H2); intros. + inversion_clear b0. + apply X; apply H3; apply compact_single_prop. + intros x H1 Hx Hx'. + elim (compact_proper_in_interval I x x (leEq_reflexive _ x)); Included. + 2: exact (compact_single_iprop I x H1). + intros a Ha. + elim Ha; clear Ha. + intros b Hb. + elim Hb; clear Hb. + intros Hab H2 H3. + elim (H0 _ _ _ H2); intros. + inversion_clear b0. + apply H4; apply H3; apply compact_single_prop. Qed. Lemma included_Feq' : forall (I : interval) F G, (forall a b Hab, included (compact a b Hab) I -> Feq (Compact Hab) F G) -> Feq I F G. -intros I F G H. -apply eq_imp_Feq. -intros x H0. -elim (H x x (leEq_reflexive _ x) (compact_single_iprop I x H0)); intros. -apply a; apply compact_single_prop. -intros x H0. -elim (H x x (leEq_reflexive _ x) (compact_single_iprop I x H0)); intros. -inversion_clear b. -apply X; apply compact_single_prop. -intros x H0 Hx Hx'. -elim (H x x (leEq_reflexive _ x) (compact_single_iprop I x H0)); intros. -inversion_clear b. -apply H1; apply compact_single_prop. +Proof. + intros I F G H. + apply eq_imp_Feq. + intros x H0. + elim (H x x (leEq_reflexive _ x) (compact_single_iprop I x H0)); intros. + apply a; apply compact_single_prop. + intros x H0. + elim (H x x (leEq_reflexive _ x) (compact_single_iprop I x H0)); intros. + inversion_clear b. + apply X; apply compact_single_prop. + intros x H0 Hx Hx'. + elim (H x x (leEq_reflexive _ x) (compact_single_iprop I x H0)); intros. + inversion_clear b. + apply H1; apply compact_single_prop. Qed. End Lemmas. diff --git a/ftc/NthDerivative.v b/ftc/NthDerivative.v index 3ae469b7f..95c9af3b4 100644 --- a/ftc/NthDerivative.v +++ b/ftc/NthDerivative.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Differentiability. @@ -106,63 +106,67 @@ Let I := Compact Hab. Lemma Diffble_I_n_wd : forall n F G, Feq I F G -> Diffble_I_n Hab' n F -> Diffble_I_n Hab' n G. -intro. -induction n as [| n Hrecn]. -simpl in |- *; unfold Feq in |- *; tauto. -intros F G H H0. -elim H0; intros H1 H2; clear H0. -cut (Diffble_I Hab' G). -2: apply Diffble_I_wd with F; assumption. -intro H0. -exists H0. -eapply Hrecn. -2: apply H2. -unfold I, Hab in |- *; apply Derivative_I_unique with F. -apply projT2. -apply Derivative_I_wdl with G. -apply Feq_symmetric; assumption. -apply projT2. +Proof. + intro. + induction n as [| n Hrecn]. + simpl in |- *; unfold Feq in |- *; tauto. + intros F G H H0. + elim H0; intros H1 H2; clear H0. + cut (Diffble_I Hab' G). + 2: apply Diffble_I_wd with F; assumption. + intro H0. + exists H0. + eapply Hrecn. + 2: apply H2. + unfold I, Hab in |- *; apply Derivative_I_unique with F. + apply projT2. + apply Derivative_I_wdl with G. + apply Feq_symmetric; assumption. + apply projT2. Qed. Lemma Derivative_I_n_wdr : forall n F G H, Feq I G H -> Derivative_I_n Hab' n F G -> Derivative_I_n Hab' n F H. -intro. -induction n as [| n Hrecn]; intros F G H H0 H1. -simpl in |- *; simpl in H1. -apply Feq_transitive with G; assumption. -elim H1; intros f' H2 H3. -exists f'; auto. -apply Hrecn with G; assumption. +Proof. + intro. + induction n as [| n Hrecn]; intros F G H H0 H1. + simpl in |- *; simpl in H1. + apply Feq_transitive with G; assumption. + elim H1; intros f' H2 H3. + exists f'; auto. + apply Hrecn with G; assumption. Qed. Lemma Derivative_I_n_wdl : forall n F G H, Feq I F G -> Derivative_I_n Hab' n F H -> Derivative_I_n Hab' n G H. -intro. -induction n as [| n Hrecn]; intros F G H H0 H1. -simpl in |- *; simpl in H1. -apply Feq_transitive with F. -apply Feq_symmetric; assumption. -auto. -elim H1; intros f' H2 H3. -exists f'; auto. -apply Derivative_I_wdl with F; assumption. +Proof. + intro. + induction n as [| n Hrecn]; intros F G H H0 H1. + simpl in |- *; simpl in H1. + apply Feq_transitive with F. + apply Feq_symmetric; assumption. + auto. + elim H1; intros f' H2 H3. + exists f'; auto. + apply Derivative_I_wdl with F; assumption. Qed. Lemma Derivative_I_n_unique : forall n F G H, Derivative_I_n Hab' n F G -> Derivative_I_n Hab' n F H -> Feq I G H. -intro. -induction n as [| n Hrecn]; intros F G H H0 H1. -simpl in H0, H1. -unfold I in |- *; apply Feq_transitive with F. -apply Feq_symmetric; assumption. -auto. -elim H0; intros g' H2 H3. -elim H1; intros h' H4 H5. -apply Hrecn with (PartInt g'). -assumption. -apply Derivative_I_n_wdl with (PartInt h'). -2: assumption. -unfold I, Hab in |- *; apply Derivative_I_unique with F; assumption. +Proof. + intro. + induction n as [| n Hrecn]; intros F G H H0 H1. + simpl in H0, H1. + unfold I in |- *; apply Feq_transitive with F. + apply Feq_symmetric; assumption. + auto. + elim H0; intros g' H2 H3. + elim H1; intros h' H4 H5. + apply Hrecn with (PartInt g'). + assumption. + apply Derivative_I_n_wdl with (PartInt h'). + 2: assumption. + unfold I, Hab in |- *; apply Derivative_I_unique with F; assumption. Qed. End Trivia. @@ -192,18 +196,20 @@ We begin by showing that having a higher order derivative implies being differen Lemma Diffble_I_n_imp_diffble : forall n : nat, 0 < n -> forall F : PartIR, Diffble_I_n Hab' n F -> Diffble_I Hab' F. -intros n H F. -rewrite (S_pred n 0);auto. simpl. intro H0. simpl in H0. -inversion_clear H0; assumption. +Proof. + intros n H F. + rewrite (S_pred n 0);auto. simpl. intro H0. simpl in H0. + inversion_clear H0; assumption. Qed. Lemma deriv_n_imp_diffble : forall n : nat, 0 < n -> forall F F' : PartIR, Derivative_I_n Hab' n F F' -> Diffble_I Hab' F. -simple destruct n. -intros; elimtype False; inversion H. -clear n; intros n H F F' H0. -elim H0; clear H0; intros f'' H0 H1. -exists f''; assumption. +Proof. + simple destruct n. + intros; elimtype False; inversion H. + clear n; intros n H F F' H0. + elim H0; clear H0; intros f'' H0 H1. + exists f''; assumption. Qed. (** @@ -212,26 +218,27 @@ If a function is [n] times differentiable then it is also [m] times differentiab Lemma le_imp_Diffble_I : forall m n : nat, m <= n -> forall F, Diffble_I_n Hab' n F -> Diffble_I_n Hab' m F. -intros m n H F H0. -induction n as [| n Hrecn]. -cut (m = 0); [ intro | auto with arith ]. -rewrite H1; simpl in |- *; tauto. -elim (le_lt_eq_dec _ _ H); intro H2. -2: rewrite H2; assumption. -apply Hrecn. -auto with arith. -elim H0; intros Hf Hf'. -clear Hf' Hf H2 Hrecn H. -generalize H0. -generalize F. -clear H0 F; induction n as [| n Hrecn]; intros. -simpl in |- *; apply diffble_imp_inc. -exact (Diffble_I_n_imp_diffble _ (lt_n_Sn 0) F H0). -simpl in |- *. -elim H0; intros Hf Hf'. -exists Hf. -apply Hrecn. -assumption. +Proof. + intros m n H F H0. + induction n as [| n Hrecn]. + cut (m = 0); [ intro | auto with arith ]. + rewrite H1; simpl in |- *; tauto. + elim (le_lt_eq_dec _ _ H); intro H2. + 2: rewrite H2; assumption. + apply Hrecn. + auto with arith. + elim H0; intros Hf Hf'. + clear Hf' Hf H2 Hrecn H. + generalize H0. + generalize F. + clear H0 F; induction n as [| n Hrecn]; intros. + simpl in |- *; apply diffble_imp_inc. + exact (Diffble_I_n_imp_diffble _ (lt_n_Sn 0) F H0). + simpl in |- *. + elim H0; intros Hf Hf'. + exists Hf. + apply Hrecn. + assumption. Qed. (** @@ -242,16 +249,17 @@ derivatives. Lemma Diffble_I_imp_le : forall n, 0 < n -> forall F F', Diffble_I_n Hab' n F -> Derivative_I Hab' F F' -> Diffble_I_n Hab' (pred n) F'. -simple destruct n. -intros; elimtype False; inversion H. -clear n; intros n H F F' H0 H1. -elim H0; intros f'' Hf''. -simpl in |- *. -eapply Diffble_I_n_wd. -2: apply Hf''. -apply Derivative_I_unique with F. -apply projT2. -assumption. +Proof. + simple destruct n. + intros; elimtype False; inversion H. + clear n; intros n H F F' H0 H1. + elim H0; intros f'' Hf''. + simpl in |- *. + eapply Diffble_I_n_wd. + 2: apply Hf''. + apply Derivative_I_unique with F. + apply projT2. + assumption. Qed. (** @@ -261,10 +269,11 @@ defined in that interval. Lemma Diffble_I_n_imp_inc : forall n F, Diffble_I_n Hab' n F -> included (Compact Hab) (Dom F). -intros n F H; induction n as [| n Hrecn]. -simpl in H; Included. -apply Hrecn. -exact (le_imp_Diffble_I _ _ (le_n_Sn n) _ H). +Proof. + intros n F H; induction n as [| n Hrecn]. + simpl in H; Included. + apply Hrecn. + exact (le_imp_Diffble_I _ _ (le_n_Sn n) _ H). Qed. (** @@ -273,37 +282,39 @@ Also, the notions of derivative and differentiability are related as expected. Lemma Diffble_I_n_imp_deriv_n : forall n F, Diffble_I_n Hab' n F -> {f' : CSetoid_fun (subset (Compact Hab)) IR | Derivative_I_n Hab' n F (PartInt f')}. -intro; induction n as [| n Hrecn]. -intros F H. -exists (IntPartIR (Diffble_I_n_imp_inc _ _ H)). -simpl in |- *; simpl in H. -FEQ. -intros F H. -elim H; intros H1 H2. -elim (Hrecn _ H2); intros f' Hf'. -exists f'. -simpl in |- *. -exists (ProjT1 H1). -apply projT2. -assumption. +Proof. + intro; induction n as [| n Hrecn]. + intros F H. + exists (IntPartIR (Diffble_I_n_imp_inc _ _ H)). + simpl in |- *; simpl in H. + FEQ. + intros F H. + elim H; intros H1 H2. + elim (Hrecn _ H2); intros f' Hf'. + exists f'. + simpl in |- *. + exists (ProjT1 H1). + apply projT2. + assumption. Qed. Lemma deriv_n_imp_Diffble_I_n : forall n F F', Derivative_I_n Hab' n F F' -> Diffble_I_n Hab' n F. -intro; induction n as [| n Hrecn]; intros F F' H. -simpl in |- *; simpl in H. -elim H; intros. -elim b0; auto. -simpl in |- *. -elim H; intros f' H0 H1. -cut (Diffble_I Hab' F); [ intro H2 | exists f'; assumption ]. -exists H2. -apply Hrecn with F'. -eapply Derivative_I_n_wdl. -2: apply H1. -apply Derivative_I_unique with F. -assumption. -apply projT2. +Proof. + intro; induction n as [| n Hrecn]; intros F F' H. + simpl in |- *; simpl in H. + elim H; intros. + elim b0; auto. + simpl in |- *. + elim H; intros f' H0 H1. + cut (Diffble_I Hab' F); [ intro H2 | exists f'; assumption ]. + exists H2. + apply Hrecn with F'. + eapply Derivative_I_n_wdl. + 2: apply H1. + apply Derivative_I_unique with F. + assumption. + apply projT2. Qed. (** @@ -313,18 +324,20 @@ From this we can prove that if [F] has an nth order derivative in Lemma Derivative_I_n_imp_inc : forall n F F', Derivative_I_n Hab' n F F' -> included I (Dom F). -intros; apply Diffble_I_n_imp_inc with n. -apply deriv_n_imp_Diffble_I_n with F'; assumption. +Proof. + intros; apply Diffble_I_n_imp_inc with n. + apply deriv_n_imp_Diffble_I_n with F'; assumption. Qed. Lemma Derivative_I_n_imp_inc' : forall n F F', Derivative_I_n Hab' n F F' -> included I (Dom F'). -intro; induction n as [| n Hrecn]; intros F F' H. -simpl in |- *; simpl in H. -elim H; intros H0 H1; elim H1; auto. -elim H; intros f' H0 H1. -apply Hrecn with (PartInt f'). -assumption. +Proof. + intro; induction n as [| n Hrecn]; intros F F' H. + simpl in |- *; simpl in H. + elim H; intros H0 H1; elim H1; auto. + elim H; intros f' H0 H1. + apply Hrecn with (PartInt f'). + assumption. Qed. Section aux. @@ -341,39 +354,38 @@ Hypothesis diffFn : Diffble_I_n Hab' 1 F. Lemma deriv_1_deriv : Feq I (PartInt (ProjT1 diffF)) (PartInt (ProjT1 (Diffble_I_n_imp_deriv_n _ _ diffFn))). -intros. -simpl in |- *. -unfold I, Hab in |- *; apply Derivative_I_unique with F. -apply projT2. -cut - (Derivative_I_n Hab' 1 F - (PartInt (ProjT1 (Diffble_I_n_imp_deriv_n 1 F diffFn)))). -2: apply projT2. -intro H. -elim H; intros f' H0 H1. -apply Derivative_I_wdr with (PartInt f'); assumption. +Proof. + intros. + simpl in |- *. + unfold I, Hab in |- *; apply Derivative_I_unique with F. + apply projT2. + cut (Derivative_I_n Hab' 1 F (PartInt (ProjT1 (Diffble_I_n_imp_deriv_n 1 F diffFn)))). + 2: apply projT2. + intro H. + elim H; intros f' H0 H1. + apply Derivative_I_wdr with (PartInt f'); assumption. Qed. Lemma deriv_1_deriv' : forall (x : subset I), ProjT1 diffF x [=] ProjT1 (Diffble_I_n_imp_deriv_n _ _ diffFn) x. -intros. -elim deriv_1_deriv; intros H H1. -elim H1; intros H0 H2. -simpl in H2. clear H0 H1. -generalize - (H2 (scs_elem _ _ x) (scs_prf _ _ x) (scs_prf _ _ x) (scs_prf _ _ x)). -intro H0. -eapply eq_transitive_unfolded. -eapply eq_transitive_unfolded. -2: apply H0. -apply csf_wd_unfolded. -cut (scs_elem _ _ x [=] scs_elem _ _ x). -case x; simpl in |- *; auto. -algebra. -apply csf_wd_unfolded. -cut (scs_elem _ _ x [=] scs_elem _ _ x). -case x; simpl in |- *; auto. -algebra. +Proof. + intros. + elim deriv_1_deriv; intros H H1. + elim H1; intros H0 H2. + simpl in H2. clear H0 H1. + generalize (H2 (scs_elem _ _ x) (scs_prf _ _ x) (scs_prf _ _ x) (scs_prf _ _ x)). + intro H0. + eapply eq_transitive_unfolded. + eapply eq_transitive_unfolded. + 2: apply H0. + apply csf_wd_unfolded. + cut (scs_elem _ _ x [=] scs_elem _ _ x). + case x; simpl in |- *; auto. + algebra. + apply csf_wd_unfolded. + cut (scs_elem _ _ x [=] scs_elem _ _ x). + case x; simpl in |- *; auto. + algebra. Qed. End aux. @@ -385,35 +397,36 @@ As usual, nth order derivability is preserved by shrinking the interval. Lemma included_imp_deriv_n : forall n c d Hcd F F', included (Compact (less_leEq _ c d Hcd)) (Compact (less_leEq _ a b Hab')) -> Derivative_I_n Hab' n F F' -> Derivative_I_n Hcd n F F'. -intro; induction n as [| n Hrecn]; simpl in |- *; intros c d Hcd F F' H H0. -apply included_Feq with (Compact (less_leEq _ _ _ Hab')); auto. -elim H0; intros f' H1 H2. -exists - (IntPartIR (F:=(Frestr (F:=PartInt f') (compact_wd _ _ _) H)) (included_refl _ _)). -apply Derivative_I_wdr with (PartInt f'). -FEQ. -simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -apply included_imp_deriv with (Hab := Hab'); auto. -apply Derivative_I_n_wdl with (PartInt f'). -FEQ. -simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -auto. +Proof. + intro; induction n as [| n Hrecn]; simpl in |- *; intros c d Hcd F F' H H0. + apply included_Feq with (Compact (less_leEq _ _ _ Hab')); auto. + elim H0; intros f' H1 H2. + exists (IntPartIR (F:=(Frestr (F:=PartInt f') (compact_wd _ _ _) H)) (included_refl _ _)). + apply Derivative_I_wdr with (PartInt f'). + FEQ. + simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + apply included_imp_deriv with (Hab := Hab'); auto. + apply Derivative_I_n_wdl with (PartInt f'). + FEQ. + simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + auto. Qed. Lemma included_imp_diffble_n : forall n c d Hcd F, included (Compact (less_leEq _ c d Hcd)) (Compact (less_leEq _ a b Hab')) -> Diffble_I_n Hab' n F -> Diffble_I_n Hcd n F. -intro; induction n as [| n Hrecn]; simpl in |- *; intros c d Hcd F H H0. -apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included. -elim H0; intros f' HF. -exists (included_imp_diffble _ _ _ _ _ _ _ H f'). -apply Diffble_I_n_wd with (PartInt (ProjT1 f')). -apply Derivative_I_unique with F. -apply included_imp_deriv with (Hab := Hab'). -auto. -apply projT2. -apply projT2. -auto. +Proof. + intro; induction n as [| n Hrecn]; simpl in |- *; intros c d Hcd F H H0. + apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included. + elim H0; intros f' HF. + exists (included_imp_diffble _ _ _ _ _ _ _ H f'). + apply Diffble_I_n_wd with (PartInt (ProjT1 f')). + apply Derivative_I_unique with F. + apply included_imp_deriv with (Hab := Hab'). + auto. + apply projT2. + apply projT2. + auto. Qed. (** @@ -422,19 +435,20 @@ And finally we have an addition rule for the order of the derivative. Lemma Derivative_I_n_plus : forall n m k F G H, Derivative_I_n Hab' m F G -> Derivative_I_n Hab' n G H -> k = m + n -> Derivative_I_n Hab' k F H. -do 2 intro. -induction m as [| m Hrecm]; intros k F G H H0 H1 H2; rewrite H2. -simpl in |- *. -apply Derivative_I_n_wdl with G. -elim H0; clear H0; intros H3 H4. -elim H4; clear H4; intros H0 H5. -apply Derivative_I_n_unique with 0 G. -simpl in |- *; apply Feq_reflexive; auto. -simpl in |- *; FEQ; algebra. -auto. -elim H0; intros F' H3 H4. -exists F'; auto. -apply Hrecm with G; auto. +Proof. + do 2 intro. + induction m as [| m Hrecm]; intros k F G H H0 H1 H2; rewrite H2. + simpl in |- *. + apply Derivative_I_n_wdl with G. + elim H0; clear H0; intros H3 H4. + elim H4; clear H4; intros H0 H5. + apply Derivative_I_n_unique with 0 G. + simpl in |- *; apply Feq_reflexive; auto. + simpl in |- *; FEQ; algebra. + auto. + elim H0; intros F' H3 H4. + exists F'; auto. + apply Hrecm with G; auto. Qed. End Basic_Results. @@ -459,25 +473,26 @@ as an existential quantification of the nth derivative relation. *) Definition n_deriv_I n F (H : Diffble_I_n Hab' n F) : PartIR. -intro; induction n as [| n Hrecn]. -intros. -simpl in H. -apply (FRestr H). -intros F H. -cut (Diffble_I Hab' F). intro H0. -set (f' := ProjT1 H0) in *. -cut (Diffble_I_n Hab' n (PartInt f')). -intro H1. -apply (Hrecn _ H1). -cut (n = pred (S n)); [ intro | simpl in |- *; reflexivity ]. -rewrite H1. -apply Diffble_I_imp_le with F. -apply lt_O_Sn. -assumption. -unfold f' in |- *; apply projT2. -apply Diffble_I_n_imp_diffble with (S n). -apply lt_O_Sn. -assumption. +Proof. + intro; induction n as [| n Hrecn]. + intros. + simpl in H. + apply (FRestr H). + intros F H. + cut (Diffble_I Hab' F). intro H0. + set (f' := ProjT1 H0) in *. + cut (Diffble_I_n Hab' n (PartInt f')). + intro H1. + apply (Hrecn _ H1). + cut (n = pred (S n)); [ intro | simpl in |- *; reflexivity ]. + rewrite H1. + apply Diffble_I_imp_le with F. + apply lt_O_Sn. + assumption. + unfold f' in |- *; apply projT2. + apply Diffble_I_n_imp_diffble with (S n). + apply lt_O_Sn. + assumption. Defined. (** @@ -486,48 +501,52 @@ This operator is well defined and works as expected. Lemma n_deriv_I_wd : forall n F G Hf Hg, Feq I F G -> Feq I (n_deriv_I n F Hf) (n_deriv_I n G Hg). -intro; induction n as [| n Hrecn]; intros F G Hf Hg H. -elim H; clear H; intros H H0. -elim H0; clear H0; intros H2 H1. -unfold I in |- *; simpl in |- *; FEQ. -simpl in |- *; apply H1; auto. -simpl in |- *. -apply Hrecn. -unfold I, Hab in |- *; apply Derivative_I_unique with F. -apply projT2. -apply Derivative_I_wdl with G. -apply Feq_symmetric; assumption. -apply projT2. +Proof. + intro; induction n as [| n Hrecn]; intros F G Hf Hg H. + elim H; clear H; intros H H0. + elim H0; clear H0; intros H2 H1. + unfold I in |- *; simpl in |- *; FEQ. + simpl in |- *; apply H1; auto. + simpl in |- *. + apply Hrecn. + unfold I, Hab in |- *; apply Derivative_I_unique with F. + apply projT2. + apply Derivative_I_wdl with G. + apply Feq_symmetric; assumption. + apply projT2. Qed. Lemma n_deriv_lemma : forall n F H, Derivative_I_n Hab' n F (n_deriv_I n F H). -intro; induction n as [| n Hrecn]; intros. -simpl in |- *; simpl in H; FEQ. -elim H; intros Hf Hf'. -exists (ProjT1 Hf). -apply projT2. -simpl in |- *. -cut (Diffble_I_n Hab' n (PartInt (ProjT1 Hf))). intro H0. -apply Derivative_I_n_wdr with (n_deriv_I _ _ H0). -2: apply Hrecn. -apply n_deriv_I_wd. -unfold I, Hab in |- *; apply Derivative_I_unique with F. -apply projT2. -apply projT2. -elim H; intros. -eapply Diffble_I_n_wd. -2: apply p. -apply Derivative_I_unique with F; apply projT2. +Proof. + intro; induction n as [| n Hrecn]; intros. + simpl in |- *; simpl in H; FEQ. + elim H; intros Hf Hf'. + exists (ProjT1 Hf). + apply projT2. + simpl in |- *. + cut (Diffble_I_n Hab' n (PartInt (ProjT1 Hf))). intro H0. + apply Derivative_I_n_wdr with (n_deriv_I _ _ H0). + 2: apply Hrecn. + apply n_deriv_I_wd. + unfold I, Hab in |- *; apply Derivative_I_unique with F. + apply projT2. + apply projT2. + elim H; intros. + eapply Diffble_I_n_wd. + 2: apply p. + apply Derivative_I_unique with F; apply projT2. Qed. Lemma n_deriv_inc : forall n F H, included (Compact Hab) (Dom (n_deriv_I n F H)). -intros; simpl in |- *. -unfold I, Hab in |- *; apply Derivative_I_n_imp_inc' with n F. -apply n_deriv_lemma. +Proof. + intros; simpl in |- *. + unfold I, Hab in |- *; apply Derivative_I_n_imp_inc' with n F. + apply n_deriv_lemma. Qed. Lemma n_deriv_inc' : forall n Hab F H, included (Dom (n_deriv_I n F H)) (compact a b Hab). -intro; induction n as [| n Hrecn]; intros; simpl in |- *; Included. +Proof. + intro; induction n as [| n Hrecn]; intros; simpl in |- *; Included. Qed. (** @@ -536,87 +555,86 @@ Some basic properties of this operation. Lemma n_Sn_deriv : forall n F H HS, Derivative_I Hab' (n_deriv_I n F H) (n_deriv_I (S n) F HS). -intro; induction n as [| n Hrecn]. -intros. -apply Derivative_I_wdl with F. -FEQ. -apply - Derivative_I_wdr - with (PartInt (ProjT1 (Diffble_I_n_imp_diffble _ _ _ _ (lt_O_Sn 0) _ HS))). -apply eq_imp_Feq. -Included. -Included. -intros; simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -apply projT2. -intro. -cut {p : nat | p = S n}. -intro H; elim H; intros p H0. -pattern (S n) at 2 4 in |- *; rewrite <- H0. -intros. -elim H1; intros H0' H0''; clear H1. -elim HS; intros H1' H1''; clear HS. -cut (Diffble_I_n Hab' n (PartInt (ProjT1 H1'))). -intro H1'''. -apply Derivative_I_wdl with (n_deriv_I _ _ H1'''). -2: apply Derivative_I_wdr with (n_deriv_I _ _ H1''). -simpl in |- *; apply n_deriv_I_wd. -unfold I, Hab in |- *; apply Derivative_I_unique with F. -apply projT2. -apply projT2. -simpl in |- *; apply n_deriv_I_wd. -unfold I, Hab in |- *; apply Derivative_I_unique with F. -apply projT2. -apply projT2. -generalize H1''. -rewrite H0. -intro. -apply Hrecn. -generalize H1''; clear H1''. -rewrite H0; intro. -apply le_imp_Diffble_I with (S n); [ auto with arith | assumption ]. -exists (S n); auto. +Proof. + intro; induction n as [| n Hrecn]. + intros. + apply Derivative_I_wdl with F. + FEQ. + apply Derivative_I_wdr with (PartInt (ProjT1 (Diffble_I_n_imp_diffble _ _ _ _ (lt_O_Sn 0) _ HS))). + apply eq_imp_Feq. + Included. + Included. + intros; simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + apply projT2. + intro. + cut {p : nat | p = S n}. + intro H; elim H; intros p H0. + pattern (S n) at 2 4 in |- *; rewrite <- H0. + intros. + elim H1; intros H0' H0''; clear H1. + elim HS; intros H1' H1''; clear HS. + cut (Diffble_I_n Hab' n (PartInt (ProjT1 H1'))). + intro H1'''. + apply Derivative_I_wdl with (n_deriv_I _ _ H1'''). + 2: apply Derivative_I_wdr with (n_deriv_I _ _ H1''). + simpl in |- *; apply n_deriv_I_wd. + unfold I, Hab in |- *; apply Derivative_I_unique with F. + apply projT2. + apply projT2. + simpl in |- *; apply n_deriv_I_wd. + unfold I, Hab in |- *; apply Derivative_I_unique with F. + apply projT2. + apply projT2. + generalize H1''. + rewrite H0. + intro. + apply Hrecn. + generalize H1''; clear H1''. + rewrite H0; intro. + apply le_imp_Diffble_I with (S n); [ auto with arith | assumption ]. + exists (S n); auto. Qed. Lemma n_deriv_plus : forall m n F H H', Derivative_I_n Hab' m (n_deriv_I n F H) (n_deriv_I (m + n) F H'). -intro; induction m as [| m Hrecm]. -simpl in |- *. -intros. -apply n_deriv_I_wd. -unfold I in |- *; apply Feq_reflexive. -exact (Diffble_I_n_imp_inc _ _ _ _ _ H). -intros. -simpl in |- *. -cut (Diffble_I_n Hab' (S n) F). -intro H0. -exists (IntPartIR (n_deriv_inc _ _ H0)). -eapply Derivative_I_wdr. -2: apply n_Sn_deriv with (HS := H0). -FEQ. -apply n_deriv_inc. -cut - (Diffble_I_n Hab' (m + n) +Proof. + intro; induction m as [| m Hrecm]. + simpl in |- *. + intros. + apply n_deriv_I_wd. + unfold I in |- *; apply Feq_reflexive. + exact (Diffble_I_n_imp_inc _ _ _ _ _ H). + intros. + simpl in |- *. + cut (Diffble_I_n Hab' (S n) F). + intro H0. + exists (IntPartIR (n_deriv_inc _ _ H0)). + eapply Derivative_I_wdr. + 2: apply n_Sn_deriv with (HS := H0). + FEQ. + apply n_deriv_inc. + cut (Diffble_I_n Hab' (m + n) (PartInt (ProjT1 (Diffble_I_n_imp_diffble _ _ _ (S n) (lt_O_Sn n) F H0)))). -intro H1. -eapply Derivative_I_n_wdr. -2: eapply Derivative_I_n_wdl. -3: apply Hrecm with (H' := H1). -apply n_deriv_I_wd. -unfold I, Hab in |- *; apply Derivative_I_unique with F. -apply projT2. -apply projT2. -FEQ. -apply n_deriv_inc. -simpl in |- *; algebra. -elim H'; intros. -eapply Diffble_I_n_wd. -2: apply p. -apply Derivative_I_unique with F. -apply projT2. -apply projT2. -apply le_imp_Diffble_I with (S m + n). -simpl in |- *; rewrite plus_comm; auto with arith. -assumption. + intro H1. + eapply Derivative_I_n_wdr. + 2: eapply Derivative_I_n_wdl. + 3: apply Hrecm with (H' := H1). + apply n_deriv_I_wd. + unfold I, Hab in |- *; apply Derivative_I_unique with F. + apply projT2. + apply projT2. + FEQ. + apply n_deriv_inc. + simpl in |- *; algebra. + elim H'; intros. + eapply Diffble_I_n_wd. + 2: apply p. + apply Derivative_I_unique with F. + apply projT2. + apply projT2. + apply le_imp_Diffble_I with (S m + n). + simpl in |- *; rewrite plus_comm; auto with arith. + assumption. Qed. End More_Results. @@ -631,151 +649,145 @@ Lemma n_deriv_I_wd' : forall n a b Hab a' b' Hab' F H H' x y, x [=] y -> Compact (less_leEq _ _ _ Hab) x -> Compact (less_leEq _ _ _ Hab') y -> Diffble_I_n (Min_less_Max _ _ a' b' Hab) n F -> forall Hx Hy, n_deriv_I a b Hab n F H x Hx [=] n_deriv_I a' b' Hab' n F H' y Hy. -intros n a b Hab a' b' Hab' F H H' x y H0 H1 H2 H3 Hx Hy. -cut (included (Compact (less_leEq _ _ _ Hab)) (Dom (n_deriv_I _ _ _ _ _ H3))). -intro H4. -cut - (included (Compact (less_leEq _ _ _ Hab')) (Dom (n_deriv_I _ _ _ _ _ H3))). -intro H5. -apply eq_transitive_unfolded with (Part (FRestr H5) y H2). -apply eq_transitive_unfolded with (Part (FRestr H4) x H1). -apply Feq_imp_eq with (Compact (less_leEq _ _ _ Hab)). -apply Derivative_I_n_unique with n F. -apply n_deriv_lemma. -apply Derivative_I_n_wdr with (n_deriv_I _ _ _ _ _ H3). -FEQ. -apply included_imp_deriv_n with (Hab' := Min_less_Max a b a' b' Hab). -intros x0 H6. -elim H6; clear H6; intros H7 H8; split. -apply leEq_transitive with a. -apply Min_leEq_lft. -auto. -apply leEq_transitive with b. -auto. -apply lft_leEq_Max. -apply n_deriv_lemma. -auto. -simpl in |- *; algebra. -apply eq_symmetric_unfolded. -apply Feq_imp_eq with (Compact (less_leEq _ _ _ Hab')). -apply Derivative_I_n_unique with n F. -apply n_deriv_lemma. -apply Derivative_I_n_wdr with (n_deriv_I _ _ _ _ _ H3). -FEQ. -apply included_imp_deriv_n with (Hab' := Min_less_Max a b a' b' Hab). -intros x0 H6. -elim H6; clear H6; intros H7 H8; split. -apply leEq_transitive with a'. -apply Min_leEq_rht. -auto. -apply leEq_transitive with b'. -auto. -apply rht_leEq_Max. -apply n_deriv_lemma. -auto. -intros x0 H5. -apply n_deriv_inc. -elim H5; clear H5; intros H6 H7; split. -apply leEq_transitive with a'. -apply Min_leEq_rht. -auto. -apply leEq_transitive with b'. -auto. -apply rht_leEq_Max. -intros x0 H4. -apply n_deriv_inc. -elim H4; clear H4; intros H5 H6; split. -apply leEq_transitive with a. -apply Min_leEq_lft. -auto. -apply leEq_transitive with b. -auto. -apply lft_leEq_Max. +Proof. + intros n a b Hab a' b' Hab' F H H' x y H0 H1 H2 H3 Hx Hy. + cut (included (Compact (less_leEq _ _ _ Hab)) (Dom (n_deriv_I _ _ _ _ _ H3))). + intro H4. + cut (included (Compact (less_leEq _ _ _ Hab')) (Dom (n_deriv_I _ _ _ _ _ H3))). + intro H5. + apply eq_transitive_unfolded with (Part (FRestr H5) y H2). + apply eq_transitive_unfolded with (Part (FRestr H4) x H1). + apply Feq_imp_eq with (Compact (less_leEq _ _ _ Hab)). + apply Derivative_I_n_unique with n F. + apply n_deriv_lemma. + apply Derivative_I_n_wdr with (n_deriv_I _ _ _ _ _ H3). + FEQ. + apply included_imp_deriv_n with (Hab' := Min_less_Max a b a' b' Hab). + intros x0 H6. + elim H6; clear H6; intros H7 H8; split. + apply leEq_transitive with a. + apply Min_leEq_lft. + auto. + apply leEq_transitive with b. + auto. + apply lft_leEq_Max. + apply n_deriv_lemma. + auto. + simpl in |- *; algebra. + apply eq_symmetric_unfolded. + apply Feq_imp_eq with (Compact (less_leEq _ _ _ Hab')). + apply Derivative_I_n_unique with n F. + apply n_deriv_lemma. + apply Derivative_I_n_wdr with (n_deriv_I _ _ _ _ _ H3). + FEQ. + apply included_imp_deriv_n with (Hab' := Min_less_Max a b a' b' Hab). + intros x0 H6. + elim H6; clear H6; intros H7 H8; split. + apply leEq_transitive with a'. + apply Min_leEq_rht. + auto. + apply leEq_transitive with b'. + auto. + apply rht_leEq_Max. + apply n_deriv_lemma. + auto. + intros x0 H5. + apply n_deriv_inc. + elim H5; clear H5; intros H6 H7; split. + apply leEq_transitive with a'. + apply Min_leEq_rht. + auto. + apply leEq_transitive with b'. + auto. + apply rht_leEq_Max. + intros x0 H4. + apply n_deriv_inc. + elim H4; clear H4; intros H5 H6; split. + apply leEq_transitive with a. + apply Min_leEq_lft. + auto. + apply leEq_transitive with b. + auto. + apply lft_leEq_Max. Qed. Lemma n_deriv_I_wd'' : forall n a b Hab Hab' F H H' x y, x [=] y -> Compact (less_leEq _ _ _ Hab) x -> Compact (less_leEq _ _ _ Hab) y -> forall Hx Hy, n_deriv_I a b Hab n F H x Hx [=] n_deriv_I a b Hab' n F H' y Hy. -intros n a b Hab Hab' F H H' x y H0 H1 H2 Hx Hy. -apply n_deriv_I_wd'. -algebra. -auto. -auto. -apply included_imp_diffble_n with (Hab' := Hab). -2: auto. -intros x0 H3. -elim H3; clear H3; intros H4 H5; split. -eapply leEq_wdl. -apply H4. -apply Min_id. -eapply leEq_wdr. -apply H5. -apply Max_id. +Proof. + intros n a b Hab Hab' F H H' x y H0 H1 H2 Hx Hy. + apply n_deriv_I_wd'. + algebra. + auto. + auto. + apply included_imp_diffble_n with (Hab' := Hab). + 2: auto. + intros x0 H3. + elim H3; clear H3; intros H4 H5; split. + eapply leEq_wdl. + apply H4. + apply Min_id. + eapply leEq_wdr. + apply H5. + apply Max_id. Qed. Lemma n_deriv_I_strext' : forall n a b Hab a' b' Hab' F H H' x y, Compact (less_leEq _ _ _ Hab) x -> Compact (less_leEq _ _ _ Hab') y -> Diffble_I_n (Min_less_Max _ _ a' b' Hab) n F -> (forall Hx Hy, n_deriv_I a b Hab n F H x Hx [#] n_deriv_I a' b' Hab' n F H' y Hy) -> x [#] y. -intros n a b Hab a' b' Hab' F H H' x y H0 H1 H2 H3. -cut (Compact (less_leEq _ _ _ (Min_less_Max a b a' b' Hab)) x). intro H4. -cut (Compact (less_leEq _ _ _ (Min_less_Max a b a' b' Hab)) y). intro H5. -apply - pfstrx - with - (n_deriv_I _ _ _ _ _ H2) - (n_deriv_inc _ _ _ _ _ H2 _ H4) - (n_deriv_inc _ _ _ _ _ H2 _ H5). -apply - ap_wdr_unfolded - with (Part (n_deriv_I _ _ _ _ _ H') y (n_deriv_inc _ _ _ _ _ H' y H1)). -apply - ap_wdl_unfolded - with (Part (n_deriv_I _ _ _ _ _ H) x (n_deriv_inc _ _ _ _ _ H x H0)). -auto. -apply Feq_imp_eq with (Compact (less_leEq _ _ _ Hab)). -apply Derivative_I_n_unique with n F. -apply n_deriv_lemma. -apply included_imp_deriv_n with (Hab' := Min_less_Max a b a' b' Hab). -intros x0 H6. -elim H6; clear H6; intros H7 H8; split. -apply leEq_transitive with a. -apply Min_leEq_lft. -auto. -apply leEq_transitive with b. -auto. -apply lft_leEq_Max. -apply n_deriv_lemma. -auto. -apply Feq_imp_eq with (Compact (less_leEq _ _ _ Hab')). -apply Derivative_I_n_unique with n F. -apply n_deriv_lemma. -apply included_imp_deriv_n with (Hab' := Min_less_Max a b a' b' Hab). -intros x0 H6. -elim H6; clear H6; intros H7 H8; split. -apply leEq_transitive with a'. -apply Min_leEq_rht. -auto. -apply leEq_transitive with b'. -auto. -apply rht_leEq_Max. -apply n_deriv_lemma. -auto. -elim H1; clear H1; intros H7 H8; split. -apply leEq_transitive with a'. -apply Min_leEq_rht. -auto. -apply leEq_transitive with b'. -auto. -apply rht_leEq_Max. -red in |- *; intros. -inversion_clear H0; split. -apply leEq_transitive with a. -apply Min_leEq_lft. -auto. -apply leEq_transitive with b. -auto. -apply lft_leEq_Max. +Proof. + intros n a b Hab a' b' Hab' F H H' x y H0 H1 H2 H3. + cut (Compact (less_leEq _ _ _ (Min_less_Max a b a' b' Hab)) x). intro H4. + cut (Compact (less_leEq _ _ _ (Min_less_Max a b a' b' Hab)) y). intro H5. + apply pfstrx with (n_deriv_I _ _ _ _ _ H2) (n_deriv_inc _ _ _ _ _ H2 _ H4) + (n_deriv_inc _ _ _ _ _ H2 _ H5). + apply ap_wdr_unfolded with (Part (n_deriv_I _ _ _ _ _ H') y (n_deriv_inc _ _ _ _ _ H' y H1)). + apply ap_wdl_unfolded with (Part (n_deriv_I _ _ _ _ _ H) x (n_deriv_inc _ _ _ _ _ H x H0)). + auto. + apply Feq_imp_eq with (Compact (less_leEq _ _ _ Hab)). + apply Derivative_I_n_unique with n F. + apply n_deriv_lemma. + apply included_imp_deriv_n with (Hab' := Min_less_Max a b a' b' Hab). + intros x0 H6. + elim H6; clear H6; intros H7 H8; split. + apply leEq_transitive with a. + apply Min_leEq_lft. + auto. + apply leEq_transitive with b. + auto. + apply lft_leEq_Max. + apply n_deriv_lemma. + auto. + apply Feq_imp_eq with (Compact (less_leEq _ _ _ Hab')). + apply Derivative_I_n_unique with n F. + apply n_deriv_lemma. + apply included_imp_deriv_n with (Hab' := Min_less_Max a b a' b' Hab). + intros x0 H6. + elim H6; clear H6; intros H7 H8; split. + apply leEq_transitive with a'. + apply Min_leEq_rht. + auto. + apply leEq_transitive with b'. + auto. + apply rht_leEq_Max. + apply n_deriv_lemma. + auto. + elim H1; clear H1; intros H7 H8; split. + apply leEq_transitive with a'. + apply Min_leEq_rht. + auto. + apply leEq_transitive with b'. + auto. + apply rht_leEq_Max. + red in |- *; intros. + inversion_clear H0; split. + apply leEq_transitive with a. + apply Min_leEq_lft. + auto. + apply leEq_transitive with b. + auto. + apply lft_leEq_Max. Qed. End More_on_n_deriv. diff --git a/ftc/PartFunEquality.v b/ftc/PartFunEquality.v index fcfb6b304..7a607a91a 100644 --- a/ftc/PartFunEquality.v +++ b/ftc/PartFunEquality.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Feq %\ensuremath{\approx}% #≈# *) @@ -115,20 +115,23 @@ this definition: Lemma eq_imp_Feq : included I P -> included I Q -> (forall x, I x -> forall Hx Hx', F x Hx [=] G x Hx') -> Feq I F G. -intros. -split. -assumption. -split; assumption. +Proof. + intros. + split. + assumption. + split; assumption. Qed. Lemma Feq_imp_eq : Feq I F G -> forall x, I x -> forall Hx Hx', F x Hx [=] G x Hx'. -intros H x Hx1 Hx Hx'. -elim H; intros H0 H1. -elim H1; auto. +Proof. + intros H x Hx1 Hx Hx'. + elim H; intros H0 H1. + elim H1; auto. Qed. Lemma included_IR : included I (fun x : IR => CTrue). -split. +Proof. + split. Qed. End Equality_Results. @@ -142,18 +145,19 @@ If two function coincide on a given subset then they coincide in any smaller sub *) Lemma included_Feq : forall P Q F G, included P Q -> Feq Q F G -> Feq P F G. -intros P Q F G H H0. -elim H0; clear H0; intros H0 H1. -elim H1; clear H1; intros H1 H2. -apply eq_imp_Feq. -eapply included_trans. -apply H. -assumption. -eapply included_trans. -apply H. -assumption. -intros; apply H2. -apply H; assumption. +Proof. + intros P Q F G H H0. + elim H0; clear H0; intros H0 H1. + elim H1; clear H1; intros H1 H2. + apply eq_imp_Feq. + eapply included_trans. + apply H. + assumption. + eapply included_trans. + apply H. + assumption. + intros; apply H2. + apply H; assumption. Qed. End Some_More. @@ -193,32 +197,35 @@ Hypothesis Hf : bnd_away_zero. (* end show *) Lemma bnd_imp_ap_zero : forall x Hx, (I x) -> F x Hx [#] Zero. -intros. -apply AbsIR_cancel_ap_zero. -apply Greater_imp_ap. -elim Hf; intros. -inversion_clear b. -eapply less_leEq_trans; auto. -auto. +Proof. + intros. + apply AbsIR_cancel_ap_zero. + apply Greater_imp_ap. + elim Hf; intros. + inversion_clear b. + eapply less_leEq_trans; auto. + auto. Qed. Lemma bnd_imp_inc_recip : included I (Dom {1/}F). -intros x Hx. -elim Hf; intros H H0. -split. -apply (H x Hx). -intro. -apply bnd_imp_ap_zero; auto. +Proof. + intros x Hx. + elim Hf; intros H H0. + split. + apply (H x Hx). + intro. + apply bnd_imp_ap_zero; auto. Qed. Lemma bnd_imp_inc_div : forall G, included I (Dom G) -> included I (Dom (G{/}F)). -intros G HG x Hx. -split; auto. -elim Hf; intros H0 H1. -split. -apply (H0 x Hx). -intro. -apply bnd_imp_ap_zero; auto. +Proof. + intros G HG x Hx. + split; auto. + elim Hf; intros H0 H1. + split. + apply (H0 x Hx). + intro. + apply bnd_imp_ap_zero; auto. Qed. End Definitions. @@ -234,20 +241,22 @@ Variable F : PartIR. Variables P Q : IR -> CProp. Lemma included_imp_bnd : included Q P -> bnd_away_zero P F -> bnd_away_zero Q F. -intros H H0. -elim H0; clear H0; intros H1 H2; split. -apply included_trans with P; auto. -elim H2; intros c Hc Hc'. -exists c; auto. +Proof. + intros H H0. + elim H0; clear H0; intros H1 H2; split. + apply included_trans with P; auto. + elim H2; intros c Hc Hc'. + exists c; auto. Qed. Lemma FRestr_bnd : forall (HP : pred_wd _ P) (H : included P (Dom F)), included Q P -> bnd_away_zero Q F -> bnd_away_zero Q (Frestr HP H). -intros HP H H0 H1. -elim H1; clear H1; intros H2 H3; split. -auto. -elim H3; intro c; intros. -exists c; simpl in |- *; auto. +Proof. + intros HP H H0 H1. + elim H1; clear H1; intros H2 H3; split. + auto. + elim H3; intro c; intros. + exists c; simpl in |- *; auto. Qed. (** @@ -266,25 +275,27 @@ An immediate consequence: Lemma bnd_in_P_imp_ap_zero : pred_wd _ P -> bnd_away_zero_in_P -> forall x, P x -> forall Hx, F x Hx [#] Zero. -intros H H0 x H1 Hx. -apply bnd_imp_ap_zero with (Compact (leEq_reflexive _ x)). -apply H0. -red in |- *; intros x0 H2. -cut (x [=] x0); intros. -apply H with x; auto. -inversion_clear H2; apply leEq_imp_eq; auto. -split; apply leEq_reflexive. +Proof. + intros H H0 x H1 Hx. + apply bnd_imp_ap_zero with (Compact (leEq_reflexive _ x)). + apply H0. + red in |- *; intros x0 H2. + cut (x [=] x0); intros. + apply H with x; auto. + inversion_clear H2; apply leEq_imp_eq; auto. + split; apply leEq_reflexive. Qed. Lemma FRestr_bnd' : forall (HP : pred_wd _ P) (H : included P (Dom F)), bnd_away_zero_everywhere F -> bnd_away_zero_everywhere (Frestr HP H). -intros HP H H0 a b Hab H1. -elim (H0 a b Hab); intros. -split. -auto. -elim b0; intro c; intros. -exists c; simpl in |- *; auto. -apply included_trans with P; simpl in H1; auto. +Proof. + intros HP H H0 a b Hab H1. + elim (H0 a b Hab); intros. + split. + auto. + elim b0; intro c; intros. + exists c; simpl in |- *; auto. + apply included_trans with P; simpl in H1; auto. Qed. End Away_from_Zero. @@ -299,7 +310,7 @@ This tactic splits a goal of the form [Feq I F G] into the three subgoals and applies [Included] to the first two and [rational] to the third. *) -(* begin hide *) +(* begin hide *) Ltac FEQ := apply eq_imp_Feq; [ Included | Included | intros; try (simpl in |- *; rational) ]. (* end hide *) @@ -323,27 +334,30 @@ Section Feq_Equivalence. Variables F G H : PartIR. Lemma Feq_reflexive : included I (Dom F) -> Feq I F F. -intro; FEQ. +Proof. + intro; FEQ. Qed. Lemma Feq_symmetric : Feq I F G -> Feq I G F. -intro H0. -elim H0; intros H' H1. -elim H1; intros incF incG. -FEQ; algebra. +Proof. + intro H0. + elim H0; intros H' H1. + elim H1; intros incF incG. + FEQ; algebra. Qed. Lemma Feq_transitive : Feq I F G -> Feq I G H -> Feq I F H. -intro H0. -elim H0; intros incF H'. -elim H'; intros incG H1. -clear H0 H'. -intro H0. -elim H0; intros incG' H'. -elim H'; intros incH H2. -clear H0 H'. -FEQ. -Step_final (G x (incG x X)). +Proof. + intro H0. + elim H0; intros incF H'. + elim H'; intros incG H1. + clear H0 H'. + intro H0. + elim H0; intros incG' H'. + elim H'; intros incH H2. + clear H0 H'. + FEQ. + Step_final (G x (incG x X)). Qed. End Feq_Equivalence. @@ -357,111 +371,120 @@ Also it is preserved through application of functional constructors and restrict Variables F F' G G' : PartIR. Lemma Feq_plus : Feq I F F' -> Feq I G G' -> Feq I (F{+}G) (F'{+}G'). -intros H0 H1. -elim H0; intros incF H0'. -elim H0'; clear H0 H0'; intros incG H2. -elim H1; intros incF' H1'. -elim H1'; clear H1 H1'; intros incG' H1. -FEQ; simpl in |- *; algebra. +Proof. + intros H0 H1. + elim H0; intros incF H0'. + elim H0'; clear H0 H0'; intros incG H2. + elim H1; intros incF' H1'. + elim H1'; clear H1 H1'; intros incG' H1. + FEQ; simpl in |- *; algebra. Qed. Lemma Feq_inv : Feq I F F' -> Feq I {--}F {--}F'. -intro H0. -elim H0; intros incF H0'. -elim H0'; clear H0 H0'; intros incF' H1. -FEQ; simpl in |- *; algebra. +Proof. + intro H0. + elim H0; intros incF H0'. + elim H0'; clear H0 H0'; intros incF' H1. + FEQ; simpl in |- *; algebra. Qed. Lemma Feq_minus : Feq I F F' -> Feq I G G' -> Feq I (F{-}G) (F'{-}G'). -intros H0 H1. -elim H0; intros incF H0'. -elim H0'; clear H0 H0'; intros incG H2. -elim H1; intros incF' H1'. -elim H1'; clear H1 H1'; intros incG' H0. -FEQ; simpl in |- *; algebra. +Proof. + intros H0 H1. + elim H0; intros incF H0'. + elim H0'; clear H0 H0'; intros incG H2. + elim H1; intros incF' H1'. + elim H1'; clear H1 H1'; intros incG' H0. + FEQ; simpl in |- *; algebra. Qed. Lemma Feq_mult : Feq I F F' -> Feq I G G' -> Feq I (F{*}G) (F'{*}G'). -intros H0 H1. -elim H0; intros incF H0'. -elim H0'; clear H0 H0'; intros incG H2. -elim H1; intros incF' H1'. -elim H1'; clear H1 H1'; intros incG' H0. -FEQ; simpl in |- *; algebra. +Proof. + intros H0 H1. + elim H0; intros incF H0'. + elim H0'; clear H0 H0'; intros incG H2. + elim H1; intros incF' H1'. + elim H1'; clear H1 H1'; intros incG' H0. + FEQ; simpl in |- *; algebra. Qed. Lemma Feq_nth : forall n : nat, Feq I F F' -> Feq I (F{^}n) (F'{^}n). -intros n H0. -elim H0; intros incF H0'. -elim H0'; clear H0 H0'; intros incF' H1. -FEQ. -astepl (F x Hx[^]n); Step_final (Part F' x Hx'[^]n). +Proof. + intros n H0. + elim H0; intros incF H0'. + elim H0'; clear H0 H0'; intros incF' H1. + FEQ. + astepl (F x Hx[^]n); Step_final (Part F' x Hx'[^]n). Qed. Lemma Feq_recip : bnd_away_zero I F -> Feq I F F' -> Feq I {1/}F {1/}F'. -intros Hbnd H0. -elim H0; intros incF H0'. -elim H0'; clear H0 H0'; intros incF' H1. -FEQ. -apply included_FRecip. -auto. -intros x H Hx; apply ap_wdl_unfolded with (F x (incF x H)). -apply bnd_imp_ap_zero with I; assumption. -auto. -simpl in |- *; algebra. +Proof. + intros Hbnd H0. + elim H0; intros incF H0'. + elim H0'; clear H0 H0'; intros incF' H1. + FEQ. + apply included_FRecip. + auto. + intros x H Hx; apply ap_wdl_unfolded with (F x (incF x H)). + apply bnd_imp_ap_zero with I; assumption. + auto. + simpl in |- *; algebra. Qed. Lemma Feq_recip' : bnd_away_zero I F -> Feq I F' F -> Feq I {1/}F' {1/}F. -intros. -apply Feq_symmetric; apply Feq_recip. -assumption. -apply Feq_symmetric; assumption. +Proof. + intros. + apply Feq_symmetric; apply Feq_recip. + assumption. + apply Feq_symmetric; assumption. Qed. Lemma Feq_div : bnd_away_zero I G -> Feq I F F' -> Feq I G G' -> Feq I (F{/}G) (F'{/}G'). -intros Hbnd H0 H1. -elim H0; intros incF H0'. -elim H0'; clear H0 H0'; intros incF' H2. -elim H1; intros incG H1'. -elim H1'; clear H1 H1'; intros incG' H0. -FEQ. -apply included_FDiv; auto. -intros x H Hx; apply ap_wdl_unfolded with (G x (incG x H)). -apply bnd_imp_ap_zero with I; assumption. -auto. -simpl in |- *; algebra. +Proof. + intros Hbnd H0 H1. + elim H0; intros incF H0'. + elim H0'; clear H0 H0'; intros incF' H2. + elim H1; intros incG H1'. + elim H1'; clear H1 H1'; intros incG' H0. + FEQ. + apply included_FDiv; auto. + intros x H Hx; apply ap_wdl_unfolded with (G x (incG x H)). + apply bnd_imp_ap_zero with I; assumption. + auto. + simpl in |- *; algebra. Qed. Lemma Feq_div' : bnd_away_zero I G -> Feq I F' F -> Feq I G' G -> Feq I (F'{/}G') (F{/}G). -intros. -apply Feq_symmetric; apply Feq_div. -assumption. -apply Feq_symmetric; assumption. -apply Feq_symmetric; assumption. +Proof. + intros. + apply Feq_symmetric; apply Feq_div. + assumption. + apply Feq_symmetric; assumption. + apply Feq_symmetric; assumption. Qed. Lemma Feq_comp : forall (J : IR -> CProp), (forall x Hx, I x -> J (F x Hx)) -> (forall x Hx, I x -> J (F' x Hx)) -> Feq I F F' -> Feq J G G' -> Feq I (G[o]F) (G'[o]F'). Proof. -intros J Hmap Hmap' [HF0 [HF1 HF2]] [HG0 [HG1 HG2]]. -repeat split; try (apply included_FComp; Included). -intros x Habx [Hx0 Hx1] [Hx'0 Hx'1]. -simpl. -assert (F x Hx0[=]F' x Hx'0). -apply HF2. -Included. -assert (X:Dom G' (F x Hx0)). -eapply dom_wd. - apply Hx'1. - apply eq_symmetric; assumption. -apply eq_transitive with (G' (F x Hx0) X). -apply HG2. -Included. -apply pfwdef. -assumption. + intros J Hmap Hmap' [HF0 [HF1 HF2]] [HG0 [HG1 HG2]]. + repeat split; try (apply included_FComp; Included). + intros x Habx [Hx0 Hx1] [Hx'0 Hx'1]. + simpl. + assert (F x Hx0[=]F' x Hx'0). + apply HF2. + Included. + assert (X:Dom G' (F x Hx0)). + eapply dom_wd. + apply Hx'1. + apply eq_symmetric; assumption. + apply eq_transitive with (G' (F x Hx0) X). + apply HG2. + Included. + apply pfwdef. + assumption. Qed. (** @@ -471,8 +494,9 @@ The restriction of a function is well defined. *) Lemma FRestr_wd : forall Iwd Hinc, Feq I F (Frestr (F:=F) (P:=I) Iwd Hinc). -intros. -FEQ. +Proof. + intros. + FEQ. Qed. (** @@ -480,16 +504,17 @@ The image of a set is extensional. *) Lemma fun_image_wd : Feq I F G -> forall x, fun_image F I x -> fun_image G I x. -intros H x H0. -elim H; clear H; intros H H1. -elim H1; clear H1; intros H2 H3. -elim H0; intros y Hy. -exists y. -elim Hy; intros H4 H1. -elim H1; clear Hy H1; intros H5 H6. -split; auto. -split; auto. -intro; Step_final (F y H5). +Proof. + intros H x H0. + elim H; clear H; intros H H1. + elim H1; clear H1; intros H2 H3. + elim H0; intros y Hy. + exists y. + elim Hy; intros H4 H1. + elim H1; clear Hy H1; intros H5 H6. + split; auto. + split; auto. + intro; Step_final (F y H5). Qed. End Operations. @@ -521,22 +546,24 @@ Hypothesis H : included Q (fun x : IR => CTrue). Hypothesis Hf : included Q (Dom F). Lemma FNth_zero : forall x, Q x -> forall Hx Hx', [-C-]One x Hx [=] (F{^}0) x Hx'. -intros. -algebra. +Proof. + intros. + algebra. Qed. Variable n : nat. Hypothesis H' : included Q (Dom (F{*}F{^}n)). Lemma FNth_mult : forall x, Q x -> forall Hx Hx', (F{*}F{^}n) x Hx [=] (F{^}S n) x Hx'. -intros. -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply mult_commutes. -apply mult_wd. -rational. -change (F x (ProjIR2 Hx) [^]n [=] F x Hx'[^]n) in |- *. -apply nexp_wd; rational. +Proof. + intros. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply mult_commutes. + apply mult_wd. + rational. + change (F x (ProjIR2 Hx) [^]n [=] F x Hx'[^]n) in |- *. + apply nexp_wd; rational. Qed. End Nth_Power. @@ -559,18 +586,20 @@ Variable F : PartIR. Hypothesis incF : included I (Dom F). Lemma FNth_zero' : Feq I [-C-]One (F{^}0). -FEQ. +Proof. + FEQ. Qed. Lemma FNth_mult' : forall n, Feq I (F{*}F{^}n) (F{^}S n). -intro; FEQ. -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply mult_commutes. -apply bin_op_wd_unfolded. -rational. -change (F x (ProjIR2 Hx) [^]n [=] F x Hx'[^]n) in |- *. -apply nexp_wd; rational. +Proof. + intro; FEQ. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply mult_commutes. + apply bin_op_wd_unfolded. + rational. + change (F x (ProjIR2 Hx) [^]n [=] F x Hx'[^]n) in |- *. + apply nexp_wd; rational. Qed. End Strong_Nth_Power. diff --git a/ftc/PartInterval.v b/ftc/PartInterval.v index 70e666ca5..2b39f14cf 100644 --- a/ftc/PartInterval.v +++ b/ftc/PartInterval.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export IntervalFunct. @@ -69,18 +69,17 @@ Hypothesis Hf : included I (Dom F). Lemma IntPartIR_strext : fun_strext (fun x : subset I => F (scs_elem _ _ x) (Hf _ (scs_prf _ _ x))). -red in |- *; intros x y H. -generalize (pfstrx _ _ _ _ _ _ H). -case x; case y; auto. +Proof. + red in |- *; intros x y H. + generalize (pfstrx _ _ _ _ _ _ H). + case x; case y; auto. Qed. Definition IntPartIR : CSetoid_fun (subset I) IR. -apply - Build_CSetoid_fun - with - (fun x : subset I => - Part F (scs_elem _ _ x) (Hf (scs_elem _ _ x) (scs_prf _ _ x))). -exact IntPartIR_strext. +Proof. + apply Build_CSetoid_fun with (fun x : subset I => + Part F (scs_elem _ _ x) (Hf (scs_elem _ _ x) (scs_prf _ _ x))). + exact IntPartIR_strext. Defined. End Conversion. @@ -104,16 +103,16 @@ Variable f : CSetoid_fun (subset I) IR. Lemma PartInt_strext : forall x y Hx Hy, f (Build_subcsetoid_crr IR _ x Hx) [#] f (Build_subcsetoid_crr IR _ y Hy) -> x [#] y. -intros x y Hx Hy H. -exact (csf_strext_unfolded _ _ _ _ _ H). +Proof. + intros x y Hx Hy H. + exact (csf_strext_unfolded _ _ _ _ _ H). Qed. Definition PartInt : PartIR. -apply - Build_PartFunct - with (pfpfun := fun (x : IR) Hx => f (Build_subcsetoid_crr IR _ x Hx)). -exact (compact_wd _ _ _). -exact PartInt_strext. + apply Build_PartFunct with (pfpfun := fun (x : IR) Hx => f (Build_subcsetoid_crr IR _ x Hx)). +Proof. + exact (compact_wd _ _ _). + exact PartInt_strext. Defined. End AntiConversion. @@ -128,7 +127,8 @@ In one direction these operators are inverses. Lemma int_part_int : forall a b Hab F (Hf : included (compact a b Hab) (Dom F)), Feq (compact a b Hab) F (PartInt (IntPartIR Hf)). -intros; FEQ. +Proof. + intros; FEQ. Qed. End Inverses. @@ -160,75 +160,82 @@ Hypothesis Ff : Feq I F (PartInt f). Hypothesis Gg : Feq I G (PartInt g). Lemma part_int_const : Feq I [-C-]c (PartInt (IConst (Hab:=Hab) c)). -apply eq_imp_Feq. -red in |- *; simpl in |- *; intros; auto. -unfold I in |- *; apply included_refl. -intros; simpl in |- *; algebra. +Proof. + apply eq_imp_Feq. + red in |- *; simpl in |- *; intros; auto. + unfold I in |- *; apply included_refl. + intros; simpl in |- *; algebra. Qed. Lemma part_int_id : Feq I FId (PartInt (IId (Hab:=Hab))). -apply eq_imp_Feq. -red in |- *; simpl in |- *; intros; auto. -unfold I in |- *; apply included_refl. -intros; simpl in |- *; algebra. +Proof. + apply eq_imp_Feq. + red in |- *; simpl in |- *; intros; auto. + unfold I in |- *; apply included_refl. + intros; simpl in |- *; algebra. Qed. Lemma part_int_plus : Feq I (F{+}G) (PartInt (IPlus f g)). -elim Ff; intros incF Hf. -elim Hf; clear Ff Hf; intros incF' Hf. -elim Gg; intros incG Hg. -elim Hg; clear Gg Hg; intros incG' Hg. -apply eq_imp_Feq. -Included. -Included. -intros; simpl in |- *; simpl in Hf, Hg. -simpl in |- *; algebra. +Proof. + elim Ff; intros incF Hf. + elim Hf; clear Ff Hf; intros incF' Hf. + elim Gg; intros incG Hg. + elim Hg; clear Gg Hg; intros incG' Hg. + apply eq_imp_Feq. + Included. + Included. + intros; simpl in |- *; simpl in Hf, Hg. + simpl in |- *; algebra. Qed. Lemma part_int_inv : Feq I {--}F (PartInt (IInv f)). -elim Ff; intros incF Hf. -elim Hf; clear Ff Hf; intros incF' Hf. -apply eq_imp_Feq. -Included. -Included. -intros; simpl in |- *; simpl in Hf. -simpl in |- *; algebra. +Proof. + elim Ff; intros incF Hf. + elim Hf; clear Ff Hf; intros incF' Hf. + apply eq_imp_Feq. + Included. + Included. + intros; simpl in |- *; simpl in Hf. + simpl in |- *; algebra. Qed. Lemma part_int_minus : Feq I (F{-}G) (PartInt (IMinus f g)). -elim Ff; intros incF Hf. -elim Hf; clear Ff Hf; intros incF' Hf. -elim Gg; intros incG Hg. -elim Hg; clear Gg Hg; intros incG' Hg. -apply eq_imp_Feq. -Included. -Included. -intros; simpl in |- *; simpl in Hf, Hg. -simpl in |- *; algebra. +Proof. + elim Ff; intros incF Hf. + elim Hf; clear Ff Hf; intros incF' Hf. + elim Gg; intros incG Hg. + elim Hg; clear Gg Hg; intros incG' Hg. + apply eq_imp_Feq. + Included. + Included. + intros; simpl in |- *; simpl in Hf, Hg. + simpl in |- *; algebra. Qed. Lemma part_int_mult : Feq I (F{*}G) (PartInt (IMult f g)). -elim Ff; intros incF Hf. -elim Hf; clear Ff Hf; intros incF' Hf. -elim Gg; intros incG Hg. -elim Hg; clear Gg Hg; intros incG' Hg. -apply eq_imp_Feq. -Included. -Included. -intros; simpl in |- *; simpl in Hf, Hg. -simpl in |- *; algebra. +Proof. + elim Ff; intros incF Hf. + elim Hf; clear Ff Hf; intros incF' Hf. + elim Gg; intros incG Hg. + elim Hg; clear Gg Hg; intros incG' Hg. + apply eq_imp_Feq. + Included. + Included. + intros; simpl in |- *; simpl in Hf, Hg. + simpl in |- *; algebra. Qed. Lemma part_int_nth : forall n : nat, Feq I (F{^}n) (PartInt (INth f n)). -intro. -elim Ff; intros incF Hf. -elim Hf; clear Ff Hf; intros incF' Hf. -apply eq_imp_Feq. -Included. -Included. -intros; simpl in |- *; simpl in Hf. -astepl (Part F x Hx[^]n); astepr (f (Build_subcsetoid_crr IR _ x Hx')[^]n). -apply nexp_wd; algebra. +Proof. + intro. + elim Ff; intros incF Hf. + elim Hf; clear Ff Hf; intros incF' Hf. + apply eq_imp_Feq. + Included. + Included. + intros; simpl in |- *; simpl in Hf. + astepl (Part F x Hx[^]n); astepr (f (Build_subcsetoid_crr IR _ x Hx')[^]n). + apply nexp_wd; algebra. Qed. (* begin show *) @@ -237,24 +244,26 @@ Hypothesis Hg : forall x : subset I, g x [#] Zero. (* end show *) Lemma part_int_recip : Feq I {1/}G (PartInt (IRecip g Hg)). -elim Gg; intros incG Hg'. -elim Hg'; clear Gg Hg'; intros incG' Hg'. -apply eq_imp_Feq. -Included. -Included. -intros; simpl in Hg'; simpl in |- *; algebra. +Proof. + elim Gg; intros incG Hg'. + elim Hg'; clear Gg Hg'; intros incG' Hg'. + apply eq_imp_Feq. + Included. + Included. + intros; simpl in Hg'; simpl in |- *; algebra. Qed. Lemma part_int_div : Feq I (F{/}G) (PartInt (IDiv f g Hg)). -elim Ff; intros incF Hf. -elim Hf; clear Ff Hf; intros incF' Hf. -elim Gg; intros incG Hg'. -elim Hg'; clear Gg Hg'; intros incG' Hg'. -apply eq_imp_Feq. -Included. -Included. -intros; simpl in Hf, Hg'; simpl in |- *. -algebra. +Proof. + elim Ff; intros incF Hf. + elim Hf; clear Ff Hf; intros incF' Hf. + elim Gg; intros incG Hg'. + elim Hg'; clear Gg Hg'; intros incG' Hg'. + apply eq_imp_Feq. + Included. + Included. + intros; simpl in Hf, Hg'; simpl in |- *. + algebra. Qed. End Equivalences. diff --git a/ftc/Partitions.v b/ftc/Partitions.v index 265ae1532..29624ea7e 100644 --- a/ftc/Partitions.v +++ b/ftc/Partitions.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Continuity. @@ -63,7 +63,7 @@ coercion); *) -Record Partition (a b : IR) (Hab : a [<=] b) (lng : nat) : Type := +Record Partition (a b : IR) (Hab : a [<=] b) (lng : nat) : Type := {Pts :> forall i, i <= lng -> IR; prf1 : forall i j, i = j -> forall Hi Hj, Pts i Hi [=] Pts j Hj; prf2 : forall i Hi HSi, Pts i Hi [<=] Pts (S i) HSi; @@ -76,27 +76,29 @@ Record Partition (a b : IR) (Hab : a [<=] b) (lng : nat) : Type := Lemma Partition_mon : forall a b Hab lng (P : Partition a b Hab lng) i j Hi Hj, i <= j -> P i Hi [<=] P j Hj. -intros; induction j as [| j Hrecj]. -cut (i = 0); [ intro | auto with arith ]. -apply eq_imp_leEq; apply prf1; auto. -elim (le_lt_eq_dec _ _ H); intro H1. -cut (j <= lng); [ intro | clear Hrecj; omega ]. -apply leEq_transitive with (Pts _ _ _ _ P j H0). -apply Hrecj; clear Hrecj; auto with arith. -apply prf2. -apply eq_imp_leEq; apply prf1; assumption. +Proof. + intros; induction j as [| j Hrecj]. + cut (i = 0); [ intro | auto with arith ]. + apply eq_imp_leEq; apply prf1; auto. + elim (le_lt_eq_dec _ _ H); intro H1. + cut (j <= lng); [ intro | clear Hrecj; omega ]. + apply leEq_transitive with (Pts _ _ _ _ P j H0). + apply Hrecj; clear Hrecj; auto with arith. + apply prf2. + apply eq_imp_leEq; apply prf1; assumption. Qed. Lemma Partition_in_compact : forall a b Hab lng (P : Partition a b Hab lng) i Hi, compact a b Hab (P i Hi). -intros. -split. -apply leEq_wdl with (P _ (le_O_n _)). -apply Partition_mon; auto with arith. -apply start. -apply leEq_wdr with (P _ (le_n _)). -apply Partition_mon; auto with arith. -apply finish. +Proof. + intros. + split. + apply leEq_wdl with (P _ (le_O_n _)). + apply Partition_mon; auto with arith. + apply start. + apply leEq_wdr with (P _ (le_n _)). + apply Partition_mon; auto with arith. + apply finish. Qed. (** @@ -107,20 +109,22 @@ define it. *) Lemma part_pred_lemma : forall a b Hab lng (P : Partition a b Hab lng) i Hi, a [<=] P i Hi. -intros. -apply leEq_wdl with (P 0 (le_O_n _)). -apply Partition_mon; auto with arith. -apply start. +Proof. + intros. + apply leEq_wdl with (P 0 (le_O_n _)). + apply Partition_mon; auto with arith. + apply start. Qed. Definition Partition_Dom a b Hab n P : Partition a _ (part_pred_lemma a b Hab (S n) P n (le_n_Sn n)) n. -intros. -apply Build_Partition with (fun (i : nat) (Hi : i <= n) => P i (le_S _ _ Hi)). -intros; simpl in |- *; apply prf1; assumption. -intros; simpl in |- *; apply prf2. -intros; simpl in |- *; apply start. -intros; simpl in |- *; apply prf1; auto. +Proof. + intros. + apply Build_Partition with (fun (i : nat) (Hi : i <= n) => P i (le_S _ _ Hi)). + intros; simpl in |- *; apply prf1; assumption. + intros; simpl in |- *; apply prf2. + intros; simpl in |- *; apply start. + intros; simpl in |- *; apply prf1; auto. Defined. (** @@ -136,13 +140,13 @@ helps us in this case. *) Definition Part_Mesh_List n a b Hab (P : Partition a b Hab n) : list IR. -intro; induction n as [| n Hrecn]; intros. -apply (@nil IR). -apply cons. -apply (P _ (le_n (S n)) [-]P _ (le_S _ _ (le_n n))). -apply - Hrecn with a (P _ (le_n_Sn n)) (part_pred_lemma _ _ _ _ P n (le_n_Sn n)). -apply Partition_Dom. +Proof. + intro; induction n as [| n Hrecn]; intros. + apply (@nil IR). + apply cons. + apply (P _ (le_n (S n)) [-]P _ (le_S _ _ (le_n n))). + apply Hrecn with a (P _ (le_n_Sn n)) (part_pred_lemma _ _ _ _ P n (le_n_Sn n)). + apply Partition_Dom. Defined. Definition Mesh a b Hab n P := maxlist (Part_Mesh_List n a b Hab P). @@ -156,33 +160,33 @@ presented simply to make the definition of even partition lighter. *) Lemma even_part_1 : forall a b n Hn, a[+]nring 0[*] (b[-]a[/] _[//]nring_ap_zero' IR n Hn) [=] a. -intros; rational. +Proof. + intros; rational. Qed. Lemma even_part_2 : forall a b n Hn, a[+]nring n[*] (b[-]a[/] _[//]nring_ap_zero' IR n Hn) [=] b. -intros; rational. +Proof. + intros; rational. Qed. Definition Even_Partition a b Hab n (Hn : 0 <> n) : Partition a b Hab n. -intros. -apply - Build_Partition - with - (fun (i : nat) (Hi : i <= n) => - a[+]nring i[*] (b[-]a[/] _[//]nring_ap_zero' _ n Hn)). -intros; simpl in |- *. -rewrite H; algebra. -intros; simpl in |- *. -apply plus_resp_leEq_lft. -apply mult_resp_leEq_rht. -apply less_leEq; apply less_plusOne. -apply shift_leEq_div. -apply nring_pos; clear Hi; apply neq_O_lt; auto. -apply shift_leEq_minus. -astepl (Zero[+]a). -astepl a; assumption. -intros; simpl in |- *; apply even_part_1; auto. -intros; simpl in |- *; apply even_part_2; auto. +Proof. + intros. + apply Build_Partition with (fun (i : nat) (Hi : i <= n) => + a[+]nring i[*] (b[-]a[/] _[//]nring_ap_zero' _ n Hn)). + intros; simpl in |- *. + rewrite H; algebra. + intros; simpl in |- *. + apply plus_resp_leEq_lft. + apply mult_resp_leEq_rht. + apply less_leEq; apply less_plusOne. + apply shift_leEq_div. + apply nring_pos; clear Hi; apply neq_O_lt; auto. + apply shift_leEq_minus. + astepl (Zero[+]a). + astepl a; assumption. + intros; simpl in |- *; apply even_part_1; auto. + intros; simpl in |- *; apply even_part_2; auto. Defined. Section Refinements. @@ -204,47 +208,48 @@ Definition Refinement := {f : nat -> nat | Lemma Refinement_prop : Refinement -> forall i (Hi : i <= m) (HSi : (S i) <= m), {j : nat | {Hj : j <= n | {HSj : S j <= n | P _ Hj [<=] Q _ Hi | Q _ HSi [<=] P _ HSj}}}. -intros H i Hi Hi'. -elim H; clear H; intros f Hf. -elim Hf; clear Hf; intros Hf0 Hf. -elim Hf; clear Hf; intros Hfn Hfmon. -intro Hf. -cut {j : nat | f j <= i | S i <= f (S j)}. -intro H. -elim H; clear H; intros j Hj Hj'. -exists j. -cut (j < n). -intro. -cut (j <= n); [ intro Hj1 | auto with arith ]. -exists Hj1. -elim (Hf j Hj1); intros H' HPts. -cut (S j <= n); [ intro Hj2 | apply H ]. -elim (Hf (S j) Hj2); intros H'' HPts'. -exists Hj2. -eapply leEq_wdl. -2: eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply HPts. -apply Partition_mon; assumption. -apply prf1; auto. -eapply leEq_wdr. -2: eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply HPts'. -apply Partition_mon; assumption. -apply prf1; auto. -clear Hj' Hf Hf0. -cut (i < f n). -intro. -cut (f j < f n); [ intro | apply le_lt_trans with i; auto ]. -apply not_ge. -intro; red in H1. -apply (le_not_lt (f j) (f n)); auto with arith. -apply Hfmon. -elim (le_lt_eq_dec _ _ H1); intro; auto. -rewrite b0 in H0; elim (lt_irrefl (f j)); auto. -rewrite <- Hfn in Hi'; auto. -apply mon_fun_covers; auto. -exists n; clear Hf Hfmon. -rewrite Hfn; assumption. +Proof. + intros H i Hi Hi'. + elim H; clear H; intros f Hf. + elim Hf; clear Hf; intros Hf0 Hf. + elim Hf; clear Hf; intros Hfn Hfmon. + intro Hf. + cut {j : nat | f j <= i | S i <= f (S j)}. + intro H. + elim H; clear H; intros j Hj Hj'. + exists j. + cut (j < n). + intro. + cut (j <= n); [ intro Hj1 | auto with arith ]. + exists Hj1. + elim (Hf j Hj1); intros H' HPts. + cut (S j <= n); [ intro Hj2 | apply H ]. + elim (Hf (S j) Hj2); intros H'' HPts'. + exists Hj2. + eapply leEq_wdl. + 2: eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply HPts. + apply Partition_mon; assumption. + apply prf1; auto. + eapply leEq_wdr. + 2: eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply HPts'. + apply Partition_mon; assumption. + apply prf1; auto. + clear Hj' Hf Hf0. + cut (i < f n). + intro. + cut (f j < f n); [ intro | apply le_lt_trans with i; auto ]. + apply not_ge. + intro; red in H1. + apply (le_not_lt (f j) (f n)); auto with arith. + apply Hfmon. + elim (le_lt_eq_dec _ _ H1); intro; auto. + rewrite b0 in H0; elim (lt_irrefl (f j)); auto. + rewrite <- Hfn in Hi'; auto. + apply mon_fun_covers; auto. + exists n; clear Hf Hfmon. + rewrite Hfn; assumption. Qed. (** @@ -260,19 +265,20 @@ Definition Points_in_Partition (g : forall i, i < n -> IR) : CProp := forall i Hi, Compact (prf2 _ _ _ _ P i (lt_le_weak _ _ Hi) Hi) (g i Hi). Lemma Pts_part_lemma : forall g, Points_in_Partition g -> forall i Hi, compact a b Hab (g i Hi). -intros g H i H0. -elim (H i H0); intros. -split. -eapply leEq_transitive. -2: apply a0. -apply leEq_wdl with (P 0 (le_O_n _)). -apply Partition_mon; auto with arith. -apply start. -eapply leEq_transitive. -apply b0. -apply leEq_wdr with (P n (le_n _)). -apply Partition_mon; auto with arith. -apply finish. +Proof. + intros g H i H0. + elim (H i H0); intros. + split. + eapply leEq_transitive. + 2: apply a0. + apply leEq_wdl with (P 0 (le_O_n _)). + apply Partition_mon; auto with arith. + apply start. + eapply leEq_transitive. + apply b0. + apply leEq_wdr with (P n (le_n _)). + apply Partition_mon; auto with arith. + apply finish. Qed. Definition Partition_Sum g F (H : Points_in_Partition g) (incF : included (Compact Hab) (Dom F)) := @@ -314,21 +320,24 @@ Variable m : nat. Variable Q : Partition a b Hab m. Definition Partition_imp_points : forall i : nat, i < m -> IR. -intros. -apply (Q i (lt_le_weak _ _ H)). +Proof. + intros. + apply (Q i (lt_le_weak _ _ H)). Defined. Lemma Partition_imp_points_1 : Points_in_Partition Q Partition_imp_points. -red in |- *; intros. -unfold Partition_imp_points in |- *; split. -apply leEq_reflexive. -apply prf2. +Proof. + red in |- *; intros. + unfold Partition_imp_points in |- *; split. + apply leEq_reflexive. + apply prf2. Qed. Lemma Partition_imp_points_2 : nat_less_n_fun Partition_imp_points. -red in |- *; intros. -unfold Partition_imp_points in |- *; simpl in |- *. -apply prf1; auto. +Proof. + red in |- *; intros. + unfold Partition_imp_points in |- *; simpl in |- *. + apply prf1; auto. Qed. End Getting_Points. @@ -341,11 +350,12 @@ Variable F : PartIR. Hypothesis contF : Continuous_I Hab F. Definition Even_Partition_Sum (n : nat) (Hn : 0 <> n) : IR. -intros. -apply Partition_Sum with a b Hab n (Even_Partition a b Hab n Hn) - (Partition_imp_points _ (Even_Partition a b Hab n Hn)) F. -apply Partition_imp_points_1. -apply contin_imp_inc; assumption. +Proof. + intros. + apply Partition_Sum with a b Hab n (Even_Partition a b Hab n Hn) + (Partition_imp_points _ (Even_Partition a b Hab n Hn)) F. + apply Partition_imp_points_1. + apply contin_imp_inc; assumption. Defined. End Definitions. @@ -374,9 +384,10 @@ If a partition has more than one point then its mesh list is nonempty. Lemma length_Part_Mesh_List : forall n (a b : IR) (Hab : a [<=] b) (P : Partition Hab n), 0 < n -> 0 < length (Part_Mesh_List P). -intro; case n; intros. -elimtype False; inversion H. -simpl in |- *; auto with arith. +Proof. + intro; case n; intros. + elimtype False; inversion H. + simpl in |- *; auto with arith. Qed. (** @@ -386,26 +397,27 @@ Any element of the auxiliary list defined to calculate the mesh of a partition h Lemma Part_Mesh_List_lemma : forall n (a b : IR) (Hab : a [<=] b) (P : Partition Hab n) x, member x (Part_Mesh_List P) -> {i : nat | {Hi : i <= n | {Hi' : S i <= n | x [=] P _ Hi'[-]P _ Hi}}}. -intro; induction n as [| n Hrecn]. -simpl in |- *; intros. -elimtype CFalse; assumption. -intros a b Hab P x H. -simpl in H; elim H; clear H; intro H0. -elim (Hrecn _ _ _ _ _ H0); clear Hrecn. -intros i H; elim H; clear H. -intros Hi H; elim H; clear H. -intros Hi' H. -simpl in H. -exists i; exists (le_S _ _ Hi); exists (le_S _ _ Hi'). -eapply eq_transitive_unfolded. -apply H. -apply cg_minus_wd; apply prf1; auto. -exists n. -exists (le_S _ _ (le_n n)). -exists (le_n (S n)). -eapply eq_transitive_unfolded. -apply H0. -apply cg_minus_wd; apply prf1; auto. +Proof. + intro; induction n as [| n Hrecn]. + simpl in |- *; intros. + elimtype CFalse; assumption. + intros a b Hab P x H. + simpl in H; elim H; clear H; intro H0. + elim (Hrecn _ _ _ _ _ H0); clear Hrecn. + intros i H; elim H; clear H. + intros Hi H; elim H; clear H. + intros Hi' H. + simpl in H. + exists i; exists (le_S _ _ Hi); exists (le_S _ _ Hi'). + eapply eq_transitive_unfolded. + apply H. + apply cg_minus_wd; apply prf1; auto. + exists n. + exists (le_S _ _ (le_n n)). + exists (le_n (S n)). + eapply eq_transitive_unfolded. + apply H0. + apply cg_minus_wd; apply prf1; auto. Qed. (** @@ -413,37 +425,39 @@ Mesh and antimesh are always nonnegative. *) Lemma Mesh_nonneg : forall n (a b : IR) (Hab : a [<=] b) (P : Partition Hab n), Zero [<=] Mesh P. -simple induction n. -intros; unfold Mesh in |- *; simpl in |- *. -apply leEq_reflexive. -clear n; intros. -unfold Mesh in |- *. -apply leEq_transitive with (P _ (le_n (S n)) [-]P _ (le_S _ _ (le_n n))). -apply shift_leEq_minus; astepl (P _ (le_S _ _ (le_n n))). -apply prf2. -apply maxlist_greater. -right; algebra. +Proof. + simple induction n. + intros; unfold Mesh in |- *; simpl in |- *. + apply leEq_reflexive. + clear n; intros. + unfold Mesh in |- *. + apply leEq_transitive with (P _ (le_n (S n)) [-]P _ (le_S _ _ (le_n n))). + apply shift_leEq_minus; astepl (P _ (le_S _ _ (le_n n))). + apply prf2. + apply maxlist_greater. + right; algebra. Qed. Lemma AntiMesh_nonneg : forall n (a b : IR) (Hab : a [<=] b) (P : Partition Hab n), Zero [<=] AntiMesh P. -intro; induction n as [| n Hrecn]. -intros; unfold AntiMesh in |- *; simpl in |- *. -apply leEq_reflexive. -intros. -unfold AntiMesh in |- *. -apply leEq_minlist. -simpl in |- *; auto with arith. -intros y H. -simpl in H; elim H; clear H; intro H0. -unfold AntiMesh in Hrecn. -apply leEq_transitive with (minlist (Part_Mesh_List (Partition_Dom P))). -2: apply minlist_smaller; assumption. -apply Hrecn. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply H0. -apply shift_leEq_minus; astepl (P _ (le_S _ _ (le_n n))). -apply prf2. +Proof. + intro; induction n as [| n Hrecn]. + intros; unfold AntiMesh in |- *; simpl in |- *. + apply leEq_reflexive. + intros. + unfold AntiMesh in |- *. + apply leEq_minlist. + simpl in |- *; auto with arith. + intros y H. + simpl in H; elim H; clear H; intro H0. + unfold AntiMesh in Hrecn. + apply leEq_transitive with (minlist (Part_Mesh_List (Partition_Dom P))). + 2: apply minlist_smaller; assumption. + apply Hrecn. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply H0. + apply shift_leEq_minus; astepl (P _ (le_S _ _ (le_n n))). + apply prf2. Qed. (** @@ -465,94 +479,95 @@ Variable n : nat. Variable P : Partition Hab n. Lemma Mesh_lemma : forall i H H', P (S i) H'[-]P i H [<=] Mesh P. -clear I; generalize n a b Hab P; clear P n Hab a b. -simple induction n. -intros; elimtype False; inversion H'. -clear n; intro m; intros. -induction m as [| m Hrecm]. -cut (0 = i); [ intro | inversion H'; auto; inversion H2 ]. -generalize H0 H'; clear H0 H'; rewrite <- H1. -intros. -unfold Mesh in |- *; simpl in |- *. -apply eq_imp_leEq; apply cg_minus_wd; apply prf1; auto. -elim (le_lt_eq_dec _ _ H'); intro H1. -cut (i <= S m); [ intro | auto with arith ]. -cut (S i <= S m); [ intro | auto with arith ]. -set (P' := Partition_Dom P) in *. -apply leEq_wdl with (P' _ H3[-]P' _ H2). -2: simpl in |- *; apply cg_minus_wd; apply prf1; auto. -apply leEq_transitive with (Mesh P'). -apply H. -unfold Mesh in |- *; simpl in |- *; apply rht_leEq_Max. -cut (i = S m); [ intro | auto with arith ]. -generalize H' H0; clear H0 H'. -rewrite H2; intros. -unfold Mesh in |- *; apply maxlist_greater; right. -apply cg_minus_wd; apply prf1; auto. +Proof. + clear I; generalize n a b Hab P; clear P n Hab a b. + simple induction n. + intros; elimtype False; inversion H'. + clear n; intro m; intros. + induction m as [| m Hrecm]. + cut (0 = i); [ intro | inversion H'; auto; inversion H2 ]. + generalize H0 H'; clear H0 H'; rewrite <- H1. + intros. + unfold Mesh in |- *; simpl in |- *. + apply eq_imp_leEq; apply cg_minus_wd; apply prf1; auto. + elim (le_lt_eq_dec _ _ H'); intro H1. + cut (i <= S m); [ intro | auto with arith ]. + cut (S i <= S m); [ intro | auto with arith ]. + set (P' := Partition_Dom P) in *. + apply leEq_wdl with (P' _ H3[-]P' _ H2). + 2: simpl in |- *; apply cg_minus_wd; apply prf1; auto. + apply leEq_transitive with (Mesh P'). + apply H. + unfold Mesh in |- *; simpl in |- *; apply rht_leEq_Max. + cut (i = S m); [ intro | auto with arith ]. + generalize H' H0; clear H0 H'. + rewrite H2; intros. + unfold Mesh in |- *; apply maxlist_greater; right. + apply cg_minus_wd; apply prf1; auto. Qed. Lemma AntiMesh_lemma : forall i H H', AntiMesh P [<=] P (S i) H'[-]P i H. -clear I; generalize n a b Hab P; clear P n Hab a b. -simple induction n. -intros; elimtype False; inversion H'. -clear n; intro m; intros. -induction m as [| m Hrecm]. -cut (0 = i); [ intro | inversion H'; auto; inversion H2 ]. -generalize H0 H'; clear H0 H'; rewrite <- H1. -intros. -unfold AntiMesh in |- *; simpl in |- *. -apply eq_imp_leEq; apply cg_minus_wd; apply prf1; auto. -elim (le_lt_eq_dec _ _ H'); intro H1. -cut (i <= S m); [ intro | auto with arith ]. -cut (S i <= S m); [ intro | auto with arith ]. -set (P' := Partition_Dom P) in *. -apply leEq_wdr with (P' _ H3[-]P' _ H2). -2: simpl in |- *; apply cg_minus_wd; apply prf1; auto. -apply leEq_transitive with (AntiMesh P'). -2: apply H. -unfold AntiMesh in |- *; simpl in |- *. unfold MIN. -eapply leEq_wdr. -2: apply cg_inv_inv. -apply inv_resp_leEq; apply rht_leEq_Max. -cut (i = S m); [ intro | auto with arith ]. -generalize H' H0; clear H0 H'. -rewrite H2; intros. -unfold AntiMesh in |- *; apply minlist_smaller; right. -apply cg_minus_wd; apply prf1; auto. +Proof. + clear I; generalize n a b Hab P; clear P n Hab a b. + simple induction n. + intros; elimtype False; inversion H'. + clear n; intro m; intros. + induction m as [| m Hrecm]. + cut (0 = i); [ intro | inversion H'; auto; inversion H2 ]. + generalize H0 H'; clear H0 H'; rewrite <- H1. + intros. + unfold AntiMesh in |- *; simpl in |- *. + apply eq_imp_leEq; apply cg_minus_wd; apply prf1; auto. + elim (le_lt_eq_dec _ _ H'); intro H1. + cut (i <= S m); [ intro | auto with arith ]. + cut (S i <= S m); [ intro | auto with arith ]. + set (P' := Partition_Dom P) in *. + apply leEq_wdr with (P' _ H3[-]P' _ H2). + 2: simpl in |- *; apply cg_minus_wd; apply prf1; auto. + apply leEq_transitive with (AntiMesh P'). + 2: apply H. + unfold AntiMesh in |- *; simpl in |- *. unfold MIN. + eapply leEq_wdr. + 2: apply cg_inv_inv. + apply inv_resp_leEq; apply rht_leEq_Max. + cut (i = S m); [ intro | auto with arith ]. + generalize H' H0; clear H0 H'. + rewrite H2; intros. + unfold AntiMesh in |- *; apply minlist_smaller; right. + apply cg_minus_wd; apply prf1; auto. Qed. Lemma Mesh_leEq : forall m (Q : Partition Hab m), Refinement P Q -> Mesh Q [<=] Mesh P. -intro; case m. -intros Q H. -unfold Mesh at 1 in |- *; simpl in |- *. -apply Mesh_nonneg. -clear m; intros m Q H. -unfold Mesh at 1 in |- *. -apply maxlist_leEq. -simpl in |- *; auto with arith. -intros x H0. -elim (Part_Mesh_List_lemma _ _ _ _ _ _ H0). -clear H0. intros i H0. -elim H0; clear H0; intros Hi H0. -elim H0; clear H0; intros Hi' H0. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply H0. -elim H; intros f Hf. -elim Hf; clear Hf; intros Hf' Hf. -cut - {j : nat | - {Hj : j <= n | {Hj' : S j <= n | P _ Hj [<=] Q _ Hi | Q _ Hi' [<=] P _ Hj'}}}. -intro H1. -elim H1; intros j Hj. -elim Hj; clear H1 Hj; intros Hj Hjaux. -elim Hjaux; clear Hjaux; intros Hj' Hjaux. -intros HPts HPts'. -apply leEq_transitive with (P _ Hj'[-]P _ Hj). -unfold cg_minus in |- *; apply plus_resp_leEq_both. -assumption. -apply inv_resp_leEq; assumption. -apply Mesh_lemma. -apply Refinement_prop; assumption. +Proof. + intro; case m. + intros Q H. + unfold Mesh at 1 in |- *; simpl in |- *. + apply Mesh_nonneg. + clear m; intros m Q H. + unfold Mesh at 1 in |- *. + apply maxlist_leEq. + simpl in |- *; auto with arith. + intros x H0. + elim (Part_Mesh_List_lemma _ _ _ _ _ _ H0). + clear H0. intros i H0. + elim H0; clear H0; intros Hi H0. + elim H0; clear H0; intros Hi' H0. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply H0. + elim H; intros f Hf. + elim Hf; clear Hf; intros Hf' Hf. + cut {j : nat | {Hj : j <= n | {Hj' : S j <= n | P _ Hj [<=] Q _ Hi | Q _ Hi' [<=] P _ Hj'}}}. + intro H1. + elim H1; intros j Hj. + elim Hj; clear H1 Hj; intros Hj Hjaux. + elim Hjaux; clear Hjaux; intros Hj' Hjaux. + intros HPts HPts'. + apply leEq_transitive with (P _ Hj'[-]P _ Hj). + unfold cg_minus in |- *; apply plus_resp_leEq_both. + assumption. + apply inv_resp_leEq; assumption. + apply Mesh_lemma. + apply Refinement_prop; assumption. Qed. End Lemmas. @@ -565,45 +580,41 @@ Section Even_Partitions. Lemma Mesh_wd : forall n a b b' (Hab : a [<=] b) (Hab' : a [<=] b') (P : Partition Hab n) (Q : Partition Hab' n), (forall i Hi, P i Hi [=] Q i Hi) -> Mesh P [=] Mesh Q. -simple induction n. -intros. -unfold Mesh in |- *; simpl in |- *; algebra. -clear n; intro. -case n. -intros. -unfold Mesh in |- *; simpl in |- *. -apply cg_minus_wd; apply H0. -clear n; intros. -unfold Mesh in |- *. -apply - eq_transitive_unfolded - with - (Max (P _ (le_n (S (S n))) [-]P _ (le_S _ _ (le_n (S n)))) - (maxlist (Part_Mesh_List (Partition_Dom P)))). -simpl in |- *; algebra. -apply - eq_transitive_unfolded - with - (Max (Q _ (le_n (S (S n))) [-]Q _ (le_S _ _ (le_n (S n)))) - (maxlist (Part_Mesh_List (Partition_Dom Q)))). -2: simpl in |- *; algebra. -apply Max_wd_unfolded. -apply cg_minus_wd; apply H0. -apply eq_transitive_unfolded with (Mesh (Partition_Dom P)). -unfold Mesh in |- *; algebra. -apply eq_transitive_unfolded with (Mesh (Partition_Dom Q)). -apply H. -intros. -unfold Partition_Dom in |- *; simpl in |- *. -apply H0. -unfold Mesh in |- *; algebra. +Proof. + simple induction n. + intros. + unfold Mesh in |- *; simpl in |- *; algebra. + clear n; intro. + case n. + intros. + unfold Mesh in |- *; simpl in |- *. + apply cg_minus_wd; apply H0. + clear n; intros. + unfold Mesh in |- *. + apply eq_transitive_unfolded with (Max (P _ (le_n (S (S n))) [-]P _ (le_S _ _ (le_n (S n)))) + (maxlist (Part_Mesh_List (Partition_Dom P)))). + simpl in |- *; algebra. + apply eq_transitive_unfolded with (Max (Q _ (le_n (S (S n))) [-]Q _ (le_S _ _ (le_n (S n)))) + (maxlist (Part_Mesh_List (Partition_Dom Q)))). + 2: simpl in |- *; algebra. + apply Max_wd_unfolded. + apply cg_minus_wd; apply H0. + apply eq_transitive_unfolded with (Mesh (Partition_Dom P)). + unfold Mesh in |- *; algebra. + apply eq_transitive_unfolded with (Mesh (Partition_Dom Q)). + apply H. + intros. + unfold Partition_Dom in |- *; simpl in |- *. + apply H0. + unfold Mesh in |- *; algebra. Qed. Lemma Mesh_wd' : forall n a b (Hab : a [<=] b) (P Q : Partition Hab n), (forall i Hi, P i Hi [=] Q i Hi) -> Mesh P [=] Mesh Q. -intros. -apply Mesh_wd. -intros; apply H. +Proof. + intros. + apply Mesh_wd. + intros; apply H. Qed. (** @@ -612,50 +623,42 @@ The mesh of an even partition is easily calculated. Lemma even_partition_Mesh : forall m Hm a b (Hab : a [<=] b), Mesh (Even_Partition Hab m Hm) [=] (b[-]a[/] _[//]nring_ap_zero' _ _ Hm). -simple induction m. -intros; elimtype False; apply Hm; auto. -intros. -unfold Mesh in |- *. -elim (le_lt_dec n 0); intro. -cut (0 = n); [ intro | auto with arith ]. -generalize Hm; clear H a0 Hm. -rewrite <- H0; intros. -simpl in |- *. -rational. -apply - eq_transitive_unfolded - with - (Max - (a[+]nring (S n) [*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hm) [-] - (a[+]nring n[*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hm))) - (maxlist (Part_Mesh_List (Partition_Dom (Even_Partition Hab _ Hm))))). -cut (n = S (pred n)); [ intro | apply S_pred with 0; auto ]. -generalize Hm; rewrite H0; clear Hm; intro. -simpl in |- *; algebra. -eapply eq_transitive_unfolded. -apply Max_comm. -simpl in |- *. -eapply eq_transitive_unfolded. -apply leEq_imp_Max_is_rht. -2: rational. -apply eq_imp_leEq. -rstepr (b[-]a[/] nring n[+]One[//]nring_ap_zero' _ _ Hm). -apply - eq_transitive_unfolded with (Mesh (Partition_Dom (Even_Partition Hab _ Hm))). -simpl in |- *; algebra. -cut (0 <> n); intro. -eapply eq_transitive_unfolded. -apply - Mesh_wd' - with - (Q := Even_Partition - (part_pred_lemma _ _ Hab (S n) (Even_Partition Hab _ Hm) n - (le_n_Sn n)) _ H0). -intros; simpl in |- *; rational. -eapply eq_transitive_unfolded. -apply H. -simpl in |- *; rational. -apply (lt_O_neq n); auto. +Proof. + simple induction m. + intros; elimtype False; apply Hm; auto. + intros. + unfold Mesh in |- *. + elim (le_lt_dec n 0); intro. + cut (0 = n); [ intro | auto with arith ]. + generalize Hm; clear H a0 Hm. + rewrite <- H0; intros. + simpl in |- *. + rational. + apply eq_transitive_unfolded with (Max (a[+]nring (S n) [*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hm) [-] + (a[+]nring n[*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hm))) + (maxlist (Part_Mesh_List (Partition_Dom (Even_Partition Hab _ Hm))))). + cut (n = S (pred n)); [ intro | apply S_pred with 0; auto ]. + generalize Hm; rewrite H0; clear Hm; intro. + simpl in |- *; algebra. + eapply eq_transitive_unfolded. + apply Max_comm. + simpl in |- *. + eapply eq_transitive_unfolded. + apply leEq_imp_Max_is_rht. + 2: rational. + apply eq_imp_leEq. + rstepr (b[-]a[/] nring n[+]One[//]nring_ap_zero' _ _ Hm). + apply eq_transitive_unfolded with (Mesh (Partition_Dom (Even_Partition Hab _ Hm))). + simpl in |- *; algebra. + cut (0 <> n); intro. + eapply eq_transitive_unfolded. + apply Mesh_wd' with (Q := Even_Partition (part_pred_lemma _ _ Hab (S n) (Even_Partition Hab _ Hm) n + (le_n_Sn n)) _ H0). + intros; simpl in |- *; rational. + eapply eq_transitive_unfolded. + apply H. + simpl in |- *; rational. + apply (lt_O_neq n); auto. Qed. (** @@ -676,56 +679,55 @@ An interesting property: in a partition, if [ai [<] aj] then [i < j]. Lemma Partition_Points_mon : forall n (P : Partition Hab n) i j Hi Hj, P i Hi [<] P j Hj -> i < j. -intros. -cut (~ j <= i); intro. -apply not_ge; auto. -elimtype False. -apply less_irreflexive_unfolded with (x := P i Hi). -apply less_leEq_trans with (P j Hj). -assumption. -apply - local_mon'_imp_mon'_le with (f := fun (i : nat) (Hi : i <= n) => P i Hi). -intros; apply prf2. -intro; intros; apply prf1; assumption. -assumption. +Proof. + intros. + cut (~ j <= i); intro. + apply not_ge; auto. + elimtype False. + apply less_irreflexive_unfolded with (x := P i Hi). + apply less_leEq_trans with (P j Hj). + assumption. + apply local_mon'_imp_mon'_le with (f := fun (i : nat) (Hi : i <= n) => P i Hi). + intros; apply prf2. + intro; intros; apply prf1; assumption. + assumption. Qed. Lemma refinement_resp_mult : forall m n Hm Hn, {k : nat | m = n * k} -> Refinement (Even_Partition Hab n Hn) (Even_Partition Hab m Hm). -intros m n Hm Hn H. -elim H; intros k Hk. -red in |- *. -cut (0 <> k); intro. -exists (fun i : nat => i * k); repeat split. -symmetry in |- *; assumption. -intros. -apply mult_lt_compat_r. -assumption. -apply neq_O_lt; auto. -intros. -cut (i * k <= m). -intro. -exists H1. -simpl in |- *. -apply bin_op_wd_unfolded. -algebra. -generalize Hm; rewrite Hk. -clear Hm; intro. -rstepl - (nring i[*]nring k[*] - (b[-]a[/] _[//] - mult_resp_ap_zero _ _ _ (nring_ap_zero' _ _ Hn) (nring_ap_zero' _ _ H0))). -apply mult_wd. -apply eq_symmetric_unfolded; apply nring_comm_mult. -apply div_wd. -algebra. -apply eq_symmetric_unfolded; apply nring_comm_mult. -rewrite Hk. -apply mult_le_compat_r; assumption. -apply Hm. -rewrite Hk. -rewrite <- H0. -auto. +Proof. + intros m n Hm Hn H. + elim H; intros k Hk. + red in |- *. + cut (0 <> k); intro. + exists (fun i : nat => i * k); repeat split. + symmetry in |- *; assumption. + intros. + apply mult_lt_compat_r. + assumption. + apply neq_O_lt; auto. + intros. + cut (i * k <= m). + intro. + exists H1. + simpl in |- *. + apply bin_op_wd_unfolded. + algebra. + generalize Hm; rewrite Hk. + clear Hm; intro. + rstepl (nring i[*]nring k[*] (b[-]a[/] _[//] + mult_resp_ap_zero _ _ _ (nring_ap_zero' _ _ Hn) (nring_ap_zero' _ _ H0))). + apply mult_wd. + apply eq_symmetric_unfolded; apply nring_comm_mult. + apply div_wd. + algebra. + apply eq_symmetric_unfolded; apply nring_comm_mult. + rewrite Hk. + apply mult_le_compat_r; assumption. + apply Hm. + rewrite Hk. + rewrite <- H0. + auto. Qed. (** @@ -749,20 +751,21 @@ Let Q := Even_Partition Hab n Hn. Lemma even_partition_refinement : {N : nat | {HN : 0 <> N | Refinement P (Even_Partition Hab N HN) | Refinement Q (Even_Partition Hab N HN)}}. -exists (m * n). -cut (0 <> m * n); intro. -exists H. -unfold P in |- *; apply refinement_resp_mult. -exists n; auto. -unfold Q in |- *; apply refinement_resp_mult. -exists m; auto with arith. -clear P Q. -cut (nring (R:=IR) (m * n) [#] Zero). -rewrite <- H; simpl in |- *. -apply ap_irreflexive_unfolded. -astepl (nring m[*]nring (R:=IR) n). -apply mult_resp_ap_zero; apply Greater_imp_ap; astepl (nring (R:=IR) 0); - apply nring_less; apply neq_O_lt; auto. +Proof. + exists (m * n). + cut (0 <> m * n); intro. + exists H. + unfold P in |- *; apply refinement_resp_mult. + exists n; auto. + unfold Q in |- *; apply refinement_resp_mult. + exists m; auto with arith. + clear P Q. + cut (nring (R:=IR) (m * n) [#] Zero). + rewrite <- H; simpl in |- *. + apply ap_irreflexive_unfolded. + astepl (nring m[*]nring (R:=IR) n). + apply mult_resp_ap_zero; apply Greater_imp_ap; astepl (nring (R:=IR) 0); + apply nring_less; apply neq_O_lt; auto. Qed. End Even_Partitions. @@ -817,20 +820,21 @@ The antimesh of a separated partition is always positive. Lemma pos_AntiMesh : forall n (P : Partition Hab n), 0 < n -> _Separated P -> Zero [<] AntiMesh P. -intro; case n; clear n. - intros P H H0; elimtype False; apply (lt_irrefl _ H). -intros n P H H0. -unfold AntiMesh in |- *. -apply less_minlist. - simpl in |- *; auto with arith. -intros y H1. -elim (Part_Mesh_List_lemma _ _ _ _ _ _ H1); intros i Hi. -elim Hi; clear Hi; intros Hi Hi'. -elim Hi'; clear Hi'; intros Hi' H'. -eapply less_wdr. - 2: apply eq_symmetric_unfolded; apply H'. -apply shift_less_minus; astepl (P i Hi). -apply H0. +Proof. + intro; case n; clear n. + intros P H H0; elimtype False; apply (lt_irrefl _ H). + intros n P H H0. + unfold AntiMesh in |- *. + apply less_minlist. + simpl in |- *; auto with arith. + intros y H1. + elim (Part_Mesh_List_lemma _ _ _ _ _ _ H1); intros i Hi. + elim Hi; clear Hi; intros Hi Hi'. + elim Hi'; clear Hi'; intros Hi' H'. + eapply less_wdr. + 2: apply eq_symmetric_unfolded; apply H'. + apply shift_less_minus; astepl (P i Hi). + apply H0. Qed. (** @@ -840,35 +844,38 @@ endpoints of the interval are the same then it must have one point. *) Lemma partition_length_zero : Partition Hab 0 -> a [=] b. -intro H. -Step_final (H 0 (le_O_n 0)). +Proof. + intro H. + Step_final (H 0 (le_O_n 0)). Qed. Lemma _Separated_imp_length_zero : forall n (P : Partition Hab n), _Separated P -> a [=] b -> 0 = n. -intros n P H H0. -cut (~ 0 <> n); [ auto with zarith | intro ]. -cut (0 < n); [ intro | apply neq_O_lt; auto ]. -cut (a [#] b). -exact (eq_imp_not_ap _ _ _ H0). -astepl (P _ (le_O_n _)). -astepr (P _ (le_n _)). -apply less_imp_ap. -apply local_mon_imp_mon_le with (f := fun (i : nat) (H : i <= n) => P i H). -exact H. -assumption. +Proof. + intros n P H H0. + cut (~ 0 <> n); [ auto with zarith | intro ]. + cut (0 < n); [ intro | apply neq_O_lt; auto ]. + cut (a [#] b). + exact (eq_imp_not_ap _ _ _ H0). + astepl (P _ (le_O_n _)). + astepr (P _ (le_n _)). + apply less_imp_ap. + apply local_mon_imp_mon_le with (f := fun (i : nat) (H : i <= n) => P i H). + exact H. + assumption. Qed. Lemma partition_less_imp_gt_zero : forall n (P : Partition Hab n), a [<] b -> 0 < n. -intros n P H. -cut (0 <> n); intro. - apply neq_O_lt; auto. -elimtype False. -cut (a [=] b). - intro; apply less_irreflexive_unfolded with (x := a). - astepr b; assumption. -apply partition_length_zero. -rewrite H0; apply P. +Proof. + intros n P H. + cut (0 <> n); intro. + apply neq_O_lt; auto. + elimtype False. + cut (a [=] b). + intro; apply less_irreflexive_unfolded with (x := a). + astepr b; assumption. + apply partition_length_zero. + rewrite H0; apply P. Qed. End Sep_Partitions. diff --git a/ftc/RefLemma.v b/ftc/RefLemma.v index f9f660953..d488e2731 100644 --- a/ftc/RefLemma.v +++ b/ftc/RefLemma.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export RefSeparating. Require Export RefSeparated. @@ -149,76 +149,87 @@ Hypothesis HfQ' : nat_less_n_fun fQ. Let sub := proj1_sig2T _ _ _ Href. Lemma RL_sub_0 : sub 0 = 0. -elim (proj2a_sig2T _ _ _ Href); auto. +Proof. + elim (proj2a_sig2T _ _ _ Href); auto. Qed. Lemma RL_sub_n : sub n = m. -elim (proj2a_sig2T _ _ _ Href); intros. -elim H0; auto. +Proof. + elim (proj2a_sig2T _ _ _ Href); intros. + elim H0; auto. Qed. Lemma RL_sub_mon : forall i j : nat, i < j -> sub i < sub j. -elim (proj2a_sig2T _ _ _ Href); intros. -elim H0; intros. -elim H1; auto. +Proof. + elim (proj2a_sig2T _ _ _ Href); intros. + elim H0; intros. + elim H1; auto. Qed. Lemma RL_sub_mon' : forall i j : nat, i <= j -> sub i <= sub j. -intros. -elim (le_lt_eq_dec _ _ H); intro. -apply lt_le_weak; apply RL_sub_mon; assumption. -rewrite b0; apply le_n. +Proof. + intros. + elim (le_lt_eq_dec _ _ H); intro. + apply lt_le_weak; apply RL_sub_mon; assumption. + rewrite b0; apply le_n. Qed. Lemma RL_sub_hyp : forall (i : nat) (H : i <= n), {H' : sub i <= m | P i H [=] Q (sub i) H'}. -apply (proj2b_sig2T _ _ _ Href). +Proof. + apply (proj2b_sig2T _ _ _ Href). Qed. Lemma RL_sub_S : forall i : nat, 0 < sub (S i). -rewrite <- RL_sub_0. -intro; apply RL_sub_mon; apply lt_O_Sn. +Proof. + rewrite <- RL_sub_0. + intro; apply RL_sub_mon; apply lt_O_Sn. Qed. Let H : forall i j : nat, i < n -> j <= pred (sub (S i)) -> j < m. -intros. -cut (S i <= n); [ intro | apply H ]. -elim (le_lt_eq_dec _ _ H1); clear H1; intro. -cut (sub (S i) < sub n); [ intro | apply RL_sub_mon; assumption ]. -rewrite <- RL_sub_n. -apply le_lt_trans with (sub (S i)); auto; eapply le_trans; - [ apply H0 | apply le_pred_n ]. -cut (0 < sub (S i)); [ intro | apply RL_sub_S ]. -rewrite <- RL_sub_n. -rewrite <- b0. -rewrite (S_pred _ _ H1); auto with arith. +Proof. + intros. + cut (S i <= n); [ intro | apply H ]. + elim (le_lt_eq_dec _ _ H1); clear H1; intro. + cut (sub (S i) < sub n); [ intro | apply RL_sub_mon; assumption ]. + rewrite <- RL_sub_n. + apply le_lt_trans with (sub (S i)); auto; eapply le_trans; [ apply H0 | apply le_pred_n ]. + cut (0 < sub (S i)); [ intro | apply RL_sub_S ]. + rewrite <- RL_sub_n. + rewrite <- b0. + rewrite (S_pred _ _ H1); auto with arith. Qed. Let H' : forall i j : nat, i < n -> j <= pred (sub (S i)) -> S j <= m. -intros; exact (H _ _ H0 H1). +Proof. + intros; exact (H _ _ H0 H1). Qed. Let H0 : forall i : nat, sub i < sub (S i). -intro; apply RL_sub_mon; apply lt_n_Sn. +Proof. + intro; apply RL_sub_mon; apply lt_n_Sn. Qed. Lemma RL_sub_SS : forall i : nat, sub i <= S (pred (sub (S i))). -intro; cut (sub i < sub (S i)); [ intro | apply H0 ]. -rewrite <- (S_pred _ _ H1); apply lt_le_weak; apply H0. +Proof. + intro; cut (sub i < sub (S i)); [ intro | apply H0 ]. + rewrite <- (S_pred _ _ H1); apply lt_le_weak; apply H0. Qed. Definition RL_h : nat -> IR. -intro i. -elim (le_lt_dec i m); intro. -apply (Q _ a0). -apply ZeroR. +Proof. + intro i. + elim (le_lt_dec i m); intro. + apply (Q _ a0). + apply ZeroR. Defined. Definition RL_g : nat -> IR. -intro i. -elim (le_lt_dec m i); intro. -apply ZeroR. -apply (Q _ b0[-]Q _ (lt_le_weak _ _ b0)). +Proof. + intro i. + elim (le_lt_dec m i); intro. + apply ZeroR. + apply (Q _ b0[-]Q _ (lt_le_weak _ _ b0)). Defined. Notation g := RL_g. @@ -228,53 +239,54 @@ Lemma ref_calc1 : forall (i : nat) (Hi : i < n), Sum2 (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => - Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj'))) [=] + Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj'))) [=] P _ Hi[-]P _ (lt_le_weak _ _ Hi). -intros. -unfold Sum2 in |- *. -elim (RL_sub_hyp (S i) Hi); intros P1 HP1. -elim (RL_sub_hyp i (lt_le_weak _ _ Hi)); intros P2 HP2. -apply eq_transitive_unfolded with (Q _ P1[-]Q _ P2). -2: apply eq_symmetric_unfolded; apply cg_minus_wd; [ apply HP1 | apply HP2 ]. -cut (sub (S i) = S (pred (sub (S i)))). -2: apply S_pred with 0; apply RL_sub_S. -intro. -generalize P1 HP1; clear HP1 P1. rewrite {1 2 11} H1; intros. -eapply eq_transitive_unfolded. -apply str_Mengolli_Sum_gen with (f := h). -apply RL_sub_SS. -intros j Hj Hj'. -elim (le_lt_dec j (pred (sub (S i)))); intro; simpl in |- *. -elim (le_lt_dec (sub i) j); intro; simpl in |- *. -unfold h in |- *. -apply cg_minus_wd. -elim (le_lt_dec (S j) m); intro; simpl in |- *. -apply prf1; auto. -cut (S j <= m); [ intro | apply H' with i; assumption ]. -elimtype False; apply (le_not_lt _ _ H2 b0). -elim (le_lt_dec j m); intro; simpl in |- *. -apply prf1; auto. -cut (j < m); [ intro | apply H with i; assumption ]. -elimtype False; apply le_not_lt with m j; auto with arith. -elimtype False; apply le_not_lt with (sub i) j; auto with arith. -elimtype False; apply (le_not_lt _ _ Hj' b0). -unfold h in |- *. -apply cg_minus_wd. -elim (le_lt_dec (S (pred (sub (S i)))) m); intro; simpl in |- *. -apply prf1; auto. -elimtype False. -apply (le_not_lt _ _ P1 b0). -elim (le_lt_dec (sub i) m); intro; simpl in |- *. -apply prf1; auto. -elimtype False. -apply (le_not_lt _ _ P2 b0). +Proof. + intros. + unfold Sum2 in |- *. + elim (RL_sub_hyp (S i) Hi); intros P1 HP1. + elim (RL_sub_hyp i (lt_le_weak _ _ Hi)); intros P2 HP2. + apply eq_transitive_unfolded with (Q _ P1[-]Q _ P2). + 2: apply eq_symmetric_unfolded; apply cg_minus_wd; [ apply HP1 | apply HP2 ]. + cut (sub (S i) = S (pred (sub (S i)))). + 2: apply S_pred with 0; apply RL_sub_S. + intro. + generalize P1 HP1; clear HP1 P1. rewrite {1 2 11} H1; intros. + eapply eq_transitive_unfolded. + apply str_Mengolli_Sum_gen with (f := h). + apply RL_sub_SS. + intros j Hj Hj'. + elim (le_lt_dec j (pred (sub (S i)))); intro; simpl in |- *. + elim (le_lt_dec (sub i) j); intro; simpl in |- *. + unfold h in |- *. + apply cg_minus_wd. + elim (le_lt_dec (S j) m); intro; simpl in |- *. + apply prf1; auto. + cut (S j <= m); [ intro | apply H' with i; assumption ]. + elimtype False; apply (le_not_lt _ _ H2 b0). + elim (le_lt_dec j m); intro; simpl in |- *. + apply prf1; auto. + cut (j < m); [ intro | apply H with i; assumption ]. + elimtype False; apply le_not_lt with m j; auto with arith. + elimtype False; apply le_not_lt with (sub i) j; auto with arith. + elimtype False; apply (le_not_lt _ _ Hj' b0). + unfold h in |- *. + apply cg_minus_wd. + elim (le_lt_dec (S (pred (sub (S i)))) m); intro; simpl in |- *. + apply prf1; auto. + elimtype False. + apply (le_not_lt _ _ P1 b0). + elim (le_lt_dec (sub i) m); intro; simpl in |- *. + apply prf1; auto. + elimtype False. + apply (le_not_lt _ _ P2 b0). Qed. Notation just1 := (incF _ (Pts_part_lemma _ _ _ _ _ _ HfP _ _)). Notation just2 := (incF _ (Pts_part_lemma _ _ _ _ _ _ HfQ _ _)). Lemma ref_calc2 : - AbsIR (Partition_Sum HfP incF[-]Partition_Sum HfQ incF) [=] + AbsIR (Partition_Sum HfP incF[-]Partition_Sum HfQ incF) [=] AbsIR (Sumx (fun (i : nat) (Hi : i < n) => @@ -288,67 +300,52 @@ Lemma ref_calc2 : (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => Part F (fQ j (H _ _ Hi Hj')) just2[*] (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))). -apply AbsIR_wd; unfold Partition_Sum in |- *. -apply cg_minus_wd. -apply Sumx_wd; intros. -apply mult_wdr. -apply eq_symmetric_unfolded; apply ref_calc1. -apply eq_symmetric_unfolded; unfold Sum2 in |- *. -apply - eq_transitive_unfolded - with - (Sumx - (fun (j : nat) (Hj : j < m) => - part_tot_nat_fun _ _ - (fun (i : nat) (H : i < m) => - Part F (fQ i H) just2[*] (Q _ H[-]Q _ (lt_le_weak _ _ H))) j)). -apply - str_Sumx_Sum_Sum - with - (g := fun (i : nat) (Hi : i < n) (i0 : nat) => - sumbool_rect (fun _ : {sub i <= i0} + {i0 < sub i} => IR) - (fun _ : sub i <= i0 => - sumbool_rect - (fun _ : {i0 <= pred (sub (S i))} + {pred (sub (S i)) < i0} => - IR) - (fun a1 : i0 <= pred (sub (S i)) => - Part F (fQ i0 (H i i0 Hi a1)) just2[*] - (Q (S i0) (H' i i0 Hi a1) [-] - Q i0 (lt_le_weak i0 m (H i i0 Hi a1)))) - (fun _ : pred (sub (S i)) < i0 => Zero) - (le_lt_dec i0 (pred (sub (S i))))) - (fun _ : i0 < sub i => Zero) (le_lt_dec (sub i) i0)) - (h := part_tot_nat_fun _ _ - (fun (i : nat) (H : i < m) => - Part F (fQ i H) just2[*] (Q _ H[-]Q _ (lt_le_weak _ _ H)))). -exact RL_sub_0. -exact RL_sub_mon. -intros. -elim (le_lt_dec (sub i) j); intro; simpl in |- *. -elim (le_lt_dec j (pred (sub (S i)))); intro; simpl in |- *. -unfold part_tot_nat_fun in |- *. -elim (le_lt_dec m j); intro; simpl in |- *. -elimtype False. -cut (0 < sub (S i)); [ intro | apply RL_sub_S ]. -cut (sub (S i) <= m); intros. -apply (le_not_lt _ _ H4); apply le_lt_trans with j; auto. -rewrite <- RL_sub_n. -apply RL_sub_mon'; apply Hi. -apply mult_wd. -apply pfwdef. -apply HfQ'; auto. -apply cg_minus_wd; apply prf1; auto. -elimtype False; apply (le_not_lt _ _ b0). -rewrite <- (S_pred _ _ (RL_sub_S i)); auto. -elimtype False; apply (le_not_lt _ _ H1 b0). -symmetry in |- *; apply RL_sub_n. -apply Sumx_wd; intros. -unfold part_tot_nat_fun in |- *. -elim (le_lt_dec m i); intro; simpl in |- *. -elimtype False; apply le_not_lt with m i; auto. -apply mult_wd. -apply pfwdef; apply HfQ'; auto. -apply cg_minus_wd; apply prf1; auto. +Proof. + apply AbsIR_wd; unfold Partition_Sum in |- *. + apply cg_minus_wd. + apply Sumx_wd; intros. + apply mult_wdr. + apply eq_symmetric_unfolded; apply ref_calc1. + apply eq_symmetric_unfolded; unfold Sum2 in |- *. + apply eq_transitive_unfolded with (Sumx (fun (j : nat) (Hj : j < m) => part_tot_nat_fun _ _ + (fun (i : nat) (H : i < m) => Part F (fQ i H) just2[*] (Q _ H[-]Q _ (lt_le_weak _ _ H))) j)). + apply str_Sumx_Sum_Sum with (g := fun (i : nat) (Hi : i < n) (i0 : nat) => + sumbool_rect (fun _ : {sub i <= i0} + {i0 < sub i} => IR) (fun _ : sub i <= i0 => sumbool_rect + (fun _ : {i0 <= pred (sub (S i))} + {pred (sub (S i)) < i0} => IR) + (fun a1 : i0 <= pred (sub (S i)) => Part F (fQ i0 (H i i0 Hi a1)) just2[*] + (Q (S i0) (H' i i0 Hi a1) [-] Q i0 (lt_le_weak i0 m (H i i0 Hi a1)))) + (fun _ : pred (sub (S i)) < i0 => Zero) (le_lt_dec i0 (pred (sub (S i))))) + (fun _ : i0 < sub i => Zero) (le_lt_dec (sub i) i0)) (h := part_tot_nat_fun _ _ + (fun (i : nat) (H : i < m) => + Part F (fQ i H) just2[*] (Q _ H[-]Q _ (lt_le_weak _ _ H)))). + exact RL_sub_0. + exact RL_sub_mon. + intros. + elim (le_lt_dec (sub i) j); intro; simpl in |- *. + elim (le_lt_dec j (pred (sub (S i)))); intro; simpl in |- *. + unfold part_tot_nat_fun in |- *. + elim (le_lt_dec m j); intro; simpl in |- *. + elimtype False. + cut (0 < sub (S i)); [ intro | apply RL_sub_S ]. + cut (sub (S i) <= m); intros. + apply (le_not_lt _ _ H4); apply le_lt_trans with j; auto. + rewrite <- RL_sub_n. + apply RL_sub_mon'; apply Hi. + apply mult_wd. + apply pfwdef. + apply HfQ'; auto. + apply cg_minus_wd; apply prf1; auto. + elimtype False; apply (le_not_lt _ _ b0). + rewrite <- (S_pred _ _ (RL_sub_S i)); auto. + elimtype False; apply (le_not_lt _ _ H1 b0). + symmetry in |- *; apply RL_sub_n. + apply Sumx_wd; intros. + unfold part_tot_nat_fun in |- *. + elim (le_lt_dec m i); intro; simpl in |- *. + elimtype False; apply le_not_lt with m i; auto. + apply mult_wd. + apply pfwdef; apply HfQ'; auto. + apply cg_minus_wd; apply prf1; auto. Qed. Lemma ref_calc3 : @@ -364,7 +361,7 @@ Lemma ref_calc3 : Sum2 (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => Part F (fQ j (H _ _ Hi Hj')) just2[*] - (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [=] + (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [=] AbsIR (Sumx (fun (i : nat) (Hi : i < n) => @@ -378,16 +375,14 @@ Lemma ref_calc3 : (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => Part F (fQ j (H _ _ Hi Hj')) just2[*] (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))). -apply AbsIR_wd. -apply cg_minus_wd; apply Sumx_wd; intros. -apply eq_symmetric_unfolded; - apply - Sum2_comm_scal' - with - (f := fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => - Q (S j) (H' _ _ H1 Hj') [-]Q j (lt_le_weak _ _ (H _ _ H1 Hj'))). -apply RL_sub_SS. -algebra. +Proof. + apply AbsIR_wd. + apply cg_minus_wd; apply Sumx_wd; intros. + apply eq_symmetric_unfolded; apply Sum2_comm_scal' with + (f := fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => + Q (S j) (H' _ _ H1 Hj') [-]Q j (lt_le_weak _ _ (H _ _ H1 Hj'))). + apply RL_sub_SS. + algebra. Qed. Lemma ref_calc4 : @@ -403,7 +398,7 @@ Lemma ref_calc4 : Sum2 (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => Part F (fQ j (H _ _ Hi Hj')) just2[*] - (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [=] + (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [=] AbsIR (Sumx (fun (i : nat) (Hi : i < n) => @@ -413,14 +408,15 @@ Lemma ref_calc4 : (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj'))) [-] Part F (fQ j (H _ _ Hi Hj')) just2[*] (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))). -apply AbsIR_wd. -eapply eq_transitive_unfolded. -apply Sumx_minus_Sumx. -apply Sumx_wd; intros. -eapply eq_transitive_unfolded. -apply Sum2_minus_Sum2. -apply RL_sub_SS. -algebra. +Proof. + apply AbsIR_wd. + eapply eq_transitive_unfolded. + apply Sumx_minus_Sumx. + apply Sumx_wd; intros. + eapply eq_transitive_unfolded. + apply Sum2_minus_Sum2. + apply RL_sub_SS. + algebra. Qed. Lemma ref_calc5 : @@ -432,7 +428,7 @@ Lemma ref_calc5 : Part F (fP i Hi) just1[*] (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj'))) [-] Part F (fQ j (H _ _ Hi Hj')) just2[*] - (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [=] + (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [=] AbsIR (Sumx (fun (i : nat) (Hi : i < n) => @@ -440,10 +436,11 @@ Lemma ref_calc5 : (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => (Part F (fP i Hi) just1[-]Part F (fQ j (H _ _ Hi Hj')) just2) [*] (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))). -apply AbsIR_wd; apply Sumx_wd; intros. -apply Sum2_wd; intros. -apply RL_sub_SS. -algebra. +Proof. + apply AbsIR_wd; apply Sumx_wd; intros. + apply Sum2_wd; intros. + apply RL_sub_SS. + algebra. Qed. Lemma ref_calc6 : @@ -453,7 +450,7 @@ Lemma ref_calc6 : Sum2 (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => (Part F (fP i Hi) just1[-]Part F (fQ j (H _ _ Hi Hj')) just2) [*] - (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [<=] + (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [<=] Sumx (fun (i : nat) (Hi : i < n) => AbsIR @@ -461,15 +458,16 @@ Lemma ref_calc6 : (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => (Part F (fP i Hi) just1[-]Part F (fQ j (H _ _ Hi Hj')) just2) [*] (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))). -eapply leEq_wdr. -apply triangle_SumxIR. -apply Sumx_wd. -intros. -apply AbsIR_wd. -apply Sum2_wd. -apply RL_sub_SS. -intros j Hj Hj'. -algebra. +Proof. + eapply leEq_wdr. + apply triangle_SumxIR. + apply Sumx_wd. + intros. + apply AbsIR_wd. + apply Sum2_wd. + apply RL_sub_SS. + intros j Hj Hj'. + algebra. Qed. Lemma ref_calc7 : @@ -479,7 +477,7 @@ Lemma ref_calc7 : (Sum2 (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => (Part F (fP i Hi) just1[-]Part F (fQ j (H _ _ Hi Hj')) just2) [*] - (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [<=] + (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [<=] Sumx (fun (i : nat) (Hi : i < n) => Sum2 @@ -487,11 +485,12 @@ Lemma ref_calc7 : AbsIR ((Part F (fP i Hi) just1[-]Part F (fQ j (H _ _ Hi Hj')) just2) [*] (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))). -apply Sumx_resp_leEq; intros. -eapply leEq_wdr. -apply triangle_Sum2IR. -apply RL_sub_SS. -algebra. +Proof. + apply Sumx_resp_leEq; intros. + eapply leEq_wdr. + apply triangle_Sum2IR. + apply RL_sub_SS. + algebra. Qed. Lemma ref_calc8 : @@ -501,105 +500,96 @@ Lemma ref_calc8 : (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => AbsIR ((Part F (fP i Hi) just1[-]Part F (fQ j (H _ _ Hi Hj')) just2) [*] - (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [<=] + (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj')))))) [<=] Sumx (fun (i : nat) (Hi : i < n) => Sum2 (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => e[*] (Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj'))))). -apply Sumx_resp_leEq; intros. -apply Sum2_resp_leEq. -apply RL_sub_SS. -intros j Hj Hj'. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both. -apply AbsIR_nonneg. -apply AbsIR_nonneg. -generalize (proj2b_sig2T _ _ _ (contF' e He)); fold d in |- *; intros. -apply H2. -unfold I in |- *; apply Pts_part_lemma with n P; assumption. -unfold I in |- *; apply Pts_part_lemma with m Q; assumption. -apply leEq_transitive with (Mesh P). -2: assumption. -apply leEq_transitive with (AbsIR (P (S i) H1[-]P i (lt_le_weak _ _ H1))). -2: eapply leEq_wdl. -3: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply Mesh_lemma. -2: apply shift_leEq_minus; astepl (P i (lt_le_weak _ _ H1)); apply prf2. -apply compact_elements with (prf2 _ _ _ _ P i (lt_le_weak _ _ H1) H1). -apply HfP. -elim (HfQ j (H _ _ H1 Hj')); intros. -split. -elim (RL_sub_hyp i (lt_le_weak _ _ H1)); intros. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply p. -apply leEq_transitive with (Q j (lt_le_weak _ _ (H i j H1 Hj'))). -apply Partition_mon; assumption. -assumption. -elim (RL_sub_hyp (S i) H1); intros. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply p. -apply leEq_transitive with (Q _ (H i j H1 Hj')). -assumption. -apply Partition_mon. -rewrite (S_pred _ _ (RL_sub_S i)); auto with arith. -apply eq_imp_leEq; apply AbsIR_eq_x. -apply shift_leEq_minus; astepl (Q j (lt_le_weak _ _ (H _ _ H1 Hj'))); - apply prf2. +Proof. + apply Sumx_resp_leEq; intros. + apply Sum2_resp_leEq. + apply RL_sub_SS. + intros j Hj Hj'. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both. + apply AbsIR_nonneg. + apply AbsIR_nonneg. + generalize (proj2b_sig2T _ _ _ (contF' e He)); fold d in |- *; intros. + apply H2. + unfold I in |- *; apply Pts_part_lemma with n P; assumption. + unfold I in |- *; apply Pts_part_lemma with m Q; assumption. + apply leEq_transitive with (Mesh P). + 2: assumption. + apply leEq_transitive with (AbsIR (P (S i) H1[-]P i (lt_le_weak _ _ H1))). + 2: eapply leEq_wdl. + 3: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply Mesh_lemma. + 2: apply shift_leEq_minus; astepl (P i (lt_le_weak _ _ H1)); apply prf2. + apply compact_elements with (prf2 _ _ _ _ P i (lt_le_weak _ _ H1) H1). + apply HfP. + elim (HfQ j (H _ _ H1 Hj')); intros. + split. + elim (RL_sub_hyp i (lt_le_weak _ _ H1)); intros. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply p. + apply leEq_transitive with (Q j (lt_le_weak _ _ (H i j H1 Hj'))). + apply Partition_mon; assumption. + assumption. + elim (RL_sub_hyp (S i) H1); intros. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply p. + apply leEq_transitive with (Q _ (H i j H1 Hj')). + assumption. + apply Partition_mon. + rewrite (S_pred _ _ (RL_sub_S i)); auto with arith. + apply eq_imp_leEq; apply AbsIR_eq_x. + apply shift_leEq_minus; astepl (Q j (lt_le_weak _ _ (H _ _ H1 Hj'))); apply prf2. Qed. (* end hide *) Lemma first_refinement_lemma : AbsIR (Partition_Sum HfP incF[-]Partition_Sum HfQ incF) [<=] e[*] (b[-]a). -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply ref_calc2. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply ref_calc3. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply ref_calc4. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply ref_calc5. -eapply leEq_transitive. -apply ref_calc6. -eapply leEq_transitive. -apply ref_calc7. -eapply leEq_transitive. -apply ref_calc8. -apply - leEq_wdl - with - (e[*] - Sumx - (fun (i : nat) (Hi : i < n) => - Sum2 - (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => - Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj'))))). -apply mult_resp_leEq_lft. -2: apply less_leEq; assumption. -apply - leEq_wdl - with - (Sumx (fun (i : nat) (Hi : i < n) => P _ Hi[-]P _ (lt_le_weak _ _ Hi))). -2: apply Sumx_wd; intros. -2: apply eq_symmetric_unfolded; apply ref_calc1. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; - apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= n) => P i Hi). -eapply leEq_transitive. -apply leEq_AbsIR. -eapply leEq_wdr. -2: apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl a; assumption. -apply compact_elements with Hab; apply Partition_in_compact. -red in |- *; intros; apply prf1; auto. -intros; apply cg_minus_wd; apply prf1; auto. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply Sumx_comm_scal'. -apply Sumx_wd; intros. -eapply eq_transitive_unfolded. -2: apply Sum2_comm_scal'. -algebra. -apply RL_sub_SS. +Proof. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply ref_calc2. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply ref_calc3. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply ref_calc4. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply ref_calc5. + eapply leEq_transitive. + apply ref_calc6. + eapply leEq_transitive. + apply ref_calc7. + eapply leEq_transitive. + apply ref_calc8. + apply leEq_wdl with (e[*] Sumx (fun (i : nat) (Hi : i < n) => Sum2 + (fun (j : nat) (Hj : sub i <= j) (Hj' : j <= pred (sub (S i))) => + Q _ (H' _ _ Hi Hj') [-]Q _ (lt_le_weak _ _ (H _ _ Hi Hj'))))). + apply mult_resp_leEq_lft. + 2: apply less_leEq; assumption. + apply leEq_wdl with (Sumx (fun (i : nat) (Hi : i < n) => P _ Hi[-]P _ (lt_le_weak _ _ Hi))). + 2: apply Sumx_wd; intros. + 2: apply eq_symmetric_unfolded; apply ref_calc1. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= n) => P i Hi). + eapply leEq_transitive. + apply leEq_AbsIR. + eapply leEq_wdr. + 2: apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl a; assumption. + apply compact_elements with Hab; apply Partition_in_compact. + red in |- *; intros; apply prf1; auto. + intros; apply cg_minus_wd; apply prf1; auto. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply Sumx_comm_scal'. + apply Sumx_wd; intros. + eapply eq_transitive_unfolded. + 2: apply Sum2_comm_scal'. + algebra. + apply RL_sub_SS. Qed. End First_Refinement_Lemma. @@ -653,22 +643,19 @@ Hypothesis HfR' : nat_less_n_fun fR. Lemma second_refinement_lemma : AbsIR (Partition_Sum HfP incF[-]Partition_Sum HfR incF) [<=] e[*] (b[-]a) [+]e'[*] (b[-]a). -set (HfQ := Partition_imp_points_1 _ _ _ _ Q) in *. -set (H' := Partition_imp_points_2 _ _ _ _ Q) in *. -apply - leEq_wdl - with - (AbsIR - (Partition_Sum HfP incF[-]Partition_Sum HfQ incF[+] - (Partition_Sum HfQ incF[-]Partition_Sum HfR incF))). -2: apply AbsIR_wd; rational. -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -apply first_refinement_lemma with He; assumption. -eapply leEq_wdl. -2: apply AbsIR_minus. -apply first_refinement_lemma with He'; assumption. +Proof. + set (HfQ := Partition_imp_points_1 _ _ _ _ Q) in *. + set (H' := Partition_imp_points_2 _ _ _ _ Q) in *. + apply leEq_wdl with (AbsIR (Partition_Sum HfP incF[-]Partition_Sum HfQ incF[+] + (Partition_Sum HfQ incF[-]Partition_Sum HfR incF))). + 2: apply AbsIR_wd; rational. + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + apply first_refinement_lemma with He; assumption. + eapply leEq_wdl. + 2: apply AbsIR_minus. + apply first_refinement_lemma with He'; assumption. Qed. End Second_Refinement_Lemma. @@ -725,17 +712,19 @@ Hypothesis Hbeta : Zero [<] beta. Let alpha := beta [/]ThreeNZ. Lemma RL_alpha : Zero [<] alpha. -unfold alpha in |- *; apply pos_div_three; assumption. +Proof. + unfold alpha in |- *; apply pos_div_three; assumption. Qed. Let csi1 := Min (b[-]a) ((d[-]Mesh P) [/]TwoNZ). Lemma RL_csi1 : Zero [<] csi1. -unfold csi1 in |- *; apply less_Min. -apply shift_less_minus; astepl a; assumption. -apply pos_div_two. -apply shift_less_minus. -astepl (Mesh P); assumption. +Proof. + unfold csi1 in |- *; apply less_Min. + apply shift_less_minus; astepl a; assumption. + apply pos_div_two. + apply shift_less_minus. + astepl (Mesh P); assumption. Qed. Let delta1 := @@ -745,71 +734,71 @@ Let delta1 := (max_one_ap_zero (Norm_Funct contF))). Lemma RL_delta1 : delta1 [/]TwoNZ [<] b[-]a. -apply shift_div_less'. -apply pos_two. -apply leEq_less_trans with (b[-]a). -unfold delta1 in |- *; clear delta1. -apply leEq_transitive with csi1. -apply Min_leEq_lft. -unfold csi1 in |- *. -apply Min_leEq_lft. -astepl (Zero[+] (b[-]a)); rstepr (b[-]a[+] (b[-]a)). -apply plus_resp_less_rht. -apply shift_less_minus; astepl a; assumption. +Proof. + apply shift_div_less'. + apply pos_two. + apply leEq_less_trans with (b[-]a). + unfold delta1 in |- *; clear delta1. + apply leEq_transitive with csi1. + apply Min_leEq_lft. + unfold csi1 in |- *. + apply Min_leEq_lft. + astepl (Zero[+] (b[-]a)); rstepr (b[-]a[+] (b[-]a)). + apply plus_resp_less_rht. + apply shift_less_minus; astepl a; assumption. Qed. Let P' := sep__part _ _ _ F contF Hab' _ P _ RL_alpha _ RL_csi1 RL_delta1. Lemma RL_P'_sep : _Separated P'. -red in |- *; intros. -unfold P' in |- *; apply sep__part_mon. +Proof. + red in |- *; intros. + unfold P' in |- *; apply sep__part_mon. Qed. Lemma RL_P'_Mesh : Mesh P' [<] d. -unfold P' in |- *. -eapply leEq_less_trans. -apply sep__part_mon_Mesh. -unfold csi1 in |- *. -apply shift_plus_less'; eapply leEq_less_trans. -apply Min_leEq_rht. -apply pos_div_two'. -apply shift_less_minus. -astepl (Mesh P); assumption. +Proof. + unfold P' in |- *. + eapply leEq_less_trans. + apply sep__part_mon_Mesh. + unfold csi1 in |- *. + apply shift_plus_less'; eapply leEq_less_trans. + apply Min_leEq_rht. + apply pos_div_two'. + apply shift_less_minus. + astepl (Mesh P); assumption. Qed. Let fP' := sep__part_pts _ _ _ F contF Hab' _ P _ RL_alpha _ RL_csi1 fP. Lemma RL_fP'_in_P' : Points_in_Partition P' fP'. -unfold fP', P' in |- *; apply sep__part_pts_in_Partition. -assumption. +Proof. + unfold fP', P' in |- *; apply sep__part_pts_in_Partition. + assumption. Qed. Lemma RL_P'_P_sum : AbsIR (Partition_Sum HfP incF[-]Partition_Sum RL_fP'_in_P' incF) [<=] alpha. -apply - leEq_wdl - with - (AbsIR - (Partition_Sum HfP incF[-] - Partition_Sum - (sep__part_pts_in_Partition _ _ _ F contF Hab' _ P _ RL_alpha _ RL_csi1 - RL_delta1 _ HfP) incF)). -apply sep__part_Sum. -assumption. -apply AbsIR_wd; apply cg_minus_wd. -algebra. -unfold Partition_Sum in |- *; apply Sumx_wd; intros. -algebra. +Proof. + apply leEq_wdl with (AbsIR (Partition_Sum HfP incF[-] Partition_Sum + (sep__part_pts_in_Partition _ _ _ F contF Hab' _ P _ RL_alpha _ RL_csi1 RL_delta1 _ HfP) incF)). + apply sep__part_Sum. + assumption. + apply AbsIR_wd; apply cg_minus_wd. + algebra. + unfold Partition_Sum in |- *; apply Sumx_wd; intros. + algebra. Qed. Let csi2 := Min (b[-]a) ((d'[-]Mesh R) [/]TwoNZ). Lemma RL_csi2 : Zero [<] csi2. -unfold csi2 in |- *; apply less_Min. -apply shift_less_minus; astepl a; assumption. -apply pos_div_two. -apply shift_less_minus. -astepl (Mesh R); assumption. +Proof. + unfold csi2 in |- *; apply less_Min. + apply shift_less_minus; astepl a; assumption. + apply pos_div_two. + apply shift_less_minus. + astepl (Mesh R); assumption. Qed. Let delta2 := @@ -819,82 +808,84 @@ Let delta2 := (max_one_ap_zero (Norm_Funct contF))). Lemma RL_delta2 : delta2 [/]TwoNZ [<] b[-]a. -apply shift_div_less'. -apply pos_two. -apply leEq_less_trans with (b[-]a). -unfold delta2 in |- *; clear delta2. -apply leEq_transitive with csi2. -apply Min_leEq_lft. -unfold csi2 in |- *. -apply Min_leEq_lft. -astepl (Zero[+] (b[-]a)); rstepr (b[-]a[+] (b[-]a)). -apply plus_resp_less_rht. -apply shift_less_minus; astepl a; assumption. +Proof. + apply shift_div_less'. + apply pos_two. + apply leEq_less_trans with (b[-]a). + unfold delta2 in |- *; clear delta2. + apply leEq_transitive with csi2. + apply Min_leEq_lft. + unfold csi2 in |- *. + apply Min_leEq_lft. + astepl (Zero[+] (b[-]a)); rstepr (b[-]a[+] (b[-]a)). + apply plus_resp_less_rht. + apply shift_less_minus; astepl a; assumption. Qed. Let R' := sep__part _ _ _ F contF Hab' _ R _ RL_alpha _ RL_csi2 RL_delta2. Lemma RL_R'_sep : _Separated R'. -red in |- *; intros. -unfold R' in |- *; apply sep__part_mon. +Proof. + red in |- *; intros. + unfold R' in |- *; apply sep__part_mon. Qed. Lemma RL_R'_Mesh : Mesh R' [<] d'. -unfold R' in |- *. -eapply leEq_less_trans. -apply sep__part_mon_Mesh. -unfold csi2 in |- *. -apply shift_plus_less'; eapply leEq_less_trans. -apply Min_leEq_rht. -apply pos_div_two'. -apply shift_less_minus. -astepl (Mesh R); assumption. +Proof. + unfold R' in |- *. + eapply leEq_less_trans. + apply sep__part_mon_Mesh. + unfold csi2 in |- *. + apply shift_plus_less'; eapply leEq_less_trans. + apply Min_leEq_rht. + apply pos_div_two'. + apply shift_less_minus. + astepl (Mesh R); assumption. Qed. Let fR' := sep__part_pts _ _ _ F contF Hab' _ R _ RL_alpha _ RL_csi2 fR. Lemma RL_fR'_in_R' : Points_in_Partition R' fR'. -unfold fR', R' in |- *; apply sep__part_pts_in_Partition. -assumption. +Proof. + unfold fR', R' in |- *; apply sep__part_pts_in_Partition. + assumption. Qed. Lemma RL_R'_R_sum : AbsIR (Partition_Sum HfR incF[-]Partition_Sum RL_fR'_in_R' incF) [<=] alpha. -apply - leEq_wdl - with - (AbsIR - (Partition_Sum HfR incF[-] - Partition_Sum - (sep__part_pts_in_Partition _ _ _ F contF Hab' _ R _ RL_alpha _ RL_csi2 - RL_delta2 _ HfR) incF)). -apply sep__part_Sum. -assumption. -apply AbsIR_wd; apply cg_minus_wd. -algebra. -unfold Partition_Sum in |- *; apply Sumx_wd; intros. -algebra. +Proof. + apply leEq_wdl with (AbsIR (Partition_Sum HfR incF[-] Partition_Sum + (sep__part_pts_in_Partition _ _ _ F contF Hab' _ R _ RL_alpha _ RL_csi2 RL_delta2 _ HfR) incF)). + apply sep__part_Sum. + assumption. + apply AbsIR_wd; apply cg_minus_wd. + algebra. + unfold Partition_Sum in |- *; apply Sumx_wd; intros. + algebra. Qed. Let csi3 := d[-]Mesh P'. Lemma RL_csi3 : Zero [<] csi3. -unfold csi3 in |- *. -apply shift_less_minus; astepl (Mesh P'). -apply RL_P'_Mesh. +Proof. + unfold csi3 in |- *. + apply shift_less_minus; astepl (Mesh P'). + apply RL_P'_Mesh. Qed. Let Q := sep__sep_part _ _ _ F contF Hab' _ _ _ _ RL_P'_sep RL_R'_sep _ RL_alpha _ RL_csi3. Lemma RL_Q_Mesh : Mesh Q [<=] d. -unfold Q in |- *; eapply leEq_wdr. -apply sep__sep_Mesh. -unfold csi3 in |- *; rational. +Proof. + unfold Q in |- *; eapply leEq_wdr. + apply sep__sep_Mesh. + unfold csi3 in |- *; rational. Qed. Lemma RL_Q_sep : Separated Q R'. -unfold Q in |- *; apply sep__sep_lemma. +Proof. + unfold Q in |- *; apply sep__sep_lemma. Qed. Let fQ := @@ -902,66 +893,56 @@ Let fQ := fP'. Lemma RL_fQ_in_Q : Points_in_Partition Q fQ. -unfold Q, fQ in |- *; apply sep__sep_points_lemma. -apply RL_fP'_in_P'. +Proof. + unfold Q, fQ in |- *; apply sep__sep_points_lemma. + apply RL_fP'_in_P'. Qed. Lemma RL_Q_P'_sum : AbsIR (Partition_Sum RL_fP'_in_P' incF[-]Partition_Sum RL_fQ_in_Q incF) [<=] alpha. -apply - leEq_wdl - with - (AbsIR - (Partition_Sum RL_fP'_in_P' incF[-] - Partition_Sum - (sep__sep_points_lemma _ _ _ F contF Hab' _ _ _ _ RL_P'_sep RL_R'_sep _ - RL_alpha _ RL_csi3 _ RL_fP'_in_P') incF)). -unfold Q, fQ in |- *; apply sep__sep_Sum. -apply AbsIR_wd. -unfold Partition_Sum in |- *; apply cg_minus_wd. -algebra. -apply Sumx_wd; intros. -algebra. +Proof. + apply leEq_wdl with (AbsIR (Partition_Sum RL_fP'_in_P' incF[-] Partition_Sum + (sep__sep_points_lemma _ _ _ F contF Hab' _ _ _ _ RL_P'_sep RL_R'_sep _ + RL_alpha _ RL_csi3 _ RL_fP'_in_P') incF)). + unfold Q, fQ in |- *; apply sep__sep_Sum. + apply AbsIR_wd. + unfold Partition_Sum in |- *; apply cg_minus_wd. + algebra. + apply Sumx_wd; intros. + algebra. Qed. (* end hide *) Lemma third_refinement_lemma : AbsIR (Partition_Sum HfP incF[-]Partition_Sum HfR incF) [<=] e[*] (b[-]a) [+]e'[*] (b[-]a) [+]beta. -apply - leEq_wdl - with - (AbsIR - (Partition_Sum HfP incF[-]Partition_Sum RL_fP'_in_P' incF[+] - (Partition_Sum RL_fP'_in_P' incF[-]Partition_Sum RL_fQ_in_Q incF) [+] - (Partition_Sum RL_fQ_in_Q incF[-]Partition_Sum RL_fR'_in_R' incF) [+] - (Partition_Sum RL_fR'_in_R' incF[-]Partition_Sum HfR incF))). -apply leEq_wdr with (alpha[+]alpha[+] (e[*] (b[-]a) [+]e'[*] (b[-]a)) [+]alpha). -2: unfold alpha in |- *; rational. -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq_both. -apply RL_P'_P_sum. -apply RL_Q_P'_sum. -2: eapply leEq_wdl. -3: apply AbsIR_minus. -2: apply RL_R'_R_sum. -2: apply AbsIR_wd; rational. -eapply - second_refinement_lemma - with - (Q := Separated_Refinement _ _ _ _ _ _ _ RL_Q_sep) - (He := He) - (He' := He'). -apply Separated_Refinement_lft. -apply Separated_Refinement_rht. -apply RL_Q_Mesh. -apply less_leEq; apply RL_R'_Mesh. +Proof. + apply leEq_wdl with (AbsIR (Partition_Sum HfP incF[-]Partition_Sum RL_fP'_in_P' incF[+] + (Partition_Sum RL_fP'_in_P' incF[-]Partition_Sum RL_fQ_in_Q incF) [+] + (Partition_Sum RL_fQ_in_Q incF[-]Partition_Sum RL_fR'_in_R' incF) [+] + (Partition_Sum RL_fR'_in_R' incF[-]Partition_Sum HfR incF))). + apply leEq_wdr with (alpha[+]alpha[+] (e[*] (b[-]a) [+]e'[*] (b[-]a)) [+]alpha). + 2: unfold alpha in |- *; rational. + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq_both. + apply RL_P'_P_sum. + apply RL_Q_P'_sum. + 2: eapply leEq_wdl. + 3: apply AbsIR_minus. + 2: apply RL_R'_R_sum. + 2: apply AbsIR_wd; rational. + eapply second_refinement_lemma with (Q := Separated_Refinement _ _ _ _ _ _ _ RL_Q_sep) (He := He) + (He' := He'). + apply Separated_Refinement_lft. + apply Separated_Refinement_rht. + apply RL_Q_Mesh. + apply less_leEq; apply RL_R'_Mesh. Qed. End Third_Refinement_Lemma. @@ -975,41 +956,34 @@ Notation just := (fun z => incF _ (Pts_part_lemma _ _ _ _ _ _ z _ _)). Lemma RL_sum_lemma_aux : forall (n : nat) (P : Partition Hab n) fP (HfP : Points_in_Partition P fP), - Partition_Sum HfP incF [=] + Partition_Sum HfP incF [=] Fa[*] (b[-]a) [-] Sumx (fun (i : nat) (Hi : i < n) => (Fa[-]Part F (fP i Hi) (just HfP)) [*] (P _ Hi[-]P _ (lt_le_weak _ _ Hi))). -intros; - apply - eq_transitive_unfolded - with - (Sumx - (fun (i : nat) (Hi : i < n) => - Fa[*] (P _ Hi[-]P _ (lt_le_weak _ _ Hi))) [-] - Sumx - (fun (i : nat) (Hi : i < n) => - (Fa[-]Part F (fP i Hi) (just HfP)) [*] - (P _ Hi[-]P _ (lt_le_weak _ _ Hi)))). -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply Sumx_minus_Sumx. -unfold Partition_Sum in |- *; apply Sumx_wd; intros. -eapply eq_transitive_unfolded. -2: apply ring_distl_minus. -apply mult_wdl. -rstepr (Part F (fP i H) (just HfP)); algebra. -apply cg_minus_wd. -2: algebra. -astepr (Fa[*]b[-]Fa[*]a). -eapply eq_transitive_unfolded. -apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= n) => Fa[*]P i Hi). -red in |- *; intros. -apply mult_wdr. -apply prf1; auto. -intros; algebra. -apply cg_minus_wd; apply mult_wdr. -apply finish. -apply start. +Proof. + intros; apply eq_transitive_unfolded with (Sumx (fun (i : nat) (Hi : i < n) => + Fa[*] (P _ Hi[-]P _ (lt_le_weak _ _ Hi))) [-] Sumx (fun (i : nat) (Hi : i < n) => + (Fa[-]Part F (fP i Hi) (just HfP)) [*] (P _ Hi[-]P _ (lt_le_weak _ _ Hi)))). + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply Sumx_minus_Sumx. + unfold Partition_Sum in |- *; apply Sumx_wd; intros. + eapply eq_transitive_unfolded. + 2: apply ring_distl_minus. + apply mult_wdl. + rstepr (Part F (fP i H) (just HfP)); algebra. + apply cg_minus_wd. + 2: algebra. + astepr (Fa[*]b[-]Fa[*]a). + eapply eq_transitive_unfolded. + apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= n) => Fa[*]P i Hi). + red in |- *; intros. + apply mult_wdr. + apply prf1; auto. + intros; algebra. + apply cg_minus_wd; apply mult_wdr. + apply finish. + apply start. Qed. (* end hide *) @@ -1049,119 +1023,88 @@ Hypothesis Hab' : b[-]a [<] Min d d'. Lemma fourth_refinement_lemma : AbsIR (Partition_Sum HfP incF[-]Partition_Sum HfR incF) [<=] e[*] (b[-]a) [+]e'[*] (b[-]a). -generalize (proj2b_sig2T _ _ _ (contF' e He)); - generalize (proj2a_sig2T _ _ _ (contF' e He)); fold d in |- *; - intros Hd Hdd. -generalize (proj2b_sig2T _ _ _ (contF' e' He')); - generalize (proj2a_sig2T _ _ _ (contF' e' He')); fold d' in |- *; - intros Hd' Hdd'. -apply - leEq_wdl - with - (AbsIR - (Fa[*] (b[-]a) [-] - Sumx - (fun (i : nat) (Hi : i < n) => - (Fa[-]Part F (fP i Hi) (just HfP)) [*] - (P _ Hi[-]P _ (lt_le_weak _ _ Hi))) [-] - (Fa[*] (b[-]a) [-] - Sumx - (fun (j : nat) (Hj : j < m) => - (Fa[-]Part F (fR j Hj) (just HfR)) [*] - (R _ Hj[-]R _ (lt_le_weak _ _ Hj)))))). -2: apply AbsIR_wd; apply eq_symmetric_unfolded. -2: apply cg_minus_wd; apply RL_sum_lemma_aux. -apply - leEq_wdl - with - (AbsIR - (Sumx - (fun (j : nat) (Hj : j < m) => - (Fa[-]Part F (fR j Hj) (just HfR)) [*] - (R _ Hj[-]R _ (lt_le_weak _ _ Hj))) [-] - Sumx - (fun (i : nat) (Hi : i < n) => - (Fa[-]Part F (fP i Hi) (just HfP)) [*] - (P _ Hi[-]P _ (lt_le_weak _ _ Hi))))). -2: apply AbsIR_wd; rational. -rstepr (e'[*] (b[-]a) [+]e[*] (b[-]a)). -eapply leEq_transitive. -apply triangle_IR_minus. -apply plus_resp_leEq_both. -eapply leEq_transitive. -apply triangle_SumxIR. -apply - leEq_wdr - with - (Sumx - (fun (i : nat) (Hi : i < m) => e'[*] (R _ Hi[-]R _ (lt_le_weak _ _ Hi)))). -apply Sumx_resp_leEq; intros. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -unfold Fa in |- *; apply Hdd'; unfold I in |- *. -apply compact_inc_lft. -apply Pts_part_lemma with m R; assumption. -apply leEq_transitive with (AbsIR (b[-]a)). -apply compact_elements with Hab. -apply compact_inc_lft. -apply Pts_part_lemma with m R; assumption. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl a; assumption. -eapply leEq_transitive. -apply less_leEq; apply Hab'. -apply Min_leEq_rht. -apply eq_imp_leEq; apply AbsIR_eq_x. -apply shift_leEq_minus; astepl (R i (lt_le_weak _ _ H)); apply prf2. -eapply eq_transitive_unfolded. -apply - Sumx_comm_scal' - with (f := fun (i : nat) (Hi : i < m) => R _ Hi[-]R _ (lt_le_weak _ _ Hi)). -apply mult_wdr. -eapply eq_transitive_unfolded. -apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= m) => R i Hi). -red in |- *; intros. -apply prf1; auto. -intros; algebra. -apply cg_minus_wd; [ apply finish | apply start ]. -eapply leEq_transitive. -apply triangle_SumxIR. -apply - leEq_wdr - with - (Sumx - (fun (i : nat) (Hi : i < n) => e[*] (P _ Hi[-]P _ (lt_le_weak _ _ Hi)))). -apply Sumx_resp_leEq; intros. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -unfold Fa in |- *; apply Hdd; unfold I in |- *. -apply compact_inc_lft. -apply Pts_part_lemma with n P; assumption. -apply leEq_transitive with (AbsIR (b[-]a)). -apply compact_elements with Hab. -apply compact_inc_lft. -apply Pts_part_lemma with n P; assumption. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl a; assumption. -eapply leEq_transitive. -apply less_leEq; apply Hab'. -apply Min_leEq_lft. -apply eq_imp_leEq; apply AbsIR_eq_x. -apply shift_leEq_minus; astepl (P i (lt_le_weak _ _ H)); apply prf2. -eapply eq_transitive_unfolded. -apply - Sumx_comm_scal' - with (f := fun (i : nat) (Hi : i < n) => P _ Hi[-]P _ (lt_le_weak _ _ Hi)). -apply mult_wdr. -eapply eq_transitive_unfolded. -apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= n) => P i Hi). -red in |- *; intros. -apply prf1; auto. -intros; algebra. -apply cg_minus_wd; [ apply finish | apply start ]. +Proof. + generalize (proj2b_sig2T _ _ _ (contF' e He)); + generalize (proj2a_sig2T _ _ _ (contF' e He)); fold d in |- *; intros Hd Hdd. + generalize (proj2b_sig2T _ _ _ (contF' e' He')); + generalize (proj2a_sig2T _ _ _ (contF' e' He')); fold d' in |- *; intros Hd' Hdd'. + apply leEq_wdl with (AbsIR (Fa[*] (b[-]a) [-] Sumx (fun (i : nat) (Hi : i < n) => + (Fa[-]Part F (fP i Hi) (just HfP)) [*] (P _ Hi[-]P _ (lt_le_weak _ _ Hi))) [-] (Fa[*] (b[-]a) [-] + Sumx (fun (j : nat) (Hj : j < m) => (Fa[-]Part F (fR j Hj) (just HfR)) [*] + (R _ Hj[-]R _ (lt_le_weak _ _ Hj)))))). + 2: apply AbsIR_wd; apply eq_symmetric_unfolded. + 2: apply cg_minus_wd; apply RL_sum_lemma_aux. + apply leEq_wdl with (AbsIR (Sumx (fun (j : nat) (Hj : j < m) => + (Fa[-]Part F (fR j Hj) (just HfR)) [*] (R _ Hj[-]R _ (lt_le_weak _ _ Hj))) [-] Sumx + (fun (i : nat) (Hi : i < n) => (Fa[-]Part F (fP i Hi) (just HfP)) [*] + (P _ Hi[-]P _ (lt_le_weak _ _ Hi))))). + 2: apply AbsIR_wd; rational. + rstepr (e'[*] (b[-]a) [+]e[*] (b[-]a)). + eapply leEq_transitive. + apply triangle_IR_minus. + apply plus_resp_leEq_both. + eapply leEq_transitive. + apply triangle_SumxIR. + apply leEq_wdr with (Sumx (fun (i : nat) (Hi : i < m) => e'[*] (R _ Hi[-]R _ (lt_le_weak _ _ Hi)))). + apply Sumx_resp_leEq; intros. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + unfold Fa in |- *; apply Hdd'; unfold I in |- *. + apply compact_inc_lft. + apply Pts_part_lemma with m R; assumption. + apply leEq_transitive with (AbsIR (b[-]a)). + apply compact_elements with Hab. + apply compact_inc_lft. + apply Pts_part_lemma with m R; assumption. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl a; assumption. + eapply leEq_transitive. + apply less_leEq; apply Hab'. + apply Min_leEq_rht. + apply eq_imp_leEq; apply AbsIR_eq_x. + apply shift_leEq_minus; astepl (R i (lt_le_weak _ _ H)); apply prf2. + eapply eq_transitive_unfolded. + apply Sumx_comm_scal' with (f := fun (i : nat) (Hi : i < m) => R _ Hi[-]R _ (lt_le_weak _ _ Hi)). + apply mult_wdr. + eapply eq_transitive_unfolded. + apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= m) => R i Hi). + red in |- *; intros. + apply prf1; auto. + intros; algebra. + apply cg_minus_wd; [ apply finish | apply start ]. + eapply leEq_transitive. + apply triangle_SumxIR. + apply leEq_wdr with (Sumx (fun (i : nat) (Hi : i < n) => e[*] (P _ Hi[-]P _ (lt_le_weak _ _ Hi)))). + apply Sumx_resp_leEq; intros. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + unfold Fa in |- *; apply Hdd; unfold I in |- *. + apply compact_inc_lft. + apply Pts_part_lemma with n P; assumption. + apply leEq_transitive with (AbsIR (b[-]a)). + apply compact_elements with Hab. + apply compact_inc_lft. + apply Pts_part_lemma with n P; assumption. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl a; assumption. + eapply leEq_transitive. + apply less_leEq; apply Hab'. + apply Min_leEq_lft. + apply eq_imp_leEq; apply AbsIR_eq_x. + apply shift_leEq_minus; astepl (P i (lt_le_weak _ _ H)); apply prf2. + eapply eq_transitive_unfolded. + apply Sumx_comm_scal' with (f := fun (i : nat) (Hi : i < n) => P _ Hi[-]P _ (lt_le_weak _ _ Hi)). + apply mult_wdr. + eapply eq_transitive_unfolded. + apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= n) => P i Hi). + red in |- *; intros. + apply prf1; auto. + intros; algebra. + apply cg_minus_wd; [ apply finish | apply start ]. Qed. End Fourth_Refinement_Lemma. @@ -1196,21 +1139,22 @@ Hypothesis HfR : Points_in_Partition R fR. Hypothesis HfR' : nat_less_n_fun fR. Lemma refinement_lemma : AbsIR (Partition_Sum HfP incF[-]Partition_Sum HfR incF) [<=] e[*] (b[-]a) [+]e'[*] (b[-]a). -cut (Zero [<] Min d d'). -intro H; elim (less_cotransitive_unfolded _ _ _ H (b[-]a)); intro. -astepr (e[*] (b[-]a) [+]e'[*] (b[-]a) [+]Zero). -apply shift_leEq_plus'. -apply approach_zero_weak. -intros beta Hbeta. -apply shift_minus_leEq. -astepr (e[*] (b[-]a) [+]e'[*] (b[-]a) [+]beta). -apply third_refinement_lemma with (He := He) (He' := He'); try assumption. -astepl (Zero[+]a); apply shift_plus_less; assumption. -apply fourth_refinement_lemma with He He'. -assumption. -apply less_Min. -unfold d in |- *; apply proj2a_sig2T. -unfold d' in |- *; apply proj2a_sig2T. +Proof. + cut (Zero [<] Min d d'). + intro H; elim (less_cotransitive_unfolded _ _ _ H (b[-]a)); intro. + astepr (e[*] (b[-]a) [+]e'[*] (b[-]a) [+]Zero). + apply shift_leEq_plus'. + apply approach_zero_weak. + intros beta Hbeta. + apply shift_minus_leEq. + astepr (e[*] (b[-]a) [+]e'[*] (b[-]a) [+]beta). + apply third_refinement_lemma with (He := He) (He' := He'); try assumption. + astepl (Zero[+]a); apply shift_plus_less; assumption. + apply fourth_refinement_lemma with He He'. + assumption. + apply less_Min. + unfold d in |- *; apply proj2a_sig2T. + unfold d' in |- *; apply proj2a_sig2T. Qed. End Main_Refinement_Lemma. diff --git a/ftc/RefSepRef.v b/ftc/RefSepRef.v index 013fe87ac..dbe88cdea 100644 --- a/ftc/RefSepRef.v +++ b/ftc/RefSepRef.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) @@ -56,36 +56,42 @@ Variable R : Partition Hab m. Hypothesis HPR : Separated P R. Lemma RSR_HP : _Separated P. -elim HPR; intros; assumption. +Proof. + elim HPR; intros; assumption. Qed. Lemma RSR_HP' : a[=]b -> 0 = n. -intro. -apply _Separated_imp_length_zero with (P := P). -exact RSR_HP. -assumption. +Proof. + intro. + apply _Separated_imp_length_zero with (P := P). + exact RSR_HP. + assumption. Qed. Lemma RSR_HR : _Separated R. -elim HPR; intros. -elim b0; intros; assumption. +Proof. + elim HPR; intros. + elim b0; intros; assumption. Qed. Lemma RSR_HR' : a[=]b -> 0 = m. -intro. -apply _Separated_imp_length_zero with (P := R). -exact RSR_HR. -assumption. +Proof. + intro. + apply _Separated_imp_length_zero with (P := R). + exact RSR_HR. + assumption. Qed. Lemma RSR_mn0 : 0 = m -> 0 = n. -intro; apply RSR_HP'; apply partition_length_zero with Hab. -rewrite H; apply R. +Proof. + intro; apply RSR_HP'; apply partition_length_zero with Hab. + rewrite H; apply R. Qed. Lemma RSR_nm0 : 0 = n -> 0 = m. -intro; apply RSR_HR'; apply partition_length_zero with Hab. -rewrite H; apply P. +Proof. + intro; apply RSR_HR'; apply partition_length_zero with Hab. + rewrite H; apply P. Qed. Lemma RSR_H' : @@ -93,77 +99,88 @@ Lemma RSR_H' : 0 < i -> 0 < j -> i < n -> j < m -> forall (Hi : i <= n) (Hj : j <= m), P i Hi[#]R j Hj. -elim HPR; do 2 intro. -elim b0; do 2 intro; assumption. +Proof. + elim HPR; do 2 intro. + elim b0; do 2 intro; assumption. Qed. Let f' (i : nat) (H : i < pred n) := P _ (lt_8 _ _ H). Let g' (j : nat) (H : j < pred m) := R _ (lt_8 _ _ H). Lemma RSR_f'_nlnf : nat_less_n_fun f'. -red in |- *; intros; unfold f' in |- *; apply prf1; auto. +Proof. + red in |- *; intros; unfold f' in |- *; apply prf1; auto. Qed. Lemma RSR_g'_nlnf : nat_less_n_fun g'. -red in |- *; intros; unfold g' in |- *; apply prf1; auto. +Proof. + red in |- *; intros; unfold g' in |- *; apply prf1; auto. Qed. Lemma RSR_f'_mon : forall (i i' : nat) Hi Hi', i < i' -> f' i Hi[<]f' i' Hi'. -intros. -apply local_mon_imp_mon_lt with (n := pred n). -intros; unfold f' in |- *; apply RSR_HP. -assumption. +Proof. + intros. + apply local_mon_imp_mon_lt with (n := pred n). + intros; unfold f' in |- *; apply RSR_HP. + assumption. Qed. Lemma RSR_g'_mon : forall (j j' : nat) Hj Hj', j < j' -> g' j Hj[<]g' j' Hj'. -intros. -apply local_mon_imp_mon_lt with (n := pred m). -intros; unfold g' in |- *; apply RSR_HR. -assumption. +Proof. + intros. + apply local_mon_imp_mon_lt with (n := pred m). + intros; unfold g' in |- *; apply RSR_HR. + assumption. Qed. Lemma RSR_f'_ap_g' : forall (i j : nat) Hi Hj, f' i Hi[#]g' j Hj. -intros. -unfold f', g' in |- *; apply RSR_H'. -apply lt_O_Sn. -apply lt_O_Sn. -apply pred_lt; assumption. -apply pred_lt; assumption. +Proof. + intros. + unfold f', g' in |- *; apply RSR_H'. + apply lt_O_Sn. + apply lt_O_Sn. + apply pred_lt; assumption. + apply pred_lt; assumption. Qed. Let h := om_fun _ _ _ _ _ RSR_f'_ap_g'. Lemma RSR_h_nlnf : nat_less_n_fun h. -unfold h in |- *; apply om_fun_1. -exact RSR_f'_nlnf. -exact RSR_g'_nlnf. +Proof. + unfold h in |- *; apply om_fun_1. + exact RSR_f'_nlnf. + exact RSR_g'_nlnf. Qed. Lemma RSR_h_mon : forall (i i' : nat) Hi Hi', i < i' -> h i Hi[<]h i' Hi'. -unfold h in |- *; apply om_fun_2; auto. -exact RSR_f'_nlnf. -exact RSR_g'_nlnf. -exact RSR_f'_mon. -exact RSR_g'_mon. +Proof. + unfold h in |- *; apply om_fun_2; auto. + exact RSR_f'_nlnf. + exact RSR_g'_nlnf. + exact RSR_f'_mon. + exact RSR_g'_mon. Qed. Lemma RSR_h_mon' : forall (i i' : nat) Hi Hi', i <= i' -> h i Hi[<=]h i' Hi'. -intros; apply mon_imp_mon'_lt with (n := pred m + pred n). -apply RSR_h_nlnf. -apply RSR_h_mon. -assumption. +Proof. + intros; apply mon_imp_mon'_lt with (n := pred m + pred n). + apply RSR_h_nlnf. + apply RSR_h_mon. + assumption. Qed. Lemma RSR_h_f' : forall (i : nat) Hi, {j : nat | {Hj : _ < _ | f' i Hi[=]h j Hj}}. -unfold h in |- *; apply om_fun_3a; auto. -exact RSR_f'_nlnf. -exact RSR_g'_nlnf. +Proof. + unfold h in |- *; apply om_fun_3a; auto. + exact RSR_f'_nlnf. + exact RSR_g'_nlnf. Qed. Lemma RSR_h_g' : forall (j : nat) Hj, {i : nat | {Hi : _ < _ | g' j Hj[=]h i Hi}}. -unfold h in |- *; apply om_fun_3b; auto. -exact RSR_f'_nlnf. -exact RSR_g'_nlnf. +Proof. + unfold h in |- *; apply om_fun_3b; auto. + exact RSR_f'_nlnf. + exact RSR_g'_nlnf. Qed. Lemma RSR_h_PropAll : @@ -171,7 +188,8 @@ Lemma RSR_h_PropAll : pred_wd' IR P -> (forall (i : nat) Hi, P (f' i Hi)) -> (forall (j : nat) Hj, P (g' j Hj)) -> forall (k : nat) Hk, P (h k Hk). -unfold h in |- *; apply om_fun_4b. +Proof. + unfold h in |- *; apply om_fun_4b. Qed. Lemma RSR_h_PropEx : @@ -180,18 +198,20 @@ Lemma RSR_h_PropEx : {i : nat | {Hi : _ < _ | P (f' i Hi)}} or {j : nat | {Hj : _ < _ | P (g' j Hj)}} -> {k : nat | {Hk : _ < _ | P (h k Hk)}}. -unfold h in |- *; intros; apply om_fun_4d; auto. -exact RSR_f'_nlnf. -exact RSR_g'_nlnf. +Proof. + unfold h in |- *; intros; apply om_fun_4d; auto. + exact RSR_f'_nlnf. + exact RSR_g'_nlnf. Qed. Definition Separated_Refinement_fun : forall i : nat, i <= pred (m + n) -> IR. -intros. -elim (le_lt_eq_dec _ _ H); intro. -elim (le_lt_dec i 0); intro. -apply a. -apply (h (pred i) (lt_10 _ _ _ b0 a0)). -apply b. +Proof. + intros. + elim (le_lt_eq_dec _ _ H); intro. + elim (le_lt_dec i 0); intro. + apply a. + apply (h (pred i) (lt_10 _ _ _ b0 a0)). + apply b. Defined. Lemma Separated_Refinement_lemma1 : @@ -199,518 +219,508 @@ Lemma Separated_Refinement_lemma1 : i = j -> forall (Hi : i <= pred (m + n)) (Hj : j <= pred (m + n)), Separated_Refinement_fun i Hi[=]Separated_Refinement_fun j Hj. -do 3 intro. -rewrite <- H; intros; unfold Separated_Refinement_fun in |- *; simpl in |- *. -elim (le_lt_eq_dec _ _ Hi); elim (le_lt_eq_dec _ _ Hj); elim (le_lt_dec i 0); - intros; simpl in |- *. -algebra. -apply RSR_h_nlnf; reflexivity. -elimtype False; rewrite <- b0 in a1; apply (lt_irrefl _ a1). -elimtype False; rewrite <- b1 in a0; apply (lt_irrefl _ a0). -elimtype False; rewrite <- b0 in a1; apply (lt_irrefl _ a1). -elimtype False; rewrite <- b1 in a0; apply (lt_irrefl _ a0). -algebra. -algebra. +Proof. + do 3 intro. + rewrite <- H; intros; unfold Separated_Refinement_fun in |- *; simpl in |- *. + elim (le_lt_eq_dec _ _ Hi); elim (le_lt_eq_dec _ _ Hj); elim (le_lt_dec i 0); intros; simpl in |- *. + algebra. + apply RSR_h_nlnf; reflexivity. + elimtype False; rewrite <- b0 in a1; apply (lt_irrefl _ a1). + elimtype False; rewrite <- b1 in a0; apply (lt_irrefl _ a0). + elimtype False; rewrite <- b0 in a1; apply (lt_irrefl _ a1). + elimtype False; rewrite <- b1 in a0; apply (lt_irrefl _ a0). + algebra. + algebra. Qed. Lemma Separated_Refinement_lemma3 : forall H : 0 <= pred (m + n), Separated_Refinement_fun 0 H[=]a. -intros; unfold Separated_Refinement_fun in |- *; simpl in |- *. -elim (le_lt_eq_dec _ _ H); elim (le_lt_dec 0 0); intros; simpl in |- *. -algebra. -elimtype False; inversion b0. -apply eq_symmetric_unfolded; apply partition_length_zero with Hab. -cut (m + n <= 1); [ intro | omega ]. -elim (plus_eq_one_imp_eq_zero _ _ H0); intro. -rewrite <- a1; apply R. -rewrite <- b1; apply P. -elimtype False; inversion b0. +Proof. + intros; unfold Separated_Refinement_fun in |- *; simpl in |- *. + elim (le_lt_eq_dec _ _ H); elim (le_lt_dec 0 0); intros; simpl in |- *. + algebra. + elimtype False; inversion b0. + apply eq_symmetric_unfolded; apply partition_length_zero with Hab. + cut (m + n <= 1); [ intro | omega ]. + elim (plus_eq_one_imp_eq_zero _ _ H0); intro. + rewrite <- a1; apply R. + rewrite <- b1; apply P. + elimtype False; inversion b0. Qed. Lemma Separated_Refinement_lemma4 : forall H : pred (m + n) <= pred (m + n), Separated_Refinement_fun (pred (m + n)) H[=]b. -intros; unfold Separated_Refinement_fun in |- *; simpl in |- *. -elim (le_lt_eq_dec _ _ H); elim (le_lt_dec 0 0); intros; simpl in |- *. -algebra. -elimtype False; apply (lt_irrefl _ a1). -elimtype False; apply (lt_irrefl _ a0). -algebra. -algebra. +Proof. + intros; unfold Separated_Refinement_fun in |- *; simpl in |- *. + elim (le_lt_eq_dec _ _ H); elim (le_lt_dec 0 0); intros; simpl in |- *. + algebra. + elimtype False; apply (lt_irrefl _ a1). + elimtype False; apply (lt_irrefl _ a0). + algebra. + algebra. Qed. Lemma Separated_Refinement_lemma2 : forall (i : nat) (H : i <= pred (m + n)) (H' : S i <= pred (m + n)), Separated_Refinement_fun i H[<=]Separated_Refinement_fun (S i) H'. -intros; unfold Separated_Refinement_fun in |- *; simpl in |- *. -elim (le_lt_eq_dec _ _ H); elim (le_lt_eq_dec _ _ H'); intros; simpl in |- *. -elim (le_lt_dec i 0); elim (le_lt_dec (S i) 0); intros; simpl in |- *. -elimtype False; inversion a2. -apply RSR_h_PropAll with (P := fun x : IR => a[<=]x). -red in |- *; intros. -apply leEq_wdr with x; assumption. -intros; unfold f' in |- *. -astepl (P 0 (le_O_n _)). -apply Partition_mon; apply le_O_n. -intros; unfold g' in |- *. -astepl (R 0 (le_O_n _)). -apply Partition_mon; apply le_O_n. -elimtype False; inversion a2. -apply less_leEq; apply RSR_h_mon; auto with arith. -elim (le_lt_dec i 0); elim (le_lt_dec (S i) 0); intros; simpl in |- *. -elimtype False; inversion a1. -assumption. -elimtype False; inversion a1. -apply RSR_h_PropAll with (P := fun x : IR => x[<=]b). -red in |- *; intros. -apply leEq_wdl with x; assumption. -intros; unfold f' in |- *. -apply leEq_wdr with (P _ (le_n _)). -apply Partition_mon; apply le_trans with (pred n); auto with arith. -apply finish. -intros; unfold g' in |- *. -apply leEq_wdr with (R _ (le_n _)). -apply Partition_mon; apply le_trans with (pred m); auto with arith. -apply finish. -elimtype False; rewrite <- b0 in H'; apply (le_Sn_n _ H'). -apply leEq_reflexive. +Proof. + intros; unfold Separated_Refinement_fun in |- *; simpl in |- *. + elim (le_lt_eq_dec _ _ H); elim (le_lt_eq_dec _ _ H'); intros; simpl in |- *. + elim (le_lt_dec i 0); elim (le_lt_dec (S i) 0); intros; simpl in |- *. + elimtype False; inversion a2. + apply RSR_h_PropAll with (P := fun x : IR => a[<=]x). + red in |- *; intros. + apply leEq_wdr with x; assumption. + intros; unfold f' in |- *. + astepl (P 0 (le_O_n _)). + apply Partition_mon; apply le_O_n. + intros; unfold g' in |- *. + astepl (R 0 (le_O_n _)). + apply Partition_mon; apply le_O_n. + elimtype False; inversion a2. + apply less_leEq; apply RSR_h_mon; auto with arith. + elim (le_lt_dec i 0); elim (le_lt_dec (S i) 0); intros; simpl in |- *. + elimtype False; inversion a1. + assumption. + elimtype False; inversion a1. + apply RSR_h_PropAll with (P := fun x : IR => x[<=]b). + red in |- *; intros. + apply leEq_wdl with x; assumption. + intros; unfold f' in |- *. + apply leEq_wdr with (P _ (le_n _)). + apply Partition_mon; apply le_trans with (pred n); auto with arith. + apply finish. + intros; unfold g' in |- *. + apply leEq_wdr with (R _ (le_n _)). + apply Partition_mon; apply le_trans with (pred m); auto with arith. + apply finish. + elimtype False; rewrite <- b0 in H'; apply (le_Sn_n _ H'). + apply leEq_reflexive. Qed. Definition Separated_Refinement : Partition Hab (pred (m + n)). -apply Build_Partition with Separated_Refinement_fun. -exact Separated_Refinement_lemma1. -exact Separated_Refinement_lemma2. -exact Separated_Refinement_lemma3. -exact Separated_Refinement_lemma4. +Proof. + apply Build_Partition with Separated_Refinement_fun. + exact Separated_Refinement_lemma1. + exact Separated_Refinement_lemma2. + exact Separated_Refinement_lemma3. + exact Separated_Refinement_lemma4. Defined. Definition RSR_auxP : nat -> nat. -intro i. -elim (le_lt_dec i 0); intro. -apply 0. -elim (le_lt_dec n i); intro. -apply (pred (m + n) + (i - n)). -apply (S (ProjT1 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b1)))). +Proof. + intro i. + elim (le_lt_dec i 0); intro. + apply 0. + elim (le_lt_dec n i); intro. + apply (pred (m + n) + (i - n)). + apply (S (ProjT1 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b1)))). Defined. Definition RSR_auxR : nat -> nat. -intro i. -elim (le_lt_dec i 0); intro. -apply 0. -elim (le_lt_dec m i); intro. -apply (pred (m + n) + (i - m)). -apply (S (ProjT1 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b1)))). +Proof. + intro i. + elim (le_lt_dec i 0); intro. + apply 0. + elim (le_lt_dec m i); intro. + apply (pred (m + n) + (i - m)). + apply (S (ProjT1 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b1)))). Defined. Lemma RSR_auxP_lemma0 : RSR_auxP 0 = 0. -unfold RSR_auxP in |- *. -elim (le_lt_dec 0 0); intro; simpl in |- *. -reflexivity. -elimtype False; inversion b0. +Proof. + unfold RSR_auxP in |- *. + elim (le_lt_dec 0 0); intro; simpl in |- *. + reflexivity. + elimtype False; inversion b0. Qed. Lemma RSR_h_inj : forall (i j : nat) Hi Hj, h i Hi[=]h j Hj -> i = j. -intros. -eapply mon_imp_inj_lt with (f := h). -exact RSR_h_mon. -apply H. +Proof. + intros. + eapply mon_imp_inj_lt with (f := h). + exact RSR_h_mon. + apply H. Qed. Lemma RSR_auxP_lemmai : forall (i : nat) (Hi : 0 < i) (Hi' : i < n), RSR_auxP i = S (ProjT1 (RSR_h_f' (pred i) (lt_pred' _ _ Hi Hi'))). -intros. -unfold RSR_auxP in |- *. -elim (le_lt_dec n i); intro; simpl in |- *. -elimtype False; apply le_not_lt with n i; auto. -elim (le_lt_dec i 0); intro; simpl in |- *. -elimtype False; apply lt_irrefl with 0; apply lt_le_trans with i; auto. -set (x := ProjT1 (RSR_h_f' _ (lt_pred' _ _ b1 b0))) in *. -set (y := ProjT1 (RSR_h_f' _ (lt_pred' _ _ Hi Hi'))) in *. -cut (x = y). -intro; auto with arith. -assert (H := ProjT2 (RSR_h_f' _ (lt_pred' _ _ b1 b0))). -assert (H0 := ProjT2 (RSR_h_f' _ (lt_pred' _ _ Hi Hi'))). -elim H; clear H; intros Hx Hx'. -elim H0; clear H0; intros Hy Hy'. -apply RSR_h_inj with Hx Hy. -eapply eq_transitive_unfolded. -2: apply Hy'. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply Hx'. -apply RSR_f'_nlnf; reflexivity. +Proof. + intros. + unfold RSR_auxP in |- *. + elim (le_lt_dec n i); intro; simpl in |- *. + elimtype False; apply le_not_lt with n i; auto. + elim (le_lt_dec i 0); intro; simpl in |- *. + elimtype False; apply lt_irrefl with 0; apply lt_le_trans with i; auto. + set (x := ProjT1 (RSR_h_f' _ (lt_pred' _ _ b1 b0))) in *. + set (y := ProjT1 (RSR_h_f' _ (lt_pred' _ _ Hi Hi'))) in *. + cut (x = y). + intro; auto with arith. + assert (H := ProjT2 (RSR_h_f' _ (lt_pred' _ _ b1 b0))). + assert (H0 := ProjT2 (RSR_h_f' _ (lt_pred' _ _ Hi Hi'))). + elim H; clear H; intros Hx Hx'. + elim H0; clear H0; intros Hy Hy'. + apply RSR_h_inj with Hx Hy. + eapply eq_transitive_unfolded. + 2: apply Hy'. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply Hx'. + apply RSR_f'_nlnf; reflexivity. Qed. Lemma RSR_auxP_lemman : RSR_auxP n = pred (m + n). -unfold RSR_auxP in |- *. -elim (le_lt_dec n 0); intro; simpl in |- *. -cut (n = 0); [ intro | auto with arith ]. -transitivity (pred m). -2: rewrite H; auto. -cut (0 = m); [ intro; rewrite <- H0; auto | apply RSR_HR' ]. -apply partition_length_zero with Hab; rewrite <- H; apply P. -elim (le_lt_dec n n); intro; simpl in |- *. -rewrite <- minus_n_n; auto. -elimtype False; apply lt_irrefl with n; auto. +Proof. + unfold RSR_auxP in |- *. + elim (le_lt_dec n 0); intro; simpl in |- *. + cut (n = 0); [ intro | auto with arith ]. + transitivity (pred m). + 2: rewrite H; auto. + cut (0 = m); [ intro; rewrite <- H0; auto | apply RSR_HR' ]. + apply partition_length_zero with Hab; rewrite <- H; apply P. + elim (le_lt_dec n n); intro; simpl in |- *. + rewrite <- minus_n_n; auto. + elimtype False; apply lt_irrefl with n; auto. Qed. Lemma RSR_auxP_lemma1 : forall i j : nat, i < j -> RSR_auxP i < RSR_auxP j. -intros; unfold RSR_auxP in |- *. -assert (X:=not_not_lt); assert (X':=plus_pred_pred_plus). -assert (X'':=RSR_mn0); assert (X''':=RSR_nm0). -elim (le_lt_dec i 0); intro. -elim (le_lt_dec j 0); intros; simpl in |- *. -apply lt_le_trans with j; try apply le_lt_trans with i; auto with arith. -elim (le_lt_dec n j); intros; simpl in |- *. -omega. -apply lt_O_Sn. -elim (le_lt_dec n i); elim (le_lt_dec j 0); intros; simpl in |- *. -elim (lt_irrefl 0); apply lt_le_trans with j; try apply le_lt_trans with i; - auto with arith. -elim (le_lt_dec n j); intro; simpl in |- *. -apply plus_lt_compat_l. -apply plus_lt_reg_l with n. -repeat rewrite <- le_plus_minus; auto. -elim (le_not_lt n i); auto; apply lt_trans with j; auto. -elim (lt_irrefl 0); apply lt_trans with i; auto; apply lt_le_trans with j; - auto. -elim (le_lt_dec n j); intro; simpl in |- *. -apply lt_le_trans with (S (pred m + pred n)). -apply lt_n_S. -apply (ProjT1 (ProjT2 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2)))). -rewrite plus_n_Sm. -rewrite <- S_pred with n 0. -2: apply lt_trans with i; auto. -replace (pred m + n) with (pred (m + n)). -auto with arith. -cut (S (pred (m + n)) = S (pred m + n)); auto. -rewrite <- plus_Sn_m. -rewrite (S_pred m 0); auto with arith. -apply neq_O_lt. -intro. -apply lt_irrefl with 0. -apply lt_trans with i; auto. -rewrite RSR_mn0; auto. -apply lt_n_S. -cut - (~ - ~ - ProjT1 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2)) < - ProjT1 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3))); intro. -apply not_not_lt; assumption. -cut - (ProjT1 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3)) <= - ProjT1 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2))); intros. -2: apply not_lt; assumption. -cut - (h _ (ProjT1 (ProjT2 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3))))[<=] - h _ (ProjT1 (ProjT2 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2))))). -intro. -2: apply RSR_h_mon'; assumption. -cut (f' (pred j) (lt_pred' _ _ b1 b3)[<=]f' (pred i) (lt_pred' _ _ b0 b2)). -2: apply - leEq_wdl - with (h _ (ProjT1 (ProjT2 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3))))). -2: apply - leEq_wdr - with (h _ (ProjT1 (ProjT2 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2))))). -2: assumption. -3: apply eq_symmetric_unfolded; - exact (ProjT2 (ProjT2 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3)))). -2: apply eq_symmetric_unfolded; - exact (ProjT2 (ProjT2 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2)))). -clear H2 H1; intro. -cut (f' _ (lt_pred' _ _ b0 b2)[<]f' _ (lt_pred' _ _ b1 b3)). -2: apply RSR_f'_mon. -2: apply lt_pred'; assumption. -intro. -elimtype False. -apply less_irreflexive_unfolded with (x := f' _ (lt_pred' _ _ b1 b3)). -eapply leEq_less_trans; [ apply H1 | apply X0 ]. +Proof. + intros; unfold RSR_auxP in |- *. + assert (X:=not_not_lt); assert (X':=plus_pred_pred_plus). + assert (X'':=RSR_mn0); assert (X''':=RSR_nm0). + elim (le_lt_dec i 0); intro. + elim (le_lt_dec j 0); intros; simpl in |- *. + apply lt_le_trans with j; try apply le_lt_trans with i; auto with arith. + elim (le_lt_dec n j); intros; simpl in |- *. + omega. + apply lt_O_Sn. + elim (le_lt_dec n i); elim (le_lt_dec j 0); intros; simpl in |- *. + elim (lt_irrefl 0); apply lt_le_trans with j; try apply le_lt_trans with i; auto with arith. + elim (le_lt_dec n j); intro; simpl in |- *. + apply plus_lt_compat_l. + apply plus_lt_reg_l with n. + repeat rewrite <- le_plus_minus; auto. + elim (le_not_lt n i); auto; apply lt_trans with j; auto. + elim (lt_irrefl 0); apply lt_trans with i; auto; apply lt_le_trans with j; auto. + elim (le_lt_dec n j); intro; simpl in |- *. + apply lt_le_trans with (S (pred m + pred n)). + apply lt_n_S. + apply (ProjT1 (ProjT2 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2)))). + rewrite plus_n_Sm. + rewrite <- S_pred with n 0. + 2: apply lt_trans with i; auto. + replace (pred m + n) with (pred (m + n)). + auto with arith. + cut (S (pred (m + n)) = S (pred m + n)); auto. + rewrite <- plus_Sn_m. + rewrite (S_pred m 0); auto with arith. + apply neq_O_lt. + intro. + apply lt_irrefl with 0. + apply lt_trans with i; auto. + rewrite RSR_mn0; auto. + apply lt_n_S. + cut (~ ~ ProjT1 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2)) < + ProjT1 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3))); intro. + apply not_not_lt; assumption. + cut (ProjT1 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3)) <= + ProjT1 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2))); intros. + 2: apply not_lt; assumption. + cut (h _ (ProjT1 (ProjT2 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3))))[<=] + h _ (ProjT1 (ProjT2 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2))))). + intro. + 2: apply RSR_h_mon'; assumption. + cut (f' (pred j) (lt_pred' _ _ b1 b3)[<=]f' (pred i) (lt_pred' _ _ b0 b2)). + 2: apply leEq_wdl with (h _ (ProjT1 (ProjT2 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3))))). + 2: apply leEq_wdr with (h _ (ProjT1 (ProjT2 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2))))). + 2: assumption. + 3: apply eq_symmetric_unfolded; exact (ProjT2 (ProjT2 (RSR_h_f' (pred j) (lt_pred' _ _ b1 b3)))). + 2: apply eq_symmetric_unfolded; exact (ProjT2 (ProjT2 (RSR_h_f' (pred i) (lt_pred' _ _ b0 b2)))). + clear H2 H1; intro. + cut (f' _ (lt_pred' _ _ b0 b2)[<]f' _ (lt_pred' _ _ b1 b3)). + 2: apply RSR_f'_mon. + 2: apply lt_pred'; assumption. + intro. + elimtype False. + apply less_irreflexive_unfolded with (x := f' _ (lt_pred' _ _ b1 b3)). + eapply leEq_less_trans; [ apply H1 | apply X0 ]. Qed. Lemma RSR_auxP_lemma2 : forall (i : nat) (H : i <= n), {H' : RSR_auxP i <= _ | P i H[=]Separated_Refinement _ H'}. -intros. -unfold Separated_Refinement in |- *; simpl in |- *. -unfold Separated_Refinement_fun in |- *; simpl in |- *. -elim (le_lt_dec i 0); intro; simpl in |- *. -cut (i = 0); [ intro | auto with arith ]. -generalize H; clear a0 H; rewrite H0. -rewrite RSR_auxP_lemma0. -clear H0; intros. -exists (le_O_n (pred (m + n))). -elim le_lt_eq_dec; intro; simpl in |- *. -elim (le_lt_dec 0 0); intro; simpl in |- *. -apply start. -elimtype False; inversion b0. -apply eq_transitive_unfolded with a. -apply start. -apply partition_length_zero with Hab. -cut (m + n <= 1). -intro. -elim (plus_eq_one_imp_eq_zero _ _ H0); intro. -rewrite <- a0; apply R. -rewrite <- b1; apply P. -generalize b0; clear b0. -case (m + n). -auto. -intros. -simpl in b0; rewrite <- b0; auto. -elim (le_lt_eq_dec _ _ H); intro. -cut (pred i < pred n); - [ intro | apply lt_pred; rewrite <- S_pred with i 0; auto ]. -cut (RSR_auxP i <= pred (m + n)). -intro; exists H1. -elim le_lt_eq_dec; intro; simpl in |- *. -elim (le_lt_dec (RSR_auxP i) 0); intro; simpl in |- *. -cut (RSR_auxP i = 0); [ intro | auto with arith ]. -rewrite <- RSR_auxP_lemma0 in H2. -cut (RSR_auxP 0 < RSR_auxP i); [ intro | apply RSR_auxP_lemma1; assumption ]. -elimtype False; rewrite H2 in H3; apply (lt_irrefl _ H3). -generalize b1 a1; clear b1 a1. -rewrite (RSR_auxP_lemmai i b0 a0); intros. -simpl in |- *. -elim (ProjT2 (RSR_h_f' _ (lt_pred' i n b0 a0))); intros. -eapply eq_transitive_unfolded. -2: eapply eq_transitive_unfolded. -2: apply p. -unfold f' in |- *. -apply prf1; apply S_pred with 0; auto. -apply RSR_h_nlnf; reflexivity. -rewrite <- RSR_auxP_lemman in b1. -cut (i = n). -intro; elimtype False; rewrite H2 in a0; apply (lt_irrefl _ a0). -apply nat_mon_imp_inj with (h := RSR_auxP). -apply RSR_auxP_lemma1. -assumption. -unfold RSR_auxP in |- *. -elim (le_lt_dec i 0); intro; simpl in |- *. -apply le_O_n. -elim (le_lt_dec n i); intro; simpl in |- *. -elim (lt_irrefl n); apply le_lt_trans with i; auto. -apply plus_pred_pred_plus. -elim (ProjT2 (RSR_h_f' _ (lt_pred' i n b1 b2))); intros. -assumption. -generalize H; clear H; rewrite b1; intro. -rewrite RSR_auxP_lemman. -exists (le_n (pred (m + n))). -elim le_lt_eq_dec; intro; simpl in |- *. -elimtype False; apply (lt_irrefl _ a0). -apply finish. +Proof. + intros. + unfold Separated_Refinement in |- *; simpl in |- *. + unfold Separated_Refinement_fun in |- *; simpl in |- *. + elim (le_lt_dec i 0); intro; simpl in |- *. + cut (i = 0); [ intro | auto with arith ]. + generalize H; clear a0 H; rewrite H0. + rewrite RSR_auxP_lemma0. + clear H0; intros. + exists (le_O_n (pred (m + n))). + elim le_lt_eq_dec; intro; simpl in |- *. + elim (le_lt_dec 0 0); intro; simpl in |- *. + apply start. + elimtype False; inversion b0. + apply eq_transitive_unfolded with a. + apply start. + apply partition_length_zero with Hab. + cut (m + n <= 1). + intro. + elim (plus_eq_one_imp_eq_zero _ _ H0); intro. + rewrite <- a0; apply R. + rewrite <- b1; apply P. + generalize b0; clear b0. + case (m + n). + auto. + intros. + simpl in b0; rewrite <- b0; auto. + elim (le_lt_eq_dec _ _ H); intro. + cut (pred i < pred n); [ intro | apply lt_pred; rewrite <- S_pred with i 0; auto ]. + cut (RSR_auxP i <= pred (m + n)). + intro; exists H1. + elim le_lt_eq_dec; intro; simpl in |- *. + elim (le_lt_dec (RSR_auxP i) 0); intro; simpl in |- *. + cut (RSR_auxP i = 0); [ intro | auto with arith ]. + rewrite <- RSR_auxP_lemma0 in H2. + cut (RSR_auxP 0 < RSR_auxP i); [ intro | apply RSR_auxP_lemma1; assumption ]. + elimtype False; rewrite H2 in H3; apply (lt_irrefl _ H3). + generalize b1 a1; clear b1 a1. + rewrite (RSR_auxP_lemmai i b0 a0); intros. + simpl in |- *. + elim (ProjT2 (RSR_h_f' _ (lt_pred' i n b0 a0))); intros. + eapply eq_transitive_unfolded. + 2: eapply eq_transitive_unfolded. + 2: apply p. + unfold f' in |- *. + apply prf1; apply S_pred with 0; auto. + apply RSR_h_nlnf; reflexivity. + rewrite <- RSR_auxP_lemman in b1. + cut (i = n). + intro; elimtype False; rewrite H2 in a0; apply (lt_irrefl _ a0). + apply nat_mon_imp_inj with (h := RSR_auxP). + apply RSR_auxP_lemma1. + assumption. + unfold RSR_auxP in |- *. + elim (le_lt_dec i 0); intro; simpl in |- *. + apply le_O_n. + elim (le_lt_dec n i); intro; simpl in |- *. + elim (lt_irrefl n); apply le_lt_trans with i; auto. + apply plus_pred_pred_plus. + elim (ProjT2 (RSR_h_f' _ (lt_pred' i n b1 b2))); intros. + assumption. + generalize H; clear H; rewrite b1; intro. + rewrite RSR_auxP_lemman. + exists (le_n (pred (m + n))). + elim le_lt_eq_dec; intro; simpl in |- *. + elimtype False; apply (lt_irrefl _ a0). + apply finish. Qed. Lemma Separated_Refinement_lft : Refinement P Separated_Refinement. -exists RSR_auxP; repeat split. -exact RSR_auxP_lemman. -intros; apply RSR_auxP_lemma1; assumption. -exact RSR_auxP_lemma2. +Proof. + exists RSR_auxP; repeat split. + exact RSR_auxP_lemman. + intros; apply RSR_auxP_lemma1; assumption. + exact RSR_auxP_lemma2. Qed. Lemma RSR_auxR_lemma0 : RSR_auxR 0 = 0. -unfold RSR_auxR in |- *. -elim (le_lt_dec 0 0); intro; simpl in |- *. -reflexivity. -elimtype False; inversion b0. +Proof. + unfold RSR_auxR in |- *. + elim (le_lt_dec 0 0); intro; simpl in |- *. + reflexivity. + elimtype False; inversion b0. Qed. Lemma RSR_auxR_lemmai : forall (i : nat) (Hi : 0 < i) (Hi' : i < m), RSR_auxR i = S (ProjT1 (RSR_h_g' (pred i) (lt_pred' _ _ Hi Hi'))). -intros. -unfold RSR_auxR in |- *. -elim (le_lt_dec m i); intro; simpl in |- *. -elimtype False; apply le_not_lt with m i; auto. -elim (le_lt_dec i 0); intro; simpl in |- *. -elimtype False; apply lt_irrefl with 0; apply lt_le_trans with i; auto. -set (x := ProjT1 (RSR_h_g' _ (lt_pred' _ _ b1 b0))) in *. -set (y := ProjT1 (RSR_h_g' _ (lt_pred' _ _ Hi Hi'))) in *. -cut (x = y). -intro; auto with arith. -assert (H := ProjT2 (RSR_h_g' _ (lt_pred' _ _ b1 b0))). -assert (H0 := ProjT2 (RSR_h_g' _ (lt_pred' _ _ Hi Hi'))). -elim H; clear H; intros Hx Hx'. -elim H0; clear H0; intros Hy Hy'. -apply RSR_h_inj with Hx Hy. -eapply eq_transitive_unfolded. -2: apply Hy'. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply Hx'. -apply RSR_g'_nlnf; reflexivity. +Proof. + intros. + unfold RSR_auxR in |- *. + elim (le_lt_dec m i); intro; simpl in |- *. + elimtype False; apply le_not_lt with m i; auto. + elim (le_lt_dec i 0); intro; simpl in |- *. + elimtype False; apply lt_irrefl with 0; apply lt_le_trans with i; auto. + set (x := ProjT1 (RSR_h_g' _ (lt_pred' _ _ b1 b0))) in *. + set (y := ProjT1 (RSR_h_g' _ (lt_pred' _ _ Hi Hi'))) in *. + cut (x = y). + intro; auto with arith. + assert (H := ProjT2 (RSR_h_g' _ (lt_pred' _ _ b1 b0))). + assert (H0 := ProjT2 (RSR_h_g' _ (lt_pred' _ _ Hi Hi'))). + elim H; clear H; intros Hx Hx'. + elim H0; clear H0; intros Hy Hy'. + apply RSR_h_inj with Hx Hy. + eapply eq_transitive_unfolded. + 2: apply Hy'. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply Hx'. + apply RSR_g'_nlnf; reflexivity. Qed. Lemma RSR_auxR_lemmam : RSR_auxR m = pred (m + n). -unfold RSR_auxR in |- *. -elim (le_lt_dec m 0); intro; simpl in |- *. -cut (m = 0); [ intro | auto with arith ]. -transitivity (pred m). -rewrite H; auto. -cut (0 = n); [ intro; rewrite <- H0; auto | apply RSR_HP' ]. -apply partition_length_zero with Hab; rewrite <- H; apply R. -elim (le_lt_dec m m); intro; simpl in |- *. -rewrite <- minus_n_n; auto. -elim (lt_irrefl _ b1). +Proof. + unfold RSR_auxR in |- *. + elim (le_lt_dec m 0); intro; simpl in |- *. + cut (m = 0); [ intro | auto with arith ]. + transitivity (pred m). + rewrite H; auto. + cut (0 = n); [ intro; rewrite <- H0; auto | apply RSR_HP' ]. + apply partition_length_zero with Hab; rewrite <- H; apply R. + elim (le_lt_dec m m); intro; simpl in |- *. + rewrite <- minus_n_n; auto. + elim (lt_irrefl _ b1). Qed. Lemma RSR_auxR_lemma1 : forall i j : nat, i < j -> RSR_auxR i < RSR_auxR j. -intros; unfold RSR_auxR in |- *. -assert (X:=not_not_lt); assert (X':=plus_pred_pred_plus). -assert (X'':=RSR_mn0); assert (X''':=RSR_nm0). -elim (le_lt_dec i 0); intro. -elim (le_lt_dec j 0); intros; simpl in |- *. -apply le_lt_trans with i; try apply lt_le_trans with j; auto with arith. -elim (le_lt_dec m j); intros; simpl in |- *. -omega. -apply lt_O_Sn. -elim (le_lt_dec m i); elim (le_lt_dec j 0); intros; simpl in |- *. -elim (lt_irrefl 0); apply le_lt_trans with i; try apply lt_le_trans with j; - auto with arith. -elim (le_lt_dec m j); intro; simpl in |- *. -apply plus_lt_compat_l. -apply plus_lt_reg_l with m. -repeat rewrite <- le_plus_minus; auto. -elim (le_not_lt m i); auto; apply lt_trans with j; auto. -elim (lt_irrefl 0); apply lt_trans with i; auto; apply lt_le_trans with j; - auto. -elim (le_lt_dec m j); intro; simpl in |- *. -set (H0 := RSR_nm0) in *; set (H1 := RSR_mn0) in *; - apply lt_le_trans with (S (pred m + pred n)). -apply lt_n_S. -apply (ProjT1 (ProjT2 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2)))). -rewrite <- plus_Sn_m. -rewrite <- S_pred with m 0. -2: apply lt_trans with i; auto. -replace (m + pred n) with (pred (m + n)). -auto with arith. -cut (S (pred (m + n)) = S (m + pred n)); auto. -rewrite plus_n_Sm. -rewrite <- S_pred with n 0; auto with arith. -symmetry in |- *; apply S_pred with 0. -apply lt_le_trans with m; auto with arith. -apply lt_trans with i; auto. -apply neq_O_lt. -intro. -apply lt_irrefl with 0. -apply lt_trans with i; auto. -rewrite RSR_nm0; auto. -apply lt_n_S. -cut - (~ - ~ - ProjT1 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2)) < - ProjT1 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3))); intro. -apply not_not_lt; assumption. -cut - (ProjT1 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3)) <= - ProjT1 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2))); intros. -2: apply not_lt; assumption. -cut - (h _ (ProjT1 (ProjT2 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3))))[<=] - h _ (ProjT1 (ProjT2 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2))))). -intro. -2: apply RSR_h_mon'; assumption. -cut (g' (pred j) (lt_pred' _ _ b1 b3)[<=]g' (pred i) (lt_pred' _ _ b0 b2)). -2: apply - leEq_wdl - with (h _ (ProjT1 (ProjT2 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3))))). -2: apply - leEq_wdr - with (h _ (ProjT1 (ProjT2 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2))))). -2: assumption. -3: apply eq_symmetric_unfolded; - exact (ProjT2 (ProjT2 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3)))). -2: apply eq_symmetric_unfolded; - exact (ProjT2 (ProjT2 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2)))). -clear H2 H1; intro. -cut (g' _ (lt_pred' _ _ b0 b2)[<]g' _ (lt_pred' _ _ b1 b3)). -2: apply RSR_g'_mon. -2: apply lt_pred'; assumption. -intro. -elimtype False. -apply less_irreflexive_unfolded with (x := g' _ (lt_pred' _ _ b1 b3)). -eapply leEq_less_trans; [ apply H1 | apply X0 ]. +Proof. + intros; unfold RSR_auxR in |- *. + assert (X:=not_not_lt); assert (X':=plus_pred_pred_plus). + assert (X'':=RSR_mn0); assert (X''':=RSR_nm0). + elim (le_lt_dec i 0); intro. + elim (le_lt_dec j 0); intros; simpl in |- *. + apply le_lt_trans with i; try apply lt_le_trans with j; auto with arith. + elim (le_lt_dec m j); intros; simpl in |- *. + omega. + apply lt_O_Sn. + elim (le_lt_dec m i); elim (le_lt_dec j 0); intros; simpl in |- *. + elim (lt_irrefl 0); apply le_lt_trans with i; try apply lt_le_trans with j; auto with arith. + elim (le_lt_dec m j); intro; simpl in |- *. + apply plus_lt_compat_l. + apply plus_lt_reg_l with m. + repeat rewrite <- le_plus_minus; auto. + elim (le_not_lt m i); auto; apply lt_trans with j; auto. + elim (lt_irrefl 0); apply lt_trans with i; auto; apply lt_le_trans with j; auto. + elim (le_lt_dec m j); intro; simpl in |- *. + set (H0 := RSR_nm0) in *; set (H1 := RSR_mn0) in *; apply lt_le_trans with (S (pred m + pred n)). + apply lt_n_S. + apply (ProjT1 (ProjT2 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2)))). + rewrite <- plus_Sn_m. + rewrite <- S_pred with m 0. + 2: apply lt_trans with i; auto. + replace (m + pred n) with (pred (m + n)). + auto with arith. + cut (S (pred (m + n)) = S (m + pred n)); auto. + rewrite plus_n_Sm. + rewrite <- S_pred with n 0; auto with arith. + symmetry in |- *; apply S_pred with 0. + apply lt_le_trans with m; auto with arith. + apply lt_trans with i; auto. + apply neq_O_lt. + intro. + apply lt_irrefl with 0. + apply lt_trans with i; auto. + rewrite RSR_nm0; auto. + apply lt_n_S. + cut (~ ~ ProjT1 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2)) < + ProjT1 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3))); intro. + apply not_not_lt; assumption. + cut (ProjT1 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3)) <= + ProjT1 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2))); intros. + 2: apply not_lt; assumption. + cut (h _ (ProjT1 (ProjT2 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3))))[<=] + h _ (ProjT1 (ProjT2 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2))))). + intro. + 2: apply RSR_h_mon'; assumption. + cut (g' (pred j) (lt_pred' _ _ b1 b3)[<=]g' (pred i) (lt_pred' _ _ b0 b2)). + 2: apply leEq_wdl with (h _ (ProjT1 (ProjT2 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3))))). + 2: apply leEq_wdr with (h _ (ProjT1 (ProjT2 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2))))). + 2: assumption. + 3: apply eq_symmetric_unfolded; exact (ProjT2 (ProjT2 (RSR_h_g' (pred j) (lt_pred' _ _ b1 b3)))). + 2: apply eq_symmetric_unfolded; exact (ProjT2 (ProjT2 (RSR_h_g' (pred i) (lt_pred' _ _ b0 b2)))). + clear H2 H1; intro. + cut (g' _ (lt_pred' _ _ b0 b2)[<]g' _ (lt_pred' _ _ b1 b3)). + 2: apply RSR_g'_mon. + 2: apply lt_pred'; assumption. + intro. + elimtype False. + apply less_irreflexive_unfolded with (x := g' _ (lt_pred' _ _ b1 b3)). + eapply leEq_less_trans; [ apply H1 | apply X0 ]. Qed. Lemma RSR_auxR_lemma2 : forall (j : nat) (H : j <= m), {H' : RSR_auxR j <= _ | R j H[=]Separated_Refinement _ H'}. -intros. -unfold Separated_Refinement in |- *; simpl in |- *. -unfold Separated_Refinement_fun in |- *; simpl in |- *. -elim (le_lt_dec j 0); intro; simpl in |- *. -cut (j = 0); [ intro | auto with arith ]. -generalize H; clear a0 H; rewrite H0. -rewrite RSR_auxR_lemma0. -clear H0; intros. -exists (le_O_n (pred (m + n))). -elim le_lt_eq_dec; intro; simpl in |- *. -elim (le_lt_dec 0 0); intro; simpl in |- *. -apply start. -elimtype False; inversion b0. -apply eq_transitive_unfolded with a. -apply start. -apply partition_length_zero with Hab. -cut (m + n <= 1). -intros. -elim (plus_eq_one_imp_eq_zero _ _ H0); intro. -rewrite <- a0; apply R. -rewrite <- b1; apply P. -generalize b0; clear b0. -case (m + n). -auto. -intros. -simpl in b0; rewrite <- b0; auto. -elim (le_lt_eq_dec _ _ H); intro. -cut (pred j < pred m); - [ intro | red in |- *; rewrite <- S_pred with j 0; auto; apply le_2; auto ]. -cut (RSR_auxR j <= pred (m + n)). -intro; exists H1. -elim le_lt_eq_dec; intro; simpl in |- *. -elim (le_lt_dec (RSR_auxR j) 0); intro; simpl in |- *. -cut (RSR_auxR j = 0); [ intro | auto with arith ]. -rewrite <- RSR_auxR_lemma0 in H2. -cut (RSR_auxR 0 < RSR_auxR j); [ intro | apply RSR_auxR_lemma1; assumption ]. -elimtype False; rewrite H2 in H3; apply (lt_irrefl _ H3). -generalize b1 a1; clear b1 a1. -rewrite (RSR_auxR_lemmai j b0 a0); intros. -simpl in |- *. -elim (ProjT2 (RSR_h_g' _ (lt_pred' _ _ b0 a0))); intros. -eapply eq_transitive_unfolded. -2: eapply eq_transitive_unfolded. -2: apply p. -unfold g' in |- *. -apply prf1; apply S_pred with 0; auto. -apply RSR_h_nlnf; reflexivity. -rewrite <- RSR_auxR_lemmam in b1. -cut (j = m). -intro; elimtype False; rewrite H2 in a0; apply (lt_irrefl _ a0). -apply nat_mon_imp_inj with (h := RSR_auxR). -apply RSR_auxR_lemma1. -assumption. -unfold RSR_auxR in |- *. -elim (le_lt_dec j 0); intro; simpl in |- *. -apply le_O_n. -elim (le_lt_dec m j); intro; simpl in |- *. -rewrite not_le_minus_0. -rewrite <- plus_n_O; auto with arith. -apply lt_not_le; auto. -apply plus_pred_pred_plus. -elim (ProjT2 (RSR_h_g' _ (lt_pred' _ _ b1 b2))); intros. -assumption. -generalize H; clear H; rewrite b1; intro. -rewrite RSR_auxR_lemmam. -exists (le_n (pred (m + n))). -elim le_lt_eq_dec; intro; simpl in |- *. -elimtype False; apply (lt_irrefl _ a0). -apply finish. +Proof. + intros. + unfold Separated_Refinement in |- *; simpl in |- *. + unfold Separated_Refinement_fun in |- *; simpl in |- *. + elim (le_lt_dec j 0); intro; simpl in |- *. + cut (j = 0); [ intro | auto with arith ]. + generalize H; clear a0 H; rewrite H0. + rewrite RSR_auxR_lemma0. + clear H0; intros. + exists (le_O_n (pred (m + n))). + elim le_lt_eq_dec; intro; simpl in |- *. + elim (le_lt_dec 0 0); intro; simpl in |- *. + apply start. + elimtype False; inversion b0. + apply eq_transitive_unfolded with a. + apply start. + apply partition_length_zero with Hab. + cut (m + n <= 1). + intros. + elim (plus_eq_one_imp_eq_zero _ _ H0); intro. + rewrite <- a0; apply R. + rewrite <- b1; apply P. + generalize b0; clear b0. + case (m + n). + auto. + intros. + simpl in b0; rewrite <- b0; auto. + elim (le_lt_eq_dec _ _ H); intro. + cut (pred j < pred m); [ intro | red in |- *; rewrite <- S_pred with j 0; auto; apply le_2; auto ]. + cut (RSR_auxR j <= pred (m + n)). + intro; exists H1. + elim le_lt_eq_dec; intro; simpl in |- *. + elim (le_lt_dec (RSR_auxR j) 0); intro; simpl in |- *. + cut (RSR_auxR j = 0); [ intro | auto with arith ]. + rewrite <- RSR_auxR_lemma0 in H2. + cut (RSR_auxR 0 < RSR_auxR j); [ intro | apply RSR_auxR_lemma1; assumption ]. + elimtype False; rewrite H2 in H3; apply (lt_irrefl _ H3). + generalize b1 a1; clear b1 a1. + rewrite (RSR_auxR_lemmai j b0 a0); intros. + simpl in |- *. + elim (ProjT2 (RSR_h_g' _ (lt_pred' _ _ b0 a0))); intros. + eapply eq_transitive_unfolded. + 2: eapply eq_transitive_unfolded. + 2: apply p. + unfold g' in |- *. + apply prf1; apply S_pred with 0; auto. + apply RSR_h_nlnf; reflexivity. + rewrite <- RSR_auxR_lemmam in b1. + cut (j = m). + intro; elimtype False; rewrite H2 in a0; apply (lt_irrefl _ a0). + apply nat_mon_imp_inj with (h := RSR_auxR). + apply RSR_auxR_lemma1. + assumption. + unfold RSR_auxR in |- *. + elim (le_lt_dec j 0); intro; simpl in |- *. + apply le_O_n. + elim (le_lt_dec m j); intro; simpl in |- *. + rewrite not_le_minus_0. + rewrite <- plus_n_O; auto with arith. + apply lt_not_le; auto. + apply plus_pred_pred_plus. + elim (ProjT2 (RSR_h_g' _ (lt_pred' _ _ b1 b2))); intros. + assumption. + generalize H; clear H; rewrite b1; intro. + rewrite RSR_auxR_lemmam. + exists (le_n (pred (m + n))). + elim le_lt_eq_dec; intro; simpl in |- *. + elimtype False; apply (lt_irrefl _ a0). + apply finish. Qed. Lemma Separated_Refinement_rht : Refinement R Separated_Refinement. -exists RSR_auxR; repeat split. -exact RSR_auxR_lemmam. -intros; apply RSR_auxR_lemma1; assumption. -exact RSR_auxR_lemma2. +Proof. + exists RSR_auxR; repeat split. + exact RSR_auxR_lemmam. + intros; apply RSR_auxR_lemma1; assumption. + exact RSR_auxR_lemma2. Qed. End Refining_Separated. diff --git a/ftc/RefSeparated.v b/ftc/RefSeparated.v index 1bcafbc75..7d99b7aea 100644 --- a/ftc/RefSeparated.v +++ b/ftc/RefSeparated.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) @@ -58,11 +58,13 @@ Hypothesis HP : _Separated P. Hypothesis HR : _Separated R. Lemma RS_pos_n : 0 < n. -apply partition_less_imp_gt_zero with a b Hab; assumption. +Proof. + apply partition_less_imp_gt_zero with a b Hab; assumption. Qed. Lemma RS_pos_m : 0 < m. -apply partition_less_imp_gt_zero with a b Hab; assumption. +Proof. + apply partition_less_imp_gt_zero with a b Hab; assumption. Qed. Variable alpha : IR. @@ -71,27 +73,31 @@ Hypothesis Halpha : Zero[<]alpha. Let e := alpha [/]TwoNZ[/] _[//]max_one_ap_zero (b[-]a). Lemma RS_He : Zero[<]e. -unfold e in |- *; apply div_resp_pos. -apply pos_max_one. -apply pos_div_two; assumption. +Proof. + unfold e in |- *; apply div_resp_pos. + apply pos_max_one. + apply pos_div_two; assumption. Qed. Let contF' := contin_prop _ _ _ _ contF. Let d : IR. -elim (contF' e RS_He). -intros; apply x. +Proof. + elim (contF' e RS_He). + intros; apply x. Defined. Lemma RS_Hd : Zero[<]d. -unfold d in |- *; elim (contF' e RS_He); auto. +Proof. + unfold d in |- *; elim (contF' e RS_He); auto. Qed. Lemma RS_Hd' : forall x y : IR, I x -> I y -> forall Hx Hy, AbsIR (x[-]y)[<=]d -> AbsIR (F x Hx[-]F y Hy)[<=]e. -unfold d in |- *; elim (contF' e RS_He); auto. +Proof. + unfold d in |- *; elim (contF' e RS_He); auto. Qed. Variable csi : IR. @@ -106,41 +112,46 @@ Let delta := (Min (alpha [/]TwoNZ[/] _[//]max_one_ap_zero (nring n[*]M)) (Min csi d)). Lemma RS_delta_deltaP : delta[<=]deltaP. -unfold delta in |- *; eapply leEq_transitive. -apply Min_leEq_lft. -apply Min_leEq_lft. +Proof. + unfold delta in |- *; eapply leEq_transitive. + apply Min_leEq_lft. + apply Min_leEq_lft. Qed. Lemma RS_delta_deltaR : delta[<=]deltaR. -unfold delta in |- *; eapply leEq_transitive. -apply Min_leEq_lft. -apply Min_leEq_rht. +Proof. + unfold delta in |- *; eapply leEq_transitive. + apply Min_leEq_lft. + apply Min_leEq_rht. Qed. Lemma RS_delta_csi : delta[<=]csi. -unfold delta in |- *; eapply leEq_transitive. -apply Min_leEq_rht. -eapply leEq_transitive. -apply Min_leEq_rht. -apply Min_leEq_lft. +Proof. + unfold delta in |- *; eapply leEq_transitive. + apply Min_leEq_rht. + eapply leEq_transitive. + apply Min_leEq_rht. + apply Min_leEq_lft. Qed. Lemma RS_delta_d : delta[<=]d. -unfold delta in |- *; eapply leEq_transitive. -apply Min_leEq_rht. -eapply leEq_transitive; apply Min_leEq_rht. +Proof. + unfold delta in |- *; eapply leEq_transitive. + apply Min_leEq_rht. + eapply leEq_transitive; apply Min_leEq_rht. Qed. Lemma RS_delta_pos : Zero[<]delta. -unfold delta in |- *; apply less_Min; apply less_Min. -unfold deltaP in |- *; apply pos_AntiMesh; [ apply RS_pos_n | assumption ]. -unfold deltaR in |- *; apply pos_AntiMesh; [ apply RS_pos_m | assumption ]. -apply div_resp_pos. -apply pos_max_one. -apply pos_div_two; assumption. -apply less_Min. -assumption. -apply RS_Hd. +Proof. + unfold delta in |- *; apply less_Min; apply less_Min. + unfold deltaP in |- *; apply pos_AntiMesh; [ apply RS_pos_n | assumption ]. + unfold deltaR in |- *; apply pos_AntiMesh; [ apply RS_pos_m | assumption ]. + apply div_resp_pos. + apply pos_max_one. + apply pos_div_two; assumption. + apply less_Min. + assumption. + apply RS_Hd. Qed. Section Defining_ai'. @@ -153,95 +164,93 @@ Lemma separation_conseq : AbsIR (P i Hi[-]R j Hj)[<]delta [/]TwoNZ -> forall j' : nat, j <> j' -> forall Hj' : j' <= m, delta [/]TwoNZ[<]AbsIR (P i Hi[-]R j' Hj'). -intros j Hj H; intros. -elim (Cnat_total_order _ _ H0); clear H0; intro H0. -elim (le_lt_dec j' m); intro. -cut (S j <= m); [ intro | clear H; apply le_trans with j'; auto ]. -eapply less_wdr. -2: apply AbsIR_minus. -cut (R (S j) H1[<=]R j' Hj'); intros. -eapply less_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -rstepr (R _ Hj'[-]R _ H1[+](R _ H1[-]R _ Hj)[+](R _ Hj[-]P i Hi)). -rstepl (Zero[+]delta[+][--](delta [/]TwoNZ)). -apply plus_resp_leEq_less. -apply plus_resp_leEq_both. -apply shift_leEq_minus; astepl (R _ H1). -assumption. -apply leEq_transitive with deltaR. -apply RS_delta_deltaR. -unfold deltaR in |- *; apply AntiMesh_lemma. -rstepl ([--](delta [/]TwoNZ)). -rstepr ([--](P i Hi[-]R j Hj)). -apply inv_resp_less. -eapply leEq_less_trans. -apply leEq_AbsIR. -assumption. -apply shift_leEq_minus; astepl (P i Hi). -eapply leEq_transitive. -2: apply H2. -apply less_leEq; - apply less_transitive_unfolded with (R j Hj[+]delta [/]TwoNZ). -apply shift_less_plus'. -eapply leEq_less_trans; [ apply leEq_AbsIR | apply H ]. -apply shift_plus_less'. -apply less_leEq_trans with delta. -apply pos_div_two'; exact RS_delta_pos. -apply leEq_transitive with deltaR. -apply RS_delta_deltaR. -unfold deltaR in |- *; apply AntiMesh_lemma. -apply local_mon_imp_mon'_le with (f := fun (i : nat) (Hi : i <= m) => R i Hi). -intros; apply HR. -red in |- *; intros; apply prf1; auto. -assumption. -elimtype False; apply (le_not_lt j' m); auto. -elim (le_lt_dec j 0); intro. -elimtype False; apply lt_n_O with j'; red in |- *; apply le_trans with j; - auto. -generalize Hj H H0; clear H0 H Hj. -set (jj := pred j) in *. -cut (j = S jj); [ intro | unfold jj in |- *; apply S_pred with 0; auto ]. -rewrite H; intros. -cut (jj <= m); [ intro | auto with arith ]. -cut (R j' Hj'[<=]R jj H2); intros. -eapply less_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -rstepr (P i Hi[-]R _ Hj[+](R _ Hj[-]R jj H2)[+](R jj H2[-]R j' Hj')). -rstepl ([--](delta [/]TwoNZ)[+]delta[+]Zero). -apply plus_resp_less_leEq. -apply plus_resp_less_leEq. -eapply less_wdr. -2: apply cg_inv_inv. -apply inv_resp_less; eapply leEq_less_trans. -2: apply H0. -apply inv_leEq_AbsIR. -eapply leEq_transitive. -apply RS_delta_deltaR. -unfold deltaR in |- *; apply AntiMesh_lemma. -apply shift_leEq_minus; eapply leEq_wdl. -apply H3. -algebra. -apply shift_leEq_minus; astepl (R j' Hj'). -eapply leEq_transitive. -apply H3. -apply less_leEq; - apply less_transitive_unfolded with (R _ Hj[-]delta [/]TwoNZ). -apply shift_less_minus; apply shift_plus_less'. -apply less_leEq_trans with delta. -apply pos_div_two'; exact RS_delta_pos. -eapply leEq_transitive. -apply RS_delta_deltaR. -unfold deltaR in |- *; apply AntiMesh_lemma. -apply shift_minus_less; apply shift_less_plus'. -eapply leEq_less_trans. -2: apply H0. -eapply leEq_wdr. -2: apply AbsIR_minus. -apply leEq_AbsIR. -apply local_mon_imp_mon'_le with (f := fun (i : nat) (Hi : i <= m) => R i Hi). -intros; apply HR. -red in |- *; intros; apply prf1; auto. -auto with arith. +Proof. + intros j Hj H; intros. + elim (Cnat_total_order _ _ H0); clear H0; intro H0. + elim (le_lt_dec j' m); intro. + cut (S j <= m); [ intro | clear H; apply le_trans with j'; auto ]. + eapply less_wdr. + 2: apply AbsIR_minus. + cut (R (S j) H1[<=]R j' Hj'); intros. + eapply less_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + rstepr (R _ Hj'[-]R _ H1[+](R _ H1[-]R _ Hj)[+](R _ Hj[-]P i Hi)). + rstepl (Zero[+]delta[+][--](delta [/]TwoNZ)). + apply plus_resp_leEq_less. + apply plus_resp_leEq_both. + apply shift_leEq_minus; astepl (R _ H1). + assumption. + apply leEq_transitive with deltaR. + apply RS_delta_deltaR. + unfold deltaR in |- *; apply AntiMesh_lemma. + rstepl ([--](delta [/]TwoNZ)). + rstepr ([--](P i Hi[-]R j Hj)). + apply inv_resp_less. + eapply leEq_less_trans. + apply leEq_AbsIR. + assumption. + apply shift_leEq_minus; astepl (P i Hi). + eapply leEq_transitive. + 2: apply H2. + apply less_leEq; apply less_transitive_unfolded with (R j Hj[+]delta [/]TwoNZ). + apply shift_less_plus'. + eapply leEq_less_trans; [ apply leEq_AbsIR | apply H ]. + apply shift_plus_less'. + apply less_leEq_trans with delta. + apply pos_div_two'; exact RS_delta_pos. + apply leEq_transitive with deltaR. + apply RS_delta_deltaR. + unfold deltaR in |- *; apply AntiMesh_lemma. + apply local_mon_imp_mon'_le with (f := fun (i : nat) (Hi : i <= m) => R i Hi). + intros; apply HR. + red in |- *; intros; apply prf1; auto. + assumption. + elimtype False; apply (le_not_lt j' m); auto. + elim (le_lt_dec j 0); intro. + elimtype False; apply lt_n_O with j'; red in |- *; apply le_trans with j; auto. + generalize Hj H H0; clear H0 H Hj. + set (jj := pred j) in *. + cut (j = S jj); [ intro | unfold jj in |- *; apply S_pred with 0; auto ]. + rewrite H; intros. + cut (jj <= m); [ intro | auto with arith ]. + cut (R j' Hj'[<=]R jj H2); intros. + eapply less_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + rstepr (P i Hi[-]R _ Hj[+](R _ Hj[-]R jj H2)[+](R jj H2[-]R j' Hj')). + rstepl ([--](delta [/]TwoNZ)[+]delta[+]Zero). + apply plus_resp_less_leEq. + apply plus_resp_less_leEq. + eapply less_wdr. + 2: apply cg_inv_inv. + apply inv_resp_less; eapply leEq_less_trans. + 2: apply H0. + apply inv_leEq_AbsIR. + eapply leEq_transitive. + apply RS_delta_deltaR. + unfold deltaR in |- *; apply AntiMesh_lemma. + apply shift_leEq_minus; eapply leEq_wdl. + apply H3. + algebra. + apply shift_leEq_minus; astepl (R j' Hj'). + eapply leEq_transitive. + apply H3. + apply less_leEq; apply less_transitive_unfolded with (R _ Hj[-]delta [/]TwoNZ). + apply shift_less_minus; apply shift_plus_less'. + apply less_leEq_trans with delta. + apply pos_div_two'; exact RS_delta_pos. + eapply leEq_transitive. + apply RS_delta_deltaR. + unfold deltaR in |- *; apply AntiMesh_lemma. + apply shift_minus_less; apply shift_less_plus'. + eapply leEq_less_trans. + 2: apply H0. + eapply leEq_wdr. + 2: apply AbsIR_minus. + apply leEq_AbsIR. + apply local_mon_imp_mon'_le with (f := fun (i : nat) (Hi : i <= m) => R i Hi). + intros; apply HR. + red in |- *; intros; apply prf1; auto. + auto with arith. Qed. Let pred1 (j : nat) (Hj : j <= m) := @@ -252,209 +261,217 @@ Let pred2 (j : nat) (Hj : j <= m) := Lemma sep__sep_aux_lemma : {j : nat | {Hj : j <= m | pred1 j Hj}} or (forall (j : nat) (Hj : j <= m), pred2 j Hj). -apply finite_or_elim. -red in |- *; unfold pred1 in |- *; do 3 intro. -rewrite H; intros H0 H' H1 Hi'. -eapply less_wdl. -apply H1 with (Hi' := Hi'). -apply AbsIR_wd; apply cg_minus_wd; apply prf1; auto. -red in |- *; unfold pred2 in |- *; intros. rename X into H1. -eapply less_wdr. -apply H1 with (Hi' := Hi'). -apply AbsIR_wd; apply cg_minus_wd; apply prf1; auto. -intros j Hj. -cut (pred2 j Hj or pred1 j Hj). -intro H; inversion_clear H; [ right | left ]; assumption. -unfold pred1, pred2 in |- *. -cut - (forall Hi' : i <= n, - delta [/]FourNZ[<]AbsIR (P i Hi'[-]R j Hj) - or AbsIR (P i Hi'[-]R j Hj)[<]delta [/]TwoNZ). intro H. -elim (le_lt_dec i n); intro. -elim (H a0); intro. -left; intro. -eapply less_wdr. -apply a1. -apply AbsIR_wd; apply cg_minus_wd; apply prf1; auto. -right; intro. -eapply less_wdl. -apply b0. -apply AbsIR_wd; apply cg_minus_wd; apply prf1; auto. -left; intro. -elimtype False; apply le_not_lt with i n; auto. -intros. -apply less_cotransitive_unfolded. -rstepl ((delta [/]TwoNZ) [/]TwoNZ). -apply pos_div_two'; apply pos_div_two; apply RS_delta_pos. +Proof. + apply finite_or_elim. + red in |- *; unfold pred1 in |- *; do 3 intro. + rewrite H; intros H0 H' H1 Hi'. + eapply less_wdl. + apply H1 with (Hi' := Hi'). + apply AbsIR_wd; apply cg_minus_wd; apply prf1; auto. + red in |- *; unfold pred2 in |- *; intros. rename X into H1. + eapply less_wdr. + apply H1 with (Hi' := Hi'). + apply AbsIR_wd; apply cg_minus_wd; apply prf1; auto. + intros j Hj. + cut (pred2 j Hj or pred1 j Hj). + intro H; inversion_clear H; [ right | left ]; assumption. + unfold pred1, pred2 in |- *. + cut (forall Hi' : i <= n, delta [/]FourNZ[<]AbsIR (P i Hi'[-]R j Hj) + or AbsIR (P i Hi'[-]R j Hj)[<]delta [/]TwoNZ). intro H. + elim (le_lt_dec i n); intro. + elim (H a0); intro. + left; intro. + eapply less_wdr. + apply a1. + apply AbsIR_wd; apply cg_minus_wd; apply prf1; auto. + right; intro. + eapply less_wdl. + apply b0. + apply AbsIR_wd; apply cg_minus_wd; apply prf1; auto. + left; intro. + elimtype False; apply le_not_lt with i n; auto. + intros. + apply less_cotransitive_unfolded. + rstepl ((delta [/]TwoNZ) [/]TwoNZ). + apply pos_div_two'; apply pos_div_two; apply RS_delta_pos. Qed. Hypothesis Hi0 : 0 < i. Hypothesis Hin : i < n. Definition sep__sep_fun_i : IR. -elim sep__sep_aux_lemma; intros. -2: apply (P i Hi). -apply (P i Hi[+]delta [/]TwoNZ). +Proof. + elim sep__sep_aux_lemma; intros. + 2: apply (P i Hi). + apply (P i Hi[+]delta [/]TwoNZ). Defined. Lemma sep__sep_leEq : forall Hi' : i <= n, P i Hi'[<=]sep__sep_fun_i. -unfold sep__sep_fun_i in |- *. -elim sep__sep_aux_lemma; intros; simpl in |- *. -2: apply eq_imp_leEq; apply prf1; auto. -apply leEq_wdl with (P i Hi). -2: apply prf1; auto. -apply shift_leEq_plus'; astepl ZeroR. -astepr (delta [/]TwoNZ). -apply less_leEq; apply pos_div_two; exact RS_delta_pos. +Proof. + unfold sep__sep_fun_i in |- *. + elim sep__sep_aux_lemma; intros; simpl in |- *. + 2: apply eq_imp_leEq; apply prf1; auto. + apply leEq_wdl with (P i Hi). + 2: apply prf1; auto. + apply shift_leEq_plus'; astepl ZeroR. + astepr (delta [/]TwoNZ). + apply less_leEq; apply pos_div_two; exact RS_delta_pos. Qed. Lemma sep__sep_less : forall Hi' : S i <= n, sep__sep_fun_i[<]P (S i) Hi'. -unfold sep__sep_fun_i in |- *. -elim sep__sep_aux_lemma; intros; simpl in |- *. -2: apply HP. -apply shift_plus_less'. -apply less_leEq_trans with delta. -astepl (delta [/]TwoNZ). -apply pos_div_two'; exact RS_delta_pos. -apply leEq_transitive with deltaP. -apply RS_delta_deltaP. -unfold deltaP in |- *; apply AntiMesh_lemma. +Proof. + unfold sep__sep_fun_i in |- *. + elim sep__sep_aux_lemma; intros; simpl in |- *. + 2: apply HP. + apply shift_plus_less'. + apply less_leEq_trans with delta. + astepl (delta [/]TwoNZ). + apply pos_div_two'; exact RS_delta_pos. + apply leEq_transitive with deltaP. + apply RS_delta_deltaP. + unfold deltaP in |- *; apply AntiMesh_lemma. Qed. Lemma sep__sep_ap : forall (j : nat) (Hj : j <= m), sep__sep_fun_i[#]R j Hj. -intros. -unfold sep__sep_fun_i in |- *; elim sep__sep_aux_lemma; intro; simpl in |- *. -2: apply zero_minus_apart; apply AbsIR_cancel_ap_zero; apply Greater_imp_ap. -elim a0; intros j' H. -elim H; clear a0 H; intros Hj' H. -unfold pred1 in H. -rstepr (P i Hi[+](R j Hj[-]P i Hi)). -apply op_lft_resp_ap. -apply un_op_strext_unfolded with AbsIR. -apply ap_wdl_unfolded with (delta [/]TwoNZ). -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply less_leEq; apply pos_div_two; exact RS_delta_pos. -eapply ap_wdr_unfolded. -2: apply AbsIR_minus. -elim (le_lt_dec j j'); intro. -elim (le_lt_eq_dec _ _ a0); clear a0; intro. -apply less_imp_ap; apply separation_conseq with j' Hj'. -apply H. -intro; rewrite H0 in a0; apply (lt_irrefl _ a0). -apply Greater_imp_ap. -eapply less_wdl. -apply H with (Hi' := Hi). -apply AbsIR_wd. -apply cg_minus_wd. -algebra. -apply prf1; auto. -apply less_imp_ap; apply separation_conseq with j' Hj'. -apply H. -intro; rewrite H0 in b0; apply (lt_irrefl _ b0). -unfold pred2 in b0. -eapply less_transitive_unfolded. -2: apply b0. -apply pos_div_four; exact RS_delta_pos. +Proof. + intros. + unfold sep__sep_fun_i in |- *; elim sep__sep_aux_lemma; intro; simpl in |- *. + 2: apply zero_minus_apart; apply AbsIR_cancel_ap_zero; apply Greater_imp_ap. + elim a0; intros j' H. + elim H; clear a0 H; intros Hj' H. + unfold pred1 in H. + rstepr (P i Hi[+](R j Hj[-]P i Hi)). + apply op_lft_resp_ap. + apply un_op_strext_unfolded with AbsIR. + apply ap_wdl_unfolded with (delta [/]TwoNZ). + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply less_leEq; apply pos_div_two; exact RS_delta_pos. + eapply ap_wdr_unfolded. + 2: apply AbsIR_minus. + elim (le_lt_dec j j'); intro. + elim (le_lt_eq_dec _ _ a0); clear a0; intro. + apply less_imp_ap; apply separation_conseq with j' Hj'. + apply H. + intro; rewrite H0 in a0; apply (lt_irrefl _ a0). + apply Greater_imp_ap. + eapply less_wdl. + apply H with (Hi' := Hi). + apply AbsIR_wd. + apply cg_minus_wd. + algebra. + apply prf1; auto. + apply less_imp_ap; apply separation_conseq with j' Hj'. + apply H. + intro; rewrite H0 in b0; apply (lt_irrefl _ b0). + unfold pred2 in b0. + eapply less_transitive_unfolded. + 2: apply b0. + apply pos_div_four; exact RS_delta_pos. Qed. End Defining_ai'. Definition sep__sep_fun : forall i : nat, i <= n -> IR. -intros. -elim (le_lt_dec i 0); intro. -apply a. -elim (le_lt_eq_dec _ _ H); intro. -apply (sep__sep_fun_i i H). -apply b. +Proof. + intros. + elim (le_lt_dec i 0); intro. + apply a. + elim (le_lt_eq_dec _ _ H); intro. + apply (sep__sep_fun_i i H). + apply b. Defined. Lemma sep__sep_fun_i_delta : forall (i : nat) (Hi Hi' : i <= n) (Hi0 : i < n), AbsIR (sep__sep_fun_i i Hi[-]P i Hi')[<=]delta [/]TwoNZ. -intros. -unfold sep__sep_fun_i in |- *. -elim (sep__sep_aux_lemma i); intro; simpl in |- *. -apply eq_imp_leEq. -eapply eq_transitive_unfolded. -2: apply AbsIR_eq_x. -apply AbsIR_wd. -rstepr (P i Hi'[+]delta [/]TwoNZ[-]P i Hi'). -apply cg_minus_wd. -apply bin_op_wd_unfolded. -apply prf1; auto. -algebra. -algebra. -astepr (delta [/]TwoNZ); apply less_leEq; apply pos_div_two; exact RS_delta_pos. -apply leEq_wdl with ZeroR. -astepr (delta [/]TwoNZ); apply less_leEq; apply pos_div_two; exact RS_delta_pos. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply AbsIRz_isz. -apply AbsIR_wd. -astepl (P i Hi[-]P i Hi). -apply cg_minus_wd; apply prf1; auto. +Proof. + intros. + unfold sep__sep_fun_i in |- *. + elim (sep__sep_aux_lemma i); intro; simpl in |- *. + apply eq_imp_leEq. + eapply eq_transitive_unfolded. + 2: apply AbsIR_eq_x. + apply AbsIR_wd. + rstepr (P i Hi'[+]delta [/]TwoNZ[-]P i Hi'). + apply cg_minus_wd. + apply bin_op_wd_unfolded. + apply prf1; auto. + algebra. + algebra. + astepr (delta [/]TwoNZ); apply less_leEq; apply pos_div_two; exact RS_delta_pos. + apply leEq_wdl with ZeroR. + astepr (delta [/]TwoNZ); apply less_leEq; apply pos_div_two; exact RS_delta_pos. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply AbsIRz_isz. + apply AbsIR_wd. + astepl (P i Hi[-]P i Hi). + apply cg_minus_wd; apply prf1; auto. Qed. Lemma sep__sep_fun_delta : forall (i : nat) (Hi Hi' : i <= n), AbsIR (sep__sep_fun i Hi[-]P i Hi')[<=]delta [/]TwoNZ. -intros. -unfold sep__sep_fun in |- *. -elim (le_lt_dec i 0); intro; simpl in |- *. -cut (i = 0); [ intro | auto with arith ]. -generalize Hi'; rewrite H; intros. -apply leEq_wdl with ZeroR. -astepr (delta [/]TwoNZ); apply less_leEq; apply pos_div_two; exact RS_delta_pos. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply AbsIRz_isz. -apply AbsIR_wd. -astepl (a[-]a). -apply cg_minus_wd; [ algebra | apply eq_symmetric_unfolded; apply start ]. -elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. -apply sep__sep_fun_i_delta; assumption. -generalize Hi'; rewrite b1; intros. -apply leEq_wdl with ZeroR. -astepr (delta [/]TwoNZ); apply less_leEq; apply pos_div_two; exact RS_delta_pos. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply AbsIRz_isz. -apply AbsIR_wd. -astepl (b[-]b). -apply cg_minus_wd; [ algebra | apply eq_symmetric_unfolded; apply finish ]. +Proof. + intros. + unfold sep__sep_fun in |- *. + elim (le_lt_dec i 0); intro; simpl in |- *. + cut (i = 0); [ intro | auto with arith ]. + generalize Hi'; rewrite H; intros. + apply leEq_wdl with ZeroR. + astepr (delta [/]TwoNZ); apply less_leEq; apply pos_div_two; exact RS_delta_pos. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply AbsIRz_isz. + apply AbsIR_wd. + astepl (a[-]a). + apply cg_minus_wd; [ algebra | apply eq_symmetric_unfolded; apply start ]. + elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. + apply sep__sep_fun_i_delta; assumption. + generalize Hi'; rewrite b1; intros. + apply leEq_wdl with ZeroR. + astepr (delta [/]TwoNZ); apply less_leEq; apply pos_div_two; exact RS_delta_pos. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply AbsIRz_isz. + apply AbsIR_wd. + astepl (b[-]b). + apply cg_minus_wd; [ algebra | apply eq_symmetric_unfolded; apply finish ]. Qed. Lemma sep__sep_mon_i : forall (i : nat) (Hi : i <= n) (Hi' : S i <= n) (Hi0 : i < n), sep__sep_fun_i i Hi[<]sep__sep_fun_i (S i) Hi'. -intros. -apply less_leEq_trans with (P (S i) Hi0). -apply sep__sep_less. -apply sep__sep_leEq. +Proof. + intros. + apply less_leEq_trans with (P (S i) Hi0). + apply sep__sep_less. + apply sep__sep_leEq. Qed. Lemma sep__sep_mon : forall (i : nat) (Hi : i <= n) (Hi' : S i <= n), sep__sep_fun i Hi[<]sep__sep_fun (S i) Hi'. -intros. -unfold sep__sep_fun in |- *. -elim (le_lt_dec (S i) 0); intro; simpl in |- *. -elimtype False; apply (le_Sn_O _ a0). -elim (le_lt_dec i 0); intro; simpl in |- *. -elim (le_lt_eq_dec _ _ Hi'); intro; simpl in |- *. -apply less_leEq_trans with (P (S i) Hi'). -apply leEq_less_trans with (P i Hi). -elim (Partition_in_compact _ _ _ _ P i Hi); intros; auto. -apply HP. -apply sep__sep_leEq. -assumption. -elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. -elim (le_lt_eq_dec _ _ Hi'); intro; simpl in |- *. -apply sep__sep_mon_i; assumption. -eapply less_wdr. -2: apply finish with (p := P) (H := le_n n). -eapply less_wdr. -apply sep__sep_less with (Hi' := Hi'). -generalize Hi'; rewrite b2. -intro; apply prf1; auto. -elimtype False; rewrite b2 in Hi'; apply (le_Sn_n _ Hi'). +Proof. + intros. + unfold sep__sep_fun in |- *. + elim (le_lt_dec (S i) 0); intro; simpl in |- *. + elimtype False; apply (le_Sn_O _ a0). + elim (le_lt_dec i 0); intro; simpl in |- *. + elim (le_lt_eq_dec _ _ Hi'); intro; simpl in |- *. + apply less_leEq_trans with (P (S i) Hi'). + apply leEq_less_trans with (P i Hi). + elim (Partition_in_compact _ _ _ _ P i Hi); intros; auto. + apply HP. + apply sep__sep_leEq. + assumption. + elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. + elim (le_lt_eq_dec _ _ Hi'); intro; simpl in |- *. + apply sep__sep_mon_i; assumption. + eapply less_wdr. + 2: apply finish with (p := P) (H := le_n n). + eapply less_wdr. + apply sep__sep_less with (Hi' := Hi'). + generalize Hi'; rewrite b2. + intro; apply prf1; auto. + elimtype False; rewrite b2 in Hi'; apply (le_Sn_n _ Hi'). Qed. Lemma sep__sep_fun_i_wd : @@ -462,147 +479,150 @@ Lemma sep__sep_fun_i_wd : i = j -> forall (Hi : i <= n) (Hj : j <= n), sep__sep_fun_i i Hi[=]sep__sep_fun_i j Hj. -do 3 intro. -rewrite <- H. -intros. -unfold sep__sep_fun_i in |- *. -elim (sep__sep_aux_lemma i); intros; simpl in |- *. -apply bin_op_wd_unfolded; [ apply prf1; auto | algebra ]. -apply prf1; auto. +Proof. + do 3 intro. + rewrite <- H. + intros. + unfold sep__sep_fun_i in |- *. + elim (sep__sep_aux_lemma i); intros; simpl in |- *. + apply bin_op_wd_unfolded; [ apply prf1; auto | algebra ]. + apply prf1; auto. Qed. Lemma sep__sep_fun_wd : forall i j : nat, i = j -> forall (Hi : i <= n) (Hj : j <= n), sep__sep_fun i Hi[=]sep__sep_fun j Hj. -intros. -unfold sep__sep_fun in |- *. -elim (le_lt_dec i 0); elim (le_lt_dec j 0); intros; simpl in |- *. -algebra. -elimtype False; apply (lt_irrefl 0); apply lt_le_trans with j; auto; - rewrite <- H; auto. -elimtype False; apply (lt_irrefl 0); apply lt_le_trans with j; auto; - rewrite <- H; auto. -elim (le_lt_eq_dec _ _ Hi); elim (le_lt_eq_dec _ _ Hj); intros; simpl in |- *. -apply sep__sep_fun_i_wd; auto. -elimtype False; rewrite H in a0; rewrite b2 in a0; apply (lt_irrefl _ a0). -elimtype False; rewrite <- H in a0; rewrite b2 in a0; apply (lt_irrefl _ a0). -algebra. +Proof. + intros. + unfold sep__sep_fun in |- *. + elim (le_lt_dec i 0); elim (le_lt_dec j 0); intros; simpl in |- *. + algebra. + elimtype False; apply (lt_irrefl 0); apply lt_le_trans with j; auto; rewrite <- H; auto. + elimtype False; apply (lt_irrefl 0); apply lt_le_trans with j; auto; rewrite <- H; auto. + elim (le_lt_eq_dec _ _ Hi); elim (le_lt_eq_dec _ _ Hj); intros; simpl in |- *. + apply sep__sep_fun_i_wd; auto. + elimtype False; rewrite H in a0; rewrite b2 in a0; apply (lt_irrefl _ a0). + elimtype False; rewrite <- H in a0; rewrite b2 in a0; apply (lt_irrefl _ a0). + algebra. Qed. Definition sep__sep_part : Partition Hab n. -apply Build_Partition with sep__sep_fun. -exact sep__sep_fun_wd. -intros; apply less_leEq; apply sep__sep_mon. -intros; unfold sep__sep_fun in |- *. -elim (le_lt_dec 0 0); intro; simpl in |- *. -algebra. -elimtype False; inversion b0. -intros; unfold sep__sep_fun in |- *. -elim (le_lt_dec n 0); intro; simpl in |- *. -apply partition_length_zero with Hab. -cut (n = 0); [ intro | auto with arith ]. -rewrite <- H0; apply P. -elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. -elimtype False; apply (lt_irrefl _ a0). -algebra. +Proof. + apply Build_Partition with sep__sep_fun. + exact sep__sep_fun_wd. + intros; apply less_leEq; apply sep__sep_mon. + intros; unfold sep__sep_fun in |- *. + elim (le_lt_dec 0 0); intro; simpl in |- *. + algebra. + elimtype False; inversion b0. + intros; unfold sep__sep_fun in |- *. + elim (le_lt_dec n 0); intro; simpl in |- *. + apply partition_length_zero with Hab. + cut (n = 0); [ intro | auto with arith ]. + rewrite <- H0; apply P. + elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. + elimtype False; apply (lt_irrefl _ a0). + algebra. Defined. Lemma sep__sep_lemma : Separated sep__sep_part R. -repeat split; unfold _Separated in |- *; intros. -apply sep__sep_mon. -apply HR. -unfold sep__sep_part in |- *; simpl in |- *. -unfold sep__sep_fun in |- *; simpl in |- *. -elim (le_lt_dec i 0); intro; simpl in |- *. -elimtype False; apply lt_irrefl with 0; apply lt_le_trans with i; auto. -elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. -apply sep__sep_ap. -elimtype False; rewrite b1 in H1; apply (lt_irrefl _ H1). +Proof. + repeat split; unfold _Separated in |- *; intros. + apply sep__sep_mon. + apply HR. + unfold sep__sep_part in |- *; simpl in |- *. + unfold sep__sep_fun in |- *; simpl in |- *. + elim (le_lt_dec i 0); intro; simpl in |- *. + elimtype False; apply lt_irrefl with 0; apply lt_le_trans with i; auto. + elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. + apply sep__sep_ap. + elimtype False; rewrite b1 in H1; apply (lt_irrefl _ H1). Qed. Variable g : forall i : nat, i < n -> IR. Hypothesis gP : Points_in_Partition P g. Definition sep__sep_points (i : nat) (Hi : i < n) : IR. -intros. -apply (Max (sep__sep_fun_i i (lt_le_weak _ _ Hi)) (g i Hi)). +Proof. + intros. + apply (Max (sep__sep_fun_i i (lt_le_weak _ _ Hi)) (g i Hi)). Defined. Lemma sep__sep_points_lemma : Points_in_Partition sep__sep_part sep__sep_points. -red in |- *; intros. -split. -unfold sep__sep_part in |- *; simpl in |- *. -unfold sep__sep_fun, sep__sep_points in |- *. -elim (le_lt_dec i 0); intro; simpl in |- *. -apply leEq_transitive with (g i Hi). -elim (Pts_part_lemma _ _ _ _ _ _ gP i Hi); intros; assumption. -apply rht_leEq_Max. -elim (le_lt_eq_dec _ _ (lt_le_weak _ _ Hi)); intro; simpl in |- *. -eapply leEq_wdl. -apply lft_leEq_Max. -apply sep__sep_fun_i_wd; auto. -elimtype False; rewrite b1 in Hi; apply (lt_irrefl _ Hi). -unfold sep__sep_part in |- *; simpl in |- *. -unfold sep__sep_fun, sep__sep_points in |- *. -elim (le_lt_dec (S i) 0); intro; simpl in |- *. -elimtype False; inversion a0. -elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. -apply Max_leEq. -apply less_leEq; apply sep__sep_mon_i; assumption. -apply leEq_transitive with (P (S i) Hi). -elim (gP i Hi); intros; auto. -apply sep__sep_leEq. -apply Max_leEq. -unfold sep__sep_fun_i in |- *. -elim (sep__sep_aux_lemma i); intro; simpl in |- *. -apply leEq_transitive with (P (S i) Hi). -apply shift_plus_leEq'. -apply leEq_transitive with delta. -astepl (delta [/]TwoNZ); apply less_leEq; apply pos_div_two'; exact RS_delta_pos. -apply leEq_transitive with deltaP. -apply RS_delta_deltaP. -unfold deltaP in |- *; apply AntiMesh_lemma. -elim (Partition_in_compact _ _ _ _ P (S i) Hi); intros; assumption. -elim (Partition_in_compact _ _ _ _ P i (lt_le_weak _ _ Hi)); intros; - assumption. -elim (Pts_part_lemma _ _ _ _ _ _ gP i Hi); intros; assumption. +Proof. + red in |- *; intros. + split. + unfold sep__sep_part in |- *; simpl in |- *. + unfold sep__sep_fun, sep__sep_points in |- *. + elim (le_lt_dec i 0); intro; simpl in |- *. + apply leEq_transitive with (g i Hi). + elim (Pts_part_lemma _ _ _ _ _ _ gP i Hi); intros; assumption. + apply rht_leEq_Max. + elim (le_lt_eq_dec _ _ (lt_le_weak _ _ Hi)); intro; simpl in |- *. + eapply leEq_wdl. + apply lft_leEq_Max. + apply sep__sep_fun_i_wd; auto. + elimtype False; rewrite b1 in Hi; apply (lt_irrefl _ Hi). + unfold sep__sep_part in |- *; simpl in |- *. + unfold sep__sep_fun, sep__sep_points in |- *. + elim (le_lt_dec (S i) 0); intro; simpl in |- *. + elimtype False; inversion a0. + elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. + apply Max_leEq. + apply less_leEq; apply sep__sep_mon_i; assumption. + apply leEq_transitive with (P (S i) Hi). + elim (gP i Hi); intros; auto. + apply sep__sep_leEq. + apply Max_leEq. + unfold sep__sep_fun_i in |- *. + elim (sep__sep_aux_lemma i); intro; simpl in |- *. + apply leEq_transitive with (P (S i) Hi). + apply shift_plus_leEq'. + apply leEq_transitive with delta. + astepl (delta [/]TwoNZ); apply less_leEq; apply pos_div_two'; exact RS_delta_pos. + apply leEq_transitive with deltaP. + apply RS_delta_deltaP. + unfold deltaP in |- *; apply AntiMesh_lemma. + elim (Partition_in_compact _ _ _ _ P (S i) Hi); intros; assumption. + elim (Partition_in_compact _ _ _ _ P i (lt_le_weak _ _ Hi)); intros; assumption. + elim (Pts_part_lemma _ _ _ _ _ _ gP i Hi); intros; assumption. Qed. Lemma sep__sep_aux : forall (i : nat) (H : i < n) Hg Hs, AbsIR (F (g i H) Hg[-]F (sep__sep_points i H) Hs)[<=]e. -intros. -apply RS_Hd'. -unfold I in |- *; apply Pts_part_lemma with n P; assumption. -unfold I in |- *; apply Pts_part_lemma with n sep__sep_part; - apply sep__sep_points_lemma. -unfold sep__sep_points in |- *; simpl in |- *. -eapply leEq_wdl. -2: apply AbsIR_minus. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply shift_minus_leEq; apply Max_leEq. -unfold sep__sep_fun_i in |- *. -elim sep__sep_aux_lemma; intro; simpl in |- *. -apply leEq_transitive with (P i (lt_le_weak _ _ H)[+]delta). -apply plus_resp_leEq_lft. -apply less_leEq; astepl (delta [/]TwoNZ); apply pos_div_two'; exact RS_delta_pos. -eapply leEq_wdr. -2: apply cag_commutes_unfolded. -apply plus_resp_leEq_both. -elim (gP i H); intros; assumption. -apply RS_delta_d. -astepl (Zero[+]P i (lt_le_weak _ _ H)). -apply plus_resp_leEq_both. -apply less_leEq; exact RS_Hd. -elim (gP i H); intros; auto. -apply shift_leEq_plus; astepl ZeroR; apply less_leEq; exact RS_Hd. -apply shift_leEq_minus. -eapply leEq_wdl. -apply rht_leEq_Max. -algebra. +Proof. + intros. + apply RS_Hd'. + unfold I in |- *; apply Pts_part_lemma with n P; assumption. + unfold I in |- *; apply Pts_part_lemma with n sep__sep_part; apply sep__sep_points_lemma. + unfold sep__sep_points in |- *; simpl in |- *. + eapply leEq_wdl. + 2: apply AbsIR_minus. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply shift_minus_leEq; apply Max_leEq. + unfold sep__sep_fun_i in |- *. + elim sep__sep_aux_lemma; intro; simpl in |- *. + apply leEq_transitive with (P i (lt_le_weak _ _ H)[+]delta). + apply plus_resp_leEq_lft. + apply less_leEq; astepl (delta [/]TwoNZ); apply pos_div_two'; exact RS_delta_pos. + eapply leEq_wdr. + 2: apply cag_commutes_unfolded. + apply plus_resp_leEq_both. + elim (gP i H); intros; assumption. + apply RS_delta_d. + astepl (Zero[+]P i (lt_le_weak _ _ H)). + apply plus_resp_leEq_both. + apply less_leEq; exact RS_Hd. + elim (gP i H); intros; auto. + apply shift_leEq_plus; astepl ZeroR; apply less_leEq; exact RS_Hd. + apply shift_leEq_minus. + eapply leEq_wdl. + apply rht_leEq_Max. + algebra. Qed. Notation just1 := (incF _ (Pts_part_lemma _ _ _ _ _ _ gP _ _)). @@ -612,234 +632,208 @@ Notation just2 := Lemma sep__sep_Sum : AbsIR (Partition_Sum gP incF[-]Partition_Sum sep__sep_points_lemma incF)[<=] alpha. -unfold Partition_Sum in |- *; simpl in |- *. -rstepr (alpha [/]TwoNZ[+]alpha [/]TwoNZ). -apply leEq_transitive with (e[*](b[-]a)[+]nring n[*]M[*]delta). -apply - leEq_wdr - with - (e[*] - Sumx (fun (i : nat) (Hi : i < n) => P _ Hi[-]P _ (lt_le_weak _ _ Hi))[+] - Sumx (fun (i : nat) (Hi : i < n) => M[*]delta)). -apply - leEq_transitive - with - (Sumx - (fun (i : nat) (Hi : i < n) => - AbsIR (F (g i Hi) just1[-]F (sep__sep_points i Hi) just2)[*] - (P _ Hi[-]P _ (lt_le_weak _ _ Hi)))[+] - Sumx - (fun (i : nat) (Hi : i < n) => - AbsIR (F (sep__sep_points i Hi) just2)[*] - (AbsIR (sep__sep_fun _ Hi[-]P _ Hi)[+] - AbsIR (P _ (lt_le_weak _ _ Hi)[-]sep__sep_fun _ (lt_le_weak _ _ Hi))))). -apply - leEq_transitive - with - (AbsIR - (Sumx - (fun (i : nat) (Hi : i < n) => - F (g i Hi) just1[*](P _ Hi[-]P _ (lt_le_weak _ _ Hi))[-] - F (sep__sep_points i Hi) just2[*] - (P _ Hi[-]P _ (lt_le_weak _ _ Hi))))[+] - AbsIR - (Sumx - (fun (i : nat) (Hi : i < n) => - F (sep__sep_points i Hi) just2[*] - (sep__sep_fun _ Hi[-]P _ Hi[+] +Proof. + unfold Partition_Sum in |- *; simpl in |- *. + rstepr (alpha [/]TwoNZ[+]alpha [/]TwoNZ). + apply leEq_transitive with (e[*](b[-]a)[+]nring n[*]M[*]delta). + apply leEq_wdr with (e[*] Sumx (fun (i : nat) (Hi : i < n) => P _ Hi[-]P _ (lt_le_weak _ _ Hi))[+] + Sumx (fun (i : nat) (Hi : i < n) => M[*]delta)). + apply leEq_transitive with (Sumx (fun (i : nat) (Hi : i < n) => + AbsIR (F (g i Hi) just1[-]F (sep__sep_points i Hi) just2)[*] (P _ Hi[-]P _ (lt_le_weak _ _ Hi)))[+] + Sumx (fun (i : nat) (Hi : i < n) => AbsIR (F (sep__sep_points i Hi) just2)[*] + (AbsIR (sep__sep_fun _ Hi[-]P _ Hi)[+] + AbsIR (P _ (lt_le_weak _ _ Hi)[-]sep__sep_fun _ (lt_le_weak _ _ Hi))))). + apply leEq_transitive with (AbsIR (Sumx (fun (i : nat) (Hi : i < n) => + F (g i Hi) just1[*](P _ Hi[-]P _ (lt_le_weak _ _ Hi))[-] F (sep__sep_points i Hi) just2[*] + (P _ Hi[-]P _ (lt_le_weak _ _ Hi))))[+] AbsIR (Sumx (fun (i : nat) (Hi : i < n) => + F (sep__sep_points i Hi) just2[*] (sep__sep_fun _ Hi[-]P _ Hi[+] (P _ (lt_le_weak _ _ Hi)[-]sep__sep_fun _ (lt_le_weak _ _ Hi)))))). -eapply leEq_wdl. -apply triangle_IR_minus. -apply eq_symmetric_unfolded. -apply AbsIR_wd. -eapply eq_transitive_unfolded. -apply Sumx_minus_Sumx. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply Sumx_minus_Sumx. -apply Sumx_wd; intros. -astepl - (F (g i H) just1[*](P _ H[-]P _ (lt_le_weak _ _ H))[-] - F (sep__sep_points i H) just2[*] - (sep__sep_fun _ H[-]sep__sep_fun _ (lt_le_weak _ _ H))). -rational. -apply plus_resp_leEq_both. -eapply leEq_wdr. -apply triangle_SumxIR. -apply Sumx_wd; intros. -apply - eq_transitive_unfolded - with - (AbsIR (F (g i H) just1[-]F (sep__sep_points i H) just2)[*] - AbsIR (P _ H[-]P _ (lt_le_weak _ _ H))). -eapply eq_transitive_unfolded. -2: apply AbsIR_resp_mult. -apply AbsIR_wd; algebra. -apply mult_wdr. -apply AbsIR_eq_x. -apply shift_leEq_minus; astepl (P i (lt_le_weak _ _ H)); apply prf2. -eapply leEq_transitive. -apply triangle_SumxIR. -apply Sumx_resp_leEq; intros. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_lft. -apply triangle_IR. -apply AbsIR_nonneg. -apply plus_resp_leEq_both. -eapply leEq_wdr. -2: apply Sumx_comm_scal'. -apply Sumx_resp_leEq; intros. -apply mult_resp_leEq_rht. -apply sep__sep_aux. -apply shift_leEq_minus; astepl (P i (lt_le_weak _ _ H)); apply prf2. -apply Sumx_resp_leEq; intros. -apply mult_resp_leEq_both. -apply AbsIR_nonneg. -astepl (ZeroR[+]Zero); apply plus_resp_leEq_both; apply AbsIR_nonneg. -unfold I, M in |- *; apply norm_bnd_AbsIR. -apply Pts_part_lemma with n sep__sep_part; apply sep__sep_points_lemma. -rstepr (delta [/]TwoNZ[+]delta [/]TwoNZ). -apply plus_resp_leEq_both. -apply sep__sep_fun_delta. -eapply leEq_wdl. -2: apply AbsIR_minus. -apply sep__sep_fun_delta. -apply bin_op_wd_unfolded. -apply mult_wdr. -eapply eq_transitive_unfolded. -apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= n) => P i Hi). -red in |- *; intros; apply prf1; auto. -intros; algebra. -apply cg_minus_wd. -apply finish. -apply start. -astepr (nring n[*](M[*]delta)); apply sumx_const. -apply plus_resp_leEq_both. -unfold e in |- *. -apply - leEq_wdl with (alpha [/]TwoNZ[*](b[-]a[/] _[//]max_one_ap_zero (b[-]a))). -rstepr (alpha [/]TwoNZ[*]One). -apply mult_resp_leEq_lft. -apply shift_div_leEq. -apply pos_max_one. -astepr (Max (b[-]a) One); apply lft_leEq_Max. -apply less_leEq; apply pos_div_two; assumption. -simpl in |- *; rational. -apply leEq_transitive with (Max (nring n[*]M) One[*]delta). -apply mult_resp_leEq_rht. -apply lft_leEq_Max. -apply less_leEq; apply RS_delta_pos. -apply shift_mult_leEq' with (max_one_ap_zero (nring n[*]M)). -apply pos_max_one. -unfold delta in |- *. -eapply leEq_transitive. -apply Min_leEq_rht. -apply Min_leEq_lft. + eapply leEq_wdl. + apply triangle_IR_minus. + apply eq_symmetric_unfolded. + apply AbsIR_wd. + eapply eq_transitive_unfolded. + apply Sumx_minus_Sumx. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply Sumx_minus_Sumx. + apply Sumx_wd; intros. + astepl (F (g i H) just1[*](P _ H[-]P _ (lt_le_weak _ _ H))[-] F (sep__sep_points i H) just2[*] + (sep__sep_fun _ H[-]sep__sep_fun _ (lt_le_weak _ _ H))). + rational. + apply plus_resp_leEq_both. + eapply leEq_wdr. + apply triangle_SumxIR. + apply Sumx_wd; intros. + apply eq_transitive_unfolded with (AbsIR (F (g i H) just1[-]F (sep__sep_points i H) just2)[*] + AbsIR (P _ H[-]P _ (lt_le_weak _ _ H))). + eapply eq_transitive_unfolded. + 2: apply AbsIR_resp_mult. + apply AbsIR_wd; algebra. + apply mult_wdr. + apply AbsIR_eq_x. + apply shift_leEq_minus; astepl (P i (lt_le_weak _ _ H)); apply prf2. + eapply leEq_transitive. + apply triangle_SumxIR. + apply Sumx_resp_leEq; intros. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_lft. + apply triangle_IR. + apply AbsIR_nonneg. + apply plus_resp_leEq_both. + eapply leEq_wdr. + 2: apply Sumx_comm_scal'. + apply Sumx_resp_leEq; intros. + apply mult_resp_leEq_rht. + apply sep__sep_aux. + apply shift_leEq_minus; astepl (P i (lt_le_weak _ _ H)); apply prf2. + apply Sumx_resp_leEq; intros. + apply mult_resp_leEq_both. + apply AbsIR_nonneg. + astepl (ZeroR[+]Zero); apply plus_resp_leEq_both; apply AbsIR_nonneg. + unfold I, M in |- *; apply norm_bnd_AbsIR. + apply Pts_part_lemma with n sep__sep_part; apply sep__sep_points_lemma. + rstepr (delta [/]TwoNZ[+]delta [/]TwoNZ). + apply plus_resp_leEq_both. + apply sep__sep_fun_delta. + eapply leEq_wdl. + 2: apply AbsIR_minus. + apply sep__sep_fun_delta. + apply bin_op_wd_unfolded. + apply mult_wdr. + eapply eq_transitive_unfolded. + apply Mengolli_Sum with (f := fun (i : nat) (Hi : i <= n) => P i Hi). + red in |- *; intros; apply prf1; auto. + intros; algebra. + apply cg_minus_wd. + apply finish. + apply start. + astepr (nring n[*](M[*]delta)); apply sumx_const. + apply plus_resp_leEq_both. + unfold e in |- *. + apply leEq_wdl with (alpha [/]TwoNZ[*](b[-]a[/] _[//]max_one_ap_zero (b[-]a))). + rstepr (alpha [/]TwoNZ[*]One). + apply mult_resp_leEq_lft. + apply shift_div_leEq. + apply pos_max_one. + astepr (Max (b[-]a) One); apply lft_leEq_Max. + apply less_leEq; apply pos_div_two; assumption. + simpl in |- *; rational. + apply leEq_transitive with (Max (nring n[*]M) One[*]delta). + apply mult_resp_leEq_rht. + apply lft_leEq_Max. + apply less_leEq; apply RS_delta_pos. + apply shift_mult_leEq' with (max_one_ap_zero (nring n[*]M)). + apply pos_max_one. + unfold delta in |- *. + eapply leEq_transitive. + apply Min_leEq_rht. + apply Min_leEq_lft. Qed. Lemma sep__sep_Mesh : Mesh sep__sep_part[<=]Mesh P[+]csi. -unfold Mesh in |- *. -apply maxlist_leEq. -apply length_Part_Mesh_List. -exact RS_pos_n. -intros x H. -elim (Part_Mesh_List_lemma _ _ _ _ _ _ H); intros i Hi. -elim Hi; clear Hi; intros Hi Hi'. -elim Hi'; clear Hi'; intros Hi' Hx. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply Hx. -unfold sep__sep_part in |- *; simpl in |- *. -unfold sep__sep_fun in |- *; simpl in |- *. -elim (le_lt_dec (S i) 0); intro; simpl in |- *. -elimtype False; inversion a0. -elim (le_lt_eq_dec _ _ Hi'); intro; simpl in |- *. -elim (le_lt_dec i 0); intro; simpl in |- *. -cut (i = 0); [ intro | auto with arith ]. -unfold sep__sep_fun_i in |- *; simpl in |- *. -elim (sep__sep_aux_lemma (S i)); intro; simpl in |- *. -generalize Hi'; rewrite H0; clear Hx Hi'; intro. -apply leEq_wdl with (P 1 Hi'[+]delta [/]TwoNZ[-]P 0 (le_O_n _)). -rstepl (P 1 Hi'[-]P 0 (le_O_n _)[+]delta [/]TwoNZ). -apply plus_resp_leEq_both. -fold (Mesh P) in |- *; apply Mesh_lemma. -apply leEq_transitive with delta. -apply less_leEq; apply pos_div_two'; exact RS_delta_pos. -apply RS_delta_csi. -apply cg_minus_wd; [ algebra | apply start ]. -generalize Hi'; rewrite H0; clear Hx Hi'; intro. -apply leEq_wdl with (P 1 Hi'[-]P 0 (le_O_n _)). -fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). -astepr (Mesh P); apply Mesh_lemma. -apply plus_resp_leEq_lft. -apply less_leEq; assumption. -apply cg_minus_wd; [ algebra | apply start ]. -elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. -unfold sep__sep_fun_i in |- *. -elim (sep__sep_aux_lemma (S i)); elim (sep__sep_aux_lemma i); intros; - simpl in |- *. -rstepl (P (S i) Hi'[-]P i Hi). -fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). -astepr (Mesh P); apply Mesh_lemma. -apply plus_resp_leEq_lft. -apply less_leEq; assumption. -rstepl (P _ Hi'[-]P _ Hi[+]delta [/]TwoNZ). -apply plus_resp_leEq_both. -fold (Mesh P) in |- *; apply Mesh_lemma. -apply leEq_transitive with delta. -apply less_leEq; apply pos_div_two'; exact RS_delta_pos. -apply RS_delta_csi. -rstepl (P _ Hi'[-]P _ Hi[-]delta [/]TwoNZ). -unfold cg_minus at 1 in |- *; apply plus_resp_leEq_both. -fold (Mesh P) in |- *; apply Mesh_lemma. -apply leEq_transitive with ZeroR. -astepr ([--]ZeroR); apply inv_resp_leEq. -apply less_leEq; apply pos_div_two; exact RS_delta_pos. -apply leEq_transitive with delta. -apply less_leEq; exact RS_delta_pos. -apply RS_delta_csi. -fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). -astepr (Mesh P); apply Mesh_lemma. -apply plus_resp_leEq_lft. -apply less_leEq; assumption. -elimtype False; rewrite b2 in a0; apply lt_irrefl with (S n); - apply lt_trans with (S n); auto with arith. -elim (le_lt_dec i 0); intro; simpl in |- *. -cut (i = 0); [ intro | auto with arith ]. -rewrite H0 in b1. -clear Hx; rewrite H0 in Hi'. -apply leEq_wdl with (P 1 Hi'[-]P 0 (le_O_n n)). -fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). -astepr (Mesh P); apply Mesh_lemma. -apply plus_resp_leEq_lft. -apply less_leEq; assumption. -apply cg_minus_wd. -generalize Hi'; rewrite b1; intro; apply finish. -apply start. -elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. -unfold sep__sep_fun_i in |- *. -elim (sep__sep_aux_lemma i); intro; simpl in |- *. -apply leEq_wdl with (P (S i) Hi'[-](P i Hi[+]delta [/]TwoNZ)). -rstepl (P (S i) Hi'[-]P i Hi[-]delta [/]TwoNZ). -unfold cg_minus at 1 in |- *; apply plus_resp_leEq_both. -fold (Mesh P) in |- *; apply Mesh_lemma. -apply leEq_transitive with ZeroR. -astepr ([--]ZeroR); apply inv_resp_leEq. -apply less_leEq; apply pos_div_two; exact RS_delta_pos. -apply leEq_transitive with delta. -apply less_leEq; exact RS_delta_pos. -apply RS_delta_csi. -apply cg_minus_wd. -generalize Hi'; rewrite b1; intro; apply finish. -algebra. -apply leEq_wdl with (P (S i) Hi'[-]P i Hi). -fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). -astepr (Mesh P); apply Mesh_lemma. -apply plus_resp_leEq_lft. -apply less_leEq; assumption. -apply cg_minus_wd. -generalize Hi'; rewrite b1; intro; apply finish. -algebra. -elimtype False; rewrite b3 in b1; apply n_Sn with n; auto. +Proof. + unfold Mesh in |- *. + apply maxlist_leEq. + apply length_Part_Mesh_List. + exact RS_pos_n. + intros x H. + elim (Part_Mesh_List_lemma _ _ _ _ _ _ H); intros i Hi. + elim Hi; clear Hi; intros Hi Hi'. + elim Hi'; clear Hi'; intros Hi' Hx. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Hx. + unfold sep__sep_part in |- *; simpl in |- *. + unfold sep__sep_fun in |- *; simpl in |- *. + elim (le_lt_dec (S i) 0); intro; simpl in |- *. + elimtype False; inversion a0. + elim (le_lt_eq_dec _ _ Hi'); intro; simpl in |- *. + elim (le_lt_dec i 0); intro; simpl in |- *. + cut (i = 0); [ intro | auto with arith ]. + unfold sep__sep_fun_i in |- *; simpl in |- *. + elim (sep__sep_aux_lemma (S i)); intro; simpl in |- *. + generalize Hi'; rewrite H0; clear Hx Hi'; intro. + apply leEq_wdl with (P 1 Hi'[+]delta [/]TwoNZ[-]P 0 (le_O_n _)). + rstepl (P 1 Hi'[-]P 0 (le_O_n _)[+]delta [/]TwoNZ). + apply plus_resp_leEq_both. + fold (Mesh P) in |- *; apply Mesh_lemma. + apply leEq_transitive with delta. + apply less_leEq; apply pos_div_two'; exact RS_delta_pos. + apply RS_delta_csi. + apply cg_minus_wd; [ algebra | apply start ]. + generalize Hi'; rewrite H0; clear Hx Hi'; intro. + apply leEq_wdl with (P 1 Hi'[-]P 0 (le_O_n _)). + fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). + astepr (Mesh P); apply Mesh_lemma. + apply plus_resp_leEq_lft. + apply less_leEq; assumption. + apply cg_minus_wd; [ algebra | apply start ]. + elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. + unfold sep__sep_fun_i in |- *. + elim (sep__sep_aux_lemma (S i)); elim (sep__sep_aux_lemma i); intros; simpl in |- *. + rstepl (P (S i) Hi'[-]P i Hi). + fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). + astepr (Mesh P); apply Mesh_lemma. + apply plus_resp_leEq_lft. + apply less_leEq; assumption. + rstepl (P _ Hi'[-]P _ Hi[+]delta [/]TwoNZ). + apply plus_resp_leEq_both. + fold (Mesh P) in |- *; apply Mesh_lemma. + apply leEq_transitive with delta. + apply less_leEq; apply pos_div_two'; exact RS_delta_pos. + apply RS_delta_csi. + rstepl (P _ Hi'[-]P _ Hi[-]delta [/]TwoNZ). + unfold cg_minus at 1 in |- *; apply plus_resp_leEq_both. + fold (Mesh P) in |- *; apply Mesh_lemma. + apply leEq_transitive with ZeroR. + astepr ([--]ZeroR); apply inv_resp_leEq. + apply less_leEq; apply pos_div_two; exact RS_delta_pos. + apply leEq_transitive with delta. + apply less_leEq; exact RS_delta_pos. + apply RS_delta_csi. + fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). + astepr (Mesh P); apply Mesh_lemma. + apply plus_resp_leEq_lft. + apply less_leEq; assumption. + elimtype False; rewrite b2 in a0; apply lt_irrefl with (S n); + apply lt_trans with (S n); auto with arith. + elim (le_lt_dec i 0); intro; simpl in |- *. + cut (i = 0); [ intro | auto with arith ]. + rewrite H0 in b1. + clear Hx; rewrite H0 in Hi'. + apply leEq_wdl with (P 1 Hi'[-]P 0 (le_O_n n)). + fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). + astepr (Mesh P); apply Mesh_lemma. + apply plus_resp_leEq_lft. + apply less_leEq; assumption. + apply cg_minus_wd. + generalize Hi'; rewrite b1; intro; apply finish. + apply start. + elim (le_lt_eq_dec _ _ Hi); intro; simpl in |- *. + unfold sep__sep_fun_i in |- *. + elim (sep__sep_aux_lemma i); intro; simpl in |- *. + apply leEq_wdl with (P (S i) Hi'[-](P i Hi[+]delta [/]TwoNZ)). + rstepl (P (S i) Hi'[-]P i Hi[-]delta [/]TwoNZ). + unfold cg_minus at 1 in |- *; apply plus_resp_leEq_both. + fold (Mesh P) in |- *; apply Mesh_lemma. + apply leEq_transitive with ZeroR. + astepr ([--]ZeroR); apply inv_resp_leEq. + apply less_leEq; apply pos_div_two; exact RS_delta_pos. + apply leEq_transitive with delta. + apply less_leEq; exact RS_delta_pos. + apply RS_delta_csi. + apply cg_minus_wd. + generalize Hi'; rewrite b1; intro; apply finish. + algebra. + apply leEq_wdl with (P (S i) Hi'[-]P i Hi). + fold (Mesh P) in |- *; apply leEq_transitive with (Mesh P[+]Zero). + astepr (Mesh P); apply Mesh_lemma. + apply plus_resp_leEq_lft. + apply less_leEq; assumption. + apply cg_minus_wd. + generalize Hi'; rewrite b1; intro; apply finish. + algebra. + elimtype False; rewrite b3 in b1; apply n_Sn with n; auto. Qed. End Separating__Separated. diff --git a/ftc/RefSeparating.v b/ftc/RefSeparating.v index 72e0b0963..6d3bae3f0 100644 --- a/ftc/RefSeparating.v +++ b/ftc/RefSeparating.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) @@ -62,14 +62,16 @@ Hypothesis Hcsi : Zero[<]csi. Let M := Norm_Funct contF. Lemma RS'_pos_n : 0 < n. -apply partition_less_imp_gt_zero with a b Hab; assumption. +Proof. + apply partition_less_imp_gt_zero with a b Hab; assumption. Qed. Lemma SPap_n : n <> 0. -intro. -apply (lt_O_neq n). -exact RS'_pos_n. -auto. +Proof. + intro. + apply (lt_O_neq n). + exact RS'_pos_n. + auto. Qed. Let delta := @@ -78,17 +80,19 @@ Let delta := mult_resp_ap_zero _ _ _ (nring_ap_zero _ _ SPap_n) (max_one_ap_zero M)). Lemma RS'_delta_pos : Zero[<]delta. -unfold delta in |- *; apply less_Min. -assumption. -apply div_resp_pos. -apply mult_resp_pos. -astepl (nring (R:=IR) 0); apply nring_less; apply RS'_pos_n. -apply pos_max_one. -assumption. +Proof. + unfold delta in |- *; apply less_Min. + assumption. + apply div_resp_pos. + apply mult_resp_pos. + astepl (nring (R:=IR) 0); apply nring_less; apply RS'_pos_n. + apply pos_max_one. + assumption. Qed. Lemma RS'_delta_csi : delta[<=]csi. -unfold delta in |- *; apply Min_leEq_lft. +Proof. + unfold delta in |- *; apply Min_leEq_lft. Qed. Hypothesis Hab'' : delta [/]TwoNZ[<]b[-]a. @@ -101,238 +105,242 @@ Lemma sep__part_lemma : and (forall (j' : nat) (Hj' : j' <= n), j' < j -> P j' Hj'[-]P i Hi[<]delta [/]TwoNZ)}} or P n (le_n n)[-]P i Hi[<]delta [/]TwoNZ. -intros. -elim - (str_finite_or_elim _ - (fun (j : nat) (Hj : j <= n) => delta [/]FourNZ[<]P j Hj[-]P i Hi) - (fun (j : nat) (Hj : j <= n) => P j Hj[-]P i Hi[<]delta [/]TwoNZ)); +Proof. intros. -left. -elim a0; intros j a'. -elim a'; intros Hj Hj'. -elim Hj'; clear a0 a' Hj'; intros Hj' H0. -exists j; exists Hj. -split; assumption. -right; auto. -red in |- *; intros. rename X into H1. -eapply less_wdr. -apply H1. -apply cg_minus_wd; apply prf1; auto. -red in |- *; intros. rename X into H1. -eapply less_wdl. -apply H1. -apply cg_minus_wd; apply prf1; auto. -apply less_cotransitive_unfolded. -apply shift_div_less. -apply pos_four. -rstepr (delta[+]delta). -astepl (Zero[+]delta). -apply plus_resp_less_leEq. -apply RS'_delta_pos. -apply leEq_reflexive. + elim (str_finite_or_elim _ (fun (j : nat) (Hj : j <= n) => delta [/]FourNZ[<]P j Hj[-]P i Hi) + (fun (j : nat) (Hj : j <= n) => P j Hj[-]P i Hi[<]delta [/]TwoNZ)); intros. + left. + elim a0; intros j a'. + elim a'; intros Hj Hj'. + elim Hj'; clear a0 a' Hj'; intros Hj' H0. + exists j; exists Hj. + split; assumption. + right; auto. + red in |- *; intros. rename X into H1. + eapply less_wdr. + apply H1. + apply cg_minus_wd; apply prf1; auto. + red in |- *; intros. rename X into H1. + eapply less_wdl. + apply H1. + apply cg_minus_wd; apply prf1; auto. + apply less_cotransitive_unfolded. + apply shift_div_less. + apply pos_four. + rstepr (delta[+]delta). + astepl (Zero[+]delta). + apply plus_resp_less_leEq. + apply RS'_delta_pos. + apply leEq_reflexive. Qed. Definition sep__part_h : nat -> nat. -intro i; induction i as [| i Hreci]. -apply 0. -elim (le_lt_dec Hreci n); intro. -elim (sep__part_lemma Hreci a0); intro. -apply (ProjT1 a1). -apply n. -apply n. +Proof. + intro i; induction i as [| i Hreci]. + apply 0. + elim (le_lt_dec Hreci n); intro. + elim (sep__part_lemma Hreci a0); intro. + apply (ProjT1 a1). + apply n. + apply n. Defined. Lemma sep__part_h_bnd : forall i : nat, sep__part_h i <= n. -intro. -induction i as [| i Hreci]. -apply le_O_n. -simpl in |- *. -elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. -elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. -set (j := ProjT1 a1) in *; fold j in |- *. -elim (ProjT2 a1); intros Hj Hj'; fold j in Hj, Hj'. -assumption. -apply le_n. -apply le_n. +Proof. + intro. + induction i as [| i Hreci]. + apply le_O_n. + simpl in |- *. + elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. + elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. + set (j := ProjT1 a1) in *; fold j in |- *. + elim (ProjT2 a1); intros Hj Hj'; fold j in Hj, Hj'. + assumption. + apply le_n. + apply le_n. Qed. Lemma sep__part_h_mon_1 : forall i : nat, sep__part_h i <= sep__part_h (S i). -intros; simpl in |- *. -elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. -elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. -set (j := ProjT1 a1) in *; fold j in |- *. -elim (ProjT2 a1); intros Hj Hj'; fold j in Hj, Hj'. -elim Hj'; clear Hj'; intros Hj0 Hj1. -cut (sep__part_h i < j); intros. -apply lt_le_weak; assumption. -apply (Partition_Points_mon _ _ _ _ P) with a0 Hj. -apply less_transitive_unfolded with (P (sep__part_h i) a0[+]delta [/]FourNZ). -apply shift_less_plus'; astepl ZeroR. -apply pos_div_four; exact RS'_delta_pos. -apply shift_plus_less'; assumption. -assumption. -apply sep__part_h_bnd. +Proof. + intros; simpl in |- *. + elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. + elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. + set (j := ProjT1 a1) in *; fold j in |- *. + elim (ProjT2 a1); intros Hj Hj'; fold j in Hj, Hj'. + elim Hj'; clear Hj'; intros Hj0 Hj1. + cut (sep__part_h i < j); intros. + apply lt_le_weak; assumption. + apply (Partition_Points_mon _ _ _ _ P) with a0 Hj. + apply less_transitive_unfolded with (P (sep__part_h i) a0[+]delta [/]FourNZ). + apply shift_less_plus'; astepl ZeroR. + apply pos_div_four; exact RS'_delta_pos. + apply shift_plus_less'; assumption. + assumption. + apply sep__part_h_bnd. Qed. Lemma sep__part_h_mon_2 : forall i : nat, sep__part_h i < n -> sep__part_h i < sep__part_h (S i). -intros; simpl in |- *. -elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. -elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. -set (j := ProjT1 a1) in *; fold j in |- *. -elim (ProjT2 a1); intros Hj Hj'; fold j in Hj, Hj'. -elim Hj'; clear Hj'; intros Hj0 Hj1. -apply (Partition_Points_mon _ _ _ _ P) with a0 Hj. -apply less_transitive_unfolded with (P (sep__part_h i) a0[+]delta [/]FourNZ). -apply shift_less_plus'; astepl ZeroR. -apply pos_div_four; exact RS'_delta_pos. -apply shift_plus_less'; assumption. -assumption. -assumption. +Proof. + intros; simpl in |- *. + elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. + elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. + set (j := ProjT1 a1) in *; fold j in |- *. + elim (ProjT2 a1); intros Hj Hj'; fold j in Hj, Hj'. + elim Hj'; clear Hj'; intros Hj0 Hj1. + apply (Partition_Points_mon _ _ _ _ P) with a0 Hj. + apply less_transitive_unfolded with (P (sep__part_h i) a0[+]delta [/]FourNZ). + apply shift_less_plus'; astepl ZeroR. + apply pos_div_four; exact RS'_delta_pos. + apply shift_plus_less'; assumption. + assumption. + assumption. Qed. Lemma sep__part_h_mon_3 : forall i j : nat, sep__part_h i < n -> i < j -> sep__part_h i < sep__part_h j. -intros; induction j as [| j Hrecj]. -elimtype False; inversion H0. -cut (sep__part_h j <= sep__part_h (S j)); intros. -2: apply sep__part_h_mon_1. -elim (le_lt_eq_dec _ _ H0); intro. -apply lt_le_trans with (sep__part_h j); auto. -apply Hrecj; auto with arith. -rewrite <- b0; apply sep__part_h_mon_2; auto. +Proof. + intros; induction j as [| j Hrecj]. + elimtype False; inversion H0. + cut (sep__part_h j <= sep__part_h (S j)); intros. + 2: apply sep__part_h_mon_1. + elim (le_lt_eq_dec _ _ H0); intro. + apply lt_le_trans with (sep__part_h j); auto. + apply Hrecj; auto with arith. + rewrite <- b0; apply sep__part_h_mon_2; auto. Qed. Lemma sep__part_app_n : {m : nat | sep__part_h (S m) = n /\ (forall i : nat, i <= m -> sep__part_h i < n)}. -elim (weird_mon_covers _ _ sep__part_h_mon_2); intros m Hm Hm'. -set (m' := pred m) in *. -exists m'. -cut (m <> 0); intro. -split. -cut (S m' = m); - [ intro - | unfold m' in |- *; symmetry in |- *; apply S_pred with 0; apply neq_O_lt; - auto ]. -rewrite H0; clear H0 m'. -cut (n <= sep__part_h m). -cut (sep__part_h m <= n); intros. -auto with arith. -apply sep__part_h_bnd. -assumption. -intros; apply Hm'. -unfold m' in H0; rewrite (S_pred m 0); auto with arith. -apply neq_O_lt; auto. -apply SPap_n. -rewrite H in Hm. -simpl in Hm. -apply le_antisym; auto with arith. +Proof. + elim (weird_mon_covers _ _ sep__part_h_mon_2); intros m Hm Hm'. + set (m' := pred m) in *. + exists m'. + cut (m <> 0); intro. + split. + cut (S m' = m); [ intro | unfold m' in |- *; symmetry in |- *; apply S_pred with 0; apply neq_O_lt; + auto ]. + rewrite H0; clear H0 m'. + cut (n <= sep__part_h m). + cut (sep__part_h m <= n); intros. + auto with arith. + apply sep__part_h_bnd. + assumption. + intros; apply Hm'. + unfold m' in H0; rewrite (S_pred m 0); auto with arith. + apply neq_O_lt; auto. + apply SPap_n. + rewrite H in Hm. + simpl in Hm. + apply le_antisym; auto with arith. Qed. Lemma sep__part_h_lemma : forall i : nat, sep__part_h (S i) < n -> forall Hi Hi', P (sep__part_h i) Hi[<]P (sep__part_h (S i)) Hi'. -do 3 intro; simpl in |- *. -elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. -elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. -set (m' := ProjT1 a1) in *. -change (forall Hi' : m' <= n, P (sep__part_h i) Hi[<]P m' Hi') in |- *; - intros. -elim (ProjT2 a1); fold m' in |- *; intros Hm' Hm''. -elim Hm''; clear Hm''; intros H0 H1. -apply less_transitive_unfolded with (P (sep__part_h i) Hi[+]delta [/]FourNZ). -apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. -apply shift_plus_less'; eapply less_wdr. -apply H0. -apply cg_minus_wd; apply prf1; auto. -generalize H. -simpl in |- *. -elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. -elim (sep__part_lemma (sep__part_h i) a1); intro; simpl in |- *. -2: intro; elimtype False; apply (lt_irrefl n); auto. -2: intro; elimtype False; apply (lt_irrefl n); auto. -set (m' := ProjT1 a2) in *. -change (m' < n -> forall Hi' : n <= n, P (sep__part_h i) Hi[<]P n Hi') - in |- *; intros. -elim (ProjT2 a2); fold m' in |- *; intros Hm' Hm''. -elim Hm''; clear Hm''; intros H1 H2. -apply less_leEq_trans with (P _ Hm'). -apply less_transitive_unfolded with (P (sep__part_h i) Hi[+]delta [/]FourNZ). -apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. -apply shift_plus_less'; eapply less_wdr. -apply H1. -apply cg_minus_wd; apply prf1; auto. -apply local_mon'_imp_mon'2_le with (f := fun (i : nat) Hi => P i Hi). -intros; apply prf2. -assumption. -elimtype False; apply (le_not_lt _ _ Hi b0). +Proof. + do 3 intro; simpl in |- *. + elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. + elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. + set (m' := ProjT1 a1) in *. + change (forall Hi' : m' <= n, P (sep__part_h i) Hi[<]P m' Hi') in |- *; intros. + elim (ProjT2 a1); fold m' in |- *; intros Hm' Hm''. + elim Hm''; clear Hm''; intros H0 H1. + apply less_transitive_unfolded with (P (sep__part_h i) Hi[+]delta [/]FourNZ). + apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. + apply shift_plus_less'; eapply less_wdr. + apply H0. + apply cg_minus_wd; apply prf1; auto. + generalize H. + simpl in |- *. + elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. + elim (sep__part_lemma (sep__part_h i) a1); intro; simpl in |- *. + 2: intro; elimtype False; apply (lt_irrefl n); auto. + 2: intro; elimtype False; apply (lt_irrefl n); auto. + set (m' := ProjT1 a2) in *. + change (m' < n -> forall Hi' : n <= n, P (sep__part_h i) Hi[<]P n Hi') in |- *; intros. + elim (ProjT2 a2); fold m' in |- *; intros Hm' Hm''. + elim Hm''; clear Hm''; intros H1 H2. + apply less_leEq_trans with (P _ Hm'). + apply less_transitive_unfolded with (P (sep__part_h i) Hi[+]delta [/]FourNZ). + apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. + apply shift_plus_less'; eapply less_wdr. + apply H1. + apply cg_minus_wd; apply prf1; auto. + apply local_mon'_imp_mon'2_le with (f := fun (i : nat) Hi => P i Hi). + intros; apply prf2. + assumption. + elimtype False; apply (le_not_lt _ _ Hi b0). Qed. Lemma sep__part_h_lemma2 : forall (i : nat) Hi Hi', P (pred (sep__part_h (S i))) Hi'[-]P (sep__part_h i) Hi[<=]delta [/]TwoNZ. -do 2 intro; simpl in |- *. -elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. -elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. -set (j := ProjT1 a1) in *. -elim (ProjT2 a1); fold j in |- *; intros Hj Hj'; elim Hj'; clear Hj'; - intros H H0. -change (forall Hi', P (pred j) Hi'[-]P _ Hi[<=]delta [/]TwoNZ) in |- *. -intros; apply less_leEq. -apply less_wdl with (P (pred j) Hi'[-]P _ a0); intros. -2: apply cg_minus_wd; apply prf1; auto. -apply H0. -apply lt_pred_n_n. -apply le_lt_trans with (sep__part_h i). -apply le_O_n. -apply Partition_Points_mon with (P := P) (Hi := a0) (Hj := Hj). -apply less_transitive_unfolded with (P (sep__part_h i) a0[+]delta [/]FourNZ). -apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. -apply shift_plus_less'; assumption. -intros; eapply leEq_transitive. -2: apply less_leEq; apply b0. -unfold cg_minus in |- *; apply plus_resp_leEq_both. -apply Partition_mon; assumption. -apply inv_resp_leEq; apply eq_imp_leEq; apply prf1; auto. -elimtype False; exact (le_not_lt _ _ (sep__part_h_bnd _) b0). +Proof. + do 2 intro; simpl in |- *. + elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. + elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. + set (j := ProjT1 a1) in *. + elim (ProjT2 a1); fold j in |- *; intros Hj Hj'; elim Hj'; clear Hj'; intros H H0. + change (forall Hi', P (pred j) Hi'[-]P _ Hi[<=]delta [/]TwoNZ) in |- *. + intros; apply less_leEq. + apply less_wdl with (P (pred j) Hi'[-]P _ a0); intros. + 2: apply cg_minus_wd; apply prf1; auto. + apply H0. + apply lt_pred_n_n. + apply le_lt_trans with (sep__part_h i). + apply le_O_n. + apply Partition_Points_mon with (P := P) (Hi := a0) (Hj := Hj). + apply less_transitive_unfolded with (P (sep__part_h i) a0[+]delta [/]FourNZ). + apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. + apply shift_plus_less'; assumption. + intros; eapply leEq_transitive. + 2: apply less_leEq; apply b0. + unfold cg_minus in |- *; apply plus_resp_leEq_both. + apply Partition_mon; assumption. + apply inv_resp_leEq; apply eq_imp_leEq; apply prf1; auto. + elimtype False; exact (le_not_lt _ _ (sep__part_h_bnd _) b0). Qed. Lemma sep__part_h_lemma3 : forall (i k : nat) Hk Hk', sep__part_h i <= k -> k < pred (sep__part_h (S i)) -> P (S k) Hk'[-]P k Hk[<=]delta [/]TwoNZ. -intros. -cut (sep__part_h i <= n). -cut (pred (sep__part_h (S i)) <= n); intros. -eapply leEq_transitive. -2: apply sep__part_h_lemma2 with (Hi := H2) (Hi' := H1). -unfold cg_minus in |- *; apply plus_resp_leEq_both. -apply Partition_mon; assumption. -apply inv_resp_leEq; apply Partition_mon; assumption. -apply le_trans with (sep__part_h (S i)). -auto with arith. -apply sep__part_h_bnd. -apply sep__part_h_bnd. +Proof. + intros. + cut (sep__part_h i <= n). + cut (pred (sep__part_h (S i)) <= n); intros. + eapply leEq_transitive. + 2: apply sep__part_h_lemma2 with (Hi := H2) (Hi' := H1). + unfold cg_minus in |- *; apply plus_resp_leEq_both. + apply Partition_mon; assumption. + apply inv_resp_leEq; apply Partition_mon; assumption. + apply le_trans with (sep__part_h (S i)). + auto with arith. + apply sep__part_h_bnd. + apply sep__part_h_bnd. Qed. Lemma RS'_delta2_delta4 : forall m : nat, delta [/]FourNZ[<]P _ (sep__part_h_bnd (S m))[-]P _ (sep__part_h_bnd m) or P _ (sep__part_h_bnd (S m))[-]P _ (sep__part_h_bnd m)[<]delta [/]TwoNZ. -intro; apply less_cotransitive_unfolded. -rstepl ((delta [/]TwoNZ) [/]TwoNZ). -apply pos_div_two'; apply pos_div_two; exact RS'_delta_pos. +Proof. + intro; apply less_cotransitive_unfolded. + rstepl ((delta [/]TwoNZ) [/]TwoNZ). + apply pos_div_two'; apply pos_div_two; exact RS'_delta_pos. Qed. Definition RS'_m1 := ProjT1 sep__part_app_n. Definition RS'_m : nat. -elim (RS'_delta2_delta4 RS'_m1); intro. -apply (S RS'_m1). -apply RS'_m1. +Proof. + elim (RS'_delta2_delta4 RS'_m1); intro. + apply (S RS'_m1). + apply RS'_m1. Defined. Notation m := RS'_m. @@ -340,356 +348,353 @@ Notation m := RS'_m. Definition sep__part_length := m. Lemma RS'_m_m1 : {m = RS'_m1} + {m = S RS'_m1}. -unfold m in |- *. -elim (RS'_delta2_delta4 RS'_m1); intro; simpl in |- *. -right; auto. -left; auto. +Proof. + unfold m in |- *. + elim (RS'_delta2_delta4 RS'_m1); intro; simpl in |- *. + right; auto. + left; auto. Qed. Lemma RS'_pos_m : 0 < m. -unfold m in |- *. -elim (RS'_delta2_delta4 RS'_m1); intro; simpl in |- *. -auto with arith. -elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. -cut (0 <> RS'_m1); intro. -auto with arith. -elimtype False. -apply less_irreflexive_unfolded with (x := delta [/]TwoNZ). -apply less_transitive_unfolded with (b[-]a). -assumption. -eapply less_wdl. -apply b0. -apply cg_minus_wd. -eapply eq_transitive_unfolded. -2: apply finish with (p := P) (H := le_n n). -apply prf1. -auto. -eapply eq_transitive_unfolded. -2: apply start with (p := P) (H := le_O_n n). -apply prf1. -rewrite <- H1. -simpl in |- *; auto. +Proof. + unfold m in |- *. + elim (RS'_delta2_delta4 RS'_m1); intro; simpl in |- *. + auto with arith. + elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. + cut (0 <> RS'_m1); intro. + auto with arith. + elimtype False. + apply less_irreflexive_unfolded with (x := delta [/]TwoNZ). + apply less_transitive_unfolded with (b[-]a). + assumption. + eapply less_wdl. + apply b0. + apply cg_minus_wd. + eapply eq_transitive_unfolded. + 2: apply finish with (p := P) (H := le_n n). + apply prf1. + auto. + eapply eq_transitive_unfolded. + 2: apply start with (p := P) (H := le_O_n n). + apply prf1. + rewrite <- H1. + simpl in |- *; auto. Qed. Definition sep__part_fun : forall i : nat, i <= m -> nat. -intros i Hi. -elim (le_lt_eq_dec _ _ Hi); intro. -apply (sep__part_h i). -apply n. +Proof. + intros i Hi. + elim (le_lt_eq_dec _ _ Hi); intro. + apply (sep__part_h i). + apply n. Defined. Lemma sep__part_fun_bnd : forall (i : nat) (H : i <= m), sep__part_fun i H <= n. -intros. -unfold sep__part_fun in |- *. -elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. -apply sep__part_h_bnd. -apply le_n. +Proof. + intros. + unfold sep__part_fun in |- *. + elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. + apply sep__part_h_bnd. + apply le_n. Qed. Lemma sep__part_fun_0 : forall H : 0 <= m, sep__part_fun 0 H = 0. -intros. -unfold sep__part_fun in |- *. -elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. -reflexivity. -elimtype False. -generalize b0. -apply lt_O_neq; apply RS'_pos_m. +Proof. + intros. + unfold sep__part_fun in |- *. + elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. + reflexivity. + elimtype False. + generalize b0. + apply lt_O_neq; apply RS'_pos_m. Qed. Lemma sep__part_fun_i : forall (i : nat) (H : i <= m), i < m -> sep__part_fun i H = sep__part_h i. -intros. -unfold sep__part_fun in |- *. -elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. -reflexivity. -rewrite b0 in H0; elim (lt_irrefl _ H0). +Proof. + intros. + unfold sep__part_fun in |- *. + elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. + reflexivity. + rewrite b0 in H0; elim (lt_irrefl _ H0). Qed. Lemma sep__part_fun_m : forall H : m <= m, sep__part_fun m H = n. -intros. -unfold sep__part_fun in |- *. -elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. -elim (lt_irrefl _ a0). -reflexivity. +Proof. + intros. + unfold sep__part_fun in |- *. + elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. + elim (lt_irrefl _ a0). + reflexivity. Qed. Lemma sep__part_fun_i' : forall (i : nat) (H : i <= m), sep__part_h i <= sep__part_fun i H. -intros. -unfold sep__part_fun in |- *. -elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. -apply le_n. -apply sep__part_h_bnd. +Proof. + intros. + unfold sep__part_fun in |- *. + elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. + apply le_n. + apply sep__part_h_bnd. Qed. Lemma sep__part_fun_bnd' : forall (i : nat) (H : i <= m), i < m -> sep__part_fun i H < n. -intros. -unfold sep__part_fun in |- *. -elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. -elim (ProjT2 sep__part_app_n). -intros. -apply H2. -generalize a0; clear a0. -unfold m in |- *; elim (RS'_delta2_delta4 RS'_m1); intro; simpl in |- *. -auto with arith. -auto with arith. -rewrite b0 in H0; elim (lt_irrefl _ H0). +Proof. + intros. + unfold sep__part_fun in |- *. + elim (le_lt_eq_dec _ _ H); intro; simpl in |- *. + elim (ProjT2 sep__part_app_n). + intros. + apply H2. + generalize a0; clear a0. + unfold m in |- *; elim (RS'_delta2_delta4 RS'_m1); intro; simpl in |- *. + auto with arith. + auto with arith. + rewrite b0 in H0; elim (lt_irrefl _ H0). Qed. Lemma sep__part_fun_wd : forall (i j : nat) Hi Hj, i = j -> sep__part_fun i Hi = sep__part_fun j Hj. -intros. -unfold sep__part_fun in |- *. -elim (le_lt_eq_dec _ _ Hi); elim (le_lt_eq_dec _ _ Hj); intros; simpl in |- *. -rewrite H; auto. -rewrite H in a0; rewrite b0 in a0; elim (lt_irrefl _ a0). -rewrite <- H in a0; rewrite b0 in a0; elim (lt_irrefl _ a0). -auto. +Proof. + intros. + unfold sep__part_fun in |- *. + elim (le_lt_eq_dec _ _ Hi); elim (le_lt_eq_dec _ _ Hj); intros; simpl in |- *. + rewrite H; auto. + rewrite H in a0; rewrite b0 in a0; elim (lt_irrefl _ a0). + rewrite <- H in a0; rewrite b0 in a0; elim (lt_irrefl _ a0). + auto. Qed. Lemma sep__part_fun_mon : forall (i j : nat) Hi Hj, i < j -> sep__part_fun i Hi < sep__part_fun j Hj. -intros. -apply less_nring with (IR:COrdField). -apply - local_mon_imp_mon_le - with - (f := fun (i : nat) (Hi : i <= m) => nring (R:=IR) (sep__part_fun i Hi)). -clear H Hj Hi j i; intros; apply nring_less. -2: assumption. -elim (le_lt_eq_dec _ _ H'); intro. -rewrite (sep__part_fun_i (S i)). -2: assumption. -simpl in |- *; elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. -elim (sep__part_lemma (sep__part_h i) a1); intro; simpl in |- *. -elim (ProjT2 a2); set (j := ProjT1 a2) in *. -intros Hj Hj'. -elim Hj'; clear Hj'; intros H0 H1. -rewrite sep__part_fun_i. -2: auto with arith. -apply (Partition_Points_mon _ _ _ _ P) with a1 Hj. -apply less_transitive_unfolded with (P _ a1[+]delta [/]FourNZ). -apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. -apply shift_plus_less'; apply H0. -apply sep__part_fun_bnd'; auto with arith. -apply sep__part_fun_bnd'; auto with arith. -generalize H'; rewrite b0. -intro; rewrite sep__part_fun_m. -apply sep__part_fun_bnd'. -auto with arith. +Proof. + intros. + apply less_nring with (IR:COrdField). + apply local_mon_imp_mon_le with + (f := fun (i : nat) (Hi : i <= m) => nring (R:=IR) (sep__part_fun i Hi)). + clear H Hj Hi j i; intros; apply nring_less. + 2: assumption. + elim (le_lt_eq_dec _ _ H'); intro. + rewrite (sep__part_fun_i (S i)). + 2: assumption. + simpl in |- *; elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. + elim (sep__part_lemma (sep__part_h i) a1); intro; simpl in |- *. + elim (ProjT2 a2); set (j := ProjT1 a2) in *. + intros Hj Hj'. + elim Hj'; clear Hj'; intros H0 H1. + rewrite sep__part_fun_i. + 2: auto with arith. + apply (Partition_Points_mon _ _ _ _ P) with a1 Hj. + apply less_transitive_unfolded with (P _ a1[+]delta [/]FourNZ). + apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. + apply shift_plus_less'; apply H0. + apply sep__part_fun_bnd'; auto with arith. + apply sep__part_fun_bnd'; auto with arith. + generalize H'; rewrite b0. + intro; rewrite sep__part_fun_m. + apply sep__part_fun_bnd'. + auto with arith. Qed. Definition sep__part : Partition Hab sep__part_length. -apply - Build_Partition - with (fun (i : nat) (Hi : i <= m) => P _ (sep__part_fun_bnd i Hi)). -intros; apply prf1. -apply sep__part_fun_wd; auto. -intros. -apply - local_mon'_imp_mon'2_le with (f := fun (i : nat) (Hi : i <= n) => P i Hi). -intros; apply prf2. -apply sep__part_fun_mon; auto. -intro. -apply eq_transitive_unfolded with (P 0 (le_O_n _)). -apply prf1. -apply sep__part_fun_0. -apply start. -intro; eapply eq_transitive_unfolded. -2: apply finish with (p := P) (H := le_n n). -apply prf1. -apply sep__part_fun_m. + apply Build_Partition with (fun (i : nat) (Hi : i <= m) => P _ (sep__part_fun_bnd i Hi)). +Proof. + intros; apply prf1. + apply sep__part_fun_wd; auto. + intros. + apply local_mon'_imp_mon'2_le with (f := fun (i : nat) (Hi : i <= n) => P i Hi). + intros; apply prf2. + apply sep__part_fun_mon; auto. + intro. + apply eq_transitive_unfolded with (P 0 (le_O_n _)). + apply prf1. + apply sep__part_fun_0. + apply start. + intro; eapply eq_transitive_unfolded. + 2: apply finish with (p := P) (H := le_n n). + apply prf1. + apply sep__part_fun_m. Defined. Lemma sep__part_fun_mon_pts : forall (i : nat) Hi Hi' Hi0 Hi'0, P (sep__part_fun i Hi) Hi0[<]P (sep__part_fun (S i) Hi') Hi'0. -do 3 intro. -rewrite sep__part_fun_i. -2: auto with arith. -elim (le_lt_eq_dec _ _ Hi'); intro. -rewrite (sep__part_fun_i (S i)). -2: assumption. -intros. -apply sep__part_h_lemma. -rewrite <- sep__part_fun_i with (H := Hi'). -apply sep__part_fun_bnd'; assumption. -assumption. -generalize Hi'; clear Hi'; rewrite b0. -intro; rewrite sep__part_fun_m. -intros. -cut (m = m). -2: auto. -unfold m at 2 in |- *; elim (RS'_delta2_delta4 RS'_m1); intro; simpl in |- *; intro. -cut (i = RS'_m1); [ clear b0; intro | rewrite <- b0 in H; auto with arith ]. -generalize Hi0; clear Hi0; rewrite H0. -intro. -elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. -apply - less_transitive_unfolded with (P (sep__part_h RS'_m1) Hi0[+]delta [/]FourNZ). -apply shift_less_plus'; astepl ZeroR; apply pos_div_four; apply RS'_delta_pos. -apply shift_plus_less'; eapply less_wdr. -apply a0. -apply cg_minus_wd; apply prf1. -auto. -auto. -elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. -generalize Hi'0; clear Hi'0. -cut (S i = RS'_m1); [ intro | transitivity m; auto ]. -pattern n at 1 5 in |- *; rewrite <- H0. -rewrite <- H2. -intro. -apply less_leEq_trans with (P _ (sep__part_h_bnd (S i))). -2: apply - local_mon'_imp_mon'_le with (f := fun (i : nat) (Hi : i <= n) => P i Hi). -2: intros; apply prf2. -2: red in |- *; intros; apply prf1; assumption. -2: apply sep__part_h_mon_1. -apply sep__part_h_lemma. -apply H1. -rewrite H2; apply le_n. +Proof. + do 3 intro. + rewrite sep__part_fun_i. + 2: auto with arith. + elim (le_lt_eq_dec _ _ Hi'); intro. + rewrite (sep__part_fun_i (S i)). + 2: assumption. + intros. + apply sep__part_h_lemma. + rewrite <- sep__part_fun_i with (H := Hi'). + apply sep__part_fun_bnd'; assumption. + assumption. + generalize Hi'; clear Hi'; rewrite b0. + intro; rewrite sep__part_fun_m. + intros. + cut (m = m). + 2: auto. + unfold m at 2 in |- *; elim (RS'_delta2_delta4 RS'_m1); intro; simpl in |- *; intro. + cut (i = RS'_m1); [ clear b0; intro | rewrite <- b0 in H; auto with arith ]. + generalize Hi0; clear Hi0; rewrite H0. + intro. + elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. + apply less_transitive_unfolded with (P (sep__part_h RS'_m1) Hi0[+]delta [/]FourNZ). + apply shift_less_plus'; astepl ZeroR; apply pos_div_four; apply RS'_delta_pos. + apply shift_plus_less'; eapply less_wdr. + apply a0. + apply cg_minus_wd; apply prf1. + auto. + auto. + elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. + generalize Hi'0; clear Hi'0. + cut (S i = RS'_m1); [ intro | transitivity m; auto ]. + pattern n at 1 5 in |- *; rewrite <- H0. + rewrite <- H2. + intro. + apply less_leEq_trans with (P _ (sep__part_h_bnd (S i))). + 2: apply local_mon'_imp_mon'_le with (f := fun (i : nat) (Hi : i <= n) => P i Hi). + 2: intros; apply prf2. + 2: red in |- *; intros; apply prf1; assumption. + 2: apply sep__part_h_mon_1. + apply sep__part_h_lemma. + apply H1. + rewrite H2; apply le_n. Qed. Lemma sep__part_mon : forall (i : nat) Hi Hi', sep__part i Hi[<]sep__part (S i) Hi'. -intros. -unfold sep__part in |- *; simpl in |- *. -apply sep__part_fun_mon_pts. +Proof. + intros. + unfold sep__part in |- *; simpl in |- *. + apply sep__part_fun_mon_pts. Qed. Lemma sep__part_mon_Mesh : Mesh sep__part[<=]Mesh P[+]csi. -unfold Mesh at 1 in |- *. -apply maxlist_leEq. -apply length_Part_Mesh_List. -apply RS'_pos_m. -intros x H. -elim (Part_Mesh_List_lemma _ _ _ _ _ _ H). -intros i Hi. -elim Hi; clear Hi; intros Hi Hi'. -elim Hi'; clear Hi'; intros Hi' Hx. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply Hx. -clear Hx H x. -simpl in |- *. -cut - (forall Ha Hb, - P (sep__part_fun (S i) Hi') Ha[-]P (sep__part_fun i Hi) Hb[<=]Mesh P[+]csi). -intro. -apply H. -rename Hi' into H. -rewrite (sep__part_fun_i i). -2: assumption. -elim (le_lt_eq_dec _ _ H); intro. -rewrite sep__part_fun_i. -2: assumption. -intros. -cut (pred (sep__part_h (S i)) <= n); - [ intro | eapply le_trans; [ apply le_pred_n | auto ] ]. -rstepl (P _ Ha[-]P _ H0[+](P _ H0[-]P _ Hb)). -apply plus_resp_leEq_both. -generalize Ha; pattern (sep__part_h (S i)) at 1 2 in |- *; - replace (sep__part_h (S i)) with (S (pred (sep__part_h (S i)))); - intros. -apply Mesh_lemma. -symmetry in |- *; apply S_pred with (sep__part_h i); apply sep__part_h_mon_2. -rewrite <- sep__part_fun_i with (H := lt_le_weak _ _ H). -apply sep__part_fun_bnd'; assumption. -assumption. -eapply leEq_transitive. -apply sep__part_h_lemma2. -apply less_leEq; apply less_leEq_trans with delta. -apply pos_div_two'; exact RS'_delta_pos. -apply RS'_delta_csi. -generalize H; clear H; rewrite b0; intro H. -rewrite sep__part_fun_m. -cut (m = m); [ unfold m at 2 in |- * | auto ]. -elim RS'_delta2_delta4; intro; simpl in |- *; intro. -intros. -cut (sep__part_h (S RS'_m1) = n). -intro; generalize Ha Hb; pattern n at 1 5 in |- *. -rewrite <- H1. -cut (i = RS'_m1); - [ intro - | unfold sep__part_length in b0; rewrite <- b0 in H0; auto with arith ]. -rewrite H2. -intros. -cut (pred (sep__part_h (S RS'_m1)) <= n); - [ intro | eapply le_trans; [ apply le_pred_n | auto ] ]. -rstepl (P _ Ha0[-]P _ H3[+](P _ H3[-]P _ Hb0)). -apply plus_resp_leEq_both. -generalize Ha0; pattern (sep__part_h (S RS'_m1)) at 1 2 in |- *; - replace (sep__part_h (S RS'_m1)) with (S (pred (sep__part_h (S RS'_m1)))); - intros. -apply Mesh_lemma. -symmetry in |- *; apply S_pred with (sep__part_h RS'_m1); - apply sep__part_h_mon_2. -cut (RS'_m1 <= m). -2: rewrite H0; apply le_n_Sn. -intro. -rewrite <- sep__part_fun_i with (H := H4). -apply sep__part_fun_bnd'. -rewrite H0; apply lt_n_Sn. -rewrite H0; apply lt_n_Sn. -eapply leEq_transitive. -apply sep__part_h_lemma2. -apply less_leEq; apply less_leEq_trans with delta. -apply pos_div_two'; exact RS'_delta_pos. -apply RS'_delta_csi. -elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. -auto. -cut (sep__part_h (S RS'_m1) = n). -intro; pattern n at 1 5 in |- *. -rewrite <- H1. -intros. -cut (sep__part_h RS'_m1 <= n); [ intro | apply sep__part_h_bnd ]. -rstepl (P _ Ha[-]P _ H2[+](P _ H2[-]P _ Hb)). -apply leEq_transitive with (delta [/]TwoNZ[+](Mesh P[+]delta [/]TwoNZ)). -apply plus_resp_leEq_both. -apply less_leEq; eapply less_wdl. -apply b1. -apply cg_minus_wd; apply prf1; auto. -generalize H2; clear H2; rewrite <- H0; unfold sep__part_length in b0; - rewrite <- b0. -simpl in |- *. -elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. -elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. -set (j := ProjT1 a1) in *. -change (forall H0, P j H0[-]P (sep__part_h i) Hb[<=]Mesh P[+]delta [/]TwoNZ) - in |- *. -elim (ProjT2 a1); fold j in |- *; intros Hj Hj'. -elim Hj'; clear Hj'; intros H2 H3. -intros. -cut (pred j <= n); [ intro | apply le_trans with j; auto with arith ]. -rstepl (P j H4[-]P (pred j) H5[+](P (pred j) H5[-]P (sep__part_h i) Hb)). -cut (0 < j); intros. -apply plus_resp_leEq_both. -cut (j = S (pred j)); [ intro | apply S_pred with 0; auto ]. -generalize H4; rewrite {1 2}H7; intro. -apply Mesh_lemma. -apply less_leEq. -apply less_wdl with (P (pred j) H5[-]P _ a0). -2: apply cg_minus_wd; apply prf1; auto. -apply H3. -auto with arith. -apply le_lt_trans with (sep__part_h i); auto with arith. -apply Partition_Points_mon with (P := P) (Hi := a0) (Hj := Hj). -apply less_transitive_unfolded with (P (sep__part_h i) a0[+]delta [/]FourNZ). -apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. -apply shift_plus_less'; assumption. -intros. -apply less_leEq; apply less_leEq_trans with (delta [/]TwoNZ). -eapply less_wdl. -apply b2. -apply cg_minus_wd; apply prf1; auto. -astepl (Zero[+]delta [/]TwoNZ); apply plus_resp_leEq; apply Mesh_nonneg. -elimtype False. -exact (le_not_lt _ _ (sep__part_h_bnd _) b2). -rstepl (Mesh P[+]delta). -apply plus_resp_leEq_lft; apply RS'_delta_csi. -elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. -auto. +Proof. + unfold Mesh at 1 in |- *. + apply maxlist_leEq. + apply length_Part_Mesh_List. + apply RS'_pos_m. + intros x H. + elim (Part_Mesh_List_lemma _ _ _ _ _ _ H). + intros i Hi. + elim Hi; clear Hi; intros Hi Hi'. + elim Hi'; clear Hi'; intros Hi' Hx. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Hx. + clear Hx H x. + simpl in |- *. + cut (forall Ha Hb, P (sep__part_fun (S i) Hi') Ha[-]P (sep__part_fun i Hi) Hb[<=]Mesh P[+]csi). + intro. + apply H. + rename Hi' into H. + rewrite (sep__part_fun_i i). + 2: assumption. + elim (le_lt_eq_dec _ _ H); intro. + rewrite sep__part_fun_i. + 2: assumption. + intros. + cut (pred (sep__part_h (S i)) <= n); [ intro | eapply le_trans; [ apply le_pred_n | auto ] ]. + rstepl (P _ Ha[-]P _ H0[+](P _ H0[-]P _ Hb)). + apply plus_resp_leEq_both. + generalize Ha; pattern (sep__part_h (S i)) at 1 2 in |- *; + replace (sep__part_h (S i)) with (S (pred (sep__part_h (S i)))); intros. + apply Mesh_lemma. + symmetry in |- *; apply S_pred with (sep__part_h i); apply sep__part_h_mon_2. + rewrite <- sep__part_fun_i with (H := lt_le_weak _ _ H). + apply sep__part_fun_bnd'; assumption. + assumption. + eapply leEq_transitive. + apply sep__part_h_lemma2. + apply less_leEq; apply less_leEq_trans with delta. + apply pos_div_two'; exact RS'_delta_pos. + apply RS'_delta_csi. + generalize H; clear H; rewrite b0; intro H. + rewrite sep__part_fun_m. + cut (m = m); [ unfold m at 2 in |- * | auto ]. + elim RS'_delta2_delta4; intro; simpl in |- *; intro. + intros. + cut (sep__part_h (S RS'_m1) = n). + intro; generalize Ha Hb; pattern n at 1 5 in |- *. + rewrite <- H1. + cut (i = RS'_m1); [ intro | unfold sep__part_length in b0; rewrite <- b0 in H0; auto with arith ]. + rewrite H2. + intros. + cut (pred (sep__part_h (S RS'_m1)) <= n); [ intro | eapply le_trans; [ apply le_pred_n | auto ] ]. + rstepl (P _ Ha0[-]P _ H3[+](P _ H3[-]P _ Hb0)). + apply plus_resp_leEq_both. + generalize Ha0; pattern (sep__part_h (S RS'_m1)) at 1 2 in |- *; + replace (sep__part_h (S RS'_m1)) with (S (pred (sep__part_h (S RS'_m1)))); intros. + apply Mesh_lemma. + symmetry in |- *; apply S_pred with (sep__part_h RS'_m1); apply sep__part_h_mon_2. + cut (RS'_m1 <= m). + 2: rewrite H0; apply le_n_Sn. + intro. + rewrite <- sep__part_fun_i with (H := H4). + apply sep__part_fun_bnd'. + rewrite H0; apply lt_n_Sn. + rewrite H0; apply lt_n_Sn. + eapply leEq_transitive. + apply sep__part_h_lemma2. + apply less_leEq; apply less_leEq_trans with delta. + apply pos_div_two'; exact RS'_delta_pos. + apply RS'_delta_csi. + elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. + auto. + cut (sep__part_h (S RS'_m1) = n). + intro; pattern n at 1 5 in |- *. + rewrite <- H1. + intros. + cut (sep__part_h RS'_m1 <= n); [ intro | apply sep__part_h_bnd ]. + rstepl (P _ Ha[-]P _ H2[+](P _ H2[-]P _ Hb)). + apply leEq_transitive with (delta [/]TwoNZ[+](Mesh P[+]delta [/]TwoNZ)). + apply plus_resp_leEq_both. + apply less_leEq; eapply less_wdl. + apply b1. + apply cg_minus_wd; apply prf1; auto. + generalize H2; clear H2; rewrite <- H0; unfold sep__part_length in b0; rewrite <- b0. + simpl in |- *. + elim (le_lt_dec (sep__part_h i) n); intro; simpl in |- *. + elim (sep__part_lemma (sep__part_h i) a0); intro; simpl in |- *. + set (j := ProjT1 a1) in *. + change (forall H0, P j H0[-]P (sep__part_h i) Hb[<=]Mesh P[+]delta [/]TwoNZ) in |- *. + elim (ProjT2 a1); fold j in |- *; intros Hj Hj'. + elim Hj'; clear Hj'; intros H2 H3. + intros. + cut (pred j <= n); [ intro | apply le_trans with j; auto with arith ]. + rstepl (P j H4[-]P (pred j) H5[+](P (pred j) H5[-]P (sep__part_h i) Hb)). + cut (0 < j); intros. + apply plus_resp_leEq_both. + cut (j = S (pred j)); [ intro | apply S_pred with 0; auto ]. + generalize H4; rewrite {1 2}H7; intro. + apply Mesh_lemma. + apply less_leEq. + apply less_wdl with (P (pred j) H5[-]P _ a0). + 2: apply cg_minus_wd; apply prf1; auto. + apply H3. + auto with arith. + apply le_lt_trans with (sep__part_h i); auto with arith. + apply Partition_Points_mon with (P := P) (Hi := a0) (Hj := Hj). + apply less_transitive_unfolded with (P (sep__part_h i) a0[+]delta [/]FourNZ). + apply shift_less_plus'; astepl ZeroR; apply pos_div_four; exact RS'_delta_pos. + apply shift_plus_less'; assumption. + intros. + apply less_leEq; apply less_leEq_trans with (delta [/]TwoNZ). + eapply less_wdl. + apply b2. + apply cg_minus_wd; apply prf1; auto. + astepl (Zero[+]delta [/]TwoNZ); apply plus_resp_leEq; apply Mesh_nonneg. + elimtype False. + exact (le_not_lt _ _ (sep__part_h_bnd _) b2). + rstepl (Mesh P[+]delta). + apply plus_resp_leEq_lft; apply RS'_delta_csi. + elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. + auto. Qed. Variable g : forall i : nat, i < n -> IR. @@ -697,90 +702,85 @@ Hypothesis gP : Points_in_Partition P g. Hypothesis gP' : nat_less_n_fun g. Definition sep__part_pts (i : nat) (Hi : i < sep__part_length) : IR. -intros. -cut (pred (sep__part_h (S i)) < n); intros. -apply (g _ H). -cut (sep__part_h i < sep__part_h (S i)). -2: apply sep__part_h_mon_3. -intro. -red in |- *. -replace (S (pred (sep__part_h (S i)))) with (sep__part_h (S i)); intros. -apply sep__part_h_bnd. -apply S_pred with (sep__part_h i); assumption. -rewrite <- sep__part_fun_i with (H := lt_le_weak _ _ Hi). -apply sep__part_fun_bnd'; assumption. -assumption. -apply lt_n_Sn. +Proof. + intros. + cut (pred (sep__part_h (S i)) < n); intros. + apply (g _ H). + cut (sep__part_h i < sep__part_h (S i)). + 2: apply sep__part_h_mon_3. + intro. + red in |- *. + replace (S (pred (sep__part_h (S i)))) with (sep__part_h (S i)); intros. + apply sep__part_h_bnd. + apply S_pred with (sep__part_h i); assumption. + rewrite <- sep__part_fun_i with (H := lt_le_weak _ _ Hi). + apply sep__part_fun_bnd'; assumption. + assumption. + apply lt_n_Sn. Defined. Lemma sep__part_pts_lemma : forall (i : nat) Hi Hi', sep__part_pts i Hi[=]g (pred (sep__part_h (S i))) Hi'. -intros; unfold sep__part_pts in |- *. -apply gP'; auto. +Proof. + intros; unfold sep__part_pts in |- *. + apply gP'; auto. Qed. Lemma sep__part_pts_in_Partition : Points_in_Partition sep__part sep__part_pts. -red in |- *; intros i Hi. -set - (H := - sep__part_h_mon_3 _ _ - (eq_ind (sep__part_fun i (lt_le_weak _ _ Hi)) ( - fun n0 : nat => n0 < n) (sep__part_fun_bnd' i (lt_le_weak _ _ Hi) Hi) - (sep__part_h i) (sep__part_fun_i i (lt_le_weak _ _ Hi) Hi)) - (lt_n_Sn i)) in *. -set (H0 := S_pred (sep__part_h (S i)) (sep__part_h i) H) in *. -set - (H' := - eq_ind (sep__part_h (S i)) (fun j : nat => j <= n) ( - sep__part_h_bnd (S i)) (S (pred (sep__part_h (S i)))) H0) - in *. -elim (gP _ H'); intros. -simpl in |- *; unfold sep__part_pts in |- *. -split. -eapply leEq_transitive. -2: apply a0. -apply Partition_mon; apply le_2. -rewrite sep__part_fun_i; assumption. -eapply leEq_transitive. -apply b0. -apply Partition_mon. -rewrite <- H0. -apply sep__part_fun_i'. +Proof. + red in |- *; intros i Hi. + set (H := sep__part_h_mon_3 _ _ (eq_ind (sep__part_fun i (lt_le_weak _ _ Hi)) ( + fun n0 : nat => n0 < n) (sep__part_fun_bnd' i (lt_le_weak _ _ Hi) Hi) + (sep__part_h i) (sep__part_fun_i i (lt_le_weak _ _ Hi) Hi)) (lt_n_Sn i)) in *. + set (H0 := S_pred (sep__part_h (S i)) (sep__part_h i) H) in *. + set (H' := eq_ind (sep__part_h (S i)) (fun j : nat => j <= n) ( + sep__part_h_bnd (S i)) (S (pred (sep__part_h (S i)))) H0) in *. + elim (gP _ H'); intros. + simpl in |- *; unfold sep__part_pts in |- *. + split. + eapply leEq_transitive. + 2: apply a0. + apply Partition_mon; apply le_2. + rewrite sep__part_fun_i; assumption. + eapply leEq_transitive. + apply b0. + apply Partition_mon. + rewrite <- H0. + apply sep__part_fun_i'. Qed. Lemma RS'_Hsep_S : forall (i j : nat) (Hi : S i <= m), j <= pred (sep__part_fun (S i) Hi) -> S j <= n. -intros. -apply le_trans with (sep__part_fun (S i) Hi). -2: apply sep__part_fun_bnd. -rewrite - (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi))) - . -auto with arith. -apply sep__part_fun_mon; apply lt_n_Sn. +Proof. + intros. + apply le_trans with (sep__part_fun (S i) Hi). + 2: apply sep__part_fun_bnd. + rewrite (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi))) . + auto with arith. + apply sep__part_fun_mon; apply lt_n_Sn. Qed. Lemma RS'_Hsep : forall (i j : nat) (Hi : S i <= m), j <= pred (sep__part_fun (S i) Hi) -> j <= n. -intros. -apply le_trans with (sep__part_fun (S i) Hi). -2: apply sep__part_fun_bnd. -rewrite - (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi))) - . -apply le_S; assumption. -apply sep__part_fun_mon; apply lt_n_Sn. +Proof. + intros. + apply le_trans with (sep__part_fun (S i) Hi). + 2: apply sep__part_fun_bnd. + rewrite (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi))) . + apply le_S; assumption. + apply sep__part_fun_mon; apply lt_n_Sn. Qed. Definition RS'_h : nat -> IR. -intro i. -elim (le_lt_dec i n); intro. -apply (P i a0). -apply ZeroR. +Proof. + intro i. + elim (le_lt_dec i n); intro. + apply (P i a0). + apply ZeroR. Defined. Notation h := RS'_h. @@ -795,50 +795,47 @@ Lemma sep__part_suRS'_m1 : (Hj' : j <= pred (sep__part_fun (S i) Hi)) => P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj'))[=] sep__part _ Hi[-]sep__part _ (lt_le_weak _ _ Hi). -intros; simpl in |- *. -unfold Sum2 in |- *. -cut (sep__part_fun (S i) Hi = S (pred (sep__part_fun (S i) Hi))). -2: apply S_pred with (sep__part_fun i (lt_le_weak _ _ Hi)); - apply sep__part_fun_mon; apply lt_n_Sn. -intro. -cut (S (pred (sep__part_fun (S i) Hi)) <= n). -2: rewrite <- H; apply sep__part_fun_bnd. -intro. -apply - eq_transitive_unfolded - with (P _ H0[-]P _ (sep__part_fun_bnd i (lt_le_weak _ _ Hi))). -2: apply cg_minus_wd; apply prf1; auto. -eapply eq_transitive_unfolded. -apply str_Mengolli_Sum_gen with (f := h). -rewrite <- H; apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. -intro j; intros. -do 2 elim le_lt_dec; intros; simpl in |- *. -unfold h in |- *. -do 2 elim le_lt_dec; intros; simpl in |- *. -apply cg_minus_wd; apply prf1; auto. -elimtype False; apply le_not_lt with j n. -apply le_trans with (S j); auto with arith. -assumption. -elimtype False; apply le_not_lt with (S j) n. -exact (RS'_Hsep_S _ _ Hi a1). -assumption. -elimtype False; apply le_not_lt with (S j) n. -exact (RS'_Hsep_S _ _ Hi a1). -assumption. -elimtype False; exact (le_not_lt _ _ H1 b0). -elimtype False; exact (le_not_lt _ _ H2 b0). -elimtype False; exact (le_not_lt _ _ H1 b0). -unfold h in |- *. -apply cg_minus_wd. -elim le_lt_dec; simpl in |- *; intros. -apply prf1; auto. -elimtype False; exact (le_not_lt _ _ H0 b0). -elim le_lt_dec; intro; simpl in |- *. -apply prf1; auto. -elimtype False; rewrite <- H in H0; - apply le_not_lt with (sep__part_fun i (lt_le_weak _ _ Hi)) n. -apply sep__part_fun_bnd. -assumption. +Proof. + intros; simpl in |- *. + unfold Sum2 in |- *. + cut (sep__part_fun (S i) Hi = S (pred (sep__part_fun (S i) Hi))). + 2: apply S_pred with (sep__part_fun i (lt_le_weak _ _ Hi)); apply sep__part_fun_mon; apply lt_n_Sn. + intro. + cut (S (pred (sep__part_fun (S i) Hi)) <= n). + 2: rewrite <- H; apply sep__part_fun_bnd. + intro. + apply eq_transitive_unfolded with (P _ H0[-]P _ (sep__part_fun_bnd i (lt_le_weak _ _ Hi))). + 2: apply cg_minus_wd; apply prf1; auto. + eapply eq_transitive_unfolded. + apply str_Mengolli_Sum_gen with (f := h). + rewrite <- H; apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. + intro j; intros. + do 2 elim le_lt_dec; intros; simpl in |- *. + unfold h in |- *. + do 2 elim le_lt_dec; intros; simpl in |- *. + apply cg_minus_wd; apply prf1; auto. + elimtype False; apply le_not_lt with j n. + apply le_trans with (S j); auto with arith. + assumption. + elimtype False; apply le_not_lt with (S j) n. + exact (RS'_Hsep_S _ _ Hi a1). + assumption. + elimtype False; apply le_not_lt with (S j) n. + exact (RS'_Hsep_S _ _ Hi a1). + assumption. + elimtype False; exact (le_not_lt _ _ H1 b0). + elimtype False; exact (le_not_lt _ _ H2 b0). + elimtype False; exact (le_not_lt _ _ H1 b0). + unfold h in |- *. + apply cg_minus_wd. + elim le_lt_dec; simpl in |- *; intros. + apply prf1; auto. + elimtype False; exact (le_not_lt _ _ H0 b0). + elim le_lt_dec; intro; simpl in |- *. + apply prf1; auto. + elimtype False; rewrite <- H in H0; apply le_not_lt with (sep__part_fun i (lt_le_weak _ _ Hi)) n. + apply sep__part_fun_bnd. + assumption. Qed. Lemma sep__part_Sum2 : @@ -850,81 +847,62 @@ Lemma sep__part_Sum2 : (Hj' : j <= pred (sep__part_fun (S i) Hi)) => F (g j (RS'_Hsep_S _ _ _ Hj')) just1[*] (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))). -unfold Partition_Sum in |- *. -apply eq_symmetric_unfolded. -unfold Sum2 in |- *. -apply - eq_transitive_unfolded - with - (Sumx - (fun (j : nat) (Hj : j < n) => - part_tot_nat_fun _ _ - (fun (i : nat) (H : i < n) => - F (g i H) just1[*](P _ H[-]P _ (lt_le_weak _ _ H))) j)). -apply - str_Sumx_Sum_Sum' - with - (g := fun (i : nat) (Hi : i < m) (i0 : nat) => - sumbool_rect - (fun - _ : {sep__part_fun i (lt_le_weak i m Hi) <= i0} + - {i0 < sep__part_fun i (lt_le_weak i m Hi)} => IR) - (fun _ : sep__part_fun i (lt_le_weak i m Hi) <= i0 => - sumbool_rect - (fun - _ : {i0 <= pred (sep__part_fun (S i) Hi)} + - {pred (sep__part_fun (S i) Hi) < i0} => IR) - (fun H0 : i0 <= pred (sep__part_fun (S i) Hi) => - F (g i0 (RS'_Hsep_S i i0 Hi H0)) - (incF (g i0 (RS'_Hsep_S i i0 Hi H0)) - (Pts_part_lemma a b Hab n P g gP i0 (RS'_Hsep_S i i0 Hi H0)))[*] +Proof. + unfold Partition_Sum in |- *. + apply eq_symmetric_unfolded. + unfold Sum2 in |- *. + apply eq_transitive_unfolded with (Sumx (fun (j : nat) (Hj : j < n) => part_tot_nat_fun _ _ + (fun (i : nat) (H : i < n) => F (g i H) just1[*](P _ H[-]P _ (lt_le_weak _ _ H))) j)). + apply str_Sumx_Sum_Sum' with (g := fun (i : nat) (Hi : i < m) (i0 : nat) => sumbool_rect (fun + _ : {sep__part_fun i (lt_le_weak i m Hi) <= i0} + {i0 < sep__part_fun i (lt_le_weak i m Hi)} => IR) + (fun _ : sep__part_fun i (lt_le_weak i m Hi) <= i0 => sumbool_rect (fun + _ : {i0 <= pred (sep__part_fun (S i) Hi)} + {pred (sep__part_fun (S i) Hi) < i0} => IR) + (fun H0 : i0 <= pred (sep__part_fun (S i) Hi) => F (g i0 (RS'_Hsep_S i i0 Hi H0)) + (incF (g i0 (RS'_Hsep_S i i0 Hi H0)) + (Pts_part_lemma a b Hab n P g gP i0 (RS'_Hsep_S i i0 Hi H0)))[*] (P (S i0) (RS'_Hsep_S i i0 Hi H0)[-]P i0 (RS'_Hsep i i0 Hi H0))) - (fun _ : pred (sep__part_fun (S i) Hi) < i0 => Zero) - (le_lt_dec i0 (pred (sep__part_fun (S i) Hi)))) - (fun _ : i0 < sep__part_fun i (lt_le_weak i m Hi) => Zero) - (le_lt_dec (sep__part_fun i (lt_le_weak i m Hi)) i0)) - (h := part_tot_nat_fun _ _ - (fun (i : nat) (H : i < n) => - F (g i H) just1[*](P _ H[-]P _ (lt_le_weak _ _ H)))). -apply sep__part_fun_0. -intros; apply sep__part_fun_wd; auto. -intros; apply sep__part_fun_mon; auto. -intros. -elim le_lt_dec; intro; simpl in |- *. -elim le_lt_dec; intro; simpl in |- *. -unfold part_tot_nat_fun in |- *. -elim (le_lt_dec n j); intro; simpl in |- *. -elimtype False. -apply le_not_lt with n j. -assumption. -apply lt_le_trans with (sep__part_fun (S i) Hi''). -assumption. -apply sep__part_fun_bnd. -apply mult_wd; algebra. -apply cg_minus_wd; apply prf1; auto. -elimtype False. -apply le_not_lt with (sep__part_fun i Hi') j. -assumption. -cut (sep__part_fun i Hi' = sep__part_fun i (lt_le_weak _ _ Hi)); - [ intro | apply sep__part_fun_wd; auto ]. -rewrite H1; assumption. -elimtype False. -apply le_not_lt with (S j) (sep__part_fun (S i) Hi). -cut (sep__part_fun (S i) Hi = sep__part_fun (S i) Hi''); - [ intro | apply sep__part_fun_wd; auto ]. -rewrite H1; apply H0. -rewrite - (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi))) - . -auto with arith. -apply sep__part_fun_mon; apply lt_n_Sn. -intros; symmetry in |- *; apply sep__part_fun_m. -apply Sumx_wd; intros. -unfold part_tot_nat_fun in |- *. -elim (le_lt_dec n i); intro; simpl in |- *. -elimtype False; apply le_not_lt with n i; auto. -apply mult_wd; algebra. -apply cg_minus_wd; apply prf1; auto. + (fun _ : pred (sep__part_fun (S i) Hi) < i0 => Zero) + (le_lt_dec i0 (pred (sep__part_fun (S i) Hi)))) + (fun _ : i0 < sep__part_fun i (lt_le_weak i m Hi) => Zero) + (le_lt_dec (sep__part_fun i (lt_le_weak i m Hi)) i0)) + (h := part_tot_nat_fun _ _ (fun (i : nat) (H : i < n) => + F (g i H) just1[*](P _ H[-]P _ (lt_le_weak _ _ H)))). + apply sep__part_fun_0. + intros; apply sep__part_fun_wd; auto. + intros; apply sep__part_fun_mon; auto. + intros. + elim le_lt_dec; intro; simpl in |- *. + elim le_lt_dec; intro; simpl in |- *. + unfold part_tot_nat_fun in |- *. + elim (le_lt_dec n j); intro; simpl in |- *. + elimtype False. + apply le_not_lt with n j. + assumption. + apply lt_le_trans with (sep__part_fun (S i) Hi''). + assumption. + apply sep__part_fun_bnd. + apply mult_wd; algebra. + apply cg_minus_wd; apply prf1; auto. + elimtype False. + apply le_not_lt with (sep__part_fun i Hi') j. + assumption. + cut (sep__part_fun i Hi' = sep__part_fun i (lt_le_weak _ _ Hi)); + [ intro | apply sep__part_fun_wd; auto ]. + rewrite H1; assumption. + elimtype False. + apply le_not_lt with (S j) (sep__part_fun (S i) Hi). + cut (sep__part_fun (S i) Hi = sep__part_fun (S i) Hi''); [ intro | apply sep__part_fun_wd; auto ]. + rewrite H1; apply H0. + rewrite (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi))) . + auto with arith. + apply sep__part_fun_mon; apply lt_n_Sn. + intros; symmetry in |- *; apply sep__part_fun_m. + apply Sumx_wd; intros. + unfold part_tot_nat_fun in |- *. + elim (le_lt_dec n i); intro; simpl in |- *. + elimtype False; apply le_not_lt with n i; auto. + apply mult_wd; algebra. + apply cg_minus_wd; apply prf1; auto. Qed. Lemma sep__part_Sum3 : @@ -938,78 +916,55 @@ Lemma sep__part_Sum3 : (Hj' : j <= pred (sep__part_fun (S i) Hi)) => (F (g j (RS'_Hsep_S _ _ _ Hj')) just1[-]F (sep__part_pts i Hi) just2)[*] (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj'))))). -apply AbsIR_wd. -apply - eq_transitive_unfolded - with - (Sumx - (fun (i : nat) (Hi : i < m) => - Sum2 - (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) - (Hj' : j <= pred (sep__part_fun (S i) Hi)) => - F (g j (RS'_Hsep_S _ _ _ Hj')) just1[*] - (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))[-] - F (sep__part_pts i Hi) just2[*] - Sum2 - (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) - (Hj' : j <= pred (sep__part_fun (S i) Hi)) => - P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))). -eapply eq_transitive_unfolded. -2: apply - Sumx_minus_Sumx - with - (f := fun (i : nat) (Hi : i < m) => - Sum2 - (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) - (Hj' : j <= pred (sep__part_fun (S i) Hi)) => - F (g j (RS'_Hsep_S _ _ _ Hj')) just1[*] - (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))) - (g := fun (i : nat) (Hi : i < m) => - F (sep__part_pts i Hi) just2[*] - Sum2 - (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) - (Hj' : j <= pred (sep__part_fun (S i) Hi)) => - P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj'))). -apply cg_minus_wd. -apply sep__part_Sum2. -unfold Partition_Sum in |- *; apply Sumx_wd; intros. -apply mult_wdr. -apply eq_symmetric_unfolded; apply sep__part_suRS'_m1. -apply Sumx_wd; intros i Hi. -apply - eq_transitive_unfolded - with - (Sum2 - (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) - (Hj' : j <= pred (sep__part_fun (S i) Hi)) => - F (g j (RS'_Hsep_S _ _ _ Hj')) just1[*] - (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))[-] - Sum2 - (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) - (Hj' : j <= pred (sep__part_fun (S i) Hi)) => - F (sep__part_pts i Hi) just2[*] - (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))). -apply cg_minus_wd. -algebra. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply Sum2_comm_scal'. -algebra. -rewrite <- - (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi)) +Proof. + apply AbsIR_wd. + apply eq_transitive_unfolded with (Sumx (fun (i : nat) (Hi : i < m) => Sum2 + (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) + (Hj' : j <= pred (sep__part_fun (S i) Hi)) => F (g j (RS'_Hsep_S _ _ _ Hj')) just1[*] + (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))[-] F (sep__part_pts i Hi) just2[*] + Sum2 (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) + (Hj' : j <= pred (sep__part_fun (S i) Hi)) => + P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))). + eapply eq_transitive_unfolded. + 2: apply Sumx_minus_Sumx with (f := fun (i : nat) (Hi : i < m) => Sum2 + (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) + (Hj' : j <= pred (sep__part_fun (S i) Hi)) => F (g j (RS'_Hsep_S _ _ _ Hj')) just1[*] + (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))) (g := fun (i : nat) (Hi : i < m) => + F (sep__part_pts i Hi) just2[*] Sum2 + (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) + (Hj' : j <= pred (sep__part_fun (S i) Hi)) => + P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj'))). + apply cg_minus_wd. + apply sep__part_Sum2. + unfold Partition_Sum in |- *; apply Sumx_wd; intros. + apply mult_wdr. + apply eq_symmetric_unfolded; apply sep__part_suRS'_m1. + apply Sumx_wd; intros i Hi. + apply eq_transitive_unfolded with (Sum2 + (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) + (Hj' : j <= pred (sep__part_fun (S i) Hi)) => F (g j (RS'_Hsep_S _ _ _ Hj')) just1[*] + (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))[-] Sum2 + (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) + (Hj' : j <= pred (sep__part_fun (S i) Hi)) => F (sep__part_pts i Hi) just2[*] + (P _ (RS'_Hsep_S _ _ _ Hj')[-]P _ (RS'_Hsep _ _ _ Hj')))). + apply cg_minus_wd. + algebra. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply Sum2_comm_scal'. + algebra. + rewrite <- (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi)) (sep__part_fun_mon _ _ _ _ (lt_n_Sn i))). -apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. -eapply eq_transitive_unfolded. -apply Sum2_minus_Sum2. -rewrite <- - (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi)) + apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. + eapply eq_transitive_unfolded. + apply Sum2_minus_Sum2. + rewrite <- (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi)) (sep__part_fun_mon _ _ _ _ (lt_n_Sn i))). -apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. -apply Sum2_wd; intros. -rewrite <- - (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi)) + apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. + apply Sum2_wd; intros. + rewrite <- (S_pred (sep__part_fun (S i) Hi) (sep__part_fun i (lt_le_weak _ _ Hi)) (sep__part_fun_mon _ _ _ _ (lt_n_Sn i))). -apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. -algebra. + apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. + algebra. Qed. Lemma sep__part_Sum4 : @@ -1019,301 +974,259 @@ Lemma sep__part_Sum4 : (fun (j : nat) (Hj : sep__part_fun i (lt_le_weak _ _ Hi) <= j) (Hj' : j <= pred (sep__part_fun (S i) Hi)) => (M[+]M)[*]delta [/]TwoNZ))[<=]alpha. -unfold Sum2 in |- *. -apply - leEq_wdl - with - (Sumx - (fun (j : nat) (_ : j < n) => - part_tot_nat_fun _ _ - (fun (i : nat) (_ : i < n) => (M[+]M)[*]delta [/]TwoNZ) j)). -2: apply eq_symmetric_unfolded; - apply - str_Sumx_Sum_Sum' - with - (g := fun (i : nat) (Hi : i < m) (i0 : nat) => - sumbool_rect - (fun - _ : {sep__part_fun i (lt_le_weak i m Hi) <= i0} + - {i0 < sep__part_fun i (lt_le_weak i m Hi)} => IR) - (fun _ : sep__part_fun i (lt_le_weak i m Hi) <= i0 => - sumbool_rect - (fun - _ : {i0 <= pred (sep__part_fun (S i) Hi)} + - {pred (sep__part_fun (S i) Hi) < i0} => IR) - (fun _ : i0 <= pred (sep__part_fun (S i) Hi) => - (M[+]M)[*]delta [/]TwoNZ) - (fun _ : pred (sep__part_fun (S i) Hi) < i0 => Zero) - (le_lt_dec i0 (pred (sep__part_fun (S i) Hi)))) - (fun _ : i0 < sep__part_fun i (lt_le_weak i m Hi) => Zero) - (le_lt_dec (sep__part_fun i (lt_le_weak i m Hi)) i0)) - (h := part_tot_nat_fun _ _ - (fun (i : nat) (_ : i < n) => (M[+]M)[*]delta [/]TwoNZ)). -apply - leEq_wdr - with - (Sumx - (fun (i : nat) (_ : i < n) => alpha[/] _[//]nring_ap_zero _ _ SPap_n)). -2: rstepr (nring n[*](alpha[/] _[//]nring_ap_zero _ _ SPap_n)); - apply sumx_const. -apply Sumx_resp_leEq; intros. -unfold part_tot_nat_fun in |- *. -elim (le_lt_dec n i); intro; simpl in |- *. -elimtype False; exact (le_not_lt _ _ a0 H). -unfold delta in |- *. -apply - leEq_transitive - with - ((M[+]M)[*] - (alpha[/] _[//] - mult_resp_ap_zero _ _ _ (nring_ap_zero _ _ SPap_n) (max_one_ap_zero M)) - [/]TwoNZ). -apply mult_resp_leEq_lft. -apply div_resp_leEq. -apply pos_two. -apply Min_leEq_rht. -astepl (ZeroR[+]Zero); apply plus_resp_leEq_both; unfold M in |- *; - apply positive_norm. -rstepl - (alpha[*](M[/] _[//]max_one_ap_zero M)[*] - (One[/] _[//]nring_ap_zero _ _ SPap_n)). -rstepr (alpha[*]One[*](One[/] _[//]nring_ap_zero _ _ SPap_n)). -apply mult_resp_leEq_rht. -apply mult_resp_leEq_lft. -apply shift_div_leEq. -apply pos_max_one. -astepr (Max M One); apply lft_leEq_Max. -apply less_leEq; assumption. -apply less_leEq; apply recip_resp_pos. -astepl (nring (R:=IR) 0); apply nring_less; apply RS'_pos_n. -apply sep__part_fun_0. -exact sep__part_fun_wd. -exact sep__part_fun_mon. -unfold part_tot_nat_fun in |- *. -intros; elim (le_lt_dec (sep__part_fun i (lt_le_weak _ _ Hi)) j); intro; - simpl in |- *. -elim (le_lt_dec j (pred (sep__part_fun (S i) Hi))); intro; simpl in |- *. -elim (le_lt_dec n j); intro; simpl in |- *. -elimtype False; apply (le_not_lt n j). -assumption. -eapply lt_le_trans. -apply H0. -apply sep__part_fun_bnd. -algebra. -elimtype False; apply (le_not_lt _ _ H0). -rewrite (S_pred (sep__part_fun (S i) Hi'') (sep__part_fun i Hi')). -cut (sep__part_fun (S i) Hi'' = sep__part_fun (S i) Hi); - [ intro | apply sep__part_fun_wd; auto ]. -rewrite H1; auto with arith. -apply sep__part_fun_mon. -apply lt_n_Sn. -elimtype False; apply (le_not_lt _ _ H). -rewrite sep__part_fun_i. -2: assumption. -rewrite sep__part_fun_i in b0; assumption. -intros; symmetry in |- *; apply sep__part_fun_m. +Proof. + unfold Sum2 in |- *. + apply leEq_wdl with (Sumx (fun (j : nat) (_ : j < n) => part_tot_nat_fun _ _ + (fun (i : nat) (_ : i < n) => (M[+]M)[*]delta [/]TwoNZ) j)). + 2: apply eq_symmetric_unfolded; apply str_Sumx_Sum_Sum' with + (g := fun (i : nat) (Hi : i < m) (i0 : nat) => sumbool_rect (fun + _ : {sep__part_fun i (lt_le_weak i m Hi) <= i0} + + {i0 < sep__part_fun i (lt_le_weak i m Hi)} => IR) + (fun _ : sep__part_fun i (lt_le_weak i m Hi) <= i0 => sumbool_rect (fun + _ : {i0 <= pred (sep__part_fun (S i) Hi)} + {pred (sep__part_fun (S i) Hi) < i0} => IR) + (fun _ : i0 <= pred (sep__part_fun (S i) Hi) => (M[+]M)[*]delta [/]TwoNZ) + (fun _ : pred (sep__part_fun (S i) Hi) < i0 => Zero) + (le_lt_dec i0 (pred (sep__part_fun (S i) Hi)))) + (fun _ : i0 < sep__part_fun i (lt_le_weak i m Hi) => Zero) + (le_lt_dec (sep__part_fun i (lt_le_weak i m Hi)) i0)) (h := part_tot_nat_fun _ _ + (fun (i : nat) (_ : i < n) => (M[+]M)[*]delta [/]TwoNZ)). + apply leEq_wdr with (Sumx (fun (i : nat) (_ : i < n) => alpha[/] _[//]nring_ap_zero _ _ SPap_n)). + 2: rstepr (nring n[*](alpha[/] _[//]nring_ap_zero _ _ SPap_n)); apply sumx_const. + apply Sumx_resp_leEq; intros. + unfold part_tot_nat_fun in |- *. + elim (le_lt_dec n i); intro; simpl in |- *. + elimtype False; exact (le_not_lt _ _ a0 H). + unfold delta in |- *. + apply leEq_transitive with ((M[+]M)[*] (alpha[/] _[//] + mult_resp_ap_zero _ _ _ (nring_ap_zero _ _ SPap_n) (max_one_ap_zero M)) [/]TwoNZ). + apply mult_resp_leEq_lft. + apply div_resp_leEq. + apply pos_two. + apply Min_leEq_rht. + astepl (ZeroR[+]Zero); apply plus_resp_leEq_both; unfold M in |- *; apply positive_norm. + rstepl (alpha[*](M[/] _[//]max_one_ap_zero M)[*] (One[/] _[//]nring_ap_zero _ _ SPap_n)). + rstepr (alpha[*]One[*](One[/] _[//]nring_ap_zero _ _ SPap_n)). + apply mult_resp_leEq_rht. + apply mult_resp_leEq_lft. + apply shift_div_leEq. + apply pos_max_one. + astepr (Max M One); apply lft_leEq_Max. + apply less_leEq; assumption. + apply less_leEq; apply recip_resp_pos. + astepl (nring (R:=IR) 0); apply nring_less; apply RS'_pos_n. + apply sep__part_fun_0. + exact sep__part_fun_wd. + exact sep__part_fun_mon. + unfold part_tot_nat_fun in |- *. + intros; elim (le_lt_dec (sep__part_fun i (lt_le_weak _ _ Hi)) j); intro; simpl in |- *. + elim (le_lt_dec j (pred (sep__part_fun (S i) Hi))); intro; simpl in |- *. + elim (le_lt_dec n j); intro; simpl in |- *. + elimtype False; apply (le_not_lt n j). + assumption. + eapply lt_le_trans. + apply H0. + apply sep__part_fun_bnd. + algebra. + elimtype False; apply (le_not_lt _ _ H0). + rewrite (S_pred (sep__part_fun (S i) Hi'') (sep__part_fun i Hi')). + cut (sep__part_fun (S i) Hi'' = sep__part_fun (S i) Hi); [ intro | apply sep__part_fun_wd; auto ]. + rewrite H1; auto with arith. + apply sep__part_fun_mon. + apply lt_n_Sn. + elimtype False; apply (le_not_lt _ _ H). + rewrite sep__part_fun_i. + 2: assumption. + rewrite sep__part_fun_i in b0; assumption. + intros; symmetry in |- *; apply sep__part_fun_m. Qed. Lemma sep__part_aux : forall i : nat, pred (sep__part_h (S i)) < n. -intros. -red in |- *. -rewrite <- S_pred with (sep__part_h (S i)) (sep__part_h 0). -apply sep__part_h_bnd. -apply sep__part_h_mon_3. -rewrite <- sep__part_fun_i with (H := le_O_n m). -2: apply RS'_pos_m. -2: apply lt_O_Sn. -rewrite <- sep__part_fun_m with (H := le_n m). -apply sep__part_fun_mon. -apply RS'_pos_m. +Proof. + intros. + red in |- *. + rewrite <- S_pred with (sep__part_h (S i)) (sep__part_h 0). + apply sep__part_h_bnd. + apply sep__part_h_mon_3. + rewrite <- sep__part_fun_i with (H := le_O_n m). + 2: apply RS'_pos_m. + 2: apply lt_O_Sn. + rewrite <- sep__part_fun_m with (H := le_n m). + apply sep__part_fun_mon. + apply RS'_pos_m. Qed. Lemma sep__part_Sum : AbsIR (Partition_Sum gP incF[-]Partition_Sum sep__part_pts_in_Partition incF)[<=] alpha. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply sep__part_Sum3. -eapply leEq_transitive. -2: apply sep__part_Sum4. -eapply leEq_transitive. -apply triangle_SumxIR. -apply Sumx_resp_leEq; intros. -eapply leEq_transitive. -apply triangle_Sum2IR. -rewrite <- - (S_pred (sep__part_fun (S i) H) (sep__part_fun i (lt_le_weak _ _ H)) +Proof. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply sep__part_Sum3. + eapply leEq_transitive. + 2: apply sep__part_Sum4. + eapply leEq_transitive. + apply triangle_SumxIR. + apply Sumx_resp_leEq; intros. + eapply leEq_transitive. + apply triangle_Sum2IR. + rewrite <- (S_pred (sep__part_fun (S i) H) (sep__part_fun i (lt_le_weak _ _ H)) (sep__part_fun_mon _ _ _ _ (lt_n_Sn i))). -apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. -apply Sum2_resp_leEq. -rewrite <- - (S_pred (sep__part_fun (S i) H) (sep__part_fun i (lt_le_weak _ _ H)) + apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. + apply Sum2_resp_leEq. + rewrite <- (S_pred (sep__part_fun (S i) H) (sep__part_fun i (lt_le_weak _ _ H)) (sep__part_fun_mon _ _ _ _ (lt_n_Sn i))). -apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. -intros k Hk Hk'. -elim (le_lt_dec m (S i)); intro. -cut (S i = m); [ intro | clear Hk Hk'; omega ]. -generalize H0. -unfold m at 1 in |- *; elim RS'_delta2_delta4; intro; simpl in |- *; intro. -cut (i < m); [ intro | assumption ]. -apply - leEq_wdl - with - (AbsIR - ((F (g k (RS'_Hsep_S _ _ H Hk')) just1[-]F (g _ (sep__part_aux RS'_m1)) just1)[*] - (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk')))). -2: apply AbsIR_wd; apply mult_wdl. -2: apply cg_minus_wd; [ algebra | idtac ]. -2: cut (i = RS'_m1); [ intro | auto ]. -2: generalize H; rewrite H3; intro. -2: unfold sep__part_pts in |- *; simpl in |- *; algebra. -elim (le_lt_dec (pred (sep__part_h (S RS'_m1))) k); intro. -cut (pred (sep__part_h (S RS'_m1)) = k); intros. -apply leEq_wdl with ZeroR. -astepl ((Zero[+]Zero)[*]ZeroR). -apply mult_resp_leEq_both. -apply eq_imp_leEq; algebra. -apply leEq_reflexive. -apply plus_resp_leEq_both; unfold M in |- *; apply positive_norm. -apply less_leEq; astepr (delta [/]TwoNZ); apply pos_div_two; exact RS'_delta_pos. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply AbsIRz_isz. -apply AbsIR_wd. -rstepr - ((F (g _ (sep__part_aux RS'_m1)) just1[-]F (g _ (sep__part_aux RS'_m1)) just1)[*] - (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk'))). -algebra. -cut (forall H, sep__part_fun (S i) H = n). -intro. -cut (sep__part_h (S RS'_m1) = n); intros. -rewrite H4 in a2. -rewrite H3 in Hk'. -rewrite H4. -apply le_antisym; auto. -elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. -auto. -rewrite H0; exact sep__part_fun_m. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -eapply leEq_transitive. -apply triangle_IR_minus. -apply plus_resp_leEq_both; unfold M, I in |- *; apply norm_bnd_AbsIR; - apply Pts_part_lemma with n P; apply gP. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (P k (RS'_Hsep i k H Hk')); apply prf2. -apply sep__part_h_lemma3 with i. -rewrite sep__part_fun_i in Hk; assumption. -rewrite H1; assumption. -apply - leEq_wdl - with - (AbsIR - ((F (g k (RS'_Hsep_S _ _ H Hk')) just1[-]F (g _ (sep__part_aux i)) just1)[*] - (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk')))). -2: apply AbsIR_wd; apply mult_wd. -2: apply cg_minus_wd; apply pfwdef; - [ algebra | unfold sep__part_pts in |- *; apply gP' ]; - auto. -2: apply cg_minus_wd; apply prf1; auto. -elim (le_lt_dec (pred (sep__part_h RS'_m1)) k); intro. -elim (le_lt_eq_dec _ _ a1); intro. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -eapply leEq_transitive. -apply triangle_IR_minus. -apply plus_resp_leEq_both; unfold M, I in |- *; apply norm_bnd_AbsIR; - apply Pts_part_lemma with n P; assumption. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (P k (RS'_Hsep i k H Hk')); apply prf2. -apply less_leEq; eapply leEq_less_trans. -2: apply b0. -unfold cg_minus in |- *; apply plus_resp_leEq_both. -apply Partition_mon. -rewrite (S_pred (sep__part_h (S RS'_m1)) (sep__part_h RS'_m1)). -apply le_n_S. -cut (forall H, sep__part_h (S RS'_m1) = sep__part_fun (S i) H); intros. -rewrite (H2 H); assumption. -generalize H2; rewrite H0. -intro; rewrite sep__part_fun_m. -elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; auto. -apply sep__part_h_mon_3. -elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. -apply H3; apply le_n. -apply lt_n_Sn. -apply inv_resp_leEq; apply Partition_mon. -eapply le_trans. -2: apply a2. -clear Hk Hk'; omega. -apply leEq_wdl with ZeroR. -astepl ((Zero[+]Zero)[*]ZeroR). -apply mult_resp_leEq_both. -apply eq_imp_leEq; algebra. -apply leEq_reflexive. -apply plus_resp_leEq_both; unfold M in |- *; apply positive_norm. -apply less_leEq; astepr (delta [/]TwoNZ); apply pos_div_two; exact RS'_delta_pos. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply AbsIRz_isz. -apply AbsIR_wd. -rstepr - ((F (g _ (sep__part_aux i)) just1[-]F (g _ (sep__part_aux i)) just1)[*] - (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk'))). -apply mult_wdl. -apply cg_minus_wd; apply pfwdef; apply gP'; auto. -rewrite H1; auto. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -eapply leEq_transitive. -apply triangle_IR_minus. -apply plus_resp_leEq_both; unfold M, I in |- *; apply norm_bnd_AbsIR; - apply Pts_part_lemma with n P; assumption. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (P k (RS'_Hsep i k H Hk')); apply prf2. -apply sep__part_h_lemma3 with i. -rewrite sep__part_fun_i in Hk; assumption. -rewrite H1; assumption. -elim (le_lt_eq_dec _ _ Hk'); intro. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -eapply leEq_transitive. -apply triangle_IR_minus. -apply plus_resp_leEq_both; unfold M, I in |- *; apply norm_bnd_AbsIR. -apply Pts_part_lemma with n P; assumption. -apply Pts_part_lemma with sep__part_length sep__part; - apply sep__part_pts_in_Partition. -cut (pred (sep__part_fun (S i) H) <= n); intros. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (P k (RS'_Hsep i k H Hk')); apply prf2. -apply sep__part_h_lemma3 with i. -rewrite sep__part_fun_i in Hk; assumption. -rewrite sep__part_fun_i in a0; assumption. -apply le_trans with (sep__part_fun (S i) H). -auto with arith. -apply sep__part_fun_bnd. -apply leEq_wdl with ZeroR. -astepl ((Zero[+]Zero)[*]ZeroR). -apply mult_resp_leEq_both. -apply eq_imp_leEq; algebra. -apply leEq_reflexive. -apply plus_resp_leEq_both; unfold M in |- *; apply positive_norm. -apply less_leEq; astepr (delta [/]TwoNZ); apply pos_div_two; exact RS'_delta_pos. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply AbsIRz_isz. -apply AbsIR_wd. -rstepr - ((F (g _ (sep__part_aux i)) just1[-]F (g _ (sep__part_aux i)) just1)[*] - (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk'))). -apply mult_wdl. -apply cg_minus_wd; apply pfwdef; unfold sep__part_pts in |- *; apply gP'; - auto. -rewrite sep__part_fun_i in b1; assumption. + apply lt_le_weak; apply sep__part_fun_mon; apply lt_n_Sn. + intros k Hk Hk'. + elim (le_lt_dec m (S i)); intro. + cut (S i = m); [ intro | clear Hk Hk'; omega ]. + generalize H0. + unfold m at 1 in |- *; elim RS'_delta2_delta4; intro; simpl in |- *; intro. + cut (i < m); [ intro | assumption ]. + apply leEq_wdl with (AbsIR + ((F (g k (RS'_Hsep_S _ _ H Hk')) just1[-]F (g _ (sep__part_aux RS'_m1)) just1)[*] + (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk')))). + 2: apply AbsIR_wd; apply mult_wdl. + 2: apply cg_minus_wd; [ algebra | idtac ]. + 2: cut (i = RS'_m1); [ intro | auto ]. + 2: generalize H; rewrite H3; intro. + 2: unfold sep__part_pts in |- *; simpl in |- *; algebra. + elim (le_lt_dec (pred (sep__part_h (S RS'_m1))) k); intro. + cut (pred (sep__part_h (S RS'_m1)) = k); intros. + apply leEq_wdl with ZeroR. + astepl ((Zero[+]Zero)[*]ZeroR). + apply mult_resp_leEq_both. + apply eq_imp_leEq; algebra. + apply leEq_reflexive. + apply plus_resp_leEq_both; unfold M in |- *; apply positive_norm. + apply less_leEq; astepr (delta [/]TwoNZ); apply pos_div_two; exact RS'_delta_pos. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply AbsIRz_isz. + apply AbsIR_wd. + rstepr ((F (g _ (sep__part_aux RS'_m1)) just1[-]F (g _ (sep__part_aux RS'_m1)) just1)[*] + (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk'))). + algebra. + cut (forall H, sep__part_fun (S i) H = n). + intro. + cut (sep__part_h (S RS'_m1) = n); intros. + rewrite H4 in a2. + rewrite H3 in Hk'. + rewrite H4. + apply le_antisym; auto. + elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. + auto. + rewrite H0; exact sep__part_fun_m. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + eapply leEq_transitive. + apply triangle_IR_minus. + apply plus_resp_leEq_both; unfold M, I in |- *; apply norm_bnd_AbsIR; + apply Pts_part_lemma with n P; apply gP. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (P k (RS'_Hsep i k H Hk')); apply prf2. + apply sep__part_h_lemma3 with i. + rewrite sep__part_fun_i in Hk; assumption. + rewrite H1; assumption. + apply leEq_wdl with (AbsIR + ((F (g k (RS'_Hsep_S _ _ H Hk')) just1[-]F (g _ (sep__part_aux i)) just1)[*] + (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk')))). + 2: apply AbsIR_wd; apply mult_wd. + 2: apply cg_minus_wd; apply pfwdef; [ algebra | unfold sep__part_pts in |- *; apply gP' ]; auto. + 2: apply cg_minus_wd; apply prf1; auto. + elim (le_lt_dec (pred (sep__part_h RS'_m1)) k); intro. + elim (le_lt_eq_dec _ _ a1); intro. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + eapply leEq_transitive. + apply triangle_IR_minus. + apply plus_resp_leEq_both; unfold M, I in |- *; apply norm_bnd_AbsIR; + apply Pts_part_lemma with n P; assumption. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (P k (RS'_Hsep i k H Hk')); apply prf2. + apply less_leEq; eapply leEq_less_trans. + 2: apply b0. + unfold cg_minus in |- *; apply plus_resp_leEq_both. + apply Partition_mon. + rewrite (S_pred (sep__part_h (S RS'_m1)) (sep__part_h RS'_m1)). + apply le_n_S. + cut (forall H, sep__part_h (S RS'_m1) = sep__part_fun (S i) H); intros. + rewrite (H2 H); assumption. + generalize H2; rewrite H0. + intro; rewrite sep__part_fun_m. + elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; auto. + apply sep__part_h_mon_3. + elim (ProjT2 sep__part_app_n); fold RS'_m1 in |- *; intros. + apply H3; apply le_n. + apply lt_n_Sn. + apply inv_resp_leEq; apply Partition_mon. + eapply le_trans. + 2: apply a2. + clear Hk Hk'; omega. + apply leEq_wdl with ZeroR. + astepl ((Zero[+]Zero)[*]ZeroR). + apply mult_resp_leEq_both. + apply eq_imp_leEq; algebra. + apply leEq_reflexive. + apply plus_resp_leEq_both; unfold M in |- *; apply positive_norm. + apply less_leEq; astepr (delta [/]TwoNZ); apply pos_div_two; exact RS'_delta_pos. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply AbsIRz_isz. + apply AbsIR_wd. + rstepr ((F (g _ (sep__part_aux i)) just1[-]F (g _ (sep__part_aux i)) just1)[*] + (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk'))). + apply mult_wdl. + apply cg_minus_wd; apply pfwdef; apply gP'; auto. + rewrite H1; auto. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + eapply leEq_transitive. + apply triangle_IR_minus. + apply plus_resp_leEq_both; unfold M, I in |- *; apply norm_bnd_AbsIR; + apply Pts_part_lemma with n P; assumption. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (P k (RS'_Hsep i k H Hk')); apply prf2. + apply sep__part_h_lemma3 with i. + rewrite sep__part_fun_i in Hk; assumption. + rewrite H1; assumption. + elim (le_lt_eq_dec _ _ Hk'); intro. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + eapply leEq_transitive. + apply triangle_IR_minus. + apply plus_resp_leEq_both; unfold M, I in |- *; apply norm_bnd_AbsIR. + apply Pts_part_lemma with n P; assumption. + apply Pts_part_lemma with sep__part_length sep__part; apply sep__part_pts_in_Partition. + cut (pred (sep__part_fun (S i) H) <= n); intros. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (P k (RS'_Hsep i k H Hk')); apply prf2. + apply sep__part_h_lemma3 with i. + rewrite sep__part_fun_i in Hk; assumption. + rewrite sep__part_fun_i in a0; assumption. + apply le_trans with (sep__part_fun (S i) H). + auto with arith. + apply sep__part_fun_bnd. + apply leEq_wdl with ZeroR. + astepl ((Zero[+]Zero)[*]ZeroR). + apply mult_resp_leEq_both. + apply eq_imp_leEq; algebra. + apply leEq_reflexive. + apply plus_resp_leEq_both; unfold M in |- *; apply positive_norm. + apply less_leEq; astepr (delta [/]TwoNZ); apply pos_div_two; exact RS'_delta_pos. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply AbsIRz_isz. + apply AbsIR_wd. + rstepr ((F (g _ (sep__part_aux i)) just1[-]F (g _ (sep__part_aux i)) just1)[*] + (P (S k) (RS'_Hsep_S _ _ H Hk')[-]P k (RS'_Hsep _ _ H Hk'))). + apply mult_wdl. + apply cg_minus_wd; apply pfwdef; unfold sep__part_pts in |- *; apply gP'; auto. + rewrite sep__part_fun_i in b1; assumption. Qed. End Separating_Partition. diff --git a/ftc/Rolle.v b/ftc/Rolle.v index 2f683d88f..0fe5cc676 100644 --- a/ftc/Rolle.v +++ b/ftc/Rolle.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export DiffTactics2. Require Export MoreFunctions. @@ -75,8 +75,9 @@ Variable e : IR. Hypothesis He : Zero [<] e. Let contF' : Continuous_I Hab F'. -apply deriv_imp_contin'_I with Hab' F. -assumption. +Proof. + apply deriv_imp_contin'_I with Hab' F. + assumption. Qed. Let derivF : @@ -89,10 +90,11 @@ Let derivF : forall Hx Hy Hx', AbsIR (x[-]y) [<=] d -> AbsIR (F y Hy[-]F x Hx[-]F' x Hx'[*] (y[-]x)) [<=] e[*]AbsIR (y[-]x)}. -elim derF. -intros a0 b0. -elim b0; intros H b1. -unfold I in |- *; assumption. +Proof. + elim derF. + intros a0 b0. + elim b0; intros H b1. + unfold I in |- *; assumption. Qed. Let Rolle_lemma2 : @@ -103,7 +105,8 @@ Let Rolle_lemma2 : forall Hx Hy Hx', AbsIR (x[-]y) [<=] d -> AbsIR (F y Hy[-]F x Hx[-]F' x Hx'[*] (y[-]x)) [<=] e [/]TwoNZ[*]AbsIR (y[-]x)}. -exact (derivF _ (pos_div_two _ _ He)). +Proof. + exact (derivF _ (pos_div_two _ _ He)). Qed. Let df := proj1_sig2T _ _ _ Rolle_lemma2. @@ -125,8 +128,9 @@ Let Rolle_lemma3 : I x -> I y -> forall Hx Hy, AbsIR (x[-]y) [<=] d -> AbsIR (F' x Hx[-]F' y Hy) [<=] e [/]TwoNZ}. -elim contF'; intros. -exact (b0 _ (pos_div_two _ _ He)). +Proof. + elim contF'; intros. + exact (b0 _ (pos_div_two _ _ He)). Qed. Let df' := proj1_sig2T _ _ _ Rolle_lemma3. @@ -144,11 +148,13 @@ Let Hf' : Let d := Min df df'. Let Hd : Zero [<] d. -unfold d in |- *; apply less_Min; auto. +Proof. + unfold d in |- *; apply less_Min; auto. Qed. Let incF : included (Compact Hab) (Dom F). -elim derF; intros; assumption. +Proof. + elim derF; intros; assumption. Qed. Let n := compact_nat a b d Hd. @@ -158,26 +164,28 @@ Let fcp (i : nat) (Hi : i <= n) := (incF _ (compact_part_hyp a b Hab Hab' d Hd i Hi)). Let Rolle_lemma1 : - Sumx (fun (i : nat) (H : i < n) => fcp (S i) H[-]fcp i (lt_le_weak i n H)) [=] + Sumx (fun (i : nat) (H : i < n) => fcp (S i) H[-]fcp i (lt_le_weak i n H)) [=] Zero. -apply eq_transitive_unfolded with (fcp _ (le_n n) [-]fcp 0 (le_O_n n)). -apply Mengolli_Sum with (f := fun (i : nat) (H : i <= n) => fcp _ H). -red in |- *; do 3 intro. -rewrite H; intros. -unfold fcp in |- *; simpl in |- *; algebra. -intros; algebra. -apply eq_transitive_unfolded with (F b Hb[-]F a Ha). -unfold fcp, compact_part, n in |- *; simpl in |- *. -apply cg_minus_wd; apply pfwdef; rational. -astepr (F a Ha[-]F a Ha); apply cg_minus_wd. -apply eq_symmetric_unfolded; apply Fab. -algebra. +Proof. + apply eq_transitive_unfolded with (fcp _ (le_n n) [-]fcp 0 (le_O_n n)). + apply Mengolli_Sum with (f := fun (i : nat) (H : i <= n) => fcp _ H). + red in |- *; do 3 intro. + rewrite H; intros. + unfold fcp in |- *; simpl in |- *; algebra. + intros; algebra. + apply eq_transitive_unfolded with (F b Hb[-]F a Ha). + unfold fcp, compact_part, n in |- *; simpl in |- *. + apply cg_minus_wd; apply pfwdef; rational. + astepr (F a Ha[-]F a Ha); apply cg_minus_wd. + apply eq_symmetric_unfolded; apply Fab. + algebra. Qed. Let incF' : included (Compact Hab) (Dom F'). -elim derF; intros. -elim b0; intros. -assumption. +Proof. + elim derF; intros. + elim b0; intros. + assumption. Qed. Let fcp' (i : nat) (Hi : i <= n) := @@ -189,154 +197,129 @@ Notation cp := (compact_part a b Hab' d Hd). Let Rolle_lemma4 : {i : nat | {H : i < n | - Zero [<] + Zero [<] (fcp' _ (lt_le_weak _ _ H) [+]e) [*] (cp (S i) H[-]cp i (lt_le_weak _ _ H))}}. -apply - positive_Sumx - with - (f := fun (i : nat) (H : i < n) => - (fcp' _ (lt_le_weak _ _ H) [+]e) [*] - (cp _ H[-]cp _ (lt_le_weak _ _ H))). -red in |- *; do 3 intro. -rewrite H; intros. -unfold fcp' in |- *; algebra. -apply - less_wdl - with - (Sumx (fun (i : nat) (H : i < n) => fcp _ H[-]fcp _ (lt_le_weak _ _ H))). -2: apply Rolle_lemma1. -apply Sumx_resp_less. -apply less_nring with (IR:COrdField); simpl in |- *; unfold n in |- *; - apply pos_compact_nat; auto. -intros. -apply - leEq_less_trans - with - ((fcp' i (lt_le_weak _ _ H) [+]e [/]TwoNZ) [*] - (cp (S i) H[-]cp i (lt_le_weak _ _ H))). -2: apply mult_resp_less. -3: apply compact_less. -2: apply plus_resp_less_lft. -2: apply pos_div_two'; assumption. -rstepl - (fcp' i (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)) [+] - (fcp _ H[-]fcp _ (lt_le_weak _ _ H) [-] - fcp' i (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)))). -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply ring_distl_unfolded. -apply plus_resp_leEq_lft. -apply - leEq_wdr with (e [/]TwoNZ[*]AbsIR (cp (S i) H[-]cp i (lt_le_weak _ _ H))). -2: apply mult_wd. -2: algebra. -2: apply AbsIR_eq_x. -2: apply less_leEq; apply compact_less. -eapply leEq_transitive. -apply leEq_AbsIR. -unfold fcp, fcp' in |- *; apply Hf. -unfold I in |- *; apply compact_part_hyp. -unfold I in |- *; apply compact_part_hyp. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_minus. -apply leEq_transitive with d. -2: unfold d in |- *; apply Min_leEq_lft. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply compact_leEq. -apply less_leEq; apply compact_less. +Proof. + apply positive_Sumx with (f := fun (i : nat) (H : i < n) => (fcp' _ (lt_le_weak _ _ H) [+]e) [*] + (cp _ H[-]cp _ (lt_le_weak _ _ H))). + red in |- *; do 3 intro. + rewrite H; intros. + unfold fcp' in |- *; algebra. + apply less_wdl with (Sumx (fun (i : nat) (H : i < n) => fcp _ H[-]fcp _ (lt_le_weak _ _ H))). + 2: apply Rolle_lemma1. + apply Sumx_resp_less. + apply less_nring with (IR:COrdField); simpl in |- *; unfold n in |- *; apply pos_compact_nat; auto. + intros. + apply leEq_less_trans with ((fcp' i (lt_le_weak _ _ H) [+]e [/]TwoNZ) [*] + (cp (S i) H[-]cp i (lt_le_weak _ _ H))). + 2: apply mult_resp_less. + 3: apply compact_less. + 2: apply plus_resp_less_lft. + 2: apply pos_div_two'; assumption. + rstepl (fcp' i (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)) [+] + (fcp _ H[-]fcp _ (lt_le_weak _ _ H) [-] + fcp' i (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)))). + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply ring_distl_unfolded. + apply plus_resp_leEq_lft. + apply leEq_wdr with (e [/]TwoNZ[*]AbsIR (cp (S i) H[-]cp i (lt_le_weak _ _ H))). + 2: apply mult_wd. + 2: algebra. + 2: apply AbsIR_eq_x. + 2: apply less_leEq; apply compact_less. + eapply leEq_transitive. + apply leEq_AbsIR. + unfold fcp, fcp' in |- *; apply Hf. + unfold I in |- *; apply compact_part_hyp. + unfold I in |- *; apply compact_part_hyp. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_minus. + apply leEq_transitive with d. + 2: unfold d in |- *; apply Min_leEq_lft. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply compact_leEq. + apply less_leEq; apply compact_less. Qed. Let Rolle_lemma5 : {i : nat | {H : i <= n | [--]e [<] fcp' _ H}}. -elim Rolle_lemma4; intros i Hi; elim Hi; clear Hi; intros Hi Hi'. -exists i; exists (lt_le_weak _ _ Hi). -astepl (Zero[-]e); apply shift_minus_less. -eapply mult_cancel_less. -2: eapply less_wdl. -2: apply Hi'. -2: algebra. -apply compact_less. +Proof. + elim Rolle_lemma4; intros i Hi; elim Hi; clear Hi; intros Hi Hi'. + exists i; exists (lt_le_weak _ _ Hi). + astepl (Zero[-]e); apply shift_minus_less. + eapply mult_cancel_less. + 2: eapply less_wdl. + 2: apply Hi'. + 2: algebra. + apply compact_less. Qed. Let Rolle_lemma6 : {i : nat | {H : i < n | - (fcp' _ (lt_le_weak _ _ H) [-]e) [*] (cp (S i) H[-]cp i (lt_le_weak _ _ H)) [<] + (fcp' _ (lt_le_weak _ _ H) [-]e) [*] (cp (S i) H[-]cp i (lt_le_weak _ _ H)) [<] Zero}}. -apply - negative_Sumx - with - (f := fun (i : nat) (H : i < n) => - (fcp' _ (lt_le_weak _ _ H) [-]e) [*] - (cp _ H[-]cp _ (lt_le_weak _ _ H))). -red in |- *; do 3 intro. -rewrite H; intros. -unfold fcp' in |- *; algebra. -apply - less_wdr - with - (Sumx (fun (i : nat) (H : i < n) => fcp _ H[-]fcp _ (lt_le_weak _ _ H))). -2: apply Rolle_lemma1. -apply Sumx_resp_less. -apply less_nring with (IR:COrdField); simpl in |- *; unfold n in |- *; - apply pos_compact_nat; auto. -intros. -apply - less_leEq_trans - with - ((fcp' _ (lt_le_weak _ _ H) [-]e [/]TwoNZ) [*] - (cp _ H[-]cp _ (lt_le_weak _ _ H))). -apply mult_resp_less. -2: apply compact_less. -unfold cg_minus in |- *; apply plus_resp_less_lft. -apply inv_resp_less; apply pos_div_two'; assumption. -rstepr - (fcp' _ (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)) [+] - [--] - [--] - (fcp _ H[-]fcp _ (lt_le_weak _ _ H) [-] - fcp' _ (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)))). -rstepl - (fcp' _ (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)) [-] - e [/]TwoNZ[*] (cp _ H[-]cp _ (lt_le_weak _ _ H))). -unfold cg_minus at 1 in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq; - apply leEq_wdr with (e [/]TwoNZ[*]AbsIR (cp _ H[-]cp _ (lt_le_weak _ _ H))). -2: apply mult_wd. -2: algebra. -2: apply AbsIR_eq_x. -2: apply less_leEq; apply compact_less. -eapply leEq_transitive. -apply inv_leEq_AbsIR. -unfold fcp, fcp' in |- *; apply Hf. -unfold I in |- *; apply compact_part_hyp. -unfold I in |- *; apply compact_part_hyp. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_minus. -apply leEq_transitive with d. -2: unfold d in |- *; apply Min_leEq_lft. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply compact_leEq. -apply less_leEq; apply compact_less. +Proof. + apply negative_Sumx with (f := fun (i : nat) (H : i < n) => (fcp' _ (lt_le_weak _ _ H) [-]e) [*] + (cp _ H[-]cp _ (lt_le_weak _ _ H))). + red in |- *; do 3 intro. + rewrite H; intros. + unfold fcp' in |- *; algebra. + apply less_wdr with (Sumx (fun (i : nat) (H : i < n) => fcp _ H[-]fcp _ (lt_le_weak _ _ H))). + 2: apply Rolle_lemma1. + apply Sumx_resp_less. + apply less_nring with (IR:COrdField); simpl in |- *; unfold n in |- *; apply pos_compact_nat; auto. + intros. + apply less_leEq_trans with ((fcp' _ (lt_le_weak _ _ H) [-]e [/]TwoNZ) [*] + (cp _ H[-]cp _ (lt_le_weak _ _ H))). + apply mult_resp_less. + 2: apply compact_less. + unfold cg_minus in |- *; apply plus_resp_less_lft. + apply inv_resp_less; apply pos_div_two'; assumption. + rstepr (fcp' _ (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)) [+] [--] [--] + (fcp _ H[-]fcp _ (lt_le_weak _ _ H) [-] + fcp' _ (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)))). + rstepl (fcp' _ (lt_le_weak _ _ H) [*] (cp _ H[-]cp _ (lt_le_weak _ _ H)) [-] + e [/]TwoNZ[*] (cp _ H[-]cp _ (lt_le_weak _ _ H))). + unfold cg_minus at 1 in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq; apply leEq_wdr with (e [/]TwoNZ[*]AbsIR (cp _ H[-]cp _ (lt_le_weak _ _ H))). + 2: apply mult_wd. + 2: algebra. + 2: apply AbsIR_eq_x. + 2: apply less_leEq; apply compact_less. + eapply leEq_transitive. + apply inv_leEq_AbsIR. + unfold fcp, fcp' in |- *; apply Hf. + unfold I in |- *; apply compact_part_hyp. + unfold I in |- *; apply compact_part_hyp. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_minus. + apply leEq_transitive with d. + 2: unfold d in |- *; apply Min_leEq_lft. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply compact_leEq. + apply less_leEq; apply compact_less. Qed. Let Rolle_lemma7 : {i : nat | {H : i <= n | fcp' _ H [<] e}}. -elim Rolle_lemma6; intros i Hi; elim Hi; clear Hi; intros Hi Hi'. -exists i; exists (lt_le_weak _ _ Hi). -astepr (e[+]Zero); apply shift_less_plus'. -eapply mult_cancel_less. -2: eapply less_wdr. -2: apply Hi'. -2: algebra. -apply shift_less_minus. -astepl (cp _ (lt_le_weak _ _ Hi)). -unfold compact_part in |- *. -apply plus_resp_less_lft. -apply mult_resp_less. -simpl in |- *; apply less_plusOne. -apply div_resp_pos. -2: apply shift_less_minus; astepl a; auto. -apply pos_compact_nat; auto. +Proof. + elim Rolle_lemma6; intros i Hi; elim Hi; clear Hi; intros Hi Hi'. + exists i; exists (lt_le_weak _ _ Hi). + astepr (e[+]Zero); apply shift_less_plus'. + eapply mult_cancel_less. + 2: eapply less_wdr. + 2: apply Hi'. + 2: algebra. + apply shift_less_minus. + astepl (cp _ (lt_le_weak _ _ Hi)). + unfold compact_part in |- *. + apply plus_resp_less_lft. + apply mult_resp_less. + simpl in |- *; apply less_plusOne. + apply div_resp_pos. + 2: apply shift_less_minus; astepl a; auto. + apply pos_compact_nat; auto. Qed. Let j := ProjT1 Rolle_lemma5. @@ -344,7 +327,8 @@ Let j := ProjT1 Rolle_lemma5. Let Hj := ProjT1 (ProjT2 Rolle_lemma5). Let Hj' : [--]e [<] fcp' _ Hj. -exact (ProjT2 (ProjT2 Rolle_lemma5)). +Proof. + exact (ProjT2 (ProjT2 Rolle_lemma5)). Qed. Let k := ProjT1 Rolle_lemma7. @@ -352,214 +336,223 @@ Let k := ProjT1 Rolle_lemma7. Let Hk := ProjT1 (ProjT2 Rolle_lemma7). Let Hk' : fcp' _ Hk [<] e. -exact (ProjT2 (ProjT2 Rolle_lemma7)). +Proof. + exact (ProjT2 (ProjT2 Rolle_lemma7)). Qed. Let Rolle_lemma8 : forall (i : nat) (H : i <= n), AbsIR (fcp' _ H) [<] e or e [/]TwoNZ [<] AbsIR (fcp' _ H). -intros. -cut (e [/]TwoNZ [<] AbsIR (fcp' _ H) or AbsIR (fcp' _ H) [<] e). -intro H0; inversion_clear H0; [ right | left ]; assumption. -apply less_cotransitive_unfolded. -apply pos_div_two'; assumption. +Proof. + intros. + cut (e [/]TwoNZ [<] AbsIR (fcp' _ H) or AbsIR (fcp' _ H) [<] e). + intro H0; inversion_clear H0; [ right | left ]; assumption. + apply less_cotransitive_unfolded. + apply pos_div_two'; assumption. Qed. Let Rolle_lemma9 : {m : nat | {Hm : m <= n | AbsIR (fcp' _ Hm) [<] e}} or (forall (i : nat) (H : i <= n), e [/]TwoNZ [<] AbsIR (fcp' _ H)). -set (P := fun (i : nat) (H : i <= n) => AbsIR (fcp' _ H) [<] e) in *. -set (Q := fun (i : nat) (H : i <= n) => e [/]TwoNZ [<] AbsIR (fcp' _ H)) in *. -apply finite_or_elim with (P := P) (Q := Q). -red in |- *. -intros i i' Hii'; rewrite Hii'; intros Hi Hi' HP. -red in |- *; red in HP. -eapply less_wdl. -apply HP. -apply AbsIR_wd; unfold fcp' in |- *; algebra. -red in |- *. -intros i i' Hii'; rewrite Hii'; intros Hi Hi' HQ. -red in |- *; red in HQ. -eapply less_wdr. -apply HQ. -apply AbsIR_wd; unfold fcp' in |- *; algebra. -apply Rolle_lemma8. +Proof. + set (P := fun (i : nat) (H : i <= n) => AbsIR (fcp' _ H) [<] e) in *. + set (Q := fun (i : nat) (H : i <= n) => e [/]TwoNZ [<] AbsIR (fcp' _ H)) in *. + apply finite_or_elim with (P := P) (Q := Q). + red in |- *. + intros i i' Hii'; rewrite Hii'; intros Hi Hi' HP. + red in |- *; red in HP. + eapply less_wdl. + apply HP. + apply AbsIR_wd; unfold fcp' in |- *; algebra. + red in |- *. + intros i i' Hii'; rewrite Hii'; intros Hi Hi' HQ. + red in |- *; red in HQ. + eapply less_wdr. + apply HQ. + apply AbsIR_wd; unfold fcp' in |- *; algebra. + apply Rolle_lemma8. Qed. Let Rolle_lemma10 : {m : nat | {Hm : m <= n | AbsIR (fcp' _ Hm) [<] e}} -> {x : IR | I x | forall Hx, AbsIR (F' x Hx) [<=] e}. -intro H. -elim H; intros m Hm; elim Hm; clear H Hm; intros Hm Hm'. -exists (cp _ Hm). -red in |- *; apply compact_part_hyp. -intro; apply less_leEq; eapply less_wdl. -apply Hm'. -apply AbsIR_wd; unfold fcp' in |- *; algebra. +Proof. + intro H. + elim H; intros m Hm; elim Hm; clear H Hm; intros Hm Hm'. + exists (cp _ Hm). + red in |- *; apply compact_part_hyp. + intro; apply less_leEq; eapply less_wdl. + apply Hm'. + apply AbsIR_wd; unfold fcp' in |- *; algebra. Qed. Let Rolle_lemma11 : (forall (i : nat) (H : i <= n), e [/]TwoNZ [<] AbsIR (fcp' _ H)) -> (forall H : 0 <= n, fcp' _ H [<] [--] (e [/]TwoNZ)) -> forall (i : nat) (H : i <= n), fcp' _ H [<] Zero. -intros H H0. -cut (forall H : 0 <= n, fcp' _ H [<] Zero). -intro. -simple induction i. -assumption. -intros i' Hrec HSi'. -astepr (e [/]TwoNZ[-]e [/]TwoNZ). -apply shift_less_minus. -cut (i' <= n). -2: auto with arith. -intro Hi'. -apply less_leEq_trans with (fcp' _ HSi'[-]fcp' _ Hi'). -unfold cg_minus in |- *; apply plus_resp_less_lft. -cut (e [/]TwoNZ [<] fcp' _ Hi' or fcp' _ Hi' [<] [--] (e [/]TwoNZ)). -intro H2. -elim H2; clear H2; intro H3. -elimtype False. -cut (e [/]TwoNZ [<] Zero). -apply less_antisymmetric_unfolded. -apply pos_div_two; assumption. -eapply less_transitive_unfolded; [ apply H3 | apply Hrec ]. -astepl ( [--][--] (e [/]TwoNZ)); apply inv_resp_less; assumption. -cut (e [/]TwoNZ [<] AbsIR (fcp' _ Hi')). -2: exact (H i' Hi'). -intro H2. -apply less_AbsIR. -apply pos_div_two; assumption. -assumption. -eapply leEq_transitive. -apply leEq_AbsIR. -unfold fcp' in |- *; apply Hf'. -red in |- *; apply compact_part_hyp. -red in |- *; apply compact_part_hyp. -apply leEq_transitive with d. -2: unfold d in |- *; apply Min_leEq_rht. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply compact_leEq. -apply less_leEq; apply compact_less. -intro. -eapply less_transitive_unfolded. -apply (H0 H1). -astepr ( [--]ZeroR); apply inv_resp_less; apply pos_div_two; assumption. +Proof. + intros H H0. + cut (forall H : 0 <= n, fcp' _ H [<] Zero). + intro. + simple induction i. + assumption. + intros i' Hrec HSi'. + astepr (e [/]TwoNZ[-]e [/]TwoNZ). + apply shift_less_minus. + cut (i' <= n). + 2: auto with arith. + intro Hi'. + apply less_leEq_trans with (fcp' _ HSi'[-]fcp' _ Hi'). + unfold cg_minus in |- *; apply plus_resp_less_lft. + cut (e [/]TwoNZ [<] fcp' _ Hi' or fcp' _ Hi' [<] [--] (e [/]TwoNZ)). + intro H2. + elim H2; clear H2; intro H3. + elimtype False. + cut (e [/]TwoNZ [<] Zero). + apply less_antisymmetric_unfolded. + apply pos_div_two; assumption. + eapply less_transitive_unfolded; [ apply H3 | apply Hrec ]. + astepl ( [--][--] (e [/]TwoNZ)); apply inv_resp_less; assumption. + cut (e [/]TwoNZ [<] AbsIR (fcp' _ Hi')). + 2: exact (H i' Hi'). + intro H2. + apply less_AbsIR. + apply pos_div_two; assumption. + assumption. + eapply leEq_transitive. + apply leEq_AbsIR. + unfold fcp' in |- *; apply Hf'. + red in |- *; apply compact_part_hyp. + red in |- *; apply compact_part_hyp. + apply leEq_transitive with d. + 2: unfold d in |- *; apply Min_leEq_rht. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply compact_leEq. + apply less_leEq; apply compact_less. + intro. + eapply less_transitive_unfolded. + apply (H0 H1). + astepr ( [--]ZeroR); apply inv_resp_less; apply pos_div_two; assumption. Qed. Let Rolle_lemma12 : (forall (i : nat) (H : i <= n), e [/]TwoNZ [<] AbsIR (fcp' _ H)) -> (forall H : 0 <= n, e [/]TwoNZ [<] fcp' _ H) -> forall (i : nat) (H : i <= n), Zero [<] fcp' _ H. -intros H H0. -cut (forall H : 0 <= n, Zero [<] fcp' _ H). -intro. -simple induction i. -assumption. -intros i' Hrec HSi'. -astepl ( [--]ZeroR); astepr ( [--][--] (fcp' _ HSi')); apply inv_resp_less. -astepr (e [/]TwoNZ[-]e [/]TwoNZ). -apply shift_less_minus'. -astepl (e [/]TwoNZ[-]fcp' _ HSi'). -cut (i' <= n). -2: auto with arith. -intro Hi'. -apply less_leEq_trans with (fcp' _ Hi'[-]fcp' _ HSi'). -unfold cg_minus in |- *; apply plus_resp_less_rht. -cut (e [/]TwoNZ [<] fcp' _ Hi' or fcp' _ Hi' [<] [--] (e [/]TwoNZ)). -intro H2; elim H2; clear H2; intro H3. -assumption. -elimtype False. -cut (Zero [<] [--] (e [/]TwoNZ)). -apply less_antisymmetric_unfolded. -astepr ( [--]ZeroR); apply inv_resp_less; apply pos_div_two; assumption. -eapply less_transitive_unfolded; [ apply (Hrec Hi') | apply H3 ]. -cut (e [/]TwoNZ [<] AbsIR (fcp' _ Hi')). -2: exact (H i' Hi'). -intro. -apply less_AbsIR. -apply pos_div_two; assumption. -assumption. -eapply leEq_transitive. -apply leEq_AbsIR. -unfold fcp' in |- *; apply Hf'. -red in |- *; apply compact_part_hyp. -red in |- *; apply compact_part_hyp. -apply leEq_transitive with d. -2: unfold d in |- *; apply Min_leEq_rht. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_minus. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply compact_leEq. -apply less_leEq; apply compact_less. -intro. -eapply less_transitive_unfolded. -2: apply (H0 H1). -apply pos_div_two; assumption. +Proof. + intros H H0. + cut (forall H : 0 <= n, Zero [<] fcp' _ H). + intro. + simple induction i. + assumption. + intros i' Hrec HSi'. + astepl ( [--]ZeroR); astepr ( [--][--] (fcp' _ HSi')); apply inv_resp_less. + astepr (e [/]TwoNZ[-]e [/]TwoNZ). + apply shift_less_minus'. + astepl (e [/]TwoNZ[-]fcp' _ HSi'). + cut (i' <= n). + 2: auto with arith. + intro Hi'. + apply less_leEq_trans with (fcp' _ Hi'[-]fcp' _ HSi'). + unfold cg_minus in |- *; apply plus_resp_less_rht. + cut (e [/]TwoNZ [<] fcp' _ Hi' or fcp' _ Hi' [<] [--] (e [/]TwoNZ)). + intro H2; elim H2; clear H2; intro H3. + assumption. + elimtype False. + cut (Zero [<] [--] (e [/]TwoNZ)). + apply less_antisymmetric_unfolded. + astepr ( [--]ZeroR); apply inv_resp_less; apply pos_div_two; assumption. + eapply less_transitive_unfolded; [ apply (Hrec Hi') | apply H3 ]. + cut (e [/]TwoNZ [<] AbsIR (fcp' _ Hi')). + 2: exact (H i' Hi'). + intro. + apply less_AbsIR. + apply pos_div_two; assumption. + assumption. + eapply leEq_transitive. + apply leEq_AbsIR. + unfold fcp' in |- *; apply Hf'. + red in |- *; apply compact_part_hyp. + red in |- *; apply compact_part_hyp. + apply leEq_transitive with d. + 2: unfold d in |- *; apply Min_leEq_rht. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_minus. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply compact_leEq. + apply less_leEq; apply compact_less. + intro. + eapply less_transitive_unfolded. + 2: apply (H0 H1). + apply pos_div_two; assumption. Qed. Let Rolle_lemma13 : (forall (i : nat) (H : i <= n), fcp' _ H [<] Zero) or (forall (i : nat) (H : i <= n), Zero [<] fcp' _ H) -> {x : IR | I x | forall Hx, AbsIR (F' x Hx) [<=] e}. -intro H; elim H; clear H; intro H0. -exists (cp _ Hj). -red in |- *; apply compact_part_hyp. -intro; simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. -apply less_leEq; apply less_transitive_unfolded with ZeroR. -eapply less_wdl. -apply (H0 _ Hj). -unfold fcp' in |- *; algebra. -assumption. -astepr ( [--][--]e); apply inv_resp_leEq. -apply less_leEq; eapply less_wdr. -apply Hj'. -unfold fcp' in |- *; algebra. -exists (cp _ Hk). -red in |- *; apply compact_part_hyp. -intros. -simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. -apply less_leEq; eapply less_wdl. -apply Hk'. -unfold fcp' in |- *; algebra. -apply less_leEq; apply less_transitive_unfolded with ZeroR. -astepr ( [--]ZeroR); apply inv_resp_less; eapply less_wdr. -apply (H0 _ Hk). -unfold fcp' in |- *; rational. -assumption. +Proof. + intro H; elim H; clear H; intro H0. + exists (cp _ Hj). + red in |- *; apply compact_part_hyp. + intro; simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. + apply less_leEq; apply less_transitive_unfolded with ZeroR. + eapply less_wdl. + apply (H0 _ Hj). + unfold fcp' in |- *; algebra. + assumption. + astepr ( [--][--]e); apply inv_resp_leEq. + apply less_leEq; eapply less_wdr. + apply Hj'. + unfold fcp' in |- *; algebra. + exists (cp _ Hk). + red in |- *; apply compact_part_hyp. + intros. + simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. + apply less_leEq; eapply less_wdl. + apply Hk'. + unfold fcp' in |- *; algebra. + apply less_leEq; apply less_transitive_unfolded with ZeroR. + astepr ( [--]ZeroR); apply inv_resp_less; eapply less_wdr. + apply (H0 _ Hk). + unfold fcp' in |- *; rational. + assumption. Qed. Let Rolle_lemma15 : (forall (i : nat) (H : i <= n), e [/]TwoNZ [<] AbsIR (fcp' _ H)) -> fcp' _ (le_O_n n) [<] [--] (e [/]TwoNZ) or e [/]TwoNZ [<] fcp' _ (le_O_n n). -intro H. -cut (e [/]TwoNZ [<] fcp' _ (le_O_n n) or fcp' _ (le_O_n n) [<] [--] (e [/]TwoNZ)). -intro H0; inversion_clear H0; [ right | left ]; assumption. -apply less_AbsIR. -apply pos_div_two; assumption. -apply H. +Proof. + intro H. + cut (e [/]TwoNZ [<] fcp' _ (le_O_n n) or fcp' _ (le_O_n n) [<] [--] (e [/]TwoNZ)). + intro H0; inversion_clear H0; [ right | left ]; assumption. + apply less_AbsIR. + apply pos_div_two; assumption. + apply H. Qed. (* end hide *) Theorem Rolle : {x : IR | I x | forall Hx, AbsIR (F' x Hx) [<=] e}. -elim Rolle_lemma9. -exact Rolle_lemma10. -intro. -apply Rolle_lemma13. -elim (Rolle_lemma15 b0). -left; apply Rolle_lemma11. -assumption. -intro. -eapply less_wdl. -apply a0. -unfold fcp' in |- *; algebra. -right; apply Rolle_lemma12. -assumption. -intro. -eapply less_wdr. -apply b1. -unfold fcp' in |- *; algebra. +Proof. + elim Rolle_lemma9. + exact Rolle_lemma10. + intro. + apply Rolle_lemma13. + elim (Rolle_lemma15 b0). + left; apply Rolle_lemma11. + assumption. + intro. + eapply less_wdl. + apply a0. + unfold fcp' in |- *; algebra. + right; apply Rolle_lemma12. + assumption. + intro. + eapply less_wdr. + apply b1. + unfold fcp' in |- *; algebra. Qed. End Rolle. @@ -589,41 +582,38 @@ Hypothesis HB : Dom F b. Lemma Law_of_the_Mean_I : forall e, Zero [<] e -> {x : IR | I x | forall Hx, AbsIR (F b HB[-]F a HA[-]F' x Hx[*] (b[-]a)) [<=] e}. -intros e H. -set (h := (FId{-} [-C-]a) {*} [-C-] (F b HB[-]F a HA) {-}F{*} [-C-] (b[-]a)) in *. -set (h' := [-C-] (F b HB[-]F a HA) {-}F'{*} [-C-] (b[-]a)) in *. -cut (Derivative_I Hab' h h'). -intro H0. -cut {x : IR | I x | forall Hx, AbsIR (h' x Hx) [<=] e}. -intro H1. -elim H1; intros x Ix Hx. -exists x. -assumption. -intro. -eapply leEq_wdl. -apply (Hx (derivative_imp_inc' _ _ _ _ _ H0 x Ix)). -apply AbsIR_wd; simpl in |- *; rational. -unfold I, Hab in |- *; - eapply - Rolle - with - h - (derivative_imp_inc _ _ _ _ _ H0 _ (compact_inc_lft _ _ _)) - (derivative_imp_inc _ _ _ _ _ H0 _ (compact_inc_rht _ _ _)). -assumption. -simpl in |- *; rational. -assumption. -unfold h, h' in |- *; clear h h'. -New_Deriv. -apply Feq_reflexive. -apply included_FMinus; Included. -apply eq_imp_Feq. -apply included_FMinus. -apply included_FPlus; Included. -Included. -Included. -intros. -simpl in |- *; rational. +Proof. + intros e H. + set (h := (FId{-} [-C-]a) {*} [-C-] (F b HB[-]F a HA) {-}F{*} [-C-] (b[-]a)) in *. + set (h' := [-C-] (F b HB[-]F a HA) {-}F'{*} [-C-] (b[-]a)) in *. + cut (Derivative_I Hab' h h'). + intro H0. + cut {x : IR | I x | forall Hx, AbsIR (h' x Hx) [<=] e}. + intro H1. + elim H1; intros x Ix Hx. + exists x. + assumption. + intro. + eapply leEq_wdl. + apply (Hx (derivative_imp_inc' _ _ _ _ _ H0 x Ix)). + apply AbsIR_wd; simpl in |- *; rational. + unfold I, Hab in |- *; eapply Rolle with h + (derivative_imp_inc _ _ _ _ _ H0 _ (compact_inc_lft _ _ _)) + (derivative_imp_inc _ _ _ _ _ H0 _ (compact_inc_rht _ _ _)). + assumption. + simpl in |- *; rational. + assumption. + unfold h, h' in |- *; clear h h'. + New_Deriv. + apply Feq_reflexive. + apply included_FMinus; Included. + apply eq_imp_Feq. + apply included_FMinus. + apply included_FPlus; Included. + Included. + Included. + intros. + simpl in |- *; rational. Qed. End Law_of_the_Mean. @@ -648,27 +638,25 @@ Hypothesis HF : Diffble_I Hab' F. Theorem Rolle' : (forall Ha Hb, F a Ha [=] F b Hb) -> forall e, Zero [<] e -> {x : IR | Compact Hab x | forall Hx, AbsIR (PartInt (ProjT1 HF) x Hx) [<=] e}. -intros. -unfold Hab in |- *. -apply - Rolle - with - F - (diffble_imp_inc _ _ _ _ HF _ (compact_inc_lft a b Hab)) - (diffble_imp_inc _ _ _ _ HF _ (compact_inc_rht a b Hab)). -apply projT2. -apply H. -assumption. +Proof. + intros. + unfold Hab in |- *. + apply Rolle with F (diffble_imp_inc _ _ _ _ HF _ (compact_inc_lft a b Hab)) + (diffble_imp_inc _ _ _ _ HF _ (compact_inc_rht a b Hab)). + apply projT2. + apply H. + assumption. Qed. Lemma Law_of_the_Mean'_I : forall HA HB e, Zero [<] e -> {x : IR | Compact Hab x | forall Hx, AbsIR (F b HB[-]F a HA[-]PartInt (ProjT1 HF) x Hx[*] (b[-]a)) [<=] e}. -intros. -unfold Hab in |- *. -apply Law_of_the_Mean_I. -apply projT2. -assumption. +Proof. + intros. + unfold Hab in |- *. + apply Law_of_the_Mean_I. + apply projT2. + assumption. Qed. End Corollaries. @@ -701,74 +689,65 @@ Let incF' := Derivative_imp_inc' _ _ _ _ derF. Theorem Law_of_the_Mean : forall a b, I a -> I b -> forall e, Zero [<] e -> {x : IR | Compact (Min_leEq_Max a b) x | forall Ha Hb Hx, AbsIR (F b Hb[-]F a Ha[-]F' x Hx[*] (b[-]a)) [<=] e}. -intros a b Ha Hb e He. -cut (included (Compact (Min_leEq_Max a b)) I). intro H. -2: apply included_interval'; auto. -elim - (less_cotransitive_unfolded _ _ _ He - (AbsIR (F b (incF _ Hb) [-]F a (incF _ Ha) [-]F' a (incF' _ Ha) [*] (b[-]a)))); - intros. -cut (Min a b [<] Max a b). intro H0. -cut (included (Compact (less_leEq _ _ _ H0)) I). intro H1. -2: apply included_interval'; auto. -elim (ap_imp_less _ _ _ (Min_less_Max_imp_ap _ _ H0)); intro. -cut (included (Compact (less_leEq _ _ _ a1)) I). intro H2. -2: apply included_trans with (Compact (less_leEq _ _ _ H0)); - [ apply compact_map2 | apply H1 ]. -elim - (Law_of_the_Mean_I _ _ a1 _ _ - (included_imp_Derivative _ _ _ _ derF _ _ a1 H2) ( - incF _ Ha) (incF _ Hb) e He). -intros x H3 H4. -exists x; auto. -apply compact_map2 with (Hab := less_leEq _ _ _ a1); auto. -intros. -eapply leEq_wdl. -apply (H4 Hx). -apply AbsIR_wd; algebra. -cut (included (Compact (Min_leEq_Max b a)) (Compact (Min_leEq_Max a b))). intro H2. -cut (included (Compact (less_leEq _ _ _ b0)) I). intro H3. -2: apply included_trans with (Compact (Min_leEq_Max b a)); - [ apply compact_map2 - | apply included_trans with (Compact (less_leEq _ _ _ H0)); - [ apply H2 | apply H1 ] ]. -elim - (Law_of_the_Mean_I _ _ b0 _ _ - (included_imp_Derivative _ _ _ _ derF _ _ b0 H3) ( - incF _ Hb) (incF _ Ha) e He). -intros x H4 H5. -exists x; auto. -apply H2; apply compact_map2 with (Hab := less_leEq _ _ _ b0); auto. -intros. -eapply leEq_wdl. -apply (H5 Hx). -eapply eq_transitive_unfolded. -apply AbsIR_minus. -apply AbsIR_wd; rational. -intros x H2. -elim H2; clear H2; intros H3 H4; split. -eapply leEq_wdl; [ apply H3 | apply Min_comm ]. -eapply leEq_wdr; [ apply H4 | apply Max_comm ]. -apply ap_imp_Min_less_Max. -cut - (Part _ _ (incF b Hb) [-]Part _ _ (incF a Ha) [#] Zero - or Part _ _ (incF' a Ha) [*] (b[-]a) [#] Zero). -intro H0. -elim H0; clear H0; intro H1. -apply pfstrx with F (incF a Ha) (incF b Hb). -apply ap_symmetric_unfolded; apply zero_minus_apart; auto. -apply ap_symmetric_unfolded; apply zero_minus_apart. -eapply cring_mult_ap_zero_op; apply H1. -apply cg_minus_strext. -astepr ZeroR. -apply AbsIR_cancel_ap_zero. -apply Greater_imp_ap; auto. -exists a. -apply compact_Min_lft. -intros; apply less_leEq. -eapply less_wdl. -apply b0. -apply AbsIR_wd; algebra. +Proof. + intros a b Ha Hb e He. + cut (included (Compact (Min_leEq_Max a b)) I). intro H. + 2: apply included_interval'; auto. + elim (less_cotransitive_unfolded _ _ _ He + (AbsIR (F b (incF _ Hb) [-]F a (incF _ Ha) [-]F' a (incF' _ Ha) [*] (b[-]a)))); intros. + cut (Min a b [<] Max a b). intro H0. + cut (included (Compact (less_leEq _ _ _ H0)) I). intro H1. + 2: apply included_interval'; auto. + elim (ap_imp_less _ _ _ (Min_less_Max_imp_ap _ _ H0)); intro. + cut (included (Compact (less_leEq _ _ _ a1)) I). intro H2. + 2: apply included_trans with (Compact (less_leEq _ _ _ H0)); [ apply compact_map2 | apply H1 ]. + elim (Law_of_the_Mean_I _ _ a1 _ _ (included_imp_Derivative _ _ _ _ derF _ _ a1 H2) ( + incF _ Ha) (incF _ Hb) e He). + intros x H3 H4. + exists x; auto. + apply compact_map2 with (Hab := less_leEq _ _ _ a1); auto. + intros. + eapply leEq_wdl. + apply (H4 Hx). + apply AbsIR_wd; algebra. + cut (included (Compact (Min_leEq_Max b a)) (Compact (Min_leEq_Max a b))). intro H2. + cut (included (Compact (less_leEq _ _ _ b0)) I). intro H3. + 2: apply included_trans with (Compact (Min_leEq_Max b a)); [ apply compact_map2 + | apply included_trans with (Compact (less_leEq _ _ _ H0)); [ apply H2 | apply H1 ] ]. + elim (Law_of_the_Mean_I _ _ b0 _ _ (included_imp_Derivative _ _ _ _ derF _ _ b0 H3) ( + incF _ Hb) (incF _ Ha) e He). + intros x H4 H5. + exists x; auto. + apply H2; apply compact_map2 with (Hab := less_leEq _ _ _ b0); auto. + intros. + eapply leEq_wdl. + apply (H5 Hx). + eapply eq_transitive_unfolded. + apply AbsIR_minus. + apply AbsIR_wd; rational. + intros x H2. + elim H2; clear H2; intros H3 H4; split. + eapply leEq_wdl; [ apply H3 | apply Min_comm ]. + eapply leEq_wdr; [ apply H4 | apply Max_comm ]. + apply ap_imp_Min_less_Max. + cut (Part _ _ (incF b Hb) [-]Part _ _ (incF a Ha) [#] Zero + or Part _ _ (incF' a Ha) [*] (b[-]a) [#] Zero). + intro H0. + elim H0; clear H0; intro H1. + apply pfstrx with F (incF a Ha) (incF b Hb). + apply ap_symmetric_unfolded; apply zero_minus_apart; auto. + apply ap_symmetric_unfolded; apply zero_minus_apart. + eapply cring_mult_ap_zero_op; apply H1. + apply cg_minus_strext. + astepr ZeroR. + apply AbsIR_cancel_ap_zero. + apply Greater_imp_ap; auto. + exists a. + apply compact_Min_lft. + intros; apply less_leEq. + eapply less_wdl. + apply b0. + apply AbsIR_wd; algebra. Qed. (** @@ -778,37 +757,38 @@ We further generalize the mean law by writing as an explicit bound. Theorem Law_of_the_Mean_Abs_ineq : forall a b, I a -> I b -> forall c, (forall x, Compact (Min_leEq_Max a b) x -> forall Hx, AbsIR (F' x Hx) [<=] c) -> forall Ha Hb, AbsIR (F b Hb[-]F a Ha) [<=] c[*]AbsIR (b[-]a). -intros a b Ia Ib c Hc Ha Hb. -astepr (c[*]AbsIR (b[-]a) [+]Zero). -apply shift_leEq_plus'. -apply approach_zero_weak. -intros e H. -elim Law_of_the_Mean with a b e; auto. -intros x H0 H1. -cut (Dom F' x). intro H2. -eapply leEq_transitive. -2: apply (H1 Ha Hb H2). -eapply leEq_transitive. -2: apply triangle_IR_minus'. -unfold cg_minus at 1 4 in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq. -stepl (AbsIR (F' x H2)[*]AbsIR(b[-]a)). -2:apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_rht. -auto. -apply AbsIR_nonneg. -apply (Derivative_imp_inc' _ _ _ _ derF). -exact (included_interval I a b Ia Ib (Min_leEq_Max a b) x H0). +Proof. + intros a b Ia Ib c Hc Ha Hb. + astepr (c[*]AbsIR (b[-]a) [+]Zero). + apply shift_leEq_plus'. + apply approach_zero_weak. + intros e H. + elim Law_of_the_Mean with a b e; auto. + intros x H0 H1. + cut (Dom F' x). intro H2. + eapply leEq_transitive. + 2: apply (H1 Ha Hb H2). + eapply leEq_transitive. + 2: apply triangle_IR_minus'. + unfold cg_minus at 1 4 in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq. + stepl (AbsIR (F' x H2)[*]AbsIR(b[-]a)). + 2:apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_rht. + auto. + apply AbsIR_nonneg. + apply (Derivative_imp_inc' _ _ _ _ derF). + exact (included_interval I a b Ia Ib (Min_leEq_Max a b) x H0). Qed. Theorem Law_of_the_Mean_ineq : forall a b, I a -> I b -> forall c, (forall x, Compact (Min_leEq_Max a b) x -> forall Hx, AbsIR (F' x Hx) [<=] c) -> forall Ha Hb, F b Hb[-]F a Ha [<=] c[*]AbsIR (b[-]a). Proof. -intros. -eapply leEq_transitive. -apply leEq_AbsIR. -apply Law_of_the_Mean_Abs_ineq; assumption. + intros. + eapply leEq_transitive. + apply leEq_AbsIR. + apply Law_of_the_Mean_Abs_ineq; assumption. Qed. End Generalizations. diff --git a/ftc/StrongIVT.v b/ftc/StrongIVT.v index 759d15644..d3b1c56a1 100644 --- a/ftc/StrongIVT.v +++ b/ftc/StrongIVT.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export WeakIVT. Require Export CalculusTheorems. @@ -87,47 +87,46 @@ Lemma IVT'_seq_lemma : forall (xy : IR ** IR) (x:=fstT xy) (y:=sndT xy) {Hxy0 : (I x0) ** (I y0) | let Hx0 := fstT Hxy0 in let Hy0 := sndT Hxy0 in x0 [<] y0 and F x0 (incF _ Hx0) [<] z and z [<] F y0 (incF _ Hy0) | y0[-]x0 [=] Two [/]ThreeNZ[*] (y[-]x) /\ x [<=] x0 /\ y0 [<=] y}}. -(* begin hide *) -do 6 intro. intros H H0. -set (x1 := (Two[*]x[+]y) [/]ThreeNZ) in *. -set (y1 := (x[+]Two[*]y) [/]ThreeNZ) in *. -cut (x1 [<] y1). intro H1. -2: unfold x1, y1 in |- *; apply lft_rht; auto. -cut (I x1). intro H2. -cut (I y1). intro H3. -cut (F x1 (incF _ H2) [<] F y1 (incF _ H3)); [ intro H4 | auto ]. -elim (less_cotransitive_unfolded _ _ _ H4 z); intros. -exists (pairT x1 y); exists (pairT H2 Hy); simpl in |- *; repeat split; auto. -apply less_transitive_unfolded with y1; unfold x1, y1 in |- *; - [ apply lft_rht | apply rht_b ]; auto. -auto. -elim H0; auto. -unfold x1 in |- *; apply smaller_rht. -unfold x1 in |- *; apply less_leEq; apply a_lft; auto. -apply leEq_reflexive. -exists (pairT x y1); exists (pairT Hx H3); simpl in |- *; repeat split; auto. -apply less_transitive_unfolded with x1; unfold x1, y1 in |- *; - [ apply a_lft | apply lft_rht ]; auto. -elim H0; auto. -unfold y1 in |- *; apply smaller_lft; auto. -apply leEq_reflexive. -apply less_leEq; unfold y1 in |- *; apply rht_b; auto. -unfold y1 in |- *; inversion_clear Hx; inversion_clear Hy; split. -apply leEq_transitive with x; auto. -apply less_leEq; apply less_transitive_unfolded with x1; unfold x1 in |- *; - [ apply a_lft | apply lft_rht ]; auto. -apply leEq_transitive with y; auto. -apply less_leEq; apply rht_b; auto. -unfold x1 in |- *; inversion_clear Hx; inversion_clear Hy; split. -apply leEq_transitive with x; auto. -apply less_leEq; apply a_lft; auto. -apply leEq_transitive with y; auto. -apply less_leEq; apply less_transitive_unfolded with y1; unfold y1 in |- *; - [ apply lft_rht | apply rht_b ]; auto. +Proof. + (* begin hide *) + do 6 intro. intros H H0. + set (x1 := (Two[*]x[+]y) [/]ThreeNZ) in *. + set (y1 := (x[+]Two[*]y) [/]ThreeNZ) in *. + cut (x1 [<] y1). intro H1. + 2: unfold x1, y1 in |- *; apply lft_rht; auto. + cut (I x1). intro H2. + cut (I y1). intro H3. + cut (F x1 (incF _ H2) [<] F y1 (incF _ H3)); [ intro H4 | auto ]. + elim (less_cotransitive_unfolded _ _ _ H4 z); intros. + exists (pairT x1 y); exists (pairT H2 Hy); simpl in |- *; repeat split; auto. + apply less_transitive_unfolded with y1; unfold x1, y1 in |- *; [ apply lft_rht | apply rht_b ]; auto. + auto. + elim H0; auto. + unfold x1 in |- *; apply smaller_rht. + unfold x1 in |- *; apply less_leEq; apply a_lft; auto. + apply leEq_reflexive. + exists (pairT x y1); exists (pairT Hx H3); simpl in |- *; repeat split; auto. + apply less_transitive_unfolded with x1; unfold x1, y1 in |- *; [ apply a_lft | apply lft_rht ]; auto. + elim H0; auto. + unfold y1 in |- *; apply smaller_lft; auto. + apply leEq_reflexive. + apply less_leEq; unfold y1 in |- *; apply rht_b; auto. + unfold y1 in |- *; inversion_clear Hx; inversion_clear Hy; split. + apply leEq_transitive with x; auto. + apply less_leEq; apply less_transitive_unfolded with x1; unfold x1 in |- *; + [ apply a_lft | apply lft_rht ]; auto. + apply leEq_transitive with y; auto. + apply less_leEq; apply rht_b; auto. + unfold x1 in |- *; inversion_clear Hx; inversion_clear Hy; split. + apply leEq_transitive with x; auto. + apply less_leEq; apply a_lft; auto. + apply leEq_transitive with y; auto. + apply less_leEq; apply less_transitive_unfolded with y1; unfold y1 in |- *; + [ apply lft_rht | apply rht_b ]; auto. Qed. (* end hide *) -Record IVT'_aux_seq_type : Type := +Record IVT'_aux_seq_type : Type := {IVT'seq1 : IR; IVT'seq2 : IR; IVT'H1 : I IVT'seq1; @@ -137,24 +136,25 @@ Record IVT'_aux_seq_type : Type := IVT'z2 : z [<] F IVT'seq2 (incF _ IVT'H2)}. Definition IVT'_iter : IVT'_aux_seq_type -> IVT'_aux_seq_type. -intro Haux; elim Haux; intros. -elim - (IVT'_seq_lemma (pairT IVT'seq3 IVT'seq4) (pairT IVT'H3 IVT'H4) IVT'prf0 - (CAnd_intro _ _ IVT'z3 IVT'z4)). -intro x; elim x; simpl in |- *; clear x; intros. -elim p. -intro x; elim x; simpl in |- *; clear x; intros. -inversion_clear p0. -inversion_clear X0. -inversion_clear q. -inversion_clear H0. -apply Build_IVT'_aux_seq_type with a0 b0 a1 b1; auto. +Proof. + intro Haux; elim Haux; intros. + elim (IVT'_seq_lemma (pairT IVT'seq3 IVT'seq4) (pairT IVT'H3 IVT'H4) IVT'prf0 + (CAnd_intro _ _ IVT'z3 IVT'z4)). + intro x; elim x; simpl in |- *; clear x; intros. + elim p. + intro x; elim x; simpl in |- *; clear x; intros. + inversion_clear p0. + inversion_clear X0. + inversion_clear q. + inversion_clear H0. + apply Build_IVT'_aux_seq_type with a0 b0 a1 b1; auto. Defined. Definition IVT'_seq : nat -> IVT'_aux_seq_type. -intro n; induction n as [| n Hrecn]. -apply Build_IVT'_aux_seq_type with a b Ha Hb; auto. -apply (IVT'_iter Hrecn). +Proof. + intro n; induction n as [| n Hrecn]. + apply Build_IVT'_aux_seq_type with a b Ha Hb; auto. + apply (IVT'_iter Hrecn). Defined. Definition a'_seq n := IVT'seq1 (IVT'_seq n). @@ -164,178 +164,186 @@ Definition a'_seq_I n : I (a'_seq n) := IVT'H1 (IVT'_seq n). Definition b'_seq_I n : I (b'_seq n) := IVT'H2 (IVT'_seq n). Lemma a'_seq_less_b'_seq : forall n, a'_seq n [<] b'_seq n. -exact (fun n => IVT'prf (IVT'_seq n)). +Proof. + exact (fun n => IVT'prf (IVT'_seq n)). Qed. Lemma a'_seq_less_z : forall n, F _ (incF _ (a'_seq_I n)) [<] z. -exact (fun n => IVT'z1 (IVT'_seq n)). +Proof. + exact (fun n => IVT'z1 (IVT'_seq n)). Qed. Lemma z_less_b'_seq : forall n, z [<] F _ (incF _ (b'_seq_I n)). -exact (fun n => IVT'z2 (IVT'_seq n)). +Proof. + exact (fun n => IVT'z2 (IVT'_seq n)). Qed. Lemma a'_seq_mon : forall i : nat, a'_seq i [<=] a'_seq (S i). -intro. -unfold a'_seq in |- *. -simpl in |- *. -elim (IVT'_seq i); simpl in |- *; intros. -elim IVT'_seq_lemma; simpl in |- *; intro. -elim x; simpl in |- *; clear x; intros. -elim p; clear p; intro. -elim x; simpl in |- *; clear x; intros. -case q; clear q; simpl in |- *; intros. -case a2; clear a2; simpl in |- *; intros. -elim p; clear p; simpl in |- *; intros. -elim b2; clear b2; simpl in |- *; auto. +Proof. + intro. + unfold a'_seq in |- *. + simpl in |- *. + elim (IVT'_seq i); simpl in |- *; intros. + elim IVT'_seq_lemma; simpl in |- *; intro. + elim x; simpl in |- *; clear x; intros. + elim p; clear p; intro. + elim x; simpl in |- *; clear x; intros. + case q; clear q; simpl in |- *; intros. + case a2; clear a2; simpl in |- *; intros. + elim p; clear p; simpl in |- *; intros. + elim b2; clear b2; simpl in |- *; auto. Qed. Lemma b'_seq_mon : forall i : nat, b'_seq (S i) [<=] b'_seq i. -intro. -unfold b'_seq in |- *. -simpl in |- *. -elim (IVT'_seq i); simpl in |- *; intros. -elim IVT'_seq_lemma; simpl in |- *; intro. -elim x; simpl in |- *; clear x; intros. -elim p; clear p; intro. -elim x; simpl in |- *; clear x; intros. -case q; clear q; simpl in |- *; intros. -case a2; clear a2; simpl in |- *; intros. -elim p; clear p; simpl in |- *; intros. -elim b2; clear b2; simpl in |- *; auto. +Proof. + intro. + unfold b'_seq in |- *. + simpl in |- *. + elim (IVT'_seq i); simpl in |- *; intros. + elim IVT'_seq_lemma; simpl in |- *; intro. + elim x; simpl in |- *; clear x; intros. + elim p; clear p; intro. + elim x; simpl in |- *; clear x; intros. + case q; clear q; simpl in |- *; intros. + case a2; clear a2; simpl in |- *; intros. + elim p; clear p; simpl in |- *; intros. + elim b2; clear b2; simpl in |- *; auto. Qed. Lemma a'_seq_b'_seq_dist_n : forall n, b'_seq (S n) [-]a'_seq (S n) [=] Two [/]ThreeNZ[*] (b'_seq n[-]a'_seq n). -intro. -unfold a'_seq, b'_seq in |- *. -simpl in |- *. -elim (IVT'_seq n); simpl in |- *; intros. -elim IVT'_seq_lemma; simpl in |- *; intro. -elim x; simpl in |- *; clear x; intros. -elim p; clear p; intro. -elim x; simpl in |- *; clear x; intros. -case q; clear q; simpl in |- *; intros. -case a2; clear a2; simpl in |- *; intros. -elim p; clear p; simpl in |- *; intros. -elim b2; clear b2; simpl in |- *; auto. +Proof. + intro. + unfold a'_seq, b'_seq in |- *. + simpl in |- *. + elim (IVT'_seq n); simpl in |- *; intros. + elim IVT'_seq_lemma; simpl in |- *; intro. + elim x; simpl in |- *; clear x; intros. + elim p; clear p; intro. + elim x; simpl in |- *; clear x; intros. + case q; clear q; simpl in |- *; intros. + case a2; clear a2; simpl in |- *; intros. + elim p; clear p; simpl in |- *; intros. + elim b2; clear b2; simpl in |- *; auto. Qed. Lemma a'_seq_b'_seq_dist : forall n, b'_seq n[-]a'_seq n [=] (Two [/]ThreeNZ) [^]n[*] (b[-]a). -simple induction n. -simpl in |- *; algebra. -clear n; intros. -astepr (Two [/]ThreeNZ[*] (Two [/]ThreeNZ) [^]n[*] (b[-]a)). -astepr (Two [/]ThreeNZ[*] ((Two [/]ThreeNZ) [^]n[*] (b[-]a))). -astepr (Two [/]ThreeNZ[*] (b'_seq n[-]a'_seq n)). -apply a'_seq_b'_seq_dist_n. +Proof. + simple induction n. + simpl in |- *; algebra. + clear n; intros. + astepr (Two [/]ThreeNZ[*] (Two [/]ThreeNZ) [^]n[*] (b[-]a)). + astepr (Two [/]ThreeNZ[*] ((Two [/]ThreeNZ) [^]n[*] (b[-]a))). + astepr (Two [/]ThreeNZ[*] (b'_seq n[-]a'_seq n)). + apply a'_seq_b'_seq_dist_n. Qed. Lemma a'_seq_Cauchy : Cauchy_prop a'_seq. -intros e H. -elim (intervals_small' a b e H); intros i Hi. -exists i; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_transitive. -2: apply Hi. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (a'_seq i). -2: apply local_mon'_imp_mon'; auto; exact a'_seq_mon. -eapply leEq_wdr. -2: apply a'_seq_b'_seq_dist. -apply minus_resp_leEq. -apply less_leEq; apply a_b'. -exact a'_seq_mon. -exact b'_seq_mon. -exact a'_seq_less_b'_seq. +Proof. + intros e H. + elim (intervals_small' a b e H); intros i Hi. + exists i; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_transitive. + 2: apply Hi. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (a'_seq i). + 2: apply local_mon'_imp_mon'; auto; exact a'_seq_mon. + eapply leEq_wdr. + 2: apply a'_seq_b'_seq_dist. + apply minus_resp_leEq. + apply less_leEq; apply a_b'. + exact a'_seq_mon. + exact b'_seq_mon. + exact a'_seq_less_b'_seq. Qed. Lemma b'_seq_Cauchy : Cauchy_prop b'_seq. -intros e H. -elim (intervals_small' a b e H); intros i Hi. -exists i; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_transitive. -2: apply Hi. -eapply leEq_wdl. -2: apply AbsIR_minus. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (b'_seq m). -2: astepl ( [--][--] (b'_seq m)); astepr ( [--][--] (b'_seq i)). -2: apply inv_resp_leEq; - apply local_mon'_imp_mon' with (f := fun n => [--] (b'_seq n)); - auto. -2: intro; apply inv_resp_leEq; apply b'_seq_mon. -eapply leEq_wdr. -2: apply a'_seq_b'_seq_dist. -unfold cg_minus in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq. -apply less_leEq; apply a_b'. -exact a'_seq_mon. -exact b'_seq_mon. -exact a'_seq_less_b'_seq. +Proof. + intros e H. + elim (intervals_small' a b e H); intros i Hi. + exists i; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_transitive. + 2: apply Hi. + eapply leEq_wdl. + 2: apply AbsIR_minus. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (b'_seq m). + 2: astepl ( [--][--] (b'_seq m)); astepr ( [--][--] (b'_seq i)). + 2: apply inv_resp_leEq; apply local_mon'_imp_mon' with (f := fun n => [--] (b'_seq n)); auto. + 2: intro; apply inv_resp_leEq; apply b'_seq_mon. + eapply leEq_wdr. + 2: apply a'_seq_b'_seq_dist. + unfold cg_minus in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq. + apply less_leEq; apply a_b'. + exact a'_seq_mon. + exact b'_seq_mon. + exact a'_seq_less_b'_seq. Qed. Let xa := Lim (Build_CauchySeq _ _ a'_seq_Cauchy). Let xb := Lim (Build_CauchySeq _ _ b'_seq_Cauchy). Lemma a'_seq_b'_seq_lim : xa [=] xb. -unfold xa, xb in |- *; clear xa xb. -apply cg_inv_unique_2. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -2: apply Lim_minus. -simpl in |- *. -apply Limits_unique. -simpl in |- *. -intros eps H. -elim (intervals_small' a b eps H); intros i Hi. -exists i; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_transitive. -2: apply Hi. -eapply leEq_wdl. -2: apply AbsIR_minus. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (a'_seq m[-]b'_seq m). -2: apply shift_minus_leEq; astepr (b'_seq m). -2: apply less_leEq; apply a'_seq_less_b'_seq. -eapply leEq_wdr. -2: apply a'_seq_b'_seq_dist. -rstepl (b'_seq m[-]a'_seq m). -unfold cg_minus in |- *; apply plus_resp_leEq_both. -astepl ( [--][--] (b'_seq m)); astepr ( [--][--] (b'_seq i)). -apply inv_resp_leEq; - apply local_mon'_imp_mon' with (f := fun n => [--] (b'_seq n)); - auto. -intro; apply inv_resp_leEq; apply b'_seq_mon. -apply inv_resp_leEq; apply local_mon'_imp_mon'; auto; exact a'_seq_mon. +Proof. + unfold xa, xb in |- *; clear xa xb. + apply cg_inv_unique_2. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + 2: apply Lim_minus. + simpl in |- *. + apply Limits_unique. + simpl in |- *. + intros eps H. + elim (intervals_small' a b eps H); intros i Hi. + exists i; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_transitive. + 2: apply Hi. + eapply leEq_wdl. + 2: apply AbsIR_minus. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (a'_seq m[-]b'_seq m). + 2: apply shift_minus_leEq; astepr (b'_seq m). + 2: apply less_leEq; apply a'_seq_less_b'_seq. + eapply leEq_wdr. + 2: apply a'_seq_b'_seq_dist. + rstepl (b'_seq m[-]a'_seq m). + unfold cg_minus in |- *; apply plus_resp_leEq_both. + astepl ( [--][--] (b'_seq m)); astepr ( [--][--] (b'_seq i)). + apply inv_resp_leEq; apply local_mon'_imp_mon' with (f := fun n => [--] (b'_seq n)); auto. + intro; apply inv_resp_leEq; apply b'_seq_mon. + apply inv_resp_leEq; apply local_mon'_imp_mon'; auto; exact a'_seq_mon. Qed. Lemma xa'_in_interval : I xa. -split. -unfold xa in |- *. -apply leEq_seq_so_leEq_Lim. -simpl in |- *. -intro; elim (a'_seq_I i); auto. -unfold xa in |- *. -apply seq_leEq_so_Lim_leEq. -simpl in |- *. -intro; elim (a'_seq_I i); auto. +Proof. + split. + unfold xa in |- *. + apply leEq_seq_so_leEq_Lim. + simpl in |- *. + intro; elim (a'_seq_I i); auto. + unfold xa in |- *. + apply seq_leEq_so_Lim_leEq. + simpl in |- *. + intro; elim (a'_seq_I i); auto. Qed. Lemma IVT'_I : {x : IR | I' x | forall Hx, F x Hx [=] z}. -elim (IVT_I a b Hab' Hab F contF) with z; try apply less_leEq; auto. -intros x H H0. -exists x; auto. -elim H; intros; split; apply leEq_not_eq; auto. -apply pfstrx with F (incF _ Ha) (incF _ H). -apply less_imp_ap; astepr z; auto. -apply pfstrx with F (incF _ H) (incF _ Hb). -apply less_imp_ap; astepl z; auto. +Proof. + elim (IVT_I a b Hab' Hab F contF) with z; try apply less_leEq; auto. + intros x H H0. + exists x; auto. + elim H; intros; split; apply leEq_not_eq; auto. + apply pfstrx with F (incF _ Ha) (incF _ H). + apply less_imp_ap; astepr z; auto. + apply pfstrx with F (incF _ H) (incF _ Hb). + apply less_imp_ap; astepl z; auto. Qed. End IVT'. @@ -350,112 +358,109 @@ theorem to more widely applicable forms. Lemma Weak_IVT : forall I F, Continuous I F -> forall a b Ha Hb (HFab : F a Ha [<] F b Hb), I a -> I b -> forall e, Zero [<] e -> forall y, Compact (less_leEq _ _ _ HFab) y -> {x : IR | Compact (Min_leEq_Max a b) x | forall Hx, AbsIR (F x Hx[-]y) [<=] e}. -intros I F H a b Ha Hb HFab H0 H1 e H2 y H3. -set (H5 := less_imp_ap _ _ _ HFab) in *. -set (H6 := pfstrx _ _ _ _ _ _ H5) in *. -elim (ap_imp_less _ _ _ H6); clear H6 H5; intro. -cut (Continuous_I (Min_leEq_Max a b) F). intro H4. -2: apply included_imp_Continuous with I; auto; apply included_interval; auto. -set (incF := contin_imp_inc _ _ _ _ H4) in *. -cut (Min a b [=] a). -cut (Max a b [=] b); intros. -2: apply leEq_imp_Max_is_rht; apply less_leEq; auto. -2: apply leEq_imp_Min_is_lft; apply less_leEq; auto. -set (Ha' := incF _ (compact_inc_lft _ _ (Min_leEq_Max a b))) in *. -set (Hb' := incF _ (compact_inc_rht _ _ (Min_leEq_Max a b))) in *. -cut (F _ Ha' [<] F _ Hb'). intro H7. -apply Weak_IVT_ap_lft with (HFab := H7); auto. -apply compact_wd' with (Hab := less_leEq _ _ _ HFab); algebra. -astepl (F a Ha); astepr (F b Hb); auto. -cut (Continuous_I (Min_leEq_Max b a) F). intro H4. -2: apply included_imp_Continuous with I; auto; apply included_interval; auto. -set (incF := contin_imp_inc _ _ _ _ H4) in *. -cut (Min a b [=] b). -cut (Max a b [=] a); intros. -2: eapply eq_transitive_unfolded; - [ apply Max_comm | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. -2: eapply eq_transitive_unfolded; +Proof. + intros I F H a b Ha Hb HFab H0 H1 e H2 y H3. + set (H5 := less_imp_ap _ _ _ HFab) in *. + set (H6 := pfstrx _ _ _ _ _ _ H5) in *. + elim (ap_imp_less _ _ _ H6); clear H6 H5; intro. + cut (Continuous_I (Min_leEq_Max a b) F). intro H4. + 2: apply included_imp_Continuous with I; auto; apply included_interval; auto. + set (incF := contin_imp_inc _ _ _ _ H4) in *. + cut (Min a b [=] a). + cut (Max a b [=] b); intros. + 2: apply leEq_imp_Max_is_rht; apply less_leEq; auto. + 2: apply leEq_imp_Min_is_lft; apply less_leEq; auto. + set (Ha' := incF _ (compact_inc_lft _ _ (Min_leEq_Max a b))) in *. + set (Hb' := incF _ (compact_inc_rht _ _ (Min_leEq_Max a b))) in *. + cut (F _ Ha' [<] F _ Hb'). intro H7. + apply Weak_IVT_ap_lft with (HFab := H7); auto. + apply compact_wd' with (Hab := less_leEq _ _ _ HFab); algebra. + astepl (F a Ha); astepr (F b Hb); auto. + cut (Continuous_I (Min_leEq_Max b a) F). intro H4. + 2: apply included_imp_Continuous with I; auto; apply included_interval; auto. + set (incF := contin_imp_inc _ _ _ _ H4) in *. + cut (Min a b [=] b). + cut (Max a b [=] a); intros. + 2: eapply eq_transitive_unfolded; + [ apply Max_comm | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. + 2: eapply eq_transitive_unfolded; [ apply Min_comm | apply leEq_imp_Min_is_lft; apply less_leEq; auto ]. -set (Ha' := incF _ (compact_inc_lft _ _ (Min_leEq_Max b a))) in *. -set (Hb' := incF _ (compact_inc_rht _ _ (Min_leEq_Max b a))) in *. -cut (F _ Hb' [<] F _ Ha'). intro H7. -elim (Weak_IVT_ap_rht _ _ _ _ H4 _ _ H7 _ H2 y); auto. -intro x; intros. -exists x; auto. -apply compact_wd' with (Hab := Min_leEq_Max b a); - [ apply Min_comm | apply Max_comm | auto ]. -apply compact_wd' with (Hab := less_leEq _ _ _ HFab); algebra. -apply pfwdef; astepl (Max a b); apply Max_comm. -apply pfwdef; astepl (Min a b); apply Min_comm. -apply less_wdl with (F a Ha). -apply less_wdr with (F b Hb). -auto. -apply pfwdef; astepl (Min a b); apply Min_comm. -apply pfwdef; astepl (Max a b); apply Max_comm. + set (Ha' := incF _ (compact_inc_lft _ _ (Min_leEq_Max b a))) in *. + set (Hb' := incF _ (compact_inc_rht _ _ (Min_leEq_Max b a))) in *. + cut (F _ Hb' [<] F _ Ha'). intro H7. + elim (Weak_IVT_ap_rht _ _ _ _ H4 _ _ H7 _ H2 y); auto. + intro x; intros. + exists x; auto. + apply compact_wd' with (Hab := Min_leEq_Max b a); [ apply Min_comm | apply Max_comm | auto ]. + apply compact_wd' with (Hab := less_leEq _ _ _ HFab); algebra. + apply pfwdef; astepl (Max a b); apply Max_comm. + apply pfwdef; astepl (Min a b); apply Min_comm. + apply less_wdl with (F a Ha). + apply less_wdr with (F b Hb). + auto. + apply pfwdef; astepl (Min a b); apply Min_comm. + apply pfwdef; astepl (Max a b); apply Max_comm. Qed. Lemma IVT_inc : forall I F, Continuous I F -> forall a b Ha Hb, F a Ha [#] F b Hb -> I a -> I b -> (forall x y, I x -> I y -> x [<] y -> forall Hx Hy, F x Hx [<] F y Hy) -> forall y, Compact (Min_leEq_Max (F a Ha) (F b Hb)) y -> {x : IR | Compact (Min_leEq_Max a b) x | forall Hx, F x Hx [=] y}. -intros I F H a b Ha Hb H0 H1 H2 H3 y H4. -set (H5 := pfstrx _ _ _ _ _ _ H0) in *. -elim (ap_imp_less _ _ _ H5); clear H5; intro. -cut (Continuous_I (Min_leEq_Max a b) F). intro H5. -2: apply included_imp_Continuous with I; auto; apply included_interval; auto. -cut (Min a b [=] a); - [ intro | apply leEq_imp_Min_is_lft; apply less_leEq; auto ]. -cut (Max a b [=] b); - [ intro | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. -cut (forall H H', F (Min a b) H [<] F (Max a b) H'); intros. -2: apply H3; auto. -2: apply iprop_wd with a; algebra. -2: apply iprop_wd with b; algebra. -2: astepl a; astepr b; auto. -elim H4; intros. -apply IVT_I with H5. -apply ap_imp_Min_less_Max; apply less_imp_ap; auto. -intros. -apply H3; auto. -apply (included_interval _ _ _ H1 H2 (Min_leEq_Max a b)); auto. -apply (included_interval _ _ _ H1 H2 (Min_leEq_Max a b)); auto. -eapply leEq_wdl. -apply a1. -astepr (F a Ha); apply leEq_imp_Min_is_lft; apply less_leEq; auto. -eapply leEq_wdr. -apply b0. -astepr (F b Hb); apply leEq_imp_Max_is_rht; apply less_leEq; auto. -cut (Continuous_I (Min_leEq_Max b a) F). intro H5. -2: apply included_imp_Continuous with I; auto; apply included_interval; auto. -cut (Min b a [=] b); - [ intro | apply leEq_imp_Min_is_lft; apply less_leEq; auto ]. -cut (Max b a [=] a); - [ intro | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. -cut (forall H H', F (Min b a) H [<] F (Max b a) H'). intro H8. -2: apply H3; auto. -2: apply iprop_wd with b; algebra. -2: apply iprop_wd with a; algebra. -2: astepl b; astepr a; auto. -elim H4; intros. -elim IVT_I with (contF := H5) (z := y); intros; auto. -exists x; auto. -apply compact_wd' with (Hab := Min_leEq_Max b a); auto. -apply Min_comm. -apply Max_comm. -astepl b; astepr a; auto. -apply H3; auto. -apply (included_interval _ _ _ H2 H1 (Min_leEq_Max b a)); auto. -apply (included_interval _ _ _ H2 H1 (Min_leEq_Max b a)); auto. -eapply leEq_wdl. -apply a0. -astepr (F b Hb); eapply eq_transitive_unfolded. -apply Min_comm. -apply leEq_imp_Min_is_lft; apply less_leEq; auto. -eapply leEq_wdr. -apply b1. -astepr (F a Ha); eapply eq_transitive_unfolded. -apply Max_comm. -apply leEq_imp_Max_is_rht; apply less_leEq; auto. +Proof. + intros I F H a b Ha Hb H0 H1 H2 H3 y H4. + set (H5 := pfstrx _ _ _ _ _ _ H0) in *. + elim (ap_imp_less _ _ _ H5); clear H5; intro. + cut (Continuous_I (Min_leEq_Max a b) F). intro H5. + 2: apply included_imp_Continuous with I; auto; apply included_interval; auto. + cut (Min a b [=] a); [ intro | apply leEq_imp_Min_is_lft; apply less_leEq; auto ]. + cut (Max a b [=] b); [ intro | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. + cut (forall H H', F (Min a b) H [<] F (Max a b) H'); intros. + 2: apply H3; auto. + 2: apply iprop_wd with a; algebra. + 2: apply iprop_wd with b; algebra. + 2: astepl a; astepr b; auto. + elim H4; intros. + apply IVT_I with H5. + apply ap_imp_Min_less_Max; apply less_imp_ap; auto. + intros. + apply H3; auto. + apply (included_interval _ _ _ H1 H2 (Min_leEq_Max a b)); auto. + apply (included_interval _ _ _ H1 H2 (Min_leEq_Max a b)); auto. + eapply leEq_wdl. + apply a1. + astepr (F a Ha); apply leEq_imp_Min_is_lft; apply less_leEq; auto. + eapply leEq_wdr. + apply b0. + astepr (F b Hb); apply leEq_imp_Max_is_rht; apply less_leEq; auto. + cut (Continuous_I (Min_leEq_Max b a) F). intro H5. + 2: apply included_imp_Continuous with I; auto; apply included_interval; auto. + cut (Min b a [=] b); [ intro | apply leEq_imp_Min_is_lft; apply less_leEq; auto ]. + cut (Max b a [=] a); [ intro | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. + cut (forall H H', F (Min b a) H [<] F (Max b a) H'). intro H8. + 2: apply H3; auto. + 2: apply iprop_wd with b; algebra. + 2: apply iprop_wd with a; algebra. + 2: astepl b; astepr a; auto. + elim H4; intros. + elim IVT_I with (contF := H5) (z := y); intros; auto. + exists x; auto. + apply compact_wd' with (Hab := Min_leEq_Max b a); auto. + apply Min_comm. + apply Max_comm. + astepl b; astepr a; auto. + apply H3; auto. + apply (included_interval _ _ _ H2 H1 (Min_leEq_Max b a)); auto. + apply (included_interval _ _ _ H2 H1 (Min_leEq_Max b a)); auto. + eapply leEq_wdl. + apply a0. + astepr (F b Hb); eapply eq_transitive_unfolded. + apply Min_comm. + apply leEq_imp_Min_is_lft; apply less_leEq; auto. + eapply leEq_wdr. + apply b1. + astepr (F a Ha); eapply eq_transitive_unfolded. + apply Max_comm. + apply leEq_imp_Max_is_rht; apply less_leEq; auto. Qed. Transparent Min. @@ -464,97 +469,86 @@ Lemma IVT_dec : forall I F, Continuous I F -> forall a b Ha Hb, F a Ha [#] F b H I a -> I b -> (forall x y, I x -> I y -> x [<] y -> forall Hx Hy, F y Hy [<] F x Hx) -> forall y, Compact (Min_leEq_Max (F a Ha) (F b Hb)) y -> {x : IR | Compact (Min_leEq_Max a b) x | forall Hx, F x Hx [=] y}. -intros. try rename X4 into H. -elim - IVT_inc - with - (I := I) - (F := {--}F) - (a := a) - (b := b) - (y := [--]y) - (Ha := Ha) - (Hb := Hb); auto. -intros x H5 H6. -exists x; auto. -intro. -astepl ( [--][--] (F x Hx)); astepr ( [--][--]y). -apply un_op_wd_unfolded; simpl in H6; apply H6. -Contin. -simpl in |- *; apply un_op_strext_unfolded with (cg_inv (c:=IR)). -astepl (F a Ha); astepr (F b Hb); auto. -intros; simpl in |- *; apply inv_resp_less; auto. -inversion_clear H as (H0,H1); split; simpl in |- *; unfold MIN. -apply inv_resp_leEq. -eapply leEq_wdr. -apply H1. -apply Max_wd_unfolded; algebra. -astepr ( [--][--] (Max [--] (F a Ha) [--] (F b Hb))). -apply inv_resp_leEq; auto. +Proof. + intros. try rename X4 into H. + elim IVT_inc with (I := I) (F := {--}F) (a := a) (b := b) (y := [--]y) (Ha := Ha) (Hb := Hb); auto. + intros x H5 H6. + exists x; auto. + intro. + astepl ( [--][--] (F x Hx)); astepr ( [--][--]y). + apply un_op_wd_unfolded; simpl in H6; apply H6. + Contin. + simpl in |- *; apply un_op_strext_unfolded with (cg_inv (c:=IR)). + astepl (F a Ha); astepr (F b Hb); auto. + intros; simpl in |- *; apply inv_resp_less; auto. + inversion_clear H as (H0,H1); split; simpl in |- *; unfold MIN. + apply inv_resp_leEq. + eapply leEq_wdr. + apply H1. + apply Max_wd_unfolded; algebra. + astepr ( [--][--] (Max [--] (F a Ha) [--] (F b Hb))). + apply inv_resp_leEq; auto. Qed. Lemma IVT'_inc : forall I F, Continuous I F -> forall a b Ha Hb, F a Ha [#] F b Hb -> I a -> I b -> (forall x y, I x -> I y -> x [<] y -> forall Hx Hy, F x Hx [<] F y Hy) -> forall y, olor (Min (F a Ha) (F b Hb)) (Max (F a Ha) (F b Hb)) y -> {x : IR | olor (Min a b) (Max a b) x | forall Hx, F x Hx [=] y}. -intros I F H a b Ha Hb H0 H1 H2 H3 y H4. -set (H5 := pfstrx _ _ _ _ _ _ H0) in *. -elim (ap_imp_less _ _ _ H5); clear H5; intro. -cut (Continuous_I (Min_leEq_Max a b) F). intro H5. -2: apply included_imp_Continuous with I; auto; apply included_interval; auto. -cut (Min a b [=] a); - [ intro | apply leEq_imp_Min_is_lft; apply less_leEq; auto ]. -cut (Max a b [=] b); - [ intro | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. -cut (forall H H', F (Min a b) H [<] F (Max a b) H'). intro H8. -2: apply H3; auto. -2: apply iprop_wd with a; algebra. -2: apply iprop_wd with b; algebra. -2: astepl a; astepr b; auto. -elim H4; intros. -apply IVT'_I with (Min_leEq_Max a b) H5. -apply ap_imp_Min_less_Max; apply less_imp_ap; auto. -intros. -apply H3; auto. -apply (included_interval _ _ _ H1 H2 (Min_leEq_Max a b)); auto. -apply (included_interval _ _ _ H1 H2 (Min_leEq_Max a b)); auto. -eapply less_wdl. -apply a1. -astepr (F a Ha); apply leEq_imp_Min_is_lft; apply less_leEq; auto. -eapply less_wdr. -apply b0. -astepr (F b Hb); apply leEq_imp_Max_is_rht; apply less_leEq; auto. -cut (Continuous_I (Min_leEq_Max b a) F). intro H5. -2: apply included_imp_Continuous with I; auto; apply included_interval; auto. -cut (Min b a [=] b); - [ intro | apply leEq_imp_Min_is_lft; apply less_leEq; auto ]. -cut (Max b a [=] a); - [ intro | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. -cut (forall H H', F (Min b a) H [<] F (Max b a) H'). intro H8. -2: apply H3; auto. -2: apply iprop_wd with b; algebra. -2: apply iprop_wd with a; algebra. -2: astepl b; astepr a; auto. -elim H4; intros. -elim IVT'_I with (contF := H5) (z := y); auto. -intros x H9 H10; exists x; auto. -elim H9; clear H9; intros H11 H12; split. -eapply less_wdl; [ apply H11 | apply Min_comm ]. -eapply less_wdr; [ apply H12 | apply Max_comm ]. -apply ap_imp_Min_less_Max; apply less_imp_ap; auto. -intros; apply H3; auto. -apply (included_interval _ _ _ H2 H1 (Min_leEq_Max b a)); auto. -apply (included_interval _ _ _ H2 H1 (Min_leEq_Max b a)); auto. -eapply less_wdl. -apply a0. -astepr (F b Hb); eapply eq_transitive_unfolded. -apply Min_comm. -apply leEq_imp_Min_is_lft; apply less_leEq; auto. -eapply less_wdr. -apply b1. -astepr (F a Ha); eapply eq_transitive_unfolded. -apply Max_comm. -apply leEq_imp_Max_is_rht; apply less_leEq; auto. +Proof. + intros I F H a b Ha Hb H0 H1 H2 H3 y H4. + set (H5 := pfstrx _ _ _ _ _ _ H0) in *. + elim (ap_imp_less _ _ _ H5); clear H5; intro. + cut (Continuous_I (Min_leEq_Max a b) F). intro H5. + 2: apply included_imp_Continuous with I; auto; apply included_interval; auto. + cut (Min a b [=] a); [ intro | apply leEq_imp_Min_is_lft; apply less_leEq; auto ]. + cut (Max a b [=] b); [ intro | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. + cut (forall H H', F (Min a b) H [<] F (Max a b) H'). intro H8. + 2: apply H3; auto. + 2: apply iprop_wd with a; algebra. + 2: apply iprop_wd with b; algebra. + 2: astepl a; astepr b; auto. + elim H4; intros. + apply IVT'_I with (Min_leEq_Max a b) H5. + apply ap_imp_Min_less_Max; apply less_imp_ap; auto. + intros. + apply H3; auto. + apply (included_interval _ _ _ H1 H2 (Min_leEq_Max a b)); auto. + apply (included_interval _ _ _ H1 H2 (Min_leEq_Max a b)); auto. + eapply less_wdl. + apply a1. + astepr (F a Ha); apply leEq_imp_Min_is_lft; apply less_leEq; auto. + eapply less_wdr. + apply b0. + astepr (F b Hb); apply leEq_imp_Max_is_rht; apply less_leEq; auto. + cut (Continuous_I (Min_leEq_Max b a) F). intro H5. + 2: apply included_imp_Continuous with I; auto; apply included_interval; auto. + cut (Min b a [=] b); [ intro | apply leEq_imp_Min_is_lft; apply less_leEq; auto ]. + cut (Max b a [=] a); [ intro | apply leEq_imp_Max_is_rht; apply less_leEq; auto ]. + cut (forall H H', F (Min b a) H [<] F (Max b a) H'). intro H8. + 2: apply H3; auto. + 2: apply iprop_wd with b; algebra. + 2: apply iprop_wd with a; algebra. + 2: astepl b; astepr a; auto. + elim H4; intros. + elim IVT'_I with (contF := H5) (z := y); auto. + intros x H9 H10; exists x; auto. + elim H9; clear H9; intros H11 H12; split. + eapply less_wdl; [ apply H11 | apply Min_comm ]. + eapply less_wdr; [ apply H12 | apply Max_comm ]. + apply ap_imp_Min_less_Max; apply less_imp_ap; auto. + intros; apply H3; auto. + apply (included_interval _ _ _ H2 H1 (Min_leEq_Max b a)); auto. + apply (included_interval _ _ _ H2 H1 (Min_leEq_Max b a)); auto. + eapply less_wdl. + apply a0. + astepr (F b Hb); eapply eq_transitive_unfolded. + apply Min_comm. + apply leEq_imp_Min_is_lft; apply less_leEq; auto. + eapply less_wdr. + apply b1. + astepr (F a Ha); eapply eq_transitive_unfolded. + apply Max_comm. + apply leEq_imp_Max_is_rht; apply less_leEq; auto. Qed. Transparent Min. @@ -563,31 +557,23 @@ Lemma IVT'_dec : forall I F, Continuous I F -> forall a b Ha Hb, F a Ha [#] F b I a -> I b -> (forall x y, I x -> I y -> x [<] y -> forall Hx Hy, F y Hy [<] F x Hx) -> forall y, olor (Min (F a Ha) (F b Hb)) (Max (F a Ha) (F b Hb)) y -> {x : IR | olor (Min a b) (Max a b) x | forall Hx, F x Hx [=] y}. -intros. -elim - IVT'_inc - with - (I := I) - (F := {--}F) - (a := a) - (b := b) - (y := [--]y) - (Ha := Ha) - (Hb := Hb); auto. -intros x H5 H6. -exists x; auto. -intro. -astepl ( [--][--] (F x Hx)); astepr ( [--][--]y). -apply un_op_wd_unfolded; simpl in H6; apply H6. -Contin. -simpl in |- *; apply un_op_strext_unfolded with (cg_inv (c:=IR)). -astepl (F a Ha); astepr (F b Hb); auto. -intros; simpl in |- *; apply inv_resp_less; auto. -inversion_clear X4; split; simpl in |- *; unfold MIN. -apply inv_resp_less. -eapply less_wdr. -apply X6. -apply Max_wd_unfolded; algebra. -astepr ( [--][--] (Max [--] (F a Ha) [--] (F b Hb))). -apply inv_resp_less; auto. +Proof. + intros. + elim IVT'_inc with (I := I) (F := {--}F) (a := a) (b := b) (y := [--]y) (Ha := Ha) (Hb := Hb); auto. + intros x H5 H6. + exists x; auto. + intro. + astepl ( [--][--] (F x Hx)); astepr ( [--][--]y). + apply un_op_wd_unfolded; simpl in H6; apply H6. + Contin. + simpl in |- *; apply un_op_strext_unfolded with (cg_inv (c:=IR)). + astepl (F a Ha); astepr (F b Hb); auto. + intros; simpl in |- *; apply inv_resp_less; auto. + inversion_clear X4; split; simpl in |- *; unfold MIN. + apply inv_resp_less. + eapply less_wdr. + apply X6. + apply Max_wd_unfolded; algebra. + astepr ( [--][--] (Max [--] (F a Ha) [--] (F b Hb))). + apply inv_resp_less; auto. Qed. diff --git a/ftc/Taylor.v b/ftc/Taylor.v index 284fc76ad..9c5e6ddec 100644 --- a/ftc/Taylor.v +++ b/ftc/Taylor.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export TaylorLemma. @@ -76,8 +76,9 @@ Definition Taylor_Seq' n Hf := FSumx _ (funct_i n Hf). (* begin hide *) Lemma TaylorB : forall n Hf, Dom (Taylor_Seq' n Hf) b. -repeat split. -apply FSumx_pred'; repeat split. +Proof. + repeat split. + apply FSumx_pred'; repeat split. Qed. (* end hide *) @@ -88,288 +89,218 @@ Definition Taylor_Rem n Hf := F b (Diffble_n_imp_inc _ _ _ _ Hf b Hb) [-] Lemma Taylor_Sumx_lemma : forall n x z y y', (forall H, y 0 H [=] z) -> (forall i H H', y' i H' [=] y (S i) H) -> x[-]Sumx (G:=IR) (n:=S n) y [=] x[-]z[-]Sumx (G:=IR) (n:=n) y'. -intro; induction n as [| n Hrecn]. -intros; simpl in |- *. -astepl (x[-] (Zero[+]z)). -rational. -intros. -astepl - (x[-] - (Sumx (fun i (l : i < S n) => y i (lt_S _ _ l)) [+] - y (S n) (lt_n_Sn (S n)))). -rstepl - (x[-]Sumx (fun i (l : i < S n) => y i (lt_S _ _ l)) [-] - y (S n) (lt_n_Sn (S n))). -astepr - (x[-]z[-] - (Sumx (fun i (l : i < n) => y' i (lt_S _ _ l)) [+]y' n (lt_n_Sn n))). -rstepr - (x[-]z[-]Sumx (fun i (l : i < n) => y' i (lt_S _ _ l)) [-] - y' n (lt_n_Sn n)). -algebra. +Proof. + intro; induction n as [| n Hrecn]. + intros; simpl in |- *. + astepl (x[-] (Zero[+]z)). + rational. + intros. + astepl (x[-] (Sumx (fun i (l : i < S n) => y i (lt_S _ _ l)) [+] y (S n) (lt_n_Sn (S n)))). + rstepl (x[-]Sumx (fun i (l : i < S n) => y i (lt_S _ _ l)) [-] y (S n) (lt_n_Sn (S n))). + astepr (x[-]z[-] (Sumx (fun i (l : i < n) => y' i (lt_S _ _ l)) [+]y' n (lt_n_Sn n))). + rstepr (x[-]z[-]Sumx (fun i (l : i < n) => y' i (lt_S _ _ l)) [-] y' n (lt_n_Sn n)). + algebra. Qed. Lemma Taylor_lemma_ap : forall n Hf Hf' Ha', Taylor_Rem n Hf'[-]deriv_Sn b n Hf a Ha'[*] (b[-]a) [#] Zero -> a [#] b. -intros. rename X into H. -set (Hpred := Diffble_n_imp_inc _ _ _ _ Hf') in *. -cut (Taylor_Rem n Hf'[-]Part _ _ Ha'[*] (b[-]a) [#] Zero[-]Zero). -2: astepr ZeroR; auto. -clear H; intros. rename X into H. -elim (cg_minus_strext _ _ _ _ _ H); clear H; intro H. -unfold Taylor_Rem, Taylor_Seq', funct_i in H. -cut - (Dom - (FSumx n - (fun i (Hi : i < n) => - [-C-] - (fi n Hf' (S i) (lt_n_S _ _ Hi) a Ha[/] _[//] - nring_fac_ap_zero IR (S i)) {*} (FId{-} [-C-]a) {^}S i)) b). -2: apply FSumx_pred'; repeat split. -intro H0. -cut (F b (Hpred b Hb) [-]F a (Hpred a Ha) [#] Zero or Part _ _ H0 [#] Zero). intro H1. -elim H1; clear H H1; intro H. -apply pfstrx with (Hx := Hpred a Ha) (Hy := Hpred b Hb). -apply ap_symmetric_unfolded; apply zero_minus_apart; auto. -cut - (ext_fun_seq' - (fun i (Hi : i < n) => - [-C-] +Proof. + intros. rename X into H. + set (Hpred := Diffble_n_imp_inc _ _ _ _ Hf') in *. + cut (Taylor_Rem n Hf'[-]Part _ _ Ha'[*] (b[-]a) [#] Zero[-]Zero). + 2: astepr ZeroR; auto. + clear H; intros. rename X into H. + elim (cg_minus_strext _ _ _ _ _ H); clear H; intro H. + unfold Taylor_Rem, Taylor_Seq', funct_i in H. + cut (Dom (FSumx n (fun i (Hi : i < n) => [-C-] (fi n Hf' (S i) (lt_n_S _ _ Hi) a Ha[/] _[//] + nring_fac_ap_zero IR (S i)) {*} (FId{-} [-C-]a) {^}S i)) b). + 2: apply FSumx_pred'; repeat split. + intro H0. + cut (F b (Hpred b Hb) [-]F a (Hpred a Ha) [#] Zero or Part _ _ H0 [#] Zero). intro H1. + elim H1; clear H H1; intro H. + apply pfstrx with (Hx := Hpred a Ha) (Hy := Hpred b Hb). + apply ap_symmetric_unfolded; apply zero_minus_apart; auto. + cut (ext_fun_seq' (fun i (Hi : i < n) => [-C-] (fi n Hf' (S i) (lt_n_S _ _ Hi) a Ha[/] _[//]nring_fac_ap_zero IR (S i)) {*} - (FId{-} [-C-]a) {^}S i)). -2: red in |- *; repeat split. -intro H1. -cut - (Sumx (fun i (Hi : i < n) => Part _ _ (FSumx_pred n _ H1 _ H0 i Hi)) [#] - Sumx (fun i (Hi : i < n) => Zero)). intro H2. -2: eapply ap_wdl_unfolded. -2: eapply ap_wdr_unfolded. -2: apply H. -2: apply eq_symmetric_unfolded; eapply eq_transitive_unfolded; - [ apply sumx_const | algebra ]. -2: exact (FSumx_char _ _ _ _ H1). -simpl in H2. -cut - (nat_less_n_fun - (fun i (Hi : i < n) => + (FId{-} [-C-]a) {^}S i)). + 2: red in |- *; repeat split. + intro H1. + cut (Sumx (fun i (Hi : i < n) => Part _ _ (FSumx_pred n _ H1 _ H0 i Hi)) [#] + Sumx (fun i (Hi : i < n) => Zero)). intro H2. + 2: eapply ap_wdl_unfolded. + 2: eapply ap_wdr_unfolded. + 2: apply H. + 2: apply eq_symmetric_unfolded; eapply eq_transitive_unfolded; [ apply sumx_const | algebra ]. + 2: exact (FSumx_char _ _ _ _ H1). + simpl in H2. + cut (nat_less_n_fun (fun i (Hi : i < n) => (fi n Hf' (S i) (lt_n_S _ _ Hi) a Ha[/] _[//]nring_fac_ap_zero IR (S i)) [*] - (nexp IR i (b[+][--]a) [*] (b[+][--]a)))); intros. -cut (nat_less_n_fun (fun i (Hi : i < n) => (Zero:IR))); intros. -elim (Sumx_strext _ _ _ _ H3 H4 H2); clear H H0 H1 H2 H3 H4; intros N HN. -elim HN; clear HN; intros HN H. -cut (b[+][--]a [#] Zero). intro H3. -2: eapply cring_mult_ap_zero_op; eapply cring_mult_ap_zero_op; apply H. -apply ap_symmetric_unfolded; apply zero_minus_apart; auto. -red in |- *; algebra. -red in |- *; do 3 intro. -rewrite H3; intros; unfold fi in |- *. -apply mult_wdl. -apply div_wd. -2: algebra. -apply Feq_imp_eq with I. -apply Derivative_n_unique with pI (S j) F; apply N_Deriv_lemma. -auto. -apply cg_minus_strext. -astepr ZeroR. -apply - ap_wdl_unfolded - with (Part _ _ (Hpred b Hb) [-]Part _ _ (TaylorB n Hf')); - auto. -unfold Taylor_Seq', funct_i in |- *. -cut - (ext_fun_seq' - (fun i Hi => - [-C-] (fi n Hf' i Hi a Ha[/] _[//]nring_fac_ap_zero IR i) {*} - (FId{-} [-C-]a) {^}i)). intro H1. -apply - eq_transitive_unfolded - with - (Part _ _ (Hpred b Hb) [-] - Sumx - (fun i Hi => - Part _ _ (FSumx_pred _ _ H1 b (TaylorB n Hf') i Hi))). -apply cg_minus_wd. -algebra. -exact (FSumx_char _ _ _ _ H1). -cut - (ext_fun_seq' - (fun i (Hi : i < n) => - [-C-] + (nexp IR i (b[+][--]a) [*] (b[+][--]a)))); intros. + cut (nat_less_n_fun (fun i (Hi : i < n) => (Zero:IR))); intros. + elim (Sumx_strext _ _ _ _ H3 H4 H2); clear H H0 H1 H2 H3 H4; intros N HN. + elim HN; clear HN; intros HN H. + cut (b[+][--]a [#] Zero). intro H3. + 2: eapply cring_mult_ap_zero_op; eapply cring_mult_ap_zero_op; apply H. + apply ap_symmetric_unfolded; apply zero_minus_apart; auto. + red in |- *; algebra. + red in |- *; do 3 intro. + rewrite H3; intros; unfold fi in |- *. + apply mult_wdl. + apply div_wd. + 2: algebra. + apply Feq_imp_eq with I. + apply Derivative_n_unique with pI (S j) F; apply N_Deriv_lemma. + auto. + apply cg_minus_strext. + astepr ZeroR. + apply ap_wdl_unfolded with (Part _ _ (Hpred b Hb) [-]Part _ _ (TaylorB n Hf')); auto. + unfold Taylor_Seq', funct_i in |- *. + cut (ext_fun_seq' (fun i Hi => [-C-] (fi n Hf' i Hi a Ha[/] _[//]nring_fac_ap_zero IR i) {*} + (FId{-} [-C-]a) {^}i)). intro H1. + apply eq_transitive_unfolded with (Part _ _ (Hpred b Hb) [-] Sumx (fun i Hi => + Part _ _ (FSumx_pred _ _ H1 b (TaylorB n Hf') i Hi))). + apply cg_minus_wd. + algebra. + exact (FSumx_char _ _ _ _ H1). + cut (ext_fun_seq' (fun i (Hi : i < n) => [-C-] (fi n Hf' (S i) (lt_n_S _ _ Hi) a Ha[/] _[//]nring_fac_ap_zero IR (S i)) {*} - (FId{-} [-C-]a) {^}S i)). intro H2. -apply - eq_transitive_unfolded - with - (Part _ _ (Hpred b Hb) [-]Part _ _ (Hpred a Ha) [-] - Sumx - (fun i (Hi : i < n) => Part _ _ (FSumx_pred _ _ H2 b H0 i Hi))). -2: apply cg_minus_wd. -2: algebra. -2: apply eq_symmetric_unfolded; exact (FSumx_char _ _ _ _ H2). -apply Taylor_Sumx_lemma. -intros; simpl in |- *. -unfold fi in |- *. -rstepr - ((Part _ _ (Hpred a Ha) [/] Zero[+]One[//]nring_fac_ap_zero IR 0) [*]One). -apply mult_wdl; apply div_wd. -2: algebra. -apply Feq_imp_eq with I. -apply Derivative_n_unique with pI 0 F. -apply N_Deriv_lemma. -split; auto. -split; auto. -intros; simpl in |- *. -apply Feq_reflexive; Included. -auto. -intros; simpl in |- *. -apply mult_wdl; apply div_wd. -2: algebra. -unfold fi in |- *. -apply Feq_imp_eq with I. -apply Derivative_n_unique with pI (S i) F; apply N_Deriv_lemma; auto. -auto. -repeat split. -repeat split. -apply ap_symmetric_unfolded; apply zero_minus_apart. -eapply cring_mult_ap_zero_op; apply H. + (FId{-} [-C-]a) {^}S i)). intro H2. + apply eq_transitive_unfolded with (Part _ _ (Hpred b Hb) [-]Part _ _ (Hpred a Ha) [-] Sumx + (fun i (Hi : i < n) => Part _ _ (FSumx_pred _ _ H2 b H0 i Hi))). + 2: apply cg_minus_wd. + 2: algebra. + 2: apply eq_symmetric_unfolded; exact (FSumx_char _ _ _ _ H2). + apply Taylor_Sumx_lemma. + intros; simpl in |- *. + unfold fi in |- *. + rstepr ((Part _ _ (Hpred a Ha) [/] Zero[+]One[//]nring_fac_ap_zero IR 0) [*]One). + apply mult_wdl; apply div_wd. + 2: algebra. + apply Feq_imp_eq with I. + apply Derivative_n_unique with pI 0 F. + apply N_Deriv_lemma. + split; auto. + split; auto. + intros; simpl in |- *. + apply Feq_reflexive; Included. + auto. + intros; simpl in |- *. + apply mult_wdl; apply div_wd. + 2: algebra. + unfold fi in |- *. + apply Feq_imp_eq with I. + apply Derivative_n_unique with pI (S i) F; apply N_Deriv_lemma; auto. + auto. + repeat split. + repeat split. + apply ap_symmetric_unfolded; apply zero_minus_apart. + eapply cring_mult_ap_zero_op; apply H. Qed. (* end hide *) Theorem Taylor' : forall n Hf Hf' e, Zero [<] e -> {c : IR | Compact (Min_leEq_Max a b) c | forall Hc, AbsIR (Taylor_Rem n Hf'[-]deriv_Sn b n Hf c Hc[*] (b[-]a)) [<=] e}. -intros. rename X into H. -cut (Dom (deriv_Sn b n Hf) a). intro H0. -2: repeat split. -2: simpl in |- *; auto. -elim - (less_cotransitive_unfolded _ _ _ H - (AbsIR (Taylor_Rem n Hf'[-]Part _ _ H0[*] (b[-]a)))). -intros. -cut (a [#] b). intro H1. -clear a0 H0. -cut (Diffble_I_n (ap_imp_Min_less_Max _ _ H1) (S n) F). intro H0. -2: apply included_imp_Diffble_n with I pI; auto. -cut (Diffble_I_n (ap_imp_Min_less_Max _ _ H1) n F). intro H2. -2: apply le_imp_Diffble_I with (S n); auto. -elim (Taylor_lemma a b H1 F (Diffble_n_imp_inc _ _ _ _ Hf b Hb) e H n H2 H0). -intros c H3 H4. -exists c; auto. -intro. -cut - (Dom - (n_deriv_I _ _ _ _ _ H0{*} [-C-] (One[/] _[//]nring_fac_ap_zero _ n) {*} - ( [-C-]b{-}FId) {^}n) c). intro H5. -2: repeat split. -2: apply n_deriv_inc; auto. -eapply leEq_wdl. -apply (H4 H5). -unfold Taylor_rem, Taylor_Rem in |- *. -apply AbsIR_wd; repeat apply cg_minus_wd. -algebra. -simpl in |- *. -repeat first - [ apply bin_op_wd_unfolded - | apply mult_wd - | apply div_wd - | apply eq_reflexive_unfolded ]. -apply FSumx_wd; intros; simpl in |- *. -apply mult_wdl. -apply div_wd. -2: algebra. -apply - eq_transitive_unfolded - with - (PartInt - (ProjT1 - (Diffble_I_n_imp_deriv_n _ _ _ _ _ - (le_imp_Diffble_I _ _ _ _ _ (lt_n_Sm_le _ _ (lt_S _ _ Hi)) _ H2))) - a (compact_Min_lft _ _ (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1)))). -simpl in |- *; algebra. -apply - Feq_imp_eq with (Compact (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1))). -apply Derivative_I_n_unique with i F. -apply projT2. -unfold fi in |- *. -elim - (N_Deriv_lemma _ _ _ _ - (le_imp_Diffble_n I pI i n (lt_n_Sm_le _ _ (lt_S _ _ Hi)) _ Hf')); - intros incF0 H'. -elim H'; intros Hinc derivF; clear H'. -apply derivF. -simpl in |- *; Included. -apply compact_Min_lft. -apply - eq_transitive_unfolded - with - (PartInt - (ProjT1 - (Diffble_I_n_imp_deriv_n _ _ _ _ _ - (le_imp_Diffble_I _ _ _ _ _ (lt_n_Sm_le _ _ (lt_n_Sn n)) _ H2))) - a (compact_Min_lft _ _ (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1)))). -simpl in |- *; algebra. -apply - Feq_imp_eq with (Compact (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1))). -apply Derivative_I_n_unique with n F. -apply projT2. -unfold fi in |- *. -elim - (N_Deriv_lemma _ _ _ _ - (le_imp_Diffble_n I pI n n (lt_n_Sm_le _ _ (lt_n_Sn n)) _ Hf')); - intros incF0 H'. -elim H'; intros Hinc derivF; clear H'. -apply derivF. -simpl in |- *; Included. -apply compact_Min_lft. -simpl in |- *. -repeat apply mult_wdl. -apply - Feq_imp_eq with (Compact (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1))). -apply Derivative_I_n_unique with (S n) F. -apply Derivative_I_n_wdr with (n_deriv_I _ _ _ _ _ H0). -apply - Derivative_I_n_unique - with - n - (n_deriv_I _ _ _ _ _ - (le_imp_Diffble_I _ _ _ _ _ (le_n_S _ _ (le_O_n n)) _ H0)). -cut - (forall HS HSn, - Derivative_I_n (ap_imp_Min_less_Max _ _ H1) n - (n_deriv_I _ _ (ap_imp_Min_less_Max _ _ H1) 1 F HS) - (n_deriv_I _ _ (ap_imp_Min_less_Max _ _ H1) (S n) F HSn)); - auto. -cut (S n = n + 1); [ intro | rewrite plus_comm; auto ]. -rewrite H6. -intros; apply n_deriv_plus. -eapply Derivative_I_n_wdl. -2: apply n_deriv_lemma. -apply Derivative_I_unique with F. -apply projT2. -apply - Derivative_I_wdl - with (n_deriv_I _ _ _ _ _ (le_imp_Diffble_I _ _ _ _ _ (le_O_n _) F H0)). -simpl in |- *. -FEQ. -apply (included_trans _ (Compact (less_leEq IR (Min a b) (Max a b) (ap_imp_Min_less_Max a b H1))) I); Included. -apply n_Sn_deriv. -apply n_deriv_lemma. -elim (N_Deriv_lemma _ _ _ _ Hf); intros incF0 H'. -elim H'; intros Hinc derivF; clear H'. -apply derivF. -simpl in |- *; Included. -elim H5; clear H5; intros H6 H7. -elim H6; clear H6; intros H5 H8. -exact (n_deriv_inc' _ _ _ _ _ _ _ _ H5). -Included. -cut (Taylor_Rem n Hf'[-]Part _ _ H0[*] (b[-]a) [#] Zero). -intro H1; exact (Taylor_lemma_ap _ _ _ _ H1). -astepr ZeroR; apply AbsIR_cancel_ap_zero; apply Greater_imp_ap; auto. -intro. -exists a. -apply compact_Min_lft. -intro; eapply leEq_wdl. -apply less_leEq; apply b0. -apply AbsIR_wd; rational. +Proof. + intros. rename X into H. + cut (Dom (deriv_Sn b n Hf) a). intro H0. + 2: repeat split. + 2: simpl in |- *; auto. + elim (less_cotransitive_unfolded _ _ _ H (AbsIR (Taylor_Rem n Hf'[-]Part _ _ H0[*] (b[-]a)))). + intros. + cut (a [#] b). intro H1. + clear a0 H0. + cut (Diffble_I_n (ap_imp_Min_less_Max _ _ H1) (S n) F). intro H0. + 2: apply included_imp_Diffble_n with I pI; auto. + cut (Diffble_I_n (ap_imp_Min_less_Max _ _ H1) n F). intro H2. + 2: apply le_imp_Diffble_I with (S n); auto. + elim (Taylor_lemma a b H1 F (Diffble_n_imp_inc _ _ _ _ Hf b Hb) e H n H2 H0). + intros c H3 H4. + exists c; auto. + intro. + cut (Dom (n_deriv_I _ _ _ _ _ H0{*} [-C-] (One[/] _[//]nring_fac_ap_zero _ n) {*} + ( [-C-]b{-}FId) {^}n) c). intro H5. + 2: repeat split. + 2: apply n_deriv_inc; auto. + eapply leEq_wdl. + apply (H4 H5). + unfold Taylor_rem, Taylor_Rem in |- *. + apply AbsIR_wd; repeat apply cg_minus_wd. + algebra. + simpl in |- *. + repeat first [ apply bin_op_wd_unfolded | apply mult_wd | apply div_wd + | apply eq_reflexive_unfolded ]. + apply FSumx_wd; intros; simpl in |- *. + apply mult_wdl. + apply div_wd. + 2: algebra. + apply eq_transitive_unfolded with (PartInt (ProjT1 (Diffble_I_n_imp_deriv_n _ _ _ _ _ + (le_imp_Diffble_I _ _ _ _ _ (lt_n_Sm_le _ _ (lt_S _ _ Hi)) _ H2))) + a (compact_Min_lft _ _ (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1)))). + simpl in |- *; algebra. + apply Feq_imp_eq with (Compact (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1))). + apply Derivative_I_n_unique with i F. + apply projT2. + unfold fi in |- *. + elim (N_Deriv_lemma _ _ _ _ (le_imp_Diffble_n I pI i n (lt_n_Sm_le _ _ (lt_S _ _ Hi)) _ Hf')); + intros incF0 H'. + elim H'; intros Hinc derivF; clear H'. + apply derivF. + simpl in |- *; Included. + apply compact_Min_lft. + apply eq_transitive_unfolded with (PartInt (ProjT1 (Diffble_I_n_imp_deriv_n _ _ _ _ _ + (le_imp_Diffble_I _ _ _ _ _ (lt_n_Sm_le _ _ (lt_n_Sn n)) _ H2))) + a (compact_Min_lft _ _ (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1)))). + simpl in |- *; algebra. + apply Feq_imp_eq with (Compact (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1))). + apply Derivative_I_n_unique with n F. + apply projT2. + unfold fi in |- *. + elim (N_Deriv_lemma _ _ _ _ (le_imp_Diffble_n I pI n n (lt_n_Sm_le _ _ (lt_n_Sn n)) _ Hf')); + intros incF0 H'. + elim H'; intros Hinc derivF; clear H'. + apply derivF. + simpl in |- *; Included. + apply compact_Min_lft. + simpl in |- *. + repeat apply mult_wdl. + apply Feq_imp_eq with (Compact (less_leEq _ _ _ (ap_imp_Min_less_Max _ _ H1))). + apply Derivative_I_n_unique with (S n) F. + apply Derivative_I_n_wdr with (n_deriv_I _ _ _ _ _ H0). + apply Derivative_I_n_unique with n (n_deriv_I _ _ _ _ _ + (le_imp_Diffble_I _ _ _ _ _ (le_n_S _ _ (le_O_n n)) _ H0)). + cut (forall HS HSn, Derivative_I_n (ap_imp_Min_less_Max _ _ H1) n + (n_deriv_I _ _ (ap_imp_Min_less_Max _ _ H1) 1 F HS) + (n_deriv_I _ _ (ap_imp_Min_less_Max _ _ H1) (S n) F HSn)); auto. + cut (S n = n + 1); [ intro | rewrite plus_comm; auto ]. + rewrite H6. + intros; apply n_deriv_plus. + eapply Derivative_I_n_wdl. + 2: apply n_deriv_lemma. + apply Derivative_I_unique with F. + apply projT2. + apply Derivative_I_wdl with (n_deriv_I _ _ _ _ _ (le_imp_Diffble_I _ _ _ _ _ (le_O_n _) F H0)). + simpl in |- *. + FEQ. + apply (included_trans _ (Compact (less_leEq IR (Min a b) (Max a b) (ap_imp_Min_less_Max a b H1))) I); Included. + apply n_Sn_deriv. + apply n_deriv_lemma. + elim (N_Deriv_lemma _ _ _ _ Hf); intros incF0 H'. + elim H'; intros Hinc derivF; clear H'. + apply derivF. + simpl in |- *; Included. + elim H5; clear H5; intros H6 H7. + elim H6; clear H6; intros H5 H8. + exact (n_deriv_inc' _ _ _ _ _ _ _ _ H5). + Included. + cut (Taylor_Rem n Hf'[-]Part _ _ H0[*] (b[-]a) [#] Zero). + intro H1; exact (Taylor_lemma_ap _ _ _ _ H1). + astepr ZeroR; apply AbsIR_cancel_ap_zero; apply Greater_imp_ap; auto. + intro. + exists a. + apply compact_Min_lft. + intro; eapply leEq_wdl. + apply less_leEq; apply b0. + apply AbsIR_wd; rational. Qed. End More_Taylor_Defs. @@ -416,69 +347,69 @@ Let deriv_Sn := F'{*} [-C-] (One[/] _[//]nring_fac_ap_zero _ n) {*} ( [-C-]b{-}F (* end show *) Lemma Taylor_aux : Dom Taylor_Seq b. -repeat split. -apply FSumx_pred'; repeat split. +Proof. + repeat split. + apply FSumx_pred'; repeat split. Qed. Theorem Taylor : forall e, Zero [<] e -> forall Hb', {c : IR | Compact (Min_leEq_Max a b) c | forall Hc, AbsIR (F b Hb'[-]Part _ _ Taylor_aux[-]deriv_Sn c Hc[*] (b[-]a)) [<=] e}. -intros e H Hb'. -cut (Diffble_n (S n) I pI F). -intro Hf. -cut (Diffble_n n I pI F). -intro Hf'. -elim (Taylor' I pI F _ _ Ha Hb n Hf Hf' e H); intros c Hc' Hc. -exists c. -auto. -intros. -cut - (Dom - (N_Deriv _ _ _ _ Hf{*} [-C-] (One[/] _[//]nring_fac_ap_zero IR n) {*} +Proof. + intros e H Hb'. + cut (Diffble_n (S n) I pI F). + intro Hf. + cut (Diffble_n n I pI F). + intro Hf'. + elim (Taylor' I pI F _ _ Ha Hb n Hf Hf' e H); intros c Hc' Hc. + exists c. + auto. + intros. + cut (Dom (N_Deriv _ _ _ _ Hf{*} [-C-] (One[/] _[//]nring_fac_ap_zero IR n) {*} ( [-C-]b{-}FId) {^}n) c). intro H0. -eapply leEq_wdl. -apply (Hc H0). -apply AbsIR_wd; simpl in |- *; repeat simple apply cg_minus_wd. -2: repeat simple apply mult_wdl. -unfold Taylor_Rem in |- *; simpl in |- *. -apply cg_minus_wd. -algebra. -apply bin_op_wd_unfolded. -apply Feq_imp_eq with (Compact (Min_leEq_Max a b)). -apply FSumx_wd'. -unfold funct_i in |- *; intros; simpl in |- *. -apply Feq_mult. -FEQ. -simpl in |- *. -apply div_wd. -apply Feq_imp_eq with I. -apply Derivative_n_unique with pI i F. -apply N_Deriv_lemma. -apply derF. -auto. -algebra. -apply Feq_reflexive; repeat split. -apply compact_Min_rht. -apply mult_wdl. -apply div_wd. -2: algebra. -apply Feq_imp_eq with I. -apply Derivative_n_unique with pI n F. -apply N_Deriv_lemma. -apply derF. -auto. -apply Feq_imp_eq with I. -apply Derivative_n_unique with pI (S n) F. -apply N_Deriv_lemma. -assumption. -cut (included (Compact (Min_leEq_Max a b)) I); Included. -repeat split. -Transparent N_Deriv. -simpl in |- *. -cut (included (Compact (Min_leEq_Max a b)) I); Included. -apply Derivative_n_imp_Diffble_n with (f n (lt_n_Sn n)). -apply derF. -apply Derivative_n_imp_Diffble_n with F'. -assumption. + eapply leEq_wdl. + apply (Hc H0). + apply AbsIR_wd; simpl in |- *; repeat simple apply cg_minus_wd. + 2: repeat simple apply mult_wdl. + unfold Taylor_Rem in |- *; simpl in |- *. + apply cg_minus_wd. + algebra. + apply bin_op_wd_unfolded. + apply Feq_imp_eq with (Compact (Min_leEq_Max a b)). + apply FSumx_wd'. + unfold funct_i in |- *; intros; simpl in |- *. + apply Feq_mult. + FEQ. + simpl in |- *. + apply div_wd. + apply Feq_imp_eq with I. + apply Derivative_n_unique with pI i F. + apply N_Deriv_lemma. + apply derF. + auto. + algebra. + apply Feq_reflexive; repeat split. + apply compact_Min_rht. + apply mult_wdl. + apply div_wd. + 2: algebra. + apply Feq_imp_eq with I. + apply Derivative_n_unique with pI n F. + apply N_Deriv_lemma. + apply derF. + auto. + apply Feq_imp_eq with I. + apply Derivative_n_unique with pI (S n) F. + apply N_Deriv_lemma. + assumption. + cut (included (Compact (Min_leEq_Max a b)) I); Included. + repeat split. + Transparent N_Deriv. + simpl in |- *. + cut (included (Compact (Min_leEq_Max a b)) I); Included. + apply Derivative_n_imp_Diffble_n with (f n (lt_n_Sn n)). + apply derF. + apply Derivative_n_imp_Diffble_n with F'. + assumption. Qed. End Taylor_Theorem. diff --git a/ftc/TaylorLemma.v b/ftc/TaylorLemma.v index 297e184fc..5adbf19b7 100644 --- a/ftc/TaylorLemma.v +++ b/ftc/TaylorLemma.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Rolle. @@ -81,9 +81,10 @@ $f_i=f^{(i)}$#fi=f(i)#. (* begin hide *) Lemma Taylor_lemma1 : forall n Hf i Hi, Derivative_I_n Hab' i F (PartInt (fi n Hf i Hi)). -intros. -unfold fi in |- *. -apply projT2. +Proof. + intros. + unfold fi in |- *. + apply projT2. Qed. (* end hide *) @@ -113,88 +114,93 @@ Let funct_i' n Hf i Hi := PartInt (fi n Hf i Hi) {*} [-C-] (One[/] _[//]nring_fac_ap_zero IR i) {*} ( [-C-]b{-}FId) {^}i. Lemma TL_a_i : forall n Hf i Hi, Dom (funct_i n Hf i Hi) a. -split; split; simpl in |- *; auto. +Proof. + split; split; simpl in |- *; auto. Qed. Lemma TL_b_i : forall n Hf i Hi, Dom (funct_i n Hf i Hi) b. -split; split; simpl in |- *; auto. +Proof. + split; split; simpl in |- *; auto. Qed. Lemma TL_x_i : forall x, I x -> forall n Hf i Hi, Dom (funct_i n Hf i Hi) x. -split; split; simpl in |- *; auto. +Proof. + split; split; simpl in |- *; auto. Qed. Lemma TL_a_i' : forall n Hf i Hi, Dom (funct_i' n Hf i Hi) a. -split; split; simpl in |- *; auto. +Proof. + split; split; simpl in |- *; auto. Qed. Lemma TL_b_i' : forall n Hf i Hi, Dom (funct_i' n Hf i Hi) b. -split; split; simpl in |- *; auto. +Proof. + split; split; simpl in |- *; auto. Qed. Lemma TL_x_i' : forall x, I x -> forall n Hf i Hi, Dom (funct_i' n Hf i Hi) x. -split; split; simpl in |- *; auto. +Proof. + split; split; simpl in |- *; auto. Qed. Lemma Taylor_lemma2 : forall n Hf, ext_fun_seq (funct_i n Hf). -red in |- *; intros n Hf i j H H0 H' x y H1 Hx Hy. -simpl in |- *. -apply mult_wd. -apply div_wd. -2: rewrite H; algebra. -generalize H' Hx Hy; clear Hy Hx H'. -rewrite <- H; intros. -cut - (forall Ha1 Ha2, PartInt (fi n Hf i H0) a Ha1 [=] PartInt (fi n Hf i H') a Ha2); - intros. -simpl in H2. -apply H2. -apply Feq_imp_eq with (Compact Hab). -unfold Hab in |- *; apply Derivative_I_n_unique with i F; apply Taylor_lemma1. -apply TL_compact_a. -rewrite H. -astepl ((x[+][--]a) [^]j); Step_final ((y[+][--]a) [^]j). +Proof. + red in |- *; intros n Hf i j H H0 H' x y H1 Hx Hy. + simpl in |- *. + apply mult_wd. + apply div_wd. + 2: rewrite H; algebra. + generalize H' Hx Hy; clear Hy Hx H'. + rewrite <- H; intros. + cut (forall Ha1 Ha2, PartInt (fi n Hf i H0) a Ha1 [=] PartInt (fi n Hf i H') a Ha2); intros. + simpl in H2. + apply H2. + apply Feq_imp_eq with (Compact Hab). + unfold Hab in |- *; apply Derivative_I_n_unique with i F; apply Taylor_lemma1. + apply TL_compact_a. + rewrite H. + astepl ((x[+][--]a) [^]j); Step_final ((y[+][--]a) [^]j). Qed. Lemma Taylor_lemma2' : forall n Hf, ext_fun_seq' (funct_i n Hf). -repeat intro. -repeat split. +Proof. + repeat intro. + repeat split. Qed. Lemma Taylor_lemma3 : forall n Hf, ext_fun_seq (funct_i' n Hf). -red in |- *; intros n Hf i j H H0 H' x y H1 Hx Hy. -simpl in |- *. -apply mult_wd. -apply mult_wd. -2: rewrite H; algebra. -generalize H' Hx Hy; clear Hy Hx H'. -rewrite <- H; intros. -cut - (forall Hx' Hy', PartInt (fi n Hf i H0) x Hx' [=] PartInt (fi n Hf i H') y Hy'); - intros. -simpl in H2. -apply H2. -cut (Dom (PartInt (fi n Hf i H')) x); - [ intro H2 | apply dom_wd with y; algebra ]. -apply eq_transitive_unfolded with (Part _ _ H2). -apply Feq_imp_eq with (Compact Hab). -unfold Hab in |- *; apply Derivative_I_n_unique with i F; apply Taylor_lemma1. -simpl in Hx. -elim Hx; intros. -inversion_clear a0; auto. -algebra. -rewrite H. -astepl ((b[+][--]x) [^]j); Step_final ((b[+][--]y) [^]j). +Proof. + red in |- *; intros n Hf i j H H0 H' x y H1 Hx Hy. + simpl in |- *. + apply mult_wd. + apply mult_wd. + 2: rewrite H; algebra. + generalize H' Hx Hy; clear Hy Hx H'. + rewrite <- H; intros. + cut (forall Hx' Hy', PartInt (fi n Hf i H0) x Hx' [=] PartInt (fi n Hf i H') y Hy'); intros. + simpl in H2. + apply H2. + cut (Dom (PartInt (fi n Hf i H')) x); [ intro H2 | apply dom_wd with y; algebra ]. + apply eq_transitive_unfolded with (Part _ _ H2). + apply Feq_imp_eq with (Compact Hab). + unfold Hab in |- *; apply Derivative_I_n_unique with i F; apply Taylor_lemma1. + simpl in Hx. + elim Hx; intros. + inversion_clear a0; auto. + algebra. + rewrite H. + astepl ((b[+][--]x) [^]j); Step_final ((b[+][--]y) [^]j). Qed. Lemma Taylor_lemma3' : forall n Hf, ext_fun_seq' (funct_i' n Hf). -intros n Hf i j H H0 H' x y H1 H2. -elim H2; intros. -simpl in a0, b0. -clear b0; inversion_clear a0 as (X,X0). -inversion_clear X; repeat split. -astepr x; auto. -astepl x; auto. +Proof. + intros n Hf i j H H0 H' x y H1 H2. + elim H2; intros. + simpl in a0, b0. + clear b0; inversion_clear a0 as (X,X0). + inversion_clear X; repeat split. + astepr x; auto. + astepl x; auto. Qed. (* end hide *) @@ -209,11 +215,12 @@ Definition Taylor_seq' n Hf := FSumx _ (funct_i n Hf). Let Taylor_seq'_aux n Hf := FSumx _ (funct_i' n Hf). Lemma TL_lemma_a : forall n Hf, Dom (Taylor_seq' n Hf) a. -intros. -repeat split. -apply FSumx_pred'. -repeat split. -repeat split. +Proof. + intros. + repeat split. + apply FSumx_pred'. + repeat split. + repeat split. Qed. (* end hide *) @@ -222,44 +229,47 @@ It is easy to show that [b] is in the domain of this series, which allows us to *) Lemma TL_lemma_b : forall n Hf, Dom (Taylor_seq' n Hf) b. -intros. -repeat split. -apply FSumx_pred'. -repeat split. -repeat split. +Proof. + intros. + repeat split. + apply FSumx_pred'. + repeat split. + repeat split. Qed. (* begin hide *) Lemma TL_lemma_a' : forall n Hf, Dom (Taylor_seq'_aux n Hf) a. -intros. -split. -apply FSumx_pred'. -red in |- *; intros. -simpl in X. -inversion_clear X. -inversion_clear X0. -simpl in |- *. -split; split; auto. -apply compact_wd with x; auto. -intros. -apply TL_a_i'. -apply TL_a_i'. +Proof. + intros. + split. + apply FSumx_pred'. + red in |- *; intros. + simpl in X. + inversion_clear X. + inversion_clear X0. + simpl in |- *. + split; split; auto. + apply compact_wd with x; auto. + intros. + apply TL_a_i'. + apply TL_a_i'. Qed. Lemma TL_lemma_b' : forall n Hf, Dom (Taylor_seq'_aux n Hf) b. -intros. -split. -apply FSumx_pred'. -red in |- *; intros. -simpl in X. -inversion_clear X. -inversion_clear X0. -simpl in |- *. -split; split; auto. -apply compact_wd with x; auto. -intros. -apply TL_b_i'. -apply TL_b_i'. +Proof. + intros. + split. + apply FSumx_pred'. + red in |- *; intros. + simpl in X. + inversion_clear X. + inversion_clear X0. + simpl in |- *. + split; split; auto. + apply compact_wd with x; auto. + intros. + apply TL_b_i'. + apply TL_b_i'. Qed. (* end hide *) @@ -270,148 +280,135 @@ Let g n Hf Hab := [-C-] (F b Hb) {-}Taylor_seq'_aux n Hf{-} [-C-] (Taylor_rem n Hf) {*} (( [-C-]b{-}FId) {*} [-C-] (One[/] (b[-]a) [//]Hab)). Lemma Taylor_lemma4 : forall n Hf Hab Ha', g n Hf Hab a Ha' [=] Zero. -unfold g in |- *; clear g; intros. -cut (Dom ( [-C-] (F b Hb) {-}Taylor_seq'_aux n Hf{-} [-C-] (Taylor_rem n Hf)) a). intro H. -apply eq_transitive_unfolded with (Part _ _ H). -Opaque Taylor_seq'_aux Taylor_rem. -simpl in |- *; rational. -Transparent Taylor_rem. -unfold Taylor_rem in |- *. -apply - eq_transitive_unfolded - with (Part _ _ (TL_lemma_b n Hf) [-]Part _ _ (TL_lemma_a' n Hf)). -Opaque Taylor_seq'. -simpl in |- *; rational. -Transparent Taylor_seq' Taylor_seq'_aux. -unfold Taylor_seq', Taylor_seq'_aux in |- *. -cut (Dom (FSum 0 n (FSumx_to_FSum _ (funct_i n Hf))) b). intro H0. -cut (Dom (FSum 0 n (FSumx_to_FSum _ (funct_i' n Hf))) a). intro H1. -apply eq_transitive_unfolded with (Part _ _ H0[-]Part _ _ H1). -apply eq_symmetric_unfolded; apply cg_minus_wd; apply FSum_FSumx_to_FSum. -apply Taylor_lemma2. -apply Taylor_lemma2'. -apply Taylor_lemma3. -apply Taylor_lemma3'. -eapply eq_transitive_unfolded. -simpl in |- *. -apply eq_symmetric_unfolded; apply Sum_minus_Sum. -apply Sum_zero. -auto with arith. -intros. -cut - (forall Hb' Ha', - FSumx_to_FSum (S n) (funct_i n Hf) i b Hb'[-] - FSumx_to_FSum (S n) (funct_i' n Hf) i a Ha' [=] Zero); - auto. -unfold FSumx_to_FSum in |- *. -elim le_lt_dec; intro; simpl in |- *. -algebra. -intros. -set - (w := - fi n Hf i b0 (Build_subcsetoid_crr _ _ _ TL_compact_a) [*] - (One[/] _[//]nring_fac_ap_zero IR i) [*] (b[+][--]a) [^]i) - in *. -astepr (w[-]w); unfold w in |- *; simpl in |- *. -repeat first [ apply cg_minus_wd | simple apply mult_wd ]; - try apply csf_wd_unfolded; algebra. -rational. -simpl in |- *; algebra. -simpl in |- *; intro i. -Opaque funct_i'. -unfold FSumx_to_FSum in |- *. -elim le_lt_dec; intro; simpl in |- *. -auto. -apply TL_a_i'. -Opaque funct_i. -simpl in |- *; intro i. -unfold FSumx_to_FSum in |- *. -elim le_lt_dec; intro; simpl in |- *. -auto. -apply TL_b_i. -split; split; split. -apply FSumx_pred'. -red in |- *; intros. -inversion_clear X. -inversion_clear X0. -simpl in X. -split; split; auto. -simpl in |- *; apply compact_wd with x; auto. -intros; apply TL_a_i'. -apply TL_a_i'. +Proof. + unfold g in |- *; clear g; intros. + cut (Dom ( [-C-] (F b Hb) {-}Taylor_seq'_aux n Hf{-} [-C-] (Taylor_rem n Hf)) a). intro H. + apply eq_transitive_unfolded with (Part _ _ H). + Opaque Taylor_seq'_aux Taylor_rem. + simpl in |- *; rational. + Transparent Taylor_rem. + unfold Taylor_rem in |- *. + apply eq_transitive_unfolded with (Part _ _ (TL_lemma_b n Hf) [-]Part _ _ (TL_lemma_a' n Hf)). + Opaque Taylor_seq'. + simpl in |- *; rational. + Transparent Taylor_seq' Taylor_seq'_aux. + unfold Taylor_seq', Taylor_seq'_aux in |- *. + cut (Dom (FSum 0 n (FSumx_to_FSum _ (funct_i n Hf))) b). intro H0. + cut (Dom (FSum 0 n (FSumx_to_FSum _ (funct_i' n Hf))) a). intro H1. + apply eq_transitive_unfolded with (Part _ _ H0[-]Part _ _ H1). + apply eq_symmetric_unfolded; apply cg_minus_wd; apply FSum_FSumx_to_FSum. + apply Taylor_lemma2. + apply Taylor_lemma2'. + apply Taylor_lemma3. + apply Taylor_lemma3'. + eapply eq_transitive_unfolded. + simpl in |- *. + apply eq_symmetric_unfolded; apply Sum_minus_Sum. + apply Sum_zero. + auto with arith. + intros. + cut (forall Hb' Ha', FSumx_to_FSum (S n) (funct_i n Hf) i b Hb'[-] + FSumx_to_FSum (S n) (funct_i' n Hf) i a Ha' [=] Zero); auto. + unfold FSumx_to_FSum in |- *. + elim le_lt_dec; intro; simpl in |- *. + algebra. + intros. + set (w := fi n Hf i b0 (Build_subcsetoid_crr _ _ _ TL_compact_a) [*] + (One[/] _[//]nring_fac_ap_zero IR i) [*] (b[+][--]a) [^]i) in *. + astepr (w[-]w); unfold w in |- *; simpl in |- *. + repeat first [ apply cg_minus_wd | simple apply mult_wd ]; try apply csf_wd_unfolded; algebra. + rational. + simpl in |- *; algebra. + simpl in |- *; intro i. + Opaque funct_i'. + unfold FSumx_to_FSum in |- *. + elim le_lt_dec; intro; simpl in |- *. + auto. + apply TL_a_i'. + Opaque funct_i. + simpl in |- *; intro i. + unfold FSumx_to_FSum in |- *. + elim le_lt_dec; intro; simpl in |- *. + auto. + apply TL_b_i. + split; split; split. + apply FSumx_pred'. + red in |- *; intros. + inversion_clear X. + inversion_clear X0. + simpl in X. + split; split; auto. + simpl in |- *; apply compact_wd with x; auto. + intros; apply TL_a_i'. + apply TL_a_i'. Qed. Transparent funct_i funct_i'. Lemma Taylor_lemma5 : forall n Hf Hab Hb', g n Hf Hab b Hb' [=] Zero. -unfold g in |- *; intros. -cut (Dom ( [-C-] (F b Hb) {-}Taylor_seq'_aux n Hf) b). intro H. -apply eq_transitive_unfolded with (Part _ _ H). -Opaque Taylor_seq'_aux. -simpl in |- *; rational. -Transparent Taylor_seq'_aux. -unfold Taylor_seq'_aux in |- *. -cut (Dom (FSum 0 n (FSumx_to_FSum _ (funct_i' n Hf))) b). intro H0. -apply eq_transitive_unfolded with (F b Hb[-]Part _ _ H0). -Opaque FSumx. -apply - eq_transitive_unfolded - with (F b Hb[-]FSumx (S n) (funct_i' n Hf) b (ProjIR2 H)). -simpl in |- *; rational. -apply cg_minus_wd. -algebra. -apply eq_symmetric_unfolded; apply FSum_FSumx_to_FSum. -apply Taylor_lemma3. -apply Taylor_lemma3'. -simpl in |- *. -astepr (Part _ _ Hb[-]Part _ _ Hb); apply cg_minus_wd. -algebra. -eapply eq_transitive_unfolded. -apply Sum_first. -astepr (Part _ _ Hb[+]Zero); apply bin_op_wd_unfolded. -cut (forall H', FSumx_to_FSum (S n) (funct_i' n Hf) 0 b H' [=] Part _ _ Hb); - auto. -unfold FSumx_to_FSum in |- *. -elim le_lt_dec; intro; simpl in |- *. -elimtype False; inversion a0. -intros; simpl in |- *. -rstepr (Part _ _ Hb[*]One[*]One). -apply mult_wdl. -apply mult_wd. -2: rational. -apply eq_symmetric_unfolded. -apply eq_transitive_unfolded with (PartInt (fi n Hf 0 b0) b TL_compact_b). -2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -apply Feq_imp_eq with (Compact Hab). -apply - (ProjT2 - (Diffble_I_n_imp_deriv_n _ _ _ _ _ +Proof. + unfold g in |- *; intros. + cut (Dom ( [-C-] (F b Hb) {-}Taylor_seq'_aux n Hf) b). intro H. + apply eq_transitive_unfolded with (Part _ _ H). + Opaque Taylor_seq'_aux. + simpl in |- *; rational. + Transparent Taylor_seq'_aux. + unfold Taylor_seq'_aux in |- *. + cut (Dom (FSum 0 n (FSumx_to_FSum _ (funct_i' n Hf))) b). intro H0. + apply eq_transitive_unfolded with (F b Hb[-]Part _ _ H0). + Opaque FSumx. + apply eq_transitive_unfolded with (F b Hb[-]FSumx (S n) (funct_i' n Hf) b (ProjIR2 H)). + simpl in |- *; rational. + apply cg_minus_wd. + algebra. + apply eq_symmetric_unfolded; apply FSum_FSumx_to_FSum. + apply Taylor_lemma3. + apply Taylor_lemma3'. + simpl in |- *. + astepr (Part _ _ Hb[-]Part _ _ Hb); apply cg_minus_wd. + algebra. + eapply eq_transitive_unfolded. + apply Sum_first. + astepr (Part _ _ Hb[+]Zero); apply bin_op_wd_unfolded. + cut (forall H', FSumx_to_FSum (S n) (funct_i' n Hf) 0 b H' [=] Part _ _ Hb); auto. + unfold FSumx_to_FSum in |- *. + elim le_lt_dec; intro; simpl in |- *. + elimtype False; inversion a0. + intros; simpl in |- *. + rstepr (Part _ _ Hb[*]One[*]One). + apply mult_wdl. + apply mult_wd. + 2: rational. + apply eq_symmetric_unfolded. + apply eq_transitive_unfolded with (PartInt (fi n Hf 0 b0) b TL_compact_b). + 2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + apply Feq_imp_eq with (Compact Hab). + apply (ProjT2 (Diffble_I_n_imp_deriv_n _ _ _ _ _ (le_imp_Diffble_I _ _ _ _ _ (lt_n_Sm_le 0 n b0) _ Hf))). -apply TL_compact_b. -apply Sum_zero. -auto with arith. -intros. -cut (forall H', FSumx_to_FSum (S n) (funct_i' n Hf) i b H' [=] Zero); auto. -unfold FSumx_to_FSum in |- *. -elim le_lt_dec; intro; simpl in |- *. -algebra. -intro. -astepr - (fi n Hf i b0 (Build_subcsetoid_crr IR _ b (ProjIR1 (ProjIR1 H'))) [*] - (One[/] _[//]nring_fac_ap_zero _ i) [*]Zero). -apply mult_wdr. -astepl ((b[-]b) [^]i). -Step_final (ZeroR[^]i). -intro i. -Opaque funct_i'. -unfold FSumx_to_FSum in |- *. -elim le_lt_dec; intro; simpl in |- *. -auto. -apply TL_b_i'. -split. -simpl in |- *; auto. -simpl in |- *. -apply TL_lemma_b'. + apply TL_compact_b. + apply Sum_zero. + auto with arith. + intros. + cut (forall H', FSumx_to_FSum (S n) (funct_i' n Hf) i b H' [=] Zero); auto. + unfold FSumx_to_FSum in |- *. + elim le_lt_dec; intro; simpl in |- *. + algebra. + intro. + astepr (fi n Hf i b0 (Build_subcsetoid_crr IR _ b (ProjIR1 (ProjIR1 H'))) [*] + (One[/] _[//]nring_fac_ap_zero _ i) [*]Zero). + apply mult_wdr. + astepl ((b[-]b) [^]i). + Step_final (ZeroR[^]i). + intro i. + Opaque funct_i'. + unfold FSumx_to_FSum in |- *. + elim le_lt_dec; intro; simpl in |- *. + auto. + apply TL_b_i'. + split. + simpl in |- *; auto. + simpl in |- *. + apply TL_lemma_b'. Qed. Transparent funct_i' FSumx. @@ -421,39 +418,33 @@ Let funct_aux n Hf i Hi := PartInt (fi (S n) Hf (S i) (lt_n_S _ _ Hi)) {*} Lemma Taylor_lemma6 : forall n Hf Hf' i Hi, Derivative_I Hab' (PartInt (fi n Hf i Hi)) (PartInt (fi (S n) Hf' (S i) (lt_n_S _ _ Hi))). -intros. -cut - (Derivative_I_n Hab' 1 (PartInt (fi n Hf i Hi)) - (PartInt (fi (S n) Hf' (S i) (lt_n_S i (S n) Hi)))). -intro H. -simpl in H. -elim H; intros f' H1 H2. -apply Derivative_I_wdr with (PartInt f'); assumption. -cut (S i = 1 + i); [ intro | omega ]. -cut (1 + i < S (S n)); [ intro | omega ]. -apply Derivative_I_n_wdr with (PartInt (fi (S n) Hf' _ H0)). -apply Derivative_I_n_unique with (S i) F. -generalize H0; clear H0. -rewrite <- H; intro. -apply Taylor_lemma1. -apply Taylor_lemma1. -apply - Derivative_I_n_wdl - with - (n_deriv_I _ _ _ _ _ - (le_imp_Diffble_I _ _ _ _ _ (lt_n_Sm_le i n Hi) _ Hf)). -2: apply - Derivative_I_n_wdr - with - (n_deriv_I _ _ _ _ _ - (le_imp_Diffble_I _ _ _ _ _ (lt_n_Sm_le _ _ H0) _ Hf')). -3: apply n_deriv_plus. -apply Derivative_I_n_unique with i F. -apply n_deriv_lemma. -apply Taylor_lemma1. -apply Derivative_I_n_unique with (1 + i) F. -apply n_deriv_lemma. -apply Taylor_lemma1. +Proof. + intros. + cut (Derivative_I_n Hab' 1 (PartInt (fi n Hf i Hi)) + (PartInt (fi (S n) Hf' (S i) (lt_n_S i (S n) Hi)))). + intro H. + simpl in H. + elim H; intros f' H1 H2. + apply Derivative_I_wdr with (PartInt f'); assumption. + cut (S i = 1 + i); [ intro | omega ]. + cut (1 + i < S (S n)); [ intro | omega ]. + apply Derivative_I_n_wdr with (PartInt (fi (S n) Hf' _ H0)). + apply Derivative_I_n_unique with (S i) F. + generalize H0; clear H0. + rewrite <- H; intro. + apply Taylor_lemma1. + apply Taylor_lemma1. + apply Derivative_I_n_wdl with (n_deriv_I _ _ _ _ _ + (le_imp_Diffble_I _ _ _ _ _ (lt_n_Sm_le i n Hi) _ Hf)). + 2: apply Derivative_I_n_wdr with (n_deriv_I _ _ _ _ _ + (le_imp_Diffble_I _ _ _ _ _ (lt_n_Sm_le _ _ H0) _ Hf')). + 3: apply n_deriv_plus. + apply Derivative_I_n_unique with i F. + apply n_deriv_lemma. + apply Taylor_lemma1. + apply Derivative_I_n_unique with (1 + i) F. + apply n_deriv_lemma. + apply Taylor_lemma1. Qed. Ltac Lazy_Included := @@ -476,228 +467,179 @@ Ltac Lazy_Eq := Lemma Taylor_lemma7 : forall n Hf Hf' i (Hi : 0 < i) Hi', Derivative_I Hab' (funct_i' n Hf i Hi') (funct_aux n Hf' i Hi'{-}funct_aux n Hf' (pred i) (lt_5 i (S n) Hi')). -do 5 intro. -rewrite (S_pred _ _ Hi). -set (p := pred i) in *; clearbody p; clear Hi i. -intros. -cut - (Derivative_I Hab' (PartInt (fi n Hf _ Hi')) - (PartInt (fi (S n) Hf' (S (S p)) (lt_n_S _ _ Hi')))); - [ intro | apply Taylor_lemma6 ]. -unfold funct_aux, funct_i' in |- *. -New_Deriv. -apply Feq_reflexive. -Lazy_Included. -apply eq_imp_Feq. -Lazy_Included. -Lazy_Included. -intros x X0 Hx Hx'. -simpl in Hx, Hx'; simpl in |- *. -set (fiSp1 := fi n Hf (S p) Hi') in *. -set (fiSp2 := fi (S n) Hf' (S p) (lt_n_S p (S n) (lt_5 (S p) (S n) Hi'))) - in *. -cut - (forall x y : subset I, scs_elem _ _ x [=] scs_elem _ _ y -> fiSp1 x [=] fiSp2 y); +Proof. + do 5 intro. + rewrite (S_pred _ _ Hi). + set (p := pred i) in *; clearbody p; clear Hi i. intros. -set (x1 := Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR1 (ProjIR1 Hx)))) in *. -simpl in (value of x1); fold x1 in |- *. -set (x2 := Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR1 (ProjIR2 Hx')))) - in *. -simpl in (value of x2); fold x2 in |- *. -set - (x3 := - Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR1 (ProjIR1 (ProjIR2 Hx))))) - in *. -simpl in (value of x3); fold x3 in |- *. -set (x4 := Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR1 (ProjIR1 Hx')))) - in *. -simpl in (value of x4); fold x4 in |- *. -set - (x5 := - Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR2 (ProjIR1 (ProjIR2 Hx))))) - in *. -simpl in (value of x5); fold x5 in |- *. -set (fiSSp := fi (S n) Hf' (S (S p)) (lt_n_S (S p) (S n) Hi')) in *. -set (pp := One[/] nring (fac p + p * fac p) [//]nring_fac_ap_zero IR (S p)) - in *. -set (bxp := nexp _ p (b[-]x)) in *. -set (a1 := fiSp1 x1) in *; set (a5 := fiSSp x5) in *; - simpl in (value of a1), (value of a5); fold a1 a5 in |- *. -rstepl (a5[*]pp[*] (bxp[*] (b[-]x)) [-]a1[*] ((nring p[+]One) [*]pp) [*]bxp). -unfold a1, a5 in |- *; clear a1 a5. -Lazy_Eq. -unfold x4, x5 in |- *; algebra. -simpl in |- *; algebra. -unfold pp in |- *. -rstepr - (nring (S p) [*] - (One[/] _[//] - mult_resp_ap_zero _ _ _ (nring_fac_ap_zero _ p) - (pos_ap_zero _ _ (pos_nring_S IR p)))); simpl in |- *. -apply mult_wdr; apply div_wd. -algebra. -clear X H bxp pp x5 x4 x3 x2 x1 fiSSp fiSp1 fiSp2 Hx. -cut (fac p + p * fac p = fac p * S p). -intro; rewrite H. -eapply eq_transitive_unfolded. -apply nring_comm_mult. -algebra. -transitivity (S p * fac p); auto with arith. -unfold fiSp1, fiSp2 in |- *. -apply - eq_transitive_unfolded - with (PartInt (fi n Hf (S p) Hi') (scs_elem _ _ x0) (scs_prf _ _ x0)). -2: apply - eq_transitive_unfolded - with - (PartInt (fi (S n) Hf' (S p) (lt_n_S _ _ (lt_5 _ _ Hi'))) - (scs_elem _ _ x0) (scs_prf _ _ x0)). -simpl in |- *; apply csf_wd_unfolded. -case x0; simpl in |- *; algebra. -apply Feq_imp_eq with (Compact Hab). -unfold Hab in |- *; apply Derivative_I_n_unique with (S p) F; - apply Taylor_lemma1. -apply scs_prf. -simpl in |- *; apply csf_wd_unfolded. -generalize H; case x0; case y; auto. + cut (Derivative_I Hab' (PartInt (fi n Hf _ Hi')) + (PartInt (fi (S n) Hf' (S (S p)) (lt_n_S _ _ Hi')))); [ intro | apply Taylor_lemma6 ]. + unfold funct_aux, funct_i' in |- *. + New_Deriv. + apply Feq_reflexive. + Lazy_Included. + apply eq_imp_Feq. + Lazy_Included. + Lazy_Included. + intros x X0 Hx Hx'. + simpl in Hx, Hx'; simpl in |- *. + set (fiSp1 := fi n Hf (S p) Hi') in *. + set (fiSp2 := fi (S n) Hf' (S p) (lt_n_S p (S n) (lt_5 (S p) (S n) Hi'))) in *. + cut (forall x y : subset I, scs_elem _ _ x [=] scs_elem _ _ y -> fiSp1 x [=] fiSp2 y); intros. + set (x1 := Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR1 (ProjIR1 Hx)))) in *. + simpl in (value of x1); fold x1 in |- *. + set (x2 := Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR1 (ProjIR2 Hx')))) in *. + simpl in (value of x2); fold x2 in |- *. + set (x3 := Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR1 (ProjIR1 (ProjIR2 Hx))))) in *. + simpl in (value of x3); fold x3 in |- *. + set (x4 := Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR1 (ProjIR1 Hx')))) in *. + simpl in (value of x4); fold x4 in |- *. + set (x5 := Build_subcsetoid_crr IR _ _ (ProjIR1 (ProjIR2 (ProjIR1 (ProjIR2 Hx))))) in *. + simpl in (value of x5); fold x5 in |- *. + set (fiSSp := fi (S n) Hf' (S (S p)) (lt_n_S (S p) (S n) Hi')) in *. + set (pp := One[/] nring (fac p + p * fac p) [//]nring_fac_ap_zero IR (S p)) in *. + set (bxp := nexp _ p (b[-]x)) in *. + set (a1 := fiSp1 x1) in *; set (a5 := fiSSp x5) in *; + simpl in (value of a1), (value of a5); fold a1 a5 in |- *. + rstepl (a5[*]pp[*] (bxp[*] (b[-]x)) [-]a1[*] ((nring p[+]One) [*]pp) [*]bxp). + unfold a1, a5 in |- *; clear a1 a5. + Lazy_Eq. + unfold x4, x5 in |- *; algebra. + simpl in |- *; algebra. + unfold pp in |- *. + rstepr (nring (S p) [*] (One[/] _[//] mult_resp_ap_zero _ _ _ (nring_fac_ap_zero _ p) + (pos_ap_zero _ _ (pos_nring_S IR p)))); simpl in |- *. + apply mult_wdr; apply div_wd. + algebra. + clear X H bxp pp x5 x4 x3 x2 x1 fiSSp fiSp1 fiSp2 Hx. + cut (fac p + p * fac p = fac p * S p). + intro; rewrite H. + eapply eq_transitive_unfolded. + apply nring_comm_mult. + algebra. + transitivity (S p * fac p); auto with arith. + unfold fiSp1, fiSp2 in |- *. + apply eq_transitive_unfolded with (PartInt (fi n Hf (S p) Hi') (scs_elem _ _ x0) (scs_prf _ _ x0)). + 2: apply eq_transitive_unfolded with (PartInt (fi (S n) Hf' (S p) (lt_n_S _ _ (lt_5 _ _ Hi'))) + (scs_elem _ _ x0) (scs_prf _ _ x0)). + simpl in |- *; apply csf_wd_unfolded. + case x0; simpl in |- *; algebra. + apply Feq_imp_eq with (Compact Hab). + unfold Hab in |- *; apply Derivative_I_n_unique with (S p) F; apply Taylor_lemma1. + apply scs_prf. + simpl in |- *; apply csf_wd_unfolded. + generalize H; case x0; case y; auto. Qed. Lemma Taylor_lemma8 : forall n Hf Hf' Hi, Derivative_I Hab' (funct_i' n Hf 0 Hi) (funct_aux n Hf' 0 Hi). -intros. -cut - (Derivative_I Hab' (PartInt (fi n Hf _ Hi)) - (PartInt (fi (S n) Hf' 1 (lt_n_S _ _ Hi)))); - [ intro | apply Taylor_lemma6 ]. -unfold funct_aux, funct_i' in |- *; New_Deriv. -apply Feq_reflexive; Lazy_Included. -apply eq_imp_Feq. -Lazy_Included. -Lazy_Included. -intros; simpl in |- *. -apply - eq_transitive_unfolded - with - (fi (S n) Hf' 1 (lt_n_S _ _ Hi) - (Build_subcsetoid_crr _ _ _ (ProjIR1 (ProjIR2 (ProjIR1 (ProjIR2 Hx))))) [*] +Proof. + intros. + cut (Derivative_I Hab' (PartInt (fi n Hf _ Hi)) (PartInt (fi (S n) Hf' 1 (lt_n_S _ _ Hi)))); + [ intro | apply Taylor_lemma6 ]. + unfold funct_aux, funct_i' in |- *; New_Deriv. + apply Feq_reflexive; Lazy_Included. + apply eq_imp_Feq. + Lazy_Included. + Lazy_Included. + intros; simpl in |- *. + apply eq_transitive_unfolded with (fi (S n) Hf' 1 (lt_n_S _ _ Hi) + (Build_subcsetoid_crr _ _ _ (ProjIR1 (ProjIR2 (ProjIR1 (ProjIR2 Hx))))) [*] (One[/] _[//]nring_fac_ap_zero IR 0) [*]One). -simpl in |- *; rational. -Lazy_Eq; simpl in |- *; algebra. + simpl in |- *; rational. + Lazy_Eq; simpl in |- *; algebra. Qed. Lemma Taylor_lemma9 : forall n Hf Hf', Derivative_I Hab' (Taylor_seq'_aux n Hf) (funct_aux n Hf' n (lt_n_Sn n)). -intro; induction n as [| n Hrecn]. -intros. -unfold Taylor_seq'_aux in |- *; simpl in |- *. -apply Derivative_I_wdl with (funct_i' 0 Hf 0 (lt_n_Sn 0)). -apply eq_imp_Feq. -split; split; simpl in |- *; auto. -split; split; split; simpl in |- *; auto. -intros; simpl in |- *. -apply - eq_transitive_unfolded - with - (Zero[+] - fi 0 Hf 0 (lt_n_Sn 0) - (Build_subcsetoid_crr _ _ _ (ProjIR1 (ProjIR1 Hx))) [*] - (One[/] Zero[+]One[//]nring_fac_ap_zero IR 0) [*]One). -simpl in |- *; rational. -Lazy_Eq; simpl in |- *; algebra. -apply Taylor_lemma8; assumption. -cut {p : nat | S n = p}; [ intro H | exists (S n); auto ]. -elim H; intros p H0. -rewrite H0. -intros. -unfold Taylor_seq'_aux in |- *; simpl in |- *. -generalize Hf Hf'; clear Hf Hf'. -rewrite <- H0; intros. -cut (Diffble_I_n Hab' n F); - [ intro H1 | apply le_imp_Diffble_I with (S n); [ omega | assumption ] ]. -apply - Derivative_I_wdl - with (Taylor_seq'_aux n H1{+}funct_i' _ Hf _ (lt_n_Sn (S n))). -unfold Taylor_seq'_aux in |- *. -apply eq_imp_Feq. -repeat (split; auto). try rename X into H2. -apply FSumx_pred'. -red in |- *; intros. try rename X into H6. -exact (Taylor_lemma3' _ _ _ _ H3 _ _ _ _ H4 H6). -intros; simpl in |- *; repeat (split; auto). -repeat (split; auto). try rename X into H2. -apply FSumx_pred'. -red in |- *; intros. try rename X into H6. -exact (Taylor_lemma3' _ _ _ _ H3 _ _ _ _ H4 H6). -intros; simpl in |- *; repeat (split; auto). -intros x H2 Hx Hx'; simpl in |- *. -repeat first - [ simple apply mult_wd - | simple apply bin_op_wd_unfolded - | simple apply csf_wd_unfolded - | simple apply eq_reflexive_unfolded ]; simpl in |- *. -3: algebra. -apply Feq_imp_eq with (Compact Hab). -2: assumption. -apply FSumx_wd'. -intros; apply eq_imp_Feq. -repeat (split; auto). -repeat (split; auto). -intros x0 H4; intros; simpl in |- *. -repeat apply mult_wdl. -apply eq_transitive_unfolded with (PartInt (fi n H1 i (lt_S _ _ H3)) x0 H4). -simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -apply - eq_transitive_unfolded - with (PartInt (fi (S n) Hf i (lt_S _ _ (lt_S _ _ H'))) x0 H4). -2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -apply Feq_imp_eq with (Compact Hab). -unfold Hab in |- *; apply Derivative_I_n_unique with i F; apply Taylor_lemma1. -auto. -apply eq_transitive_unfolded with (PartInt (fi n H1 n (lt_n_Sn _)) x H2). -2: apply - eq_transitive_unfolded - with (PartInt (fi (S n) Hf n (lt_S _ _ (lt_n_Sn _))) x H2). -simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -apply Feq_imp_eq with (Compact Hab). -unfold Hab in |- *; apply Derivative_I_n_unique with n F; apply Taylor_lemma1. -auto. -apply - Derivative_I_wdr - with - (funct_aux (S n) Hf' (pred (S n)) (lt_5 _ _ (lt_n_Sn (S n))) {+} - (funct_aux _ Hf' _ (lt_n_Sn (S n)) {-} - funct_aux (S n) Hf' (pred (S n)) (lt_5 _ _ (lt_n_Sn (S n))))). -Opaque funct_aux. -FEQ. -Transparent funct_aux. -repeat (split; auto). -repeat (split; auto). -apply Derivative_I_plus. -apply Derivative_I_wdr with (funct_aux n Hf n (lt_n_Sn n)). -apply eq_imp_Feq. -repeat (split; auto). -repeat (split; auto). -intros x H2 Hx Hx'; simpl in |- *. -repeat apply mult_wdl. -apply - eq_transitive_unfolded - with (PartInt (fi (S n) Hf (S n) (lt_n_S _ _ (lt_n_Sn _))) x H2). -2: apply - eq_transitive_unfolded - with - (PartInt - (fi (S (S n)) Hf' (S n) (lt_n_S _ _ (lt_5 _ _ (lt_n_Sn (S n))))) x - H2). -simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -apply Feq_imp_eq with (Compact Hab). -unfold Hab in |- *; apply Derivative_I_n_unique with (S n) F; - apply Taylor_lemma1. -auto. -apply Hrecn. -apply Taylor_lemma7. -omega. +Proof. + intro; induction n as [| n Hrecn]. + intros. + unfold Taylor_seq'_aux in |- *; simpl in |- *. + apply Derivative_I_wdl with (funct_i' 0 Hf 0 (lt_n_Sn 0)). + apply eq_imp_Feq. + split; split; simpl in |- *; auto. + split; split; split; simpl in |- *; auto. + intros; simpl in |- *. + apply eq_transitive_unfolded with (Zero[+] fi 0 Hf 0 (lt_n_Sn 0) + (Build_subcsetoid_crr _ _ _ (ProjIR1 (ProjIR1 Hx))) [*] + (One[/] Zero[+]One[//]nring_fac_ap_zero IR 0) [*]One). + simpl in |- *; rational. + Lazy_Eq; simpl in |- *; algebra. + apply Taylor_lemma8; assumption. + cut {p : nat | S n = p}; [ intro H | exists (S n); auto ]. + elim H; intros p H0. + rewrite H0. + intros. + unfold Taylor_seq'_aux in |- *; simpl in |- *. + generalize Hf Hf'; clear Hf Hf'. + rewrite <- H0; intros. + cut (Diffble_I_n Hab' n F); [ intro H1 | apply le_imp_Diffble_I with (S n); [ omega | assumption ] ]. + apply Derivative_I_wdl with (Taylor_seq'_aux n H1{+}funct_i' _ Hf _ (lt_n_Sn (S n))). + unfold Taylor_seq'_aux in |- *. + apply eq_imp_Feq. + repeat (split; auto). try rename X into H2. + apply FSumx_pred'. + red in |- *; intros. try rename X into H6. + exact (Taylor_lemma3' _ _ _ _ H3 _ _ _ _ H4 H6). + intros; simpl in |- *; repeat (split; auto). + repeat (split; auto). try rename X into H2. + apply FSumx_pred'. + red in |- *; intros. try rename X into H6. + exact (Taylor_lemma3' _ _ _ _ H3 _ _ _ _ H4 H6). + intros; simpl in |- *; repeat (split; auto). + intros x H2 Hx Hx'; simpl in |- *. + repeat first [ simple apply mult_wd | simple apply bin_op_wd_unfolded | simple apply csf_wd_unfolded + | simple apply eq_reflexive_unfolded ]; simpl in |- *. + 3: algebra. + apply Feq_imp_eq with (Compact Hab). + 2: assumption. + apply FSumx_wd'. + intros; apply eq_imp_Feq. + repeat (split; auto). + repeat (split; auto). + intros x0 H4; intros; simpl in |- *. + repeat apply mult_wdl. + apply eq_transitive_unfolded with (PartInt (fi n H1 i (lt_S _ _ H3)) x0 H4). + simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + apply eq_transitive_unfolded with (PartInt (fi (S n) Hf i (lt_S _ _ (lt_S _ _ H'))) x0 H4). + 2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + apply Feq_imp_eq with (Compact Hab). + unfold Hab in |- *; apply Derivative_I_n_unique with i F; apply Taylor_lemma1. + auto. + apply eq_transitive_unfolded with (PartInt (fi n H1 n (lt_n_Sn _)) x H2). + 2: apply eq_transitive_unfolded with (PartInt (fi (S n) Hf n (lt_S _ _ (lt_n_Sn _))) x H2). + simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + 2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + apply Feq_imp_eq with (Compact Hab). + unfold Hab in |- *; apply Derivative_I_n_unique with n F; apply Taylor_lemma1. + auto. + apply Derivative_I_wdr with (funct_aux (S n) Hf' (pred (S n)) (lt_5 _ _ (lt_n_Sn (S n))) {+} + (funct_aux _ Hf' _ (lt_n_Sn (S n)) {-} + funct_aux (S n) Hf' (pred (S n)) (lt_5 _ _ (lt_n_Sn (S n))))). + Opaque funct_aux. + FEQ. + Transparent funct_aux. + repeat (split; auto). + repeat (split; auto). + apply Derivative_I_plus. + apply Derivative_I_wdr with (funct_aux n Hf n (lt_n_Sn n)). + apply eq_imp_Feq. + repeat (split; auto). + repeat (split; auto). + intros x H2 Hx Hx'; simpl in |- *. + repeat apply mult_wdl. + apply eq_transitive_unfolded with (PartInt (fi (S n) Hf (S n) (lt_n_S _ _ (lt_n_Sn _))) x H2). + 2: apply eq_transitive_unfolded with (PartInt + (fi (S (S n)) Hf' (S n) (lt_n_S _ _ (lt_5 _ _ (lt_n_Sn (S n))))) x H2). + simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + 2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + apply Feq_imp_eq with (Compact Hab). + unfold Hab in |- *; apply Derivative_I_n_unique with (S n) F; apply Taylor_lemma1. + auto. + apply Hrecn. + apply Taylor_lemma7. + omega. Qed. Let g' n Hf Hf' Hab := @@ -705,21 +647,21 @@ Let g' n Hf Hf' Hab := Lemma Taylor_lemma10 : forall n Hf Hf' Hab (H : a [#] b), Derivative_I Hab' (g n Hf Hab) (g' n Hf Hf' Hab). -unfold g, g' in |- *. -intros. -cut - (Derivative_I Hab' (Taylor_seq'_aux n Hf) (funct_aux n Hf' n (lt_n_Sn n))); - [ intro | apply Taylor_lemma9; assumption ]. -Opaque Taylor_rem funct_aux. -New_Deriv. -apply Feq_reflexive; Lazy_Included. -Included. -apply eq_imp_Feq. -Lazy_Included. -Included. -Lazy_Included. -Included. -intros; simpl in |- *; rational. +Proof. + unfold g, g' in |- *. + intros. + cut (Derivative_I Hab' (Taylor_seq'_aux n Hf) (funct_aux n Hf' n (lt_n_Sn n))); + [ intro | apply Taylor_lemma9; assumption ]. + Opaque Taylor_rem funct_aux. + New_Deriv. + apply Feq_reflexive; Lazy_Included. + Included. + apply eq_imp_Feq. + Lazy_Included. + Included. + Lazy_Included. + Included. + intros; simpl in |- *; rational. Qed. Transparent Taylor_rem funct_aux. @@ -738,70 +680,71 @@ Hypothesis He : Zero [<] e. (* begin hide *) Lemma Taylor_lemma11 : forall n Hf Hf' H, {c : IR | I c | forall Hc, AbsIR (g' n Hf Hf' H c Hc) [<=] e[*]AbsIR (One[/] (b[-]a) [//]H)}. -intros. -cut (Dom (g n Hf H) (Min a b)). intro H0. -cut (Dom (g n Hf H) (Max a b)). intro H1. -cut (Dom (g n Hf H) a). intro H2. -cut (Dom (g n Hf H) b). intro H3. -unfold I, Hab in |- *; apply Rolle with (g n Hf H) H0 H1. -apply Taylor_lemma10; auto. -elim (ap_imp_less _ _ _ Hap); intro. -apply eq_transitive_unfolded with ZeroR. -eapply eq_transitive_unfolded. -2: apply Taylor_lemma4 with (Ha' := H2). -apply pfwdef; apply leEq_imp_Min_is_lft; apply less_leEq; auto. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -2: apply Taylor_lemma5 with (Hb' := H3). -apply pfwdef; apply leEq_imp_Max_is_rht; apply less_leEq; auto. -apply eq_transitive_unfolded with ZeroR. -eapply eq_transitive_unfolded. -2: apply Taylor_lemma5 with (Hb' := H3). -apply pfwdef; eapply eq_transitive_unfolded. -apply Min_comm. -apply leEq_imp_Min_is_lft; apply less_leEq; auto. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -2: apply Taylor_lemma4 with (Ha' := H2). -apply pfwdef; eapply eq_transitive_unfolded. -apply Max_comm. -apply leEq_imp_Max_is_rht; apply less_leEq; auto. -astepl (Zero[*]AbsIR (One[/] _[//]H)). -apply mult_resp_less. -assumption. -apply AbsIR_pos. -apply div_resp_ap_zero_rev. -apply one_ap_zero. -split; split; split; simpl in |- *; auto. -3: split; split. -2: split; split; auto; apply TL_compact_b. -apply FSumx_pred'; intros. -2: apply TL_b_i'. -red in |- *; intros. try rename X into H6. -exact (Taylor_lemma3' _ _ _ _ H3 _ _ _ _ H4 H6). -split; split; split; simpl in |- *; auto. -3: split; split. -2: split; split; auto; apply TL_compact_a. -apply FSumx_pred'; intros. -2: apply TL_a_i'. -red in |- *; intros. try rename X into H5. -exact (Taylor_lemma3' _ _ _ _ H2 _ _ _ _ H3 H5). -split; split; split; simpl in |- *; auto. -3: split; split. -2: split; split; auto; apply compact_inc_rht. -apply FSumx_pred'; intros. -2: apply TL_x_i'. -red in |- *; intros. try rename X into H4. -exact (Taylor_lemma3' _ _ _ _ H1 _ _ _ _ H2 H4). -unfold I in |- *; apply compact_inc_rht. -split; split; split; simpl in |- *; auto. -3: split; split. -2: split; split; auto; apply compact_inc_lft. -apply FSumx_pred'; intros. -2: apply TL_x_i'. -red in |- *; intros. try rename X into H3. -exact (Taylor_lemma3' _ _ _ _ H0 _ _ _ _ H1 H3). -unfold I in |- *; apply compact_inc_lft. +Proof. + intros. + cut (Dom (g n Hf H) (Min a b)). intro H0. + cut (Dom (g n Hf H) (Max a b)). intro H1. + cut (Dom (g n Hf H) a). intro H2. + cut (Dom (g n Hf H) b). intro H3. + unfold I, Hab in |- *; apply Rolle with (g n Hf H) H0 H1. + apply Taylor_lemma10; auto. + elim (ap_imp_less _ _ _ Hap); intro. + apply eq_transitive_unfolded with ZeroR. + eapply eq_transitive_unfolded. + 2: apply Taylor_lemma4 with (Ha' := H2). + apply pfwdef; apply leEq_imp_Min_is_lft; apply less_leEq; auto. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + 2: apply Taylor_lemma5 with (Hb' := H3). + apply pfwdef; apply leEq_imp_Max_is_rht; apply less_leEq; auto. + apply eq_transitive_unfolded with ZeroR. + eapply eq_transitive_unfolded. + 2: apply Taylor_lemma5 with (Hb' := H3). + apply pfwdef; eapply eq_transitive_unfolded. + apply Min_comm. + apply leEq_imp_Min_is_lft; apply less_leEq; auto. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + 2: apply Taylor_lemma4 with (Ha' := H2). + apply pfwdef; eapply eq_transitive_unfolded. + apply Max_comm. + apply leEq_imp_Max_is_rht; apply less_leEq; auto. + astepl (Zero[*]AbsIR (One[/] _[//]H)). + apply mult_resp_less. + assumption. + apply AbsIR_pos. + apply div_resp_ap_zero_rev. + apply one_ap_zero. + split; split; split; simpl in |- *; auto. + 3: split; split. + 2: split; split; auto; apply TL_compact_b. + apply FSumx_pred'; intros. + 2: apply TL_b_i'. + red in |- *; intros. try rename X into H6. + exact (Taylor_lemma3' _ _ _ _ H3 _ _ _ _ H4 H6). + split; split; split; simpl in |- *; auto. + 3: split; split. + 2: split; split; auto; apply TL_compact_a. + apply FSumx_pred'; intros. + 2: apply TL_a_i'. + red in |- *; intros. try rename X into H5. + exact (Taylor_lemma3' _ _ _ _ H2 _ _ _ _ H3 H5). + split; split; split; simpl in |- *; auto. + 3: split; split. + 2: split; split; auto; apply compact_inc_rht. + apply FSumx_pred'; intros. + 2: apply TL_x_i'. + red in |- *; intros. try rename X into H4. + exact (Taylor_lemma3' _ _ _ _ H1 _ _ _ _ H2 H4). + unfold I in |- *; apply compact_inc_rht. + split; split; split; simpl in |- *; auto. + 3: split; split. + 2: split; split; auto; apply compact_inc_lft. + apply FSumx_pred'; intros. + 2: apply TL_x_i'. + red in |- *; intros. try rename X into H3. + exact (Taylor_lemma3' _ _ _ _ H0 _ _ _ _ H1 H3). + unfold I in |- *; apply compact_inc_lft. Qed. (* end hide *) @@ -812,77 +755,68 @@ Let deriv_Sn' n Hf' := (* begin hide *) Lemma TLH : b[-]a [#] Zero. -rstepl ( [--] (a[-]b)). -apply inv_resp_ap_zero. -apply minus_ap_zero; auto. +Proof. + rstepl ( [--] (a[-]b)). + apply inv_resp_ap_zero. + apply minus_ap_zero; auto. Qed. (* end hide *) Lemma Taylor_lemma : forall n Hf Hf', {c : IR | I c | forall Hc, AbsIR (Taylor_rem n Hf[-]deriv_Sn' n Hf' c Hc[*] (b[-]a)) [<=] e}. -intros. -assert (H := TLH). -cut - {c : IR | I c | - forall Hc, AbsIR (g' n Hf Hf' H c Hc) [<=] e[*]AbsIR (One[/] _[//]H)}; - [ intro H0 | apply Taylor_lemma11; assumption ]. -elim H0; intros c Hc' Hc; clear H0; exists c. -auto. -intro. -cut (Dom (funct_aux n Hf' n (lt_n_Sn n)) c). intro H0. -apply - leEq_wdl - with (AbsIR (((Taylor_rem n Hf[/] _[//]H) [-]Part _ _ H0) [*] (b[-]a))). -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply shift_mult_leEq with (AbsIR_resp_ap_zero _ H). -apply AbsIR_pos; apply H. -rstepr (e[*] (One[/] _[//]AbsIR_resp_ap_zero _ H)). -apply leEq_wdr with (e[*]AbsIR (One[/] _[//]H)). -Opaque funct_aux. -cut (Dom (g' n Hf Hf' H) c). intro H1. -eapply leEq_wdl. -apply (Hc H1). -apply AbsIR_wd; unfold g' in |- *. -Opaque Taylor_rem. -simpl in |- *; rational. -repeat (split; auto). -apply mult_wdr. -apply AbsIR_recip. -apply eq_symmetric_unfolded. -apply - eq_transitive_unfolded - with (AbsIR ((Taylor_rem n Hf[/] _[//]H) [-]Part _ _ H0) [*]AbsIR (b[-]a)). -eapply eq_transitive_unfolded. -2: apply AbsIR_resp_mult. -apply AbsIR_wd. -rstepr (Taylor_rem n Hf[-]Part _ _ H0[*] (b[-]a)). -apply cg_minus_wd. -algebra. -apply mult_wdl. -Transparent Taylor_rem funct_aux. -unfold deriv_Sn', funct_aux in |- *. -cut (Dom (n_deriv_I _ _ Hab' (S n) F Hf') c). intro H1. -simpl in |- *; - apply - eq_transitive_unfolded - with - (n_deriv_I _ _ Hab' (S n) F Hf' c H1[*] +Proof. + intros. + assert (H := TLH). + cut {c : IR | I c | forall Hc, AbsIR (g' n Hf Hf' H c Hc) [<=] e[*]AbsIR (One[/] _[//]H)}; + [ intro H0 | apply Taylor_lemma11; assumption ]. + elim H0; intros c Hc' Hc; clear H0; exists c. + auto. + intro. + cut (Dom (funct_aux n Hf' n (lt_n_Sn n)) c). intro H0. + apply leEq_wdl with (AbsIR (((Taylor_rem n Hf[/] _[//]H) [-]Part _ _ H0) [*] (b[-]a))). + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply shift_mult_leEq with (AbsIR_resp_ap_zero _ H). + apply AbsIR_pos; apply H. + rstepr (e[*] (One[/] _[//]AbsIR_resp_ap_zero _ H)). + apply leEq_wdr with (e[*]AbsIR (One[/] _[//]H)). + Opaque funct_aux. + cut (Dom (g' n Hf Hf' H) c). intro H1. + eapply leEq_wdl. + apply (Hc H1). + apply AbsIR_wd; unfold g' in |- *. + Opaque Taylor_rem. + simpl in |- *; rational. + repeat (split; auto). + apply mult_wdr. + apply AbsIR_recip. + apply eq_symmetric_unfolded. + apply eq_transitive_unfolded + with (AbsIR ((Taylor_rem n Hf[/] _[//]H) [-]Part _ _ H0) [*]AbsIR (b[-]a)). + eapply eq_transitive_unfolded. + 2: apply AbsIR_resp_mult. + apply AbsIR_wd. + rstepr (Taylor_rem n Hf[-]Part _ _ H0[*] (b[-]a)). + apply cg_minus_wd. + algebra. + apply mult_wdl. + Transparent Taylor_rem funct_aux. + unfold deriv_Sn', funct_aux in |- *. + cut (Dom (n_deriv_I _ _ Hab' (S n) F Hf') c). intro H1. + simpl in |- *; apply eq_transitive_unfolded with (n_deriv_I _ _ Hab' (S n) F Hf' c H1[*] (One[/] _[//]nring_fac_ap_zero _ n) [*] (b[-]c) [^]n). -repeat apply mult_wdl; apply pfwdef; algebra. -repeat apply mult_wdl. -apply - eq_transitive_unfolded - with (PartInt (fi (S n) Hf' (S n) (lt_n_S _ _ (lt_n_Sn _))) c Hc'). -2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. -apply Feq_imp_eq with (Compact Hab). -unfold Hab in |- *; apply Derivative_I_n_unique with (S n) F. -apply n_deriv_lemma. -apply Taylor_lemma1. -auto. -apply n_deriv_inc; auto. -apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -repeat (split; auto). + repeat apply mult_wdl; apply pfwdef; algebra. + repeat apply mult_wdl. + apply eq_transitive_unfolded with (PartInt (fi (S n) Hf' (S n) (lt_n_S _ _ (lt_n_Sn _))) c Hc'). + 2: simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra. + apply Feq_imp_eq with (Compact Hab). + unfold Hab in |- *; apply Derivative_I_n_unique with (S n) F. + apply n_deriv_lemma. + apply Taylor_lemma1. + auto. + apply n_deriv_inc; auto. + apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + repeat (split; auto). Qed. End Taylor_Defs. diff --git a/ftc/WeakIVT.v b/ftc/WeakIVT.v index bb0691f6e..12ca58af3 100644 --- a/ftc/WeakIVT.v +++ b/ftc/WeakIVT.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing ** %\ensuremath\times% #×# *) @@ -72,7 +72,7 @@ Hypothesis contF : Continuous_I Hab F. the interval [[a,b]]. Let [F] be a continuous function on [I]. %\end{convention}% -We begin by proving that, if [f(a) [<] f(b)], then for every [y] in +We begin by proving that, if [f(a) [<] f(b)], then for every [y] in [[f(a),f(b)]] there is an $x\in[a,b]$#x∈[a,b]# such that [f(x)] is close enough to [z]. *) @@ -80,124 +80,115 @@ enough to [z]. Lemma Weak_IVT_ap_lft : forall Ha Hb (HFab : F a Ha [<] F b Hb) e, Zero [<] e -> forall z, Compact (less_leEq _ _ _ HFab) z -> {x : IR | Compact Hab x | forall Hx, AbsIR (F x Hx[-]z) [<=] e}. -intros Ha Hb HFab e H z H0. -cut (a [<] b). -intro Hab'. -set (G := FAbs (F{-}[-C-]z)) in *. -assert (H1 : Continuous_I Hab G). -unfold G in |- *; Contin. -set (m := glb_funct _ _ _ _ H1) in *. -elim (glb_is_glb _ _ _ _ H1). -fold m in |- *; intros. -cut (forall x : IR, Compact Hab x -> forall Hx, m [<=] AbsIR (F x Hx[-]z)); - [ clear a0; intro a0 | intros ]. -elim (less_cotransitive_unfolded _ _ _ H m); intros. - -elim H0; clear H0; intros H0 H0'. -cut (F a Ha[-]z [<=] [--]m); intros. -cut (m [<=] F b Hb[-]z); intros. -elimtype False. -elim (contin_prop _ _ _ _ contF m a1); intros d H4 H5. -set (incF := contin_imp_inc _ _ _ _ contF) in *. -set - (f := - fun i Hi => - F (compact_part _ _ Hab' d H4 i Hi) - (incF _ (compact_part_hyp _ _ Hab Hab' d H4 i Hi)) [-]z) - in *. -set (n := compact_nat a b d H4) in *. -cut (forall i Hi, f i Hi [<=] Zero). -intros. -apply (less_irreflexive_unfolded _ (F b Hb[-]z)). -eapply less_leEq_trans. -2: apply H3. -apply leEq_less_trans with ZeroR. -2: auto. -apply leEq_wdl with (f _ (le_n n)); auto. -unfold f, compact_part, n in |- *; simpl in |- *. -apply cg_minus_wd; [ apply pfwdef; rational | algebra ]. -simple induction i. -intros; unfold f, compact_part in |- *. -apply leEq_wdl with (F a Ha[-]z). -apply leEq_transitive with ( [--]m); auto. -astepr ( [--]ZeroR); apply less_leEq; apply inv_resp_less; auto. -apply cg_minus_wd; [apply pfwdef | idtac]; rational. -intros i' Hrec HSi'. -astepr (m[-]m). -apply shift_leEq_minus'. -cut (i' <= n); [ intro Hi' | auto with arith ]. -apply leEq_transitive with ( [--] (f _ Hi') [+]f _ HSi'). -apply plus_resp_leEq. -cut ({m [<=] f _ Hi'} + {f _ Hi' [<=] [--]m}). -intro; inversion_clear H6. -elimtype False. -apply (less_irreflexive_unfolded _ m). -apply leEq_less_trans with ZeroR. -eapply leEq_transitive; [ apply H7 | apply (Hrec Hi') ]. -auto. -astepl ( [--][--]m); apply inv_resp_leEq; auto. -apply leEq_distr_AbsIR. -assumption. -unfold f in |- *; apply a0; apply compact_part_hyp. -rstepl (f _ HSi'[-]f _ Hi'). -eapply leEq_transitive. -apply leEq_AbsIR. -unfold f in |- *; simpl in |- *. -apply - leEq_wdl - with - (AbsIR - (F _ (incF _ (compact_part_hyp _ _ Hab Hab' d H4 _ HSi')) [-] +Proof. + intros Ha Hb HFab e H z H0. + cut (a [<] b). + intro Hab'. + set (G := FAbs (F{-}[-C-]z)) in *. + assert (H1 : Continuous_I Hab G). + unfold G in |- *; Contin. + set (m := glb_funct _ _ _ _ H1) in *. + elim (glb_is_glb _ _ _ _ H1). + fold m in |- *; intros. + cut (forall x : IR, Compact Hab x -> forall Hx, m [<=] AbsIR (F x Hx[-]z)); + [ clear a0; intro a0 | intros ]. + elim (less_cotransitive_unfolded _ _ _ H m); intros. + elim H0; clear H0; intros H0 H0'. + cut (F a Ha[-]z [<=] [--]m); intros. + cut (m [<=] F b Hb[-]z); intros. + elimtype False. + elim (contin_prop _ _ _ _ contF m a1); intros d H4 H5. + set (incF := contin_imp_inc _ _ _ _ contF) in *. + set (f := fun i Hi => F (compact_part _ _ Hab' d H4 i Hi) + (incF _ (compact_part_hyp _ _ Hab Hab' d H4 i Hi)) [-]z) in *. + set (n := compact_nat a b d H4) in *. + cut (forall i Hi, f i Hi [<=] Zero). + intros. + apply (less_irreflexive_unfolded _ (F b Hb[-]z)). + eapply less_leEq_trans. + 2: apply H3. + apply leEq_less_trans with ZeroR. + 2: auto. + apply leEq_wdl with (f _ (le_n n)); auto. + unfold f, compact_part, n in |- *; simpl in |- *. + apply cg_minus_wd; [ apply pfwdef; rational | algebra ]. + simple induction i. + intros; unfold f, compact_part in |- *. + apply leEq_wdl with (F a Ha[-]z). + apply leEq_transitive with ( [--]m); auto. + astepr ( [--]ZeroR); apply less_leEq; apply inv_resp_less; auto. + apply cg_minus_wd; [apply pfwdef | idtac]; rational. + intros i' Hrec HSi'. + astepr (m[-]m). + apply shift_leEq_minus'. + cut (i' <= n); [ intro Hi' | auto with arith ]. + apply leEq_transitive with ( [--] (f _ Hi') [+]f _ HSi'). + apply plus_resp_leEq. + cut ({m [<=] f _ Hi'} + {f _ Hi' [<=] [--]m}). + intro; inversion_clear H6. + elimtype False. + apply (less_irreflexive_unfolded _ m). + apply leEq_less_trans with ZeroR. + eapply leEq_transitive; [ apply H7 | apply (Hrec Hi') ]. + auto. + astepl ( [--][--]m); apply inv_resp_leEq; auto. + apply leEq_distr_AbsIR. + assumption. + unfold f in |- *; apply a0; apply compact_part_hyp. + rstepl (f _ HSi'[-]f _ Hi'). + eapply leEq_transitive. + apply leEq_AbsIR. + unfold f in |- *; simpl in |- *. + apply leEq_wdl with (AbsIR (F _ (incF _ (compact_part_hyp _ _ Hab Hab' d H4 _ HSi')) [-] F _ (incF _ (compact_part_hyp _ _ Hab Hab' d H4 _ Hi')))). -apply H5; try apply compact_part_hyp. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply compact_leEq. -apply less_leEq; apply compact_less. -apply AbsIR_wd; rational. -eapply leEq_wdr. -2: apply AbsIR_eq_x. -apply a0; apply compact_inc_rht. -apply shift_leEq_minus; astepl z; auto. -astepl ( [--][--] (F a Ha[-]z)); apply inv_resp_leEq. -eapply leEq_wdr. -2: apply AbsIR_eq_inv_x. -apply a0; apply compact_inc_lft. -apply shift_minus_leEq; astepr z; auto. - -elim (b0 (e[-]m)); intros. -elim p; clear p b0; intros y Hy. -elim Hy; intros. -elim b0; clear b0; intros H2 H3. -exists y; auto. -intro. -apply leEq_wdl with (G y H2). -apply less_leEq. -apply plus_cancel_less with ( [--]m). -eapply less_wdl. -apply q. -unfold cg_minus in |- *; algebra. -unfold G in |- *. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 H2))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; algebra. -apply shift_less_minus; astepl m; auto. -apply a0. -exists x. -split. -auto. -repeat split; auto. -intro; unfold G in |- *. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 Hy))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; algebra. -set (H1 := less_imp_ap _ _ _ HFab) in *. -set (H2 := pfstrx _ _ _ _ _ _ H1) in *. -elim (ap_imp_less _ _ _ H2); intro. -auto. -elimtype False. -apply (less_irreflexive_unfolded _ a). -apply leEq_less_trans with b; auto. + apply H5; try apply compact_part_hyp. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply compact_leEq. + apply less_leEq; apply compact_less. + apply AbsIR_wd; rational. + eapply leEq_wdr. + 2: apply AbsIR_eq_x. + apply a0; apply compact_inc_rht. + apply shift_leEq_minus; astepl z; auto. + astepl ( [--][--] (F a Ha[-]z)); apply inv_resp_leEq. + eapply leEq_wdr. + 2: apply AbsIR_eq_inv_x. + apply a0; apply compact_inc_lft. + apply shift_minus_leEq; astepr z; auto. + elim (b0 (e[-]m)); intros. + elim p; clear p b0; intros y Hy. + elim Hy; intros. + elim b0; clear b0; intros H2 H3. + exists y; auto. + intro. + apply leEq_wdl with (G y H2). + apply less_leEq. + apply plus_cancel_less with ( [--]m). + eapply less_wdl. + apply q. + unfold cg_minus in |- *; algebra. + unfold G in |- *. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 H2))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; algebra. + apply shift_less_minus; astepl m; auto. + apply a0. + exists x. + split. + auto. + repeat split; auto. + intro; unfold G in |- *. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 Hy))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; algebra. + set (H1 := less_imp_ap _ _ _ HFab) in *. + set (H2 := pfstrx _ _ _ _ _ _ H1) in *. + elim (ap_imp_less _ _ _ H2); intro. + auto. + elimtype False. + apply (less_irreflexive_unfolded _ a). + apply leEq_less_trans with b; auto. Qed. End Lemma1. @@ -220,22 +211,22 @@ If [f(b) [<] f(a)], a similar result holds: Lemma Weak_IVT_ap_rht : forall Ha Hb (HFab : F b Hb [<] F a Ha) e, Zero [<] e -> forall z, Compact (less_leEq _ _ _ HFab) z -> {x : IR | Compact Hab x | forall Hx, AbsIR (F x Hx[-]z) [<=] e}. -intros Ha Hb HFab e H z H0. -set (G := {--}F) in *. -assert (contG : Continuous_I Hab G). -unfold G in |- *; Contin. -assert (HGab : G a Ha [<] G b Hb). -unfold G in |- *; simpl in |- *; apply inv_resp_less; auto. -assert (H1 : Compact (less_leEq _ _ _ HGab) [--]z). -inversion_clear H0; split; unfold G in |- *; simpl in |- *; - apply inv_resp_leEq; auto. -elim (Weak_IVT_ap_lft _ _ _ _ contG _ _ HGab _ H _ H1); intros x Hx. -exists x; auto. -intro; eapply leEq_wdl. -apply (q Hx0). -eapply eq_transitive_unfolded. -apply AbsIR_minus. -apply AbsIR_wd; unfold G in |- *; simpl in |- *; rational. +Proof. + intros Ha Hb HFab e H z H0. + set (G := {--}F) in *. + assert (contG : Continuous_I Hab G). + unfold G in |- *; Contin. + assert (HGab : G a Ha [<] G b Hb). + unfold G in |- *; simpl in |- *; apply inv_resp_less; auto. + assert (H1 : Compact (less_leEq _ _ _ HGab) [--]z). + inversion_clear H0; split; unfold G in |- *; simpl in |- *; apply inv_resp_leEq; auto. + elim (Weak_IVT_ap_lft _ _ _ _ contG _ _ HGab _ H _ H1); intros x Hx. + exists x; auto. + intro; eapply leEq_wdl. + apply (q Hx0). + eapply eq_transitive_unfolded. + apply AbsIR_minus. + apply AbsIR_wd; unfold G in |- *; simpl in |- *; rational. Qed. End Lemma2. @@ -293,45 +284,46 @@ Lemma IVT_seq_lemma : forall (xy : IR ** IR) (x:=fstT xy) (y:=sndT xy) {Hxy0 : (I x0) ** (I y0) | x0 [<] y0 | let Hx0 := fstT Hxy0 in let Hy0 := sndT Hxy0 in F x0 (incF _ Hx0) [<=] z /\ z [<=] F y0 (incF _ Hy0) /\ y0[-]x0 [=] Two [/]ThreeNZ[*] (y[-]x) /\ x [<=] x0 /\ y0 [<=] y}}. -(* begin hide *) -intros xy x y Hxy Hx Hy H H0. -set (x1 := (Two[*]x[+]y) [/]ThreeNZ) in *. -set (y1 := (x[+]Two[*]y) [/]ThreeNZ) in *. -assert (H1 : x1 [<] y1). - unfold x1, y1 in |- *; apply lft_rht; auto. -cut (I x1). intro H2. cut (I y1). intro H3. -cut (F x1 (incF _ H2) [<] F y1 (incF _ H3)); [ intro H4 | auto ]. -elim (less_cotransitive_unfolded _ _ _ H4 z); intros. -exists (pairT x1 y); exists (pairT H2 Hy); simpl in |- *; repeat split; auto. -apply less_leEq_trans with y1. - auto. -apply less_leEq; unfold x1, y1 in |- *; apply rht_b; auto. -apply less_leEq; auto. -elim H0; auto. -unfold x1 in |- *; apply smaller_rht. -unfold x1 in |- *; apply less_leEq; apply a_lft; auto. -apply leEq_reflexive. -exists (pairT x y1); exists (pairT Hx H3); simpl in |- *; repeat split; auto. -apply leEq_less_trans with x1. - apply less_leEq; unfold x1, y1 in |- *; apply a_lft; auto. -auto. -elim H0; auto. -apply less_leEq; auto. -unfold y1 in |- *; apply smaller_lft; auto. -apply leEq_reflexive. -apply less_leEq; unfold y1 in |- *; apply rht_b; auto. -unfold y1 in |- *; inversion_clear Hx; inversion_clear Hy; split. -apply leEq_transitive with x; auto. -apply less_leEq; apply less_transitive_unfolded with x1; unfold x1 in |- *; - [ apply a_lft | apply lft_rht ]; auto. -apply leEq_transitive with y; auto. -apply less_leEq; apply rht_b; auto. -unfold x1 in |- *; inversion_clear Hx; inversion_clear Hy; split. -apply leEq_transitive with x; auto. -apply less_leEq; apply a_lft; auto. -apply leEq_transitive with y; auto. -apply less_leEq; apply less_transitive_unfolded with y1; unfold y1 in |- *; - [ apply lft_rht | apply rht_b ]; auto. +Proof. + (* begin hide *) + intros xy x y Hxy Hx Hy H H0. + set (x1 := (Two[*]x[+]y) [/]ThreeNZ) in *. + set (y1 := (x[+]Two[*]y) [/]ThreeNZ) in *. + assert (H1 : x1 [<] y1). + unfold x1, y1 in |- *; apply lft_rht; auto. + cut (I x1). intro H2. cut (I y1). intro H3. + cut (F x1 (incF _ H2) [<] F y1 (incF _ H3)); [ intro H4 | auto ]. + elim (less_cotransitive_unfolded _ _ _ H4 z); intros. + exists (pairT x1 y); exists (pairT H2 Hy); simpl in |- *; repeat split; auto. + apply less_leEq_trans with y1. + auto. + apply less_leEq; unfold x1, y1 in |- *; apply rht_b; auto. + apply less_leEq; auto. + elim H0; auto. + unfold x1 in |- *; apply smaller_rht. + unfold x1 in |- *; apply less_leEq; apply a_lft; auto. + apply leEq_reflexive. + exists (pairT x y1); exists (pairT Hx H3); simpl in |- *; repeat split; auto. + apply leEq_less_trans with x1. + apply less_leEq; unfold x1, y1 in |- *; apply a_lft; auto. + auto. + elim H0; auto. + apply less_leEq; auto. + unfold y1 in |- *; apply smaller_lft; auto. + apply leEq_reflexive. + apply less_leEq; unfold y1 in |- *; apply rht_b; auto. + unfold y1 in |- *; inversion_clear Hx; inversion_clear Hy; split. + apply leEq_transitive with x; auto. + apply less_leEq; apply less_transitive_unfolded with x1; unfold x1 in |- *; + [ apply a_lft | apply lft_rht ]; auto. + apply leEq_transitive with y; auto. + apply less_leEq; apply rht_b; auto. + unfold x1 in |- *; inversion_clear Hx; inversion_clear Hy; split. + apply leEq_transitive with x; auto. + apply less_leEq; apply a_lft; auto. + apply leEq_transitive with y; auto. + apply less_leEq; apply less_transitive_unfolded with y1; unfold y1 in |- *; + [ apply lft_rht | apply rht_b ]; auto. Qed. (* end hide *) @@ -339,7 +331,7 @@ Qed. We now iterate this construction. *) -Record IVT_aux_seq_type : Type := +Record IVT_aux_seq_type : Type := {IVTseq1 : IR; IVTseq2 : IR; IVTH1 : I IVTseq1; @@ -349,24 +341,24 @@ Record IVT_aux_seq_type : Type := IVTz2 : z [<=] F IVTseq2 (incF _ IVTH2)}. Definition IVT_iter : IVT_aux_seq_type -> IVT_aux_seq_type. -intro Haux; elim Haux; intros. -elim - (IVT_seq_lemma (pairT IVTseq3 IVTseq4) (pairT IVTH3 IVTH4) IVTprf0 - (conj IVTz3 IVTz4)). -intro x; elim x; simpl in |- *; clear x; intros. -elim p. -intro x; elim x; simpl in |- *; clear x; intros. -inversion_clear q. -inversion_clear H0. -inversion_clear H2. -inversion_clear H3. -apply Build_IVT_aux_seq_type with a0 b0 a1 b1; auto. +Proof. + intro Haux; elim Haux; intros. + elim (IVT_seq_lemma (pairT IVTseq3 IVTseq4) (pairT IVTH3 IVTH4) IVTprf0 (conj IVTz3 IVTz4)). + intro x; elim x; simpl in |- *; clear x; intros. + elim p. + intro x; elim x; simpl in |- *; clear x; intros. + inversion_clear q. + inversion_clear H0. + inversion_clear H2. + inversion_clear H3. + apply Build_IVT_aux_seq_type with a0 b0 a1 b1; auto. Defined. Definition IVT_seq : nat -> IVT_aux_seq_type. -intro n; induction n as [| n Hrecn]. -apply Build_IVT_aux_seq_type with a b Ha Hb; auto. -apply (IVT_iter Hrecn). +Proof. + intro n; induction n as [| n Hrecn]. + apply Build_IVT_aux_seq_type with a b Ha Hb; auto. + apply (IVT_iter Hrecn). Defined. (** @@ -380,233 +372,241 @@ Definition a_seq_I (n : nat) : I (a_seq n) := IVTH1 (IVT_seq n). Definition b_seq_I (n : nat) : I (b_seq n) := IVTH2 (IVT_seq n). Lemma a_seq_less_b_seq : forall n : nat, a_seq n [<] b_seq n. -exact (fun n : nat => IVTprf (IVT_seq n)). +Proof. + exact (fun n : nat => IVTprf (IVT_seq n)). Qed. Lemma a_seq_leEq_z : forall n : nat, F _ (incF _ (a_seq_I n)) [<=] z. -exact (fun n : nat => IVTz1 (IVT_seq n)). +Proof. + exact (fun n : nat => IVTz1 (IVT_seq n)). Qed. Lemma z_leEq_b_seq : forall n : nat, z [<=] F _ (incF _ (b_seq_I n)). -exact (fun n : nat => IVTz2 (IVT_seq n)). +Proof. + exact (fun n : nat => IVTz2 (IVT_seq n)). Qed. Lemma a_seq_mon : forall i : nat, a_seq i [<=] a_seq (S i). -intro. -unfold a_seq in |- *. -simpl in |- *. -elim IVT_seq; simpl in |- *; intros. -elim IVT_seq_lemma; simpl in |- *; intro. -elim x; simpl in |- *; clear x; intros. -elim p; clear p; intro. -elim x; simpl in |- *; clear x; intros. -case q; clear q; simpl in |- *; intros. -case a2; clear a2; simpl in |- *; intros. -case a2; clear a2; simpl in |- *; intros. -case a2; auto. +Proof. + intro. + unfold a_seq in |- *. + simpl in |- *. + elim IVT_seq; simpl in |- *; intros. + elim IVT_seq_lemma; simpl in |- *; intro. + elim x; simpl in |- *; clear x; intros. + elim p; clear p; intro. + elim x; simpl in |- *; clear x; intros. + case q; clear q; simpl in |- *; intros. + case a2; clear a2; simpl in |- *; intros. + case a2; clear a2; simpl in |- *; intros. + case a2; auto. Qed. Lemma b_seq_mon : forall i : nat, b_seq (S i) [<=] b_seq i. -intro. -unfold b_seq in |- *. -simpl in |- *. -elim IVT_seq; simpl in |- *; intros. -elim IVT_seq_lemma; simpl in |- *; intro. -elim x; simpl in |- *; clear x; intros. -elim p; clear p; intro. -elim x; simpl in |- *; clear x; intros. -case q; clear q; simpl in |- *; intros. -case a2; clear a2; simpl in |- *; intros. -case a2; clear a2; simpl in |- *; intros. -case a2; auto. +Proof. + intro. + unfold b_seq in |- *. + simpl in |- *. + elim IVT_seq; simpl in |- *; intros. + elim IVT_seq_lemma; simpl in |- *; intro. + elim x; simpl in |- *; clear x; intros. + elim p; clear p; intro. + elim x; simpl in |- *; clear x; intros. + case q; clear q; simpl in |- *; intros. + case a2; clear a2; simpl in |- *; intros. + case a2; clear a2; simpl in |- *; intros. + case a2; auto. Qed. Lemma a_seq_b_seq_dist_n : forall n, b_seq (S n) [-]a_seq (S n) [=] Two [/]ThreeNZ[*] (b_seq n[-]a_seq n). -intro. -unfold a_seq, b_seq in |- *. -simpl in |- *. -elim IVT_seq; simpl in |- *; intros. -elim IVT_seq_lemma; simpl in |- *; intro. -elim x; simpl in |- *; clear x; intros. -elim p; clear p; intro. -elim x; simpl in |- *; clear x; intros. -case q; clear q; simpl in |- *; intros. -case a2; clear a2; simpl in |- *; intros. -case a2; clear a2; simpl in |- *; intros. -case a2; auto. +Proof. + intro. + unfold a_seq, b_seq in |- *. + simpl in |- *. + elim IVT_seq; simpl in |- *; intros. + elim IVT_seq_lemma; simpl in |- *; intro. + elim x; simpl in |- *; clear x; intros. + elim p; clear p; intro. + elim x; simpl in |- *; clear x; intros. + case q; clear q; simpl in |- *; intros. + case a2; clear a2; simpl in |- *; intros. + case a2; clear a2; simpl in |- *; intros. + case a2; auto. Qed. Lemma a_seq_b_seq_dist : forall n, b_seq n[-]a_seq n [=] (Two [/]ThreeNZ) [^]n[*] (b[-]a). -simple induction n. -simpl in |- *; algebra. -clear n; intros. -astepr (Two [/]ThreeNZ[*] (Two [/]ThreeNZ) [^]n[*] (b[-]a)). -astepr (Two [/]ThreeNZ[*] ((Two [/]ThreeNZ) [^]n[*] (b[-]a))). -astepr (Two [/]ThreeNZ[*] (b_seq n[-]a_seq n)). -apply a_seq_b_seq_dist_n. +Proof. + simple induction n. + simpl in |- *; algebra. + clear n; intros. + astepr (Two [/]ThreeNZ[*] (Two [/]ThreeNZ) [^]n[*] (b[-]a)). + astepr (Two [/]ThreeNZ[*] ((Two [/]ThreeNZ) [^]n[*] (b[-]a))). + astepr (Two [/]ThreeNZ[*] (b_seq n[-]a_seq n)). + apply a_seq_b_seq_dist_n. Qed. Lemma a_seq_Cauchy : Cauchy_prop a_seq. -intros e H. -elim (intervals_small' a b e H); intros i Hi. -exists i; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_transitive. -2: apply Hi. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (a_seq i). -2: apply local_mon'_imp_mon'; auto; exact a_seq_mon. -eapply leEq_wdr. -2: apply a_seq_b_seq_dist. -apply minus_resp_leEq. -apply less_leEq; apply a_b'. -exact a_seq_mon. -exact b_seq_mon. -exact a_seq_less_b_seq. +Proof. + intros e H. + elim (intervals_small' a b e H); intros i Hi. + exists i; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_transitive. + 2: apply Hi. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (a_seq i). + 2: apply local_mon'_imp_mon'; auto; exact a_seq_mon. + eapply leEq_wdr. + 2: apply a_seq_b_seq_dist. + apply minus_resp_leEq. + apply less_leEq; apply a_b'. + exact a_seq_mon. + exact b_seq_mon. + exact a_seq_less_b_seq. Qed. Lemma b_seq_Cauchy : Cauchy_prop b_seq. -intros e H. -elim (intervals_small' a b e H); intros i Hi. -exists i; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_transitive. -2: apply Hi. -eapply leEq_wdl. -2: apply AbsIR_minus. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (b_seq m). -2: astepl ( [--][--] (b_seq m)); astepr ( [--][--] (b_seq i)). -2: apply inv_resp_leEq; - apply local_mon'_imp_mon' with (f := fun n : nat => [--] (b_seq n)); - auto. -2: intro; apply inv_resp_leEq; apply b_seq_mon. -eapply leEq_wdr. -2: apply a_seq_b_seq_dist. -unfold cg_minus in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq. -apply less_leEq; apply a_b'. -exact a_seq_mon. -exact b_seq_mon. -exact a_seq_less_b_seq. +Proof. + intros e H. + elim (intervals_small' a b e H); intros i Hi. + exists i; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_transitive. + 2: apply Hi. + eapply leEq_wdl. + 2: apply AbsIR_minus. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (b_seq m). + 2: astepl ( [--][--] (b_seq m)); astepr ( [--][--] (b_seq i)). + 2: apply inv_resp_leEq; apply local_mon'_imp_mon' with (f := fun n : nat => [--] (b_seq n)); auto. + 2: intro; apply inv_resp_leEq; apply b_seq_mon. + eapply leEq_wdr. + 2: apply a_seq_b_seq_dist. + unfold cg_minus in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq. + apply less_leEq; apply a_b'. + exact a_seq_mon. + exact b_seq_mon. + exact a_seq_less_b_seq. Qed. Let xa := Lim (Build_CauchySeq _ _ a_seq_Cauchy). Let xb := Lim (Build_CauchySeq _ _ b_seq_Cauchy). Lemma a_seq_b_seq_lim : xa [=] xb. -unfold xa, xb in |- *; clear xa xb. -apply cg_inv_unique_2. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -2: apply Lim_minus. -simpl in |- *. -apply Limits_unique. -simpl in |- *. -intros eps H. -elim (intervals_small' a b eps H); intros i Hi. -exists i; intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_transitive. -2: apply Hi. -eapply leEq_wdl. -2: apply AbsIR_minus. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (a_seq m[-]b_seq m). -2: apply shift_minus_leEq; astepr (b_seq m). -2: apply less_leEq; apply a_seq_less_b_seq. -eapply leEq_wdr. -2: apply a_seq_b_seq_dist. -rstepl (b_seq m[-]a_seq m). -unfold cg_minus in |- *; apply plus_resp_leEq_both. -astepl ( [--][--] (b_seq m)); astepr ( [--][--] (b_seq i)). -apply inv_resp_leEq; - apply local_mon'_imp_mon' with (f := fun n : nat => [--] (b_seq n)); - auto. -intro; apply inv_resp_leEq; apply b_seq_mon. -apply inv_resp_leEq; apply local_mon'_imp_mon'; auto; exact a_seq_mon. +Proof. + unfold xa, xb in |- *; clear xa xb. + apply cg_inv_unique_2. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + 2: apply Lim_minus. + simpl in |- *. + apply Limits_unique. + simpl in |- *. + intros eps H. + elim (intervals_small' a b eps H); intros i Hi. + exists i; intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_transitive. + 2: apply Hi. + eapply leEq_wdl. + 2: apply AbsIR_minus. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (a_seq m[-]b_seq m). + 2: apply shift_minus_leEq; astepr (b_seq m). + 2: apply less_leEq; apply a_seq_less_b_seq. + eapply leEq_wdr. + 2: apply a_seq_b_seq_dist. + rstepl (b_seq m[-]a_seq m). + unfold cg_minus in |- *; apply plus_resp_leEq_both. + astepl ( [--][--] (b_seq m)); astepr ( [--][--] (b_seq i)). + apply inv_resp_leEq; apply local_mon'_imp_mon' with (f := fun n : nat => [--] (b_seq n)); auto. + intro; apply inv_resp_leEq; apply b_seq_mon. + apply inv_resp_leEq; apply local_mon'_imp_mon'; auto; exact a_seq_mon. Qed. Lemma xa_in_interval : I xa. -split. -unfold xa in |- *. -apply leEq_seq_so_leEq_Lim. -simpl in |- *. -intro; elim (a_seq_I i); auto. -unfold xa in |- *. -apply seq_leEq_so_Lim_leEq. -simpl in |- *. -intro; elim (a_seq_I i); auto. +Proof. + split. + unfold xa in |- *. + apply leEq_seq_so_leEq_Lim. + simpl in |- *. + intro; elim (a_seq_I i); auto. + unfold xa in |- *. + apply seq_leEq_so_Lim_leEq. + simpl in |- *. + intro; elim (a_seq_I i); auto. Qed. Lemma IVT_I : {x : IR | I x | forall Hx, F x Hx [=] z}. -exists xa. -apply xa_in_interval. -intro. -apply cg_inv_unique_2; apply leEq_imp_eq. -apply approach_zero. -intros e H. -apply leEq_less_trans with (e [/]TwoNZ). -2: apply pos_div_two'; auto. -elim (contin_prop _ _ _ _ contF _ (pos_div_two _ _ H)); intros d H0 H1. -elim (Cauchy_complete (Build_CauchySeq _ _ a_seq_Cauchy) _ H0); - fold xa in |- *; simpl in |- *; intros N HN. -apply leEq_transitive with (F xa Hx[-]F (a_seq N) (incF _ (a_seq_I N))). -unfold cg_minus in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq; apply a_seq_leEq_z. -eapply leEq_wdl. -2: apply AbsIR_eq_x. -apply H1; auto. -apply xa_in_interval. -apply a_seq_I. -apply AbsSmall_imp_AbsIR. -apply AbsSmall_minus. -auto. -apply shift_leEq_minus; astepl (F _ (incF _ (a_seq_I N))). -apply part_mon_imp_mon' with I; auto. -apply a_seq_I. -apply xa_in_interval. -unfold xa in |- *. -apply str_leEq_seq_so_leEq_Lim. -exists N; intros; simpl in |- *. -apply local_mon'_imp_mon'; auto; exact a_seq_mon. -astepl ( [--]ZeroR); rstepr ( [--] (z[-]F xa Hx)). -apply inv_resp_leEq. -apply approach_zero. -intros e H. -apply leEq_less_trans with (e [/]TwoNZ). -2: apply pos_div_two'; auto. -elim (contin_prop _ _ _ _ contF _ (pos_div_two _ _ H)); intros d H0 H1. -elim (Cauchy_complete (Build_CauchySeq _ _ b_seq_Cauchy) _ H0); - fold xb in |- *; simpl in |- *; intros N HN. -apply leEq_transitive with (F (b_seq N) (incF _ (b_seq_I N)) [-]F xa Hx). -apply minus_resp_leEq; apply z_leEq_b_seq. -eapply leEq_wdl. -2: apply AbsIR_eq_x. -apply H1; auto. -apply b_seq_I. -apply xa_in_interval. -apply leEq_wdl with (AbsIR (b_seq N[-]xb)). -2: apply AbsIR_wd; apply cg_minus_wd; - [ algebra | apply eq_symmetric_unfolded; apply a_seq_b_seq_lim ]. -apply AbsSmall_imp_AbsIR. -auto. -apply shift_leEq_minus; astepl (F xa Hx). -apply part_mon_imp_mon' with I; auto. -apply xa_in_interval. -apply b_seq_I. -apply leEq_wdl with xb. -2: apply eq_symmetric_unfolded; apply a_seq_b_seq_lim. -unfold xb in |- *. -apply str_seq_leEq_so_Lim_leEq. -exists N; intros; simpl in |- *. -astepl ( [--][--] (b_seq i)); astepr ( [--][--] (b_seq N)). -apply inv_resp_leEq. -apply local_mon'_imp_mon' with (f := fun n : nat => [--] (b_seq n)); auto. -intro; apply inv_resp_leEq; apply b_seq_mon. +Proof. + exists xa. + apply xa_in_interval. + intro. + apply cg_inv_unique_2; apply leEq_imp_eq. + apply approach_zero. + intros e H. + apply leEq_less_trans with (e [/]TwoNZ). + 2: apply pos_div_two'; auto. + elim (contin_prop _ _ _ _ contF _ (pos_div_two _ _ H)); intros d H0 H1. + elim (Cauchy_complete (Build_CauchySeq _ _ a_seq_Cauchy) _ H0); + fold xa in |- *; simpl in |- *; intros N HN. + apply leEq_transitive with (F xa Hx[-]F (a_seq N) (incF _ (a_seq_I N))). + unfold cg_minus in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq; apply a_seq_leEq_z. + eapply leEq_wdl. + 2: apply AbsIR_eq_x. + apply H1; auto. + apply xa_in_interval. + apply a_seq_I. + apply AbsSmall_imp_AbsIR. + apply AbsSmall_minus. + auto. + apply shift_leEq_minus; astepl (F _ (incF _ (a_seq_I N))). + apply part_mon_imp_mon' with I; auto. + apply a_seq_I. + apply xa_in_interval. + unfold xa in |- *. + apply str_leEq_seq_so_leEq_Lim. + exists N; intros; simpl in |- *. + apply local_mon'_imp_mon'; auto; exact a_seq_mon. + astepl ( [--]ZeroR); rstepr ( [--] (z[-]F xa Hx)). + apply inv_resp_leEq. + apply approach_zero. + intros e H. + apply leEq_less_trans with (e [/]TwoNZ). + 2: apply pos_div_two'; auto. + elim (contin_prop _ _ _ _ contF _ (pos_div_two _ _ H)); intros d H0 H1. + elim (Cauchy_complete (Build_CauchySeq _ _ b_seq_Cauchy) _ H0); + fold xb in |- *; simpl in |- *; intros N HN. + apply leEq_transitive with (F (b_seq N) (incF _ (b_seq_I N)) [-]F xa Hx). + apply minus_resp_leEq; apply z_leEq_b_seq. + eapply leEq_wdl. + 2: apply AbsIR_eq_x. + apply H1; auto. + apply b_seq_I. + apply xa_in_interval. + apply leEq_wdl with (AbsIR (b_seq N[-]xb)). + 2: apply AbsIR_wd; apply cg_minus_wd; + [ algebra | apply eq_symmetric_unfolded; apply a_seq_b_seq_lim ]. + apply AbsSmall_imp_AbsIR. + auto. + apply shift_leEq_minus; astepl (F xa Hx). + apply part_mon_imp_mon' with I; auto. + apply xa_in_interval. + apply b_seq_I. + apply leEq_wdl with xb. + 2: apply eq_symmetric_unfolded; apply a_seq_b_seq_lim. + unfold xb in |- *. + apply str_seq_leEq_so_Lim_leEq. + exists N; intros; simpl in |- *. + astepl ( [--][--] (b_seq i)); astepr ( [--][--] (b_seq N)). + apply inv_resp_leEq. + apply local_mon'_imp_mon' with (f := fun n : nat => [--] (b_seq n)); auto. + intro; apply inv_resp_leEq; apply b_seq_mon. Qed. End IVT. diff --git a/logic/CLogic.v b/logic/CLogic.v index 8314b9856..adddec913 100644 --- a/logic/CLogic.v +++ b/logic/CLogic.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Not %\ensuremath\neg% #~# *) (** printing CNot %\ensuremath\neg% #~# *) @@ -105,12 +105,12 @@ Inductive CAnd (A B : CProp) : CProp := CAnd_intro : A -> B -> CAnd A B. Lemma CAnd_proj1 : forall A B : CProp, (CAnd A B) -> A. Proof. -intros A B [H _]; exact H. + intros A B [H _]; exact H. Qed. Lemma CAnd_proj2 : forall A B : CProp, (CAnd A B) -> B. Proof. -intros A B [ _ H ]; exact H. + intros A B [ _ H ]; exact H. Qed. Definition Iff (A B : CProp) : CProp := CAnd (A -> B) (B -> A). @@ -155,11 +155,12 @@ Definition proj2b_sig2T (A : Type) (P Q : A -> CProp) (e : sig2T A P Q) := Inductive toCProp (A : Prop) : CProp := ts : A -> toCProp A. Lemma toCProp_e : forall A : Prop, toCProp A -> forall P : Prop, (A -> P) -> P. -intros A H P H0. -elim H. -intros H1. -apply H0. -assumption. +Proof. + intros A H P H0. + elim H. + intros H1. + apply H0. + assumption. Qed. Definition CNot (A : Prop): CProp := A -> CFalse. @@ -191,53 +192,53 @@ Notation ProjT1 := (proj1_sigT _ _). Notation ProjT2 := (proj2_sigT _ _). (* end hide *) -(** -Some lemmas to make it possible to use [Step] +(** +Some lemmas to make it possible to use [Step] when reasoning with bi-implications. *) -Lemma Iff_left : - forall (A B C : CProp), +Lemma Iff_left : + forall (A B C : CProp), (A IFF B) -> (A IFF C) -> (C IFF B). Proof. -unfold Iff. -intuition. + unfold Iff. + intuition. Qed. -Lemma Iff_right: - forall (A B C : CProp), +Lemma Iff_right: + forall (A B C : CProp), (A IFF B) -> (A IFF C) -> (B IFF C). Proof. -unfold Iff. -intuition. + unfold Iff. + intuition. Qed. Lemma Iff_refl : forall (A : CProp), (A IFF A). Proof. -unfold Iff. -intuition. + unfold Iff. + intuition. Qed. -Lemma Iff_sym : +Lemma Iff_sym : forall (A B : CProp),(A IFF B) -> (B IFF A). Proof. -unfold Iff. -intuition. + unfold Iff. + intuition. Qed. -Lemma Iff_trans : - forall (A B C : CProp), +Lemma Iff_trans : + forall (A B C : CProp), (CAnd (A IFF B) (B IFF C)) -> (A IFF C). Proof. -unfold Iff. -intuition. + unfold Iff. + intuition. Qed. -Lemma Iff_imp_imp : +Lemma Iff_imp_imp : forall (A B : CProp), (A IFF B) -> (CAnd (A->B) (B->A)). Proof. -unfold Iff. -intuition. + unfold Iff. + intuition. Qed. Declare Right Step Iff_right. @@ -246,26 +247,26 @@ Hint Resolve Iff_trans Iff_sym Iff_refl Iff_right Iff_left Iff_imp_imp : algebra -Lemma not_r_cor_rect : - forall (A B : CProp) (S : Type) (l r : S), - Not B -> +Lemma not_r_cor_rect : + forall (A B : CProp) (S : Type) (l r : S), + Not B -> forall H : A or B, COr_rect A B (fun _ : A or B => S) (fun x : A => l) (fun x : B => r) H = l. Proof. -intros. elim H0. -intros. reflexivity. -intro. elim H. assumption. + intros. elim H0. + intros. reflexivity. + intro. elim H. assumption. Qed. -Lemma not_l_cor_rect : - forall (A B : CProp) (S : Type) (l r : S), - Not A -> +Lemma not_l_cor_rect : + forall (A B : CProp) (S : Type) (l r : S), + Not A -> forall H : A or B, COr_rect A B (fun _ : A or B => S) (fun x : A => l) (fun x : B => r) H = r. Proof. -intros. elim H0. -intro. elim H. assumption. -intros. reflexivity. + intros. elim H0. + intro. elim H. assumption. + intros. reflexivity. Qed. (* begin hide *) @@ -303,13 +304,13 @@ Let [P] be a predicate on $\NN^2$#N times N#. Variable P : nat -> nat -> Prop. -Lemma choice : - (forall n : nat, {m : nat | P n m}) -> +Lemma choice : + (forall n : nat, {m : nat | P n m}) -> {d : nat -> nat | forall n : nat, P n (d n)}. Proof. -intro H. -exists (fun i : nat => proj1_sigT _ _ (H i)). -apply (fun i : nat => proj2_sigT _ _ (H i)). + intro H. + exists (fun i : nat => proj1_sigT _ _ (H i)). + apply (fun i : nat => proj2_sigT _ _ (H i)). Qed. End Choice. @@ -322,13 +323,14 @@ when [A], [B] and [C] are non trivial. Lemma CNot_Not_or : forall A B C : CProp, (A -> Not C) -> (B -> Not C) -> ~ Not (A or B) -> Not C. -intros A B C H H0 H1. -intro H2. -apply H1. -intro H3. -elim H3. -intro; apply H; auto. -intro; apply H0; auto. +Proof. + intros A B C H H0 H1. + intro H2. + apply H1. + intro H3. + elim H3. + intro; apply H; auto. + intro; apply H0; auto. Qed. Lemma CdeMorgan_ex_all : forall (A : Type) (P : A -> CProp) (X : Type), @@ -356,16 +358,16 @@ Definition Crelation := A -> A -> CProp. Variable R : Crelation. -Definition Creflexive : CProp := +Definition Creflexive : CProp := forall x : A, R x x. -Definition Ctransitive : CProp := +Definition Ctransitive : CProp := forall x y z : A, R x y -> R y z -> R x z. -Definition Csymmetric : CProp := +Definition Csymmetric : CProp := forall x y : A, R x y -> R y x. -Record Cequivalence : CProp := +Record Cequivalence : CProp := {Cequiv_refl : Creflexive; Cequiv_symm : Csymmetric; Cequiv_trans : Ctransitive}. @@ -421,102 +423,104 @@ Theorem Cnat_double_ind : forall R : nat -> nat -> CProp, (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. - simple induction n; auto. - simple induction m; auto. + simple induction n; auto. + simple induction m; auto. Qed. Theorem my_Cle_ind : forall (n : nat) (P : nat -> CProp), P n -> (forall m : nat, Cle n m -> P m -> P (S m)) -> forall n0 : nat, Cle n n0 -> P n0. Proof. -intros n P. -generalize (Cle_rect n (fun (n0 : nat) (H : Cle n n0) => P n0)); intro. -assumption. + intros n P. + generalize (Cle_rect n (fun (n0 : nat) (H : Cle n n0) => P n0)); intro. + assumption. Qed. Theorem Cle_n_S : forall n m : nat, Cle n m -> Cle (S n) (S m). Proof. -intros n m H. -pattern m in |- *. -apply (my_Cle_ind n). -apply Cle_n. -intros. -apply Cle_S. -assumption. -assumption. + intros n m H. + pattern m in |- *. + apply (my_Cle_ind n). + apply Cle_n. + intros. + apply Cle_S. + assumption. + assumption. Qed. Lemma toCle : forall m n : nat, m <= n -> Cle m n. -intros m. -induction m as [| m Hrecm]. -simple induction n. -intro H. -apply Cle_n. -intros n0 H H0. -apply Cle_S. -apply H. -apply le_O_n. -simple induction n. -intro. -elimtype False. -inversion H. -intros n0 H H0. -generalize (le_S_n _ _ H0); intro H1. -generalize (Hrecm _ H1); intro H2. -apply Cle_n_S. -assumption. +Proof. + intros m. + induction m as [| m Hrecm]. + simple induction n. + intro H. + apply Cle_n. + intros n0 H H0. + apply Cle_S. + apply H. + apply le_O_n. + simple induction n. + intro. + elimtype False. + inversion H. + intros n0 H H0. + generalize (le_S_n _ _ H0); intro H1. + generalize (Hrecm _ H1); intro H2. + apply Cle_n_S. + assumption. Qed. Hint Resolve toCle. Lemma Cle_to : forall m n : nat, Cle m n -> m <= n. -intros m n H. -elim H. -apply le_n. -intros m0 s H0. -apply le_S. -assumption. +Proof. + intros m n H. + elim H. + apply le_n. + intros m0 s H0. + apply le_S. + assumption. Qed. Definition Clt (m n : nat) : CProp := Cle (S m) n. Lemma toCProp_lt : forall m n : nat, m < n -> Clt m n. Proof. -unfold lt in |- *. -unfold Clt in |- *. -intros m n H. -apply toCle. -assumption. + unfold lt in |- *. + unfold Clt in |- *. + intros m n H. + apply toCle. + assumption. Qed. Lemma Clt_to : forall m n : nat, Clt m n -> m < n. Proof. -unfold lt in |- *. -unfold Clt in |- *. -intros m n H. -apply Cle_to. -assumption. + unfold lt in |- *. + unfold Clt in |- *. + intros m n H. + apply Cle_to. + assumption. Qed. Lemma Cle_le_S_eq : forall p q : nat, p <= q -> {S p <= q} + {p = q}. Proof. -intros p q H. -elim (gt_eq_gt_dec p q); intro H0. -elim H0; auto. -elimtype False. -apply lt_not_le with q p; auto. + intros p q H. + elim (gt_eq_gt_dec p q); intro H0. + elim H0; auto. + elimtype False. + apply lt_not_le with q p; auto. Qed. Lemma Cnat_total_order : forall m n : nat, m <> n -> {m < n} + {n < m}. Proof. -intros m n H. -elim (gt_eq_gt_dec m n). -intro H0. -elim H0; intros. -left; auto. -elimtype False. -auto. -auto. + intros m n H. + elim (gt_eq_gt_dec m n). + intro H0. + elim H0; intros. + left; auto. + elimtype False. + auto. + auto. Qed. Inductive Codd : nat -> CProp := @@ -527,72 +531,73 @@ with Ceven : nat -> CProp := Lemma Codd_even_to : forall n : nat, (Codd n -> odd n) /\ (Ceven n -> even n). Proof. -simple induction n. -split. -intro H. -inversion H. -intro. -apply even_O. -intros n0 H. -elim H; intros H0 H1. -split. -intro H2. -inversion H2. -apply odd_S. -apply H1. -assumption. -intro H2. -inversion H2. -apply even_S. -apply H0. -assumption. + simple induction n. + split. + intro H. + inversion H. + intro. + apply even_O. + intros n0 H. + elim H; intros H0 H1. + split. + intro H2. + inversion H2. + apply odd_S. + apply H1. + assumption. + intro H2. + inversion H2. + apply even_S. + apply H0. + assumption. Qed. Lemma Codd_to : forall n : nat, Codd n -> odd n. Proof. -intros n H. -elim (Codd_even_to n); auto. + intros n H. + elim (Codd_even_to n); auto. Qed. Lemma Ceven_to : forall n : nat, Ceven n -> even n. Proof. -intros n H. -elim (Codd_even_to n); auto. + intros n H. + elim (Codd_even_to n); auto. Qed. Lemma to_Codd_even : forall n : nat, (odd n -> Codd n) and (even n -> Ceven n). Proof. -simple induction n. -split. -intro H. -elimtype False. -inversion H. -intro H. -apply Ceven_O. -intros n0 H. -elim H; intros H0 H1. -split. -intro H2. -apply Codd_S. -apply H1. -inversion H2. -assumption. -intro H2. -apply Ceven_S. -apply H0. -inversion H2. -assumption. + simple induction n. + split. + intro H. + elimtype False. + inversion H. + intro H. + apply Ceven_O. + intros n0 H. + elim H; intros H0 H1. + split. + intro H2. + apply Codd_S. + apply H1. + inversion H2. + assumption. + intro H2. + apply Ceven_S. + apply H0. + inversion H2. + assumption. Qed. Lemma to_Codd : forall n : nat, odd n -> Codd n. Proof. -intros. -elim (to_Codd_even n); auto. + intros. + elim (to_Codd_even n); auto. Qed. Lemma to_Ceven : forall n : nat, even n -> Ceven n. -intros. -elim (to_Codd_even n); auto. +Proof. + intros. + elim (to_Codd_even n); auto. Qed. End le_odd. @@ -605,95 +610,95 @@ Section Misc. Lemma CZ_exh : forall z : Z, {n : nat | z = n} or {n : nat | z = (- n)%Z}. Proof. -intro z. -elim z. -left. -exists 0. -auto. -intro p. -left. -exists (nat_of_P p). -rewrite convert_is_POS. -reflexivity. -intro p. -right. -exists (nat_of_P p). -rewrite min_convert_is_NEG. -reflexivity. + intro z. + elim z. + left. + exists 0. + auto. + intro p. + left. + exists (nat_of_P p). + rewrite convert_is_POS. + reflexivity. + intro p. + right. + exists (nat_of_P p). + rewrite min_convert_is_NEG. + reflexivity. Qed. Lemma Cnats_Z_ind : forall P : Z -> CProp, (forall n : nat, P n) -> (forall n : nat, P (- n)%Z) -> forall z : Z, P z. Proof. -intros P H H0 z. -elim (CZ_exh z); intros H1. -elim H1; intros n H2. -rewrite H2. -apply H. -elim H1; intros n H2. -rewrite H2. -apply H0. + intros P H H0 z. + elim (CZ_exh z); intros H1. + elim H1; intros n H2. + rewrite H2. + apply H. + elim H1; intros n H2. + rewrite H2. + apply H0. Qed. Lemma Cdiff_Z_ind : forall P : Z -> CProp, (forall m n : nat, P (m - n)%Z) -> forall z : Z, P z. Proof. -intros P H z. -apply Cnats_Z_ind. -intro n. -replace (Z_of_nat n) with (n - 0%nat)%Z. -apply H. -simpl in |- *. -auto with zarith. -intro n. -replace (- n)%Z with (0%nat - n)%Z. -apply H. -simpl in |- *. -reflexivity. + intros P H z. + apply Cnats_Z_ind. + intro n. + replace (Z_of_nat n) with (n - 0%nat)%Z. + apply H. + simpl in |- *. + auto with zarith. + intro n. + replace (- n)%Z with (0%nat - n)%Z. + apply H. + simpl in |- *. + reflexivity. Qed. Lemma Cpred_succ_Z_ind : forall P : Z -> CProp, P 0%Z -> (forall n : Z, P n -> P (n + 1)%Z) -> (forall n : Z, P n -> P (n - 1)%Z) -> forall z : Z, P z. Proof. -intros P H H0 H1 z. -apply Cnats_Z_ind. -intro n. -elim n. -exact H. -intros n0 H2. -replace (S n0:Z) with (n0 + 1)%Z. -apply H0. -assumption. -rewrite Znat.inj_S. -reflexivity. -intro n. -elim n. -exact H. -intros n0 H2. -replace (- S n0)%Z with (- n0 - 1)%Z. -apply H1. -assumption. -rewrite Znat.inj_S. -unfold Zsucc in |- *. -rewrite Zopp_plus_distr. -reflexivity. + intros P H H0 H1 z. + apply Cnats_Z_ind. + intro n. + elim n. + exact H. + intros n0 H2. + replace (S n0:Z) with (n0 + 1)%Z. + apply H0. + assumption. + rewrite Znat.inj_S. + reflexivity. + intro n. + elim n. + exact H. + intros n0 H2. + replace (- S n0)%Z with (- n0 - 1)%Z. + apply H1. + assumption. + rewrite Znat.inj_S. + unfold Zsucc in |- *. + rewrite Zopp_plus_distr. + reflexivity. Qed. Lemma not_r_sum_rec : forall (A B S : Set) (l r : S), Not B -> forall H : A + B, sum_rec (fun _ : A + B => S) (fun x : A => l) (fun x : B => r) H = l. Proof. -intros A B S l r H H0. elim H0. -intro a. reflexivity. -intro b. elim H. assumption. + intros A B S l r H H0. elim H0. + intro a. reflexivity. + intro b. elim H. assumption. Qed. Lemma not_l_sum_rec : forall (A B S : Set) (l r : S), Not A -> forall H : A + B, sum_rec (fun _ : A + B => S) (fun x : A => l) (fun x : B => r) H = r. Proof. -intros A B S l r H H0. elim H0. -intro a. elim H. assumption. -intros. reflexivity. + intros A B S l r H H0. elim H0. + intro a. elim H. assumption. + intros. reflexivity. Qed. (** @@ -704,45 +709,45 @@ Let [M:Type]. Variable M : Type. -Lemma member_app : - forall (x : M) (l k : (list M)), - (Iff (member x (app k l)) +Lemma member_app : + forall (x : M) (l k : (list M)), + (Iff (member x (app k l)) ((member x k) or (member x l))). Proof. -intros x l. -induction k. -simpl. -unfold Iff. -intuition. -simpl. -unfold Iff in IHk |- *. -elim IHk. -intros IHk0 IHk1. -split. -intros H0. -elim H0. -clear H0. -intro H0. -intuition. -intuition. -intro H0. -elim H0. -clear H0. -intro H0. -elim H0. -clear H0. -intro H0. -left. -apply IHk1. -left. -exact H0. -intuition. -clear H0. -intro H0. -left. -apply IHk1. -right. -exact H0. + intros x l. + induction k. + simpl. + unfold Iff. + intuition. + simpl. + unfold Iff in IHk |- *. + elim IHk. + intros IHk0 IHk1. + split. + intros H0. + elim H0. + clear H0. + intro H0. + intuition. + intuition. + intro H0. + elim H0. + clear H0. + intro H0. + elim H0. + clear H0. + intro H0. + left. + apply IHk1. + left. + exact H0. + intuition. + clear H0. + intro H0. + left. + apply IHk1. + right. + exact H0. Qed. End Misc. @@ -776,19 +781,19 @@ Next, we prove the usual results about sums of even and odd numbers: Lemma even_plus_n_n : forall n : nat, even (n + n). Proof. -intro n; induction n as [| n Hrecn]. -auto with arith. -replace (S n + S n) with (S (S (n + n))). -apply even_S; apply odd_S; apply Hrecn. -rewrite plus_n_Sm; simpl in |- *; auto. + intro n; induction n as [| n Hrecn]. + auto with arith. + replace (S n + S n) with (S (S (n + n))). + apply even_S; apply odd_S; apply Hrecn. + rewrite plus_n_Sm; simpl in |- *; auto. Qed. Lemma even_or_odd_plus : forall k : nat, {j : nat & {k = j + j} + {k = S (j + j)}}. Proof. -intro k. -elim (even_odd_dec k); intro H. -elim (even_2n k H); intros j Hj; exists j; auto. -elim (odd_S2n k H); intros j Hj; exists j; auto. + intro k. + elim (even_odd_dec k); intro H. + elim (even_2n k H); intros j Hj; exists j; auto. + elim (odd_S2n k H); intros j Hj; exists j; auto. Qed. (** Finally, we prove that an arbitrary natural number can be written in some canonical way. @@ -797,12 +802,12 @@ Qed. Lemma even_or_odd_plus_gt : forall i j : nat, i <= j -> {k : nat & {j = i + (k + k)} + {j = i + S (k + k)}}. Proof. -intros i j H. -elim (even_or_odd_plus (j - i)). -intros k Hk. -elim Hk; intro H0. -exists k; left; rewrite <- H0; auto with arith. -exists k; right; rewrite <- H0; auto with arith. + intros i j H. + elim (even_or_odd_plus (j - i)). + intros k Hk. + elim Hk; intro H0. + exists k; left; rewrite <- H0; auto with arith. + exists k; right; rewrite <- H0; auto with arith. Qed. End Odd_and_Even. @@ -823,78 +828,79 @@ definitions keeping conciseness. Lemma Clt_le_weak : forall i j : nat, Clt i j -> Cle i j. Proof. -intros. -apply toCle; apply lt_le_weak; apply Clt_to; assumption. + intros. + apply toCle; apply lt_le_weak; apply Clt_to; assumption. Qed. Lemma lt_5 : forall i n : nat, i < n -> pred i < n. Proof. -intros; apply le_lt_trans with (pred n). -apply le_pred; auto with arith. -apply lt_pred_n_n; apply le_lt_trans with i; auto with arith. + intros; apply le_lt_trans with (pred n). + apply le_pred; auto with arith. + apply lt_pred_n_n; apply le_lt_trans with i; auto with arith. Qed. Lemma lt_8 : forall m n : nat, m < pred n -> m < n. Proof. -intros; apply lt_le_trans with (pred n); auto with arith. + intros; apply lt_le_trans with (pred n); auto with arith. Qed. Lemma pred_lt : forall m n : nat, m < pred n -> S m < n. Proof. -intros; apply le_lt_trans with (pred n); auto with arith. -apply lt_pred_n_n; apply le_lt_trans with m. -auto with arith. -apply lt_le_trans with (pred n); auto with arith. + intros; apply le_lt_trans with (pred n); auto with arith. + apply lt_pred_n_n; apply le_lt_trans with m. + auto with arith. + apply lt_le_trans with (pred n); auto with arith. Qed. Lemma lt_10 : forall i m n : nat, 0 < i -> i < pred (m + n) -> pred i < pred m + pred n. Proof. -intros; omega. + intros; omega. Qed. Lemma lt_pred' : forall m n : nat, 0 < m -> m < n -> pred m < pred n. Proof. -intros m n H H0; red in |- *. -destruct n. -inversion H0. -rewrite <- (S_pred m 0); auto. -simpl in |- *. -auto with arith. + intros m n H H0; red in |- *. + destruct n. + inversion H0. + rewrite <- (S_pred m 0); auto. + simpl in |- *. + auto with arith. Qed. Lemma le_1 : forall m n : nat, Cle m n -> pred m <= n. Proof. -intros. -cut (m <= n); [ intro | apply Cle_to; assumption ]. -apply le_trans with (pred n); auto with arith. -apply le_pred; auto. + intros. + cut (m <= n); [ intro | apply Cle_to; assumption ]. + apply le_trans with (pred n); auto with arith. + apply le_pred; auto. Qed. Lemma le_2 : forall i j : nat, i < j -> i <= pred j. -intros; omega. +Proof. + intros; omega. Qed. Lemma plus_eq_one_imp_eq_zero : forall m n : nat, m + n <= 1 -> {m = 0} + {n = 0}. Proof. -intros m n H. -elim (le_lt_dec m 0); intro. -left; auto with arith. -right; omega. + intros m n H. + elim (le_lt_dec m 0); intro. + left; auto with arith. + right; omega. Qed. Lemma not_not_lt : forall i j : nat, ~ ~ i < j -> i < j. Proof. -intros; omega. + intros; omega. Qed. -Lemma plus_pred_pred_plus : - forall i j k, - k <= pred i + pred j -> +Lemma plus_pred_pred_plus : + forall i j k, + k <= pred i + pred j -> k <= pred (i + j). Proof. -intros; omega. + intros; omega. Qed. (** We now prove some properties of functions on the natural numbers. @@ -911,34 +917,34 @@ for every natural number [n] then [h] is monotonous. An analogous result holds for weak monotonicity. *) -Lemma nat_local_mon_imp_mon : +Lemma nat_local_mon_imp_mon : (forall i : nat, h i < h (S i)) -> forall i j : nat, i < j -> h i < h j. Proof. -intros H i j H0. -induction j as [| j Hrecj]. -elimtype False; omega. -cut (i <= j); [ intro H1 | auto with arith ]. -elim (le_lt_eq_dec _ _ H1); intro H2. -cut (h i < h j); [ intro | apply Hrecj; assumption ]. -cut (h j < h (S j)); [ intro | apply H ]. -apply lt_trans with (h j); auto. -rewrite H2; apply H. + intros H i j H0. + induction j as [| j Hrecj]. + elimtype False; omega. + cut (i <= j); [ intro H1 | auto with arith ]. + elim (le_lt_eq_dec _ _ H1); intro H2. + cut (h i < h j); [ intro | apply Hrecj; assumption ]. + cut (h j < h (S j)); [ intro | apply H ]. + apply lt_trans with (h j); auto. + rewrite H2; apply H. Qed. -Lemma nat_local_mon_imp_mon_le : +Lemma nat_local_mon_imp_mon_le : (forall i : nat, h i <= h (S i)) -> forall i j : nat, i <= j -> h i <= h j. Proof. -intros H i j H0. -induction j as [| j Hrecj]. -cut (i = 0); [ intro H1 | auto with arith ]. -rewrite H1; apply le_n. -elim (le_lt_eq_dec _ _ H0); intro H1. -cut (h i <= h j); [ intro | apply Hrecj; auto with arith ]. -cut (h j <= h (S j)); [ intro | apply H ]. -apply le_trans with (h j); auto. -rewrite H1; apply le_n. + intros H i j H0. + induction j as [| j Hrecj]. + cut (i = 0); [ intro H1 | auto with arith ]. + rewrite H1; apply le_n. + elim (le_lt_eq_dec _ _ H0); intro H1. + cut (h i <= h j); [ intro | apply Hrecj; auto with arith ]. + cut (h j <= h (S j)); [ intro | apply H ]. + apply le_trans with (h j); auto. + rewrite H1; apply le_n. Qed. (** A strictly increasing function is injective: *) @@ -946,12 +952,12 @@ Qed. Lemma nat_mon_imp_inj : (forall i j : nat, i < j -> h i < h j) -> forall i j : nat, h i = h j -> i = j. Proof. -intros H i j H0. -cut (~ i <> j); [ omega | intro H1 ]. -cut (i < j \/ j < i); [ intro H2 | omega ]. -inversion_clear H2. -cut (h i < h j); [ rewrite H0; apply lt_irrefl | apply H; assumption ]. -cut (h j < h i); [ rewrite H0; apply lt_irrefl | apply H; assumption ]. + intros H i j H0. + cut (~ i <> j); [ omega | intro H1 ]. + cut (i < j \/ j < i); [ intro H2 | omega ]. + inversion_clear H2. + cut (h i < h j); [ rewrite H0; apply lt_irrefl | apply H; assumption ]. + cut (h j < h i); [ rewrite H0; apply lt_irrefl | apply H; assumption ]. Qed. (** And (not completely trivial) a function that preserves [lt] also preserves [le]. *) @@ -959,10 +965,10 @@ Qed. Lemma nat_mon_imp_mon' : (forall i j : nat, i < j -> h i < h j) -> forall i j : nat, i <= j -> h i <= h j. Proof. -intros H i j H0. -elim (le_lt_eq_dec _ _ H0); intro H1. -apply lt_le_weak; apply H; assumption. -rewrite H1; apply le_n. + intros H i j H0. + elim (le_lt_eq_dec _ _ H0); intro H1. + apply lt_le_weak; apply H; assumption. + rewrite H1; apply le_n. Qed. (** @@ -975,47 +981,44 @@ These are useful for integration. Lemma mon_fun_covers : (forall i j, i < j -> h i < h j) -> h 0 = 0 -> forall n, {k : nat | S n <= h k} -> {i : nat | h i <= n | S n <= h (S i)}. Proof. -intros H H0 n H1. -elim H1; intros k Hk. -induction k as [| k Hreck]. -exists 0. -rewrite H0; auto with arith. -cut (h 0 < h 1); - [ intro; apply le_trans with (h 0); auto with arith - | apply H; apply lt_n_Sn ]. - -cut (h k < h (S k)); [ intro H2 | apply H; apply lt_n_Sn ]. -elim (le_lt_dec (S n) (h k)); intro H3. -elim (Hreck H3); intros i Hi. -exists i; assumption. -exists k; auto with arith. + intros H H0 n H1. + elim H1; intros k Hk. + induction k as [| k Hreck]. + exists 0. + rewrite H0; auto with arith. + cut (h 0 < h 1); [ intro; apply le_trans with (h 0); auto with arith | apply H; apply lt_n_Sn ]. + cut (h k < h (S k)); [ intro H2 | apply H; apply lt_n_Sn ]. + elim (le_lt_dec (S n) (h k)); intro H3. + elim (Hreck H3); intros i Hi. + exists i; assumption. + exists k; auto with arith. Qed. Lemma weird_mon_covers : forall n (f : nat -> nat), (forall i, f i < n -> f i < f (S i)) -> {m : nat | n <= f m | forall i, i < m -> f i < n}. Proof. -intros; induction n as [| n Hrecn]. -exists 0. -auto with arith. -intros; inversion H0. -elim Hrecn. -2: auto. -intros m Hm Hm'. -elim (le_lt_eq_dec _ _ Hm); intro. -exists m. -assumption. -auto with arith. -exists (S m). -apply le_lt_trans with (f m). -rewrite b; auto with arith. -apply H. -rewrite b; apply lt_n_Sn. -intros. -elim (le_lt_eq_dec _ _ H0); intro. -auto with arith. -cut (i = m); [ intro | auto ]. -rewrite b; rewrite <- H1. -apply lt_n_Sn. + intros; induction n as [| n Hrecn]. + exists 0. + auto with arith. + intros; inversion H0. + elim Hrecn. + 2: auto. + intros m Hm Hm'. + elim (le_lt_eq_dec _ _ Hm); intro. + exists m. + assumption. + auto with arith. + exists (S m). + apply le_lt_trans with (f m). + rewrite b; auto with arith. + apply H. + rewrite b; apply lt_n_Sn. + intros. + elim (le_lt_eq_dec _ _ H0); intro. + auto with arith. + cut (i = m); [ intro | auto ]. + rewrite b; rewrite <- H1. + apply lt_n_Sn. Qed. End Natural_Numbers. @@ -1024,56 +1027,56 @@ End Natural_Numbers. Useful for the Fundamental Theorem of Algebra. *) -Lemma kseq_prop : +Lemma kseq_prop : forall (k : nat -> nat) (n : nat), - (forall i : nat, 1 <= k i /\ k i <= n) -> + (forall i : nat, 1 <= k i /\ k i <= n) -> (forall i : nat, k (S i) <= k i) -> {j : nat | S j < 2 * n /\ k j = k (S j) /\ k (S j) = k (S (S j))}. Proof. -intros k n. -generalize k; clear k. -induction n as [| n Hrecn]; intros k H H0. - elim (H 0); intros H1 H2. - generalize (le_trans _ _ _ H1 H2); intro H3. - elimtype False. - inversion H3. -elim (eq_nat_dec (k 0) (k 2)). + intros k n. + generalize k; clear k. + induction n as [| n Hrecn]; intros k H H0. + elim (H 0); intros H1 H2. + generalize (le_trans _ _ _ H1 H2); intro H3. + elimtype False. + inversion H3. + elim (eq_nat_dec (k 0) (k 2)). + intro H1. + exists 0. + cut (k 0 = k 1). + intro H2. + repeat split. + omega. + assumption. + rewrite <- H1. + auto. + apply le_antisym. + rewrite H1. + apply H0. + apply H0. intro H1. - exists 0. - cut (k 0 = k 1). - intro H2. - repeat split. + elim (Hrecn (fun m : nat => k (S (S m)))). + 3: intro; apply H0. + intros m Hm. + exists (S (S m)); omega. + intro i. + split. + elim (H (S (S i))); auto. + elim (lt_eq_lt_dec (k 0) (k 2)); intro H2. + elim H2; intro H3. + generalize (H0 0); intro H4. + generalize (H0 1); intro H5. omega. + tauto. + generalize (H 0); intro H3. + elim H3; intros H4 H5. + generalize (lt_le_trans _ _ _ H2 H5); intro H6. + cut (k 2 <= n). + 2: omega. + intro H7. + induction i as [| i Hreci]. assumption. - rewrite <- H1. - auto. - apply le_antisym. - rewrite H1. - apply H0. - apply H0. -intro H1. -elim (Hrecn (fun m : nat => k (S (S m)))). - 3: intro; apply H0. - intros m Hm. - exists (S (S m)); omega. -intro i. -split. - elim (H (S (S i))); auto. -elim (lt_eq_lt_dec (k 0) (k 2)); intro H2. - elim H2; intro H3. - generalize (H0 0); intro H4. - generalize (H0 1); intro H5. - omega. - tauto. -generalize (H 0); intro H3. -elim H3; intros H4 H5. -generalize (lt_le_trans _ _ _ H2 H5); intro H6. -cut (k 2 <= n). - 2: omega. -intro H7. -induction i as [| i Hreci]. - assumption. -apply le_trans with (k (S (S i))); auto. + apply le_trans with (k (S (S i))); auto. Qed. Section Predicates_to_CProp. @@ -1087,204 +1090,202 @@ for [CProp]- and [Prop]-valued predicates. We begin by presenting the results for [CProp]-valued predicates: *) -Lemma even_induction : +Lemma even_induction : forall P : nat -> CProp, - P 0 -> - (forall n, even n -> P n -> P (S (S n))) -> + P 0 -> + (forall n, even n -> P n -> P (S (S n))) -> forall n, even n -> P n. Proof. -intros P H H0 n. -pattern n in |- *; apply lt_wf_rect. -clear n. -intros n H1 H2. -induction n as [| n Hrecn]. -auto. -induction n as [| n Hrecn0]. -elimtype False; inversion H2; inversion H4. -apply H0. -inversion H2; inversion H4; auto. -apply H1. -auto with arith. -inversion H2; inversion H4; auto. -Qed. - -Lemma odd_induction : + intros P H H0 n. + pattern n in |- *; apply lt_wf_rect. + clear n. + intros n H1 H2. + induction n as [| n Hrecn]. + auto. + induction n as [| n Hrecn0]. + elimtype False; inversion H2; inversion H4. + apply H0. + inversion H2; inversion H4; auto. + apply H1. + auto with arith. + inversion H2; inversion H4; auto. +Qed. + +Lemma odd_induction : forall P : nat -> CProp, - P 1 -> - (forall n, odd n -> P n -> P (S (S n))) -> + P 1 -> + (forall n, odd n -> P n -> P (S (S n))) -> forall n, odd n -> P n. Proof. -intros P H H0 n; case n. -intro H1; elimtype False; inversion H1. -clear n; intros n H1. -pattern n in |- *; apply even_induction; auto. -intros n0 H2 H3; auto with arith. -inversion H1; auto. + intros P H H0 n; case n. + intro H1; elimtype False; inversion H1. + clear n; intros n H1. + pattern n in |- *; apply even_induction; auto. + intros n0 H2 H3; auto with arith. + inversion H1; auto. Qed. -Lemma four_induction : +Lemma four_induction : forall P : nat -> CProp, - P 0 -> P 1 -> P 2 -> P 3 -> - (forall n, P n -> P (S (S (S (S n))))) -> + P 0 -> P 1 -> P 2 -> P 3 -> + (forall n, P n -> P (S (S (S (S n))))) -> forall n, P n. Proof. -intros. -apply lt_wf_rect. -intro m. -case m; auto. -clear m; intro m. -case m; auto. -clear m; intro m. -case m; auto. -clear m; intro m. -case m; auto with arith. + intros. + apply lt_wf_rect. + intro m. + case m; auto. + clear m; intro m. + case m; auto. + clear m; intro m. + case m; auto. + clear m; intro m. + case m; auto with arith. Qed. Lemma nat_complete_double_induction : forall P : nat -> nat -> CProp, (forall m n, (forall m' n', m' < m -> n' < n -> P m' n') -> P m n) -> forall m n, P m n. Proof. -intros P H m. -pattern m in |- *; apply lt_wf_rect; auto with arith. + intros P H m. + pattern m in |- *; apply lt_wf_rect; auto with arith. Qed. Lemma odd_double_ind : forall P : nat -> CProp, (forall n, odd n -> P n) -> (forall n, 0 < n -> P n -> P (double n)) -> forall n, 0 < n -> P n. Proof. -cut (forall n : nat, 0 < double n -> 0 < n). intro. -intro. intro H0. intro H1. intro n. -pattern n in |- *. -apply lt_wf_rect. intros n0 H2 H3. -generalize (even_odd_dec n0). intro H4. elim H4. -intro. -rewrite (even_double n0). -apply H1. -apply H. -rewrite <- (even_double n0). assumption. -assumption. -apply H2. -apply lt_div2. assumption. -rewrite (even_double n0) in H3. -apply H. assumption. -assumption. -assumption. -exact (H0 n0). -unfold double in |- *. intros. -case (zerop n). intro. -absurd (0 < n + n). -rewrite e. auto with arith. -assumption. -intro. assumption. + cut (forall n : nat, 0 < double n -> 0 < n). intro. + intro. intro H0. intro H1. intro n. + pattern n in |- *. + apply lt_wf_rect. intros n0 H2 H3. + generalize (even_odd_dec n0). intro H4. elim H4. + intro. + rewrite (even_double n0). + apply H1. + apply H. + rewrite <- (even_double n0). assumption. + assumption. + apply H2. + apply lt_div2. assumption. + rewrite (even_double n0) in H3. + apply H. assumption. + assumption. + assumption. + exact (H0 n0). + unfold double in |- *. intros. + case (zerop n). intro. + absurd (0 < n + n). + rewrite e. auto with arith. + assumption. + intro. assumption. Qed. (** For subsetoid predicates in the natural numbers we can eliminate disjunction (and existential quantification) as follows. *) -Lemma finite_or_elim : +Lemma finite_or_elim : forall (n : nat) (P Q : forall i, i <= n -> CProp), - nat_less_n_pred' P -> - nat_less_n_pred' Q -> + nat_less_n_pred' P -> + nat_less_n_pred' Q -> (forall i H, P i H or Q i H) -> {m : nat | {Hm : m <= n | P m Hm}} or (forall i H, Q i H). Proof. -intro n; induction n as [| n Hrecn]. -intros P Q HP HQ H. -elim (H _ (le_n 0)); intro H0. -left; exists 0; exists (le_n 0); assumption. -right; intros i H1. -apply HQ with (H := le_n 0); auto with arith. -intros P Q H H0 H1. -elim (H1 _ (le_n (S n))); intro H2. -left; exists (S n); exists (le_n (S n)); assumption. -set (P' := fun (i : nat) (H : i <= n) => P i (le_S _ _ H)) in *. -set (Q' := fun (i : nat) (H : i <= n) => Q i (le_S _ _ H)) in *. -cut - ({m : nat | {Hm : m <= n | P' m Hm}} - or (forall (i : nat) (H : i <= n), Q' i H)). -intro H3; elim H3; intro H4. -left. -elim H4; intros m Hm; elim Hm; clear H4 Hm; intros Hm Hm'. -exists m. -unfold P' in Hm'. -exists (le_S _ _ Hm). -eapply H with (i := m); [ omega | apply Hm' ]. -right. -intros i H5. -unfold Q' in H4. -elim (le_lt_eq_dec _ _ H5); intro H6. -cut (i <= n); [ intro | auto with arith ]. -eapply H0 with (i := i); [ auto with arith | apply (H4 i H7) ]. -eapply H0 with (i := S n); [ auto with arith | apply H2 ]. -apply Hrecn. -intro i; intros j H3 H4 H5 H6. -unfold P' in |- *. -exact (H _ _ H3 _ _ H6). -intro i; intros j H3 H4 H5 H6. -unfold Q' in |- *. -exact (H0 _ _ H3 _ _ H6). -intros i H3. -unfold P', Q' in |- *; apply H1. -Qed. - -Lemma str_finite_or_elim : + intro n; induction n as [| n Hrecn]. + intros P Q HP HQ H. + elim (H _ (le_n 0)); intro H0. + left; exists 0; exists (le_n 0); assumption. + right; intros i H1. + apply HQ with (H := le_n 0); auto with arith. + intros P Q H H0 H1. + elim (H1 _ (le_n (S n))); intro H2. + left; exists (S n); exists (le_n (S n)); assumption. + set (P' := fun (i : nat) (H : i <= n) => P i (le_S _ _ H)) in *. + set (Q' := fun (i : nat) (H : i <= n) => Q i (le_S _ _ H)) in *. + cut ({m : nat | {Hm : m <= n | P' m Hm}} or (forall (i : nat) (H : i <= n), Q' i H)). + intro H3; elim H3; intro H4. + left. + elim H4; intros m Hm; elim Hm; clear H4 Hm; intros Hm Hm'. + exists m. + unfold P' in Hm'. + exists (le_S _ _ Hm). + eapply H with (i := m); [ omega | apply Hm' ]. + right. + intros i H5. + unfold Q' in H4. + elim (le_lt_eq_dec _ _ H5); intro H6. + cut (i <= n); [ intro | auto with arith ]. + eapply H0 with (i := i); [ auto with arith | apply (H4 i H7) ]. + eapply H0 with (i := S n); [ auto with arith | apply H2 ]. + apply Hrecn. + intro i; intros j H3 H4 H5 H6. + unfold P' in |- *. + exact (H _ _ H3 _ _ H6). + intro i; intros j H3 H4 H5 H6. + unfold Q' in |- *. + exact (H0 _ _ H3 _ _ H6). + intros i H3. + unfold P', Q' in |- *; apply H1. +Qed. + +Lemma str_finite_or_elim : forall (n : nat) (P Q : forall i, i <= n -> CProp), - nat_less_n_pred' P -> - nat_less_n_pred' Q -> + nat_less_n_pred' P -> + nat_less_n_pred' Q -> (forall i H, P i H or Q i H) -> {j : nat | {Hj : j <= n | P j Hj and (forall j' Hj', j' < j -> Q j' Hj')}} or (forall i H, Q i H). Proof. -intro n; induction n as [| n Hrecn]. -intros P Q H H0 H1. -elim (H1 0 (le_n 0)); intro HPQ. -left. -exists 0; exists (le_n 0). -split. -apply H with (H := le_n 0); auto. -intros; elimtype False; inversion H2. -right; intros. -apply H0 with (H := le_n 0); auto with arith. -intros P Q H H0 H1. -set (P' := fun (i : nat) (H : i <= n) => P i (le_S _ _ H)) in *. -set (Q' := fun (i : nat) (H : i <= n) => Q i (le_S _ _ H)) in *. -elim (Hrecn P' Q'). -intro H2. -left. -elim H2; intros m Hm; elim Hm; clear H2 Hm; intros Hm Hm'. -exists m. -unfold P' in Hm'. -exists (le_S _ _ Hm). -elim Hm'; clear Hm'; intros Hm' Hj. -split. -eapply H with (i := m); [ auto with arith | apply Hm' ]. -unfold Q' in Hj; intros j' Hj' H2. -cut (j' <= n); [ intro H4 | apply le_trans with m; auto with arith ]. -apply H0 with (H := le_S _ _ H4); [ auto | apply Hj; assumption ]. -elim (H1 (S n) (le_n (S n))); intro H1'. -intro H2. -left; exists (S n); exists (le_n (S n)); split. -assumption. -intros j' Hj' H3; unfold Q' in H1'. -cut (j' <= n); [ intro H4 | auto with arith ]. -unfold Q' in H2. -apply H0 with (H := le_S _ _ H4); auto. -intro H2. -right; intros i H3. -unfold Q' in H1'. -elim (le_lt_eq_dec _ _ H3); intro H4. -cut (i <= n); [ intro H5 | auto with arith ]. -unfold Q' in H2. -apply H0 with (H := le_S _ _ H5); auto. -apply H0 with (H := le_n (S n)); auto. -intro i; intros j H2 H3 H4 H5. -unfold P' in |- *. -exact (H _ _ H2 _ _ H5). -intro i; intros j H2 H3 H4 H5. -unfold Q' in |- *. -exact (H0 _ _ H2 _ _ H5). -intros i H2. -unfold P', Q' in |- *. -apply H1. + intro n; induction n as [| n Hrecn]. + intros P Q H H0 H1. + elim (H1 0 (le_n 0)); intro HPQ. + left. + exists 0; exists (le_n 0). + split. + apply H with (H := le_n 0); auto. + intros; elimtype False; inversion H2. + right; intros. + apply H0 with (H := le_n 0); auto with arith. + intros P Q H H0 H1. + set (P' := fun (i : nat) (H : i <= n) => P i (le_S _ _ H)) in *. + set (Q' := fun (i : nat) (H : i <= n) => Q i (le_S _ _ H)) in *. + elim (Hrecn P' Q'). + intro H2. + left. + elim H2; intros m Hm; elim Hm; clear H2 Hm; intros Hm Hm'. + exists m. + unfold P' in Hm'. + exists (le_S _ _ Hm). + elim Hm'; clear Hm'; intros Hm' Hj. + split. + eapply H with (i := m); [ auto with arith | apply Hm' ]. + unfold Q' in Hj; intros j' Hj' H2. + cut (j' <= n); [ intro H4 | apply le_trans with m; auto with arith ]. + apply H0 with (H := le_S _ _ H4); [ auto | apply Hj; assumption ]. + elim (H1 (S n) (le_n (S n))); intro H1'. + intro H2. + left; exists (S n); exists (le_n (S n)); split. + assumption. + intros j' Hj' H3; unfold Q' in H1'. + cut (j' <= n); [ intro H4 | auto with arith ]. + unfold Q' in H2. + apply H0 with (H := le_S _ _ H4); auto. + intro H2. + right; intros i H3. + unfold Q' in H1'. + elim (le_lt_eq_dec _ _ H3); intro H4. + cut (i <= n); [ intro H5 | auto with arith ]. + unfold Q' in H2. + apply H0 with (H := le_S _ _ H5); auto. + apply H0 with (H := le_n (S n)); auto. + intro i; intros j H2 H3 H4 H5. + unfold P' in |- *. + exact (H _ _ H2 _ _ H5). + intro i; intros j H2 H3 H4 H5. + unfold Q' in |- *. + exact (H0 _ _ H2 _ _ H5). + intros i H2. + unfold P', Q' in |- *. + apply H1. Qed. End Predicates_to_CProp. @@ -1298,55 +1299,55 @@ completeness's sake. Lemma even_ind : forall P : nat -> Prop, P 0 -> (forall n, even n -> P n -> P (S (S n))) -> forall n, even n -> P n. Proof. -intros P H H0 n. -pattern n in |- *; apply lt_wf_ind. -clear n. -intros n H1 H2. -induction n as [| n Hrecn]. -auto. -induction n as [| n Hrecn0]. -elimtype False; inversion H2; inversion H4. -apply H0. -inversion H2; inversion H4; auto. -apply H1. -auto with arith. -inversion H2; inversion H4; auto. + intros P H H0 n. + pattern n in |- *; apply lt_wf_ind. + clear n. + intros n H1 H2. + induction n as [| n Hrecn]. + auto. + induction n as [| n Hrecn0]. + elimtype False; inversion H2; inversion H4. + apply H0. + inversion H2; inversion H4; auto. + apply H1. + auto with arith. + inversion H2; inversion H4; auto. Qed. Lemma odd_ind : forall P : nat -> Prop, P 1 -> (forall n, P n -> P (S (S n))) -> forall n, odd n -> P n. Proof. -intros P H H0 n; case n. -intro H1; elimtype False; inversion H1. -clear n; intros n H1. -pattern n in |- *; apply even_ind; auto. -inversion H1; auto. + intros P H H0 n; case n. + intro H1; elimtype False; inversion H1. + clear n; intros n H1. + pattern n in |- *; apply even_ind; auto. + inversion H1; auto. Qed. -Lemma nat_complete_double_ind : +Lemma nat_complete_double_ind : forall P : nat -> nat -> Prop, - (forall m n, (forall m' n', m' < m -> n' < n -> P m' n') -> P m n) -> + (forall m n, (forall m' n', m' < m -> n' < n -> P m' n') -> P m n) -> forall m n, P m n. Proof. -intros P H m. -pattern m in |- *; apply lt_wf_ind; auto. + intros P H m. + pattern m in |- *; apply lt_wf_ind; auto. Qed. -Lemma four_ind : +Lemma four_ind : forall P : nat -> Prop, - P 0 -> P 1 -> P 2 -> P 3 -> + P 0 -> P 1 -> P 2 -> P 3 -> (forall n, P n -> P (S (S (S (S n))))) -> forall n, P n. Proof. -intros. -apply lt_wf_ind. -intro m. -case m; auto. -clear m; intro m. -case m; auto. -clear m; intro m. -case m; auto. -clear m; intro m. -case m; auto with arith. + intros. + apply lt_wf_ind. + intro m. + case m; auto. + clear m; intro m. + case m; auto. + clear m; intro m. + case m; auto. + clear m; intro m. + case m; auto with arith. Qed. End Predicates_to_Prop. @@ -1381,31 +1382,31 @@ Qed. Lemma Zsgn_1 : forall x : Z, {Zsgn x = 0%Z} + {Zsgn x = 1%Z} + {Zsgn x = (-1)%Z}. Proof. -intro x. -case x. -left. -left. -unfold Zsgn in |- *. -reflexivity. -intro p. -simpl in |- *. -left. -right. -reflexivity. -intro p. -right. -simpl in |- *. -reflexivity. + intro x. + case x. + left. + left. + unfold Zsgn in |- *. + reflexivity. + intro p. + simpl in |- *. + left. + right. + reflexivity. + intro p. + right. + simpl in |- *. + reflexivity. Qed. Lemma Zsgn_2 : forall x : Z, Zsgn x = 0%Z -> x = 0%Z. Proof. intro x. case x. - intro H. - reflexivity. - intros p H. - inversion H. + intro H. + reflexivity. + intros p H. + inversion H. intros p H. inversion H. Qed. @@ -1414,12 +1415,12 @@ Lemma Zsgn_3 : forall x : Z, x <> 0%Z -> Zsgn x <> 0%Z. Proof. intro x. case x. - intro H. - elim H. - reflexivity. - intros p H. - simpl in |- *. - discriminate. + intro H. + elim H. + reflexivity. + intros p H. + simpl in |- *. + discriminate. intros p H. simpl in |- *. discriminate. @@ -1431,53 +1432,50 @@ fast_integers.v. Lemma ZL4' : forall y : positive, {h : nat | nat_of_P y = S h}. Proof. - simple induction y; - [ intros p H; elim H; intros x H1; exists (S x + S x); - 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 - | intros p H1; elim H1; intros x H2; exists (x + S x); - 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; auto with arith ]. + simple induction y; [ intros p H; elim H; intros x H1; exists (S x + S x); + 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 + | intros p H1; elim H1; intros x H2; exists (x + S x); + 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; auto with arith ]. Qed. Lemma ZL9 : forall p : positive, Z_of_nat (nat_of_P p) = Zpos p. Proof. -intro p. -elim (ZL4 p). -intros x H0. -rewrite H0. -unfold Z_of_nat in |- *. -apply f_equal with (A := positive) (B := Z) (f := Zpos). -cut (P_of_succ_nat (nat_of_P p) = P_of_succ_nat (S x)). -intro H1. -rewrite P_of_succ_nat_o_nat_of_P_eq_succ in H1. -cut (Ppred (Psucc p) = Ppred (P_of_succ_nat (S x))). -intro H2. -rewrite Ppred_succ in H2. -simpl in H2. -rewrite Ppred_succ in H2. -auto. -apply f_equal with (A := positive) (B := positive) (f := Ppred). -assumption. -apply f_equal with (f := P_of_succ_nat). -assumption. + intro p. + elim (ZL4 p). + intros x H0. + rewrite H0. + unfold Z_of_nat in |- *. + apply f_equal with (A := positive) (B := Z) (f := Zpos). + cut (P_of_succ_nat (nat_of_P p) = P_of_succ_nat (S x)). + intro H1. + rewrite P_of_succ_nat_o_nat_of_P_eq_succ in H1. + cut (Ppred (Psucc p) = Ppred (P_of_succ_nat (S x))). + intro H2. + rewrite Ppred_succ in H2. + simpl in H2. + rewrite Ppred_succ in H2. + auto. + apply f_equal with (A := positive) (B := positive) (f := Ppred). + assumption. + apply f_equal with (f := P_of_succ_nat). + assumption. Qed. Theorem Zsgn_4 : forall a : Z, a = (Zsgn a * Zabs_nat a)%Z. Proof. intro a. case a. - simpl in |- *. - reflexivity. - intro p. - unfold Zsgn in |- *. - unfold Zabs_nat in |- *. - rewrite Zmult_1_l. - symmetry in |- *. - apply ZL9. + simpl in |- *. + reflexivity. + intro p. + unfold Zsgn in |- *. + unfold Zabs_nat in |- *. + rewrite Zmult_1_l. + symmetry in |- *. + apply ZL9. intro p. unfold Zsgn in |- *. unfold Zabs_nat in |- *. @@ -1490,73 +1488,73 @@ Theorem Zsgn_5 : forall a b x y : Z, x <> 0%Z -> y <> 0%Z -> Proof. intros a b x y H H0. case a. - case b. - simpl in |- *. - trivial. + case b. + simpl in |- *. + trivial. + intro p. + unfold Zsgn in |- *. + intro H1. + rewrite Zmult_1_l in H1. + simpl in H1. + elim H0. + auto. + intro p. + unfold Zsgn in |- *. + intro H1. + elim H0. + apply Zopp_inj. + simpl in |- *. + transitivity (-1 * y)%Z; auto. intro p. - unfold Zsgn in |- *. + unfold Zsgn at 1 in |- *. + unfold Zsgn at 2 in |- *. intro H1. + transitivity y. + rewrite Zmult_1_l. + reflexivity. + transitivity (Zsgn b * (Zsgn b * y))%Z. + case (Zsgn_1 b). + intro H2. + case H2. + intro H3. + elim H. + rewrite H3 in H1. + change ((1 * x)%Z = 0%Z) in H1. + rewrite Zmult_1_l in H1. + assumption. + intro H3. + rewrite H3. + rewrite Zmult_1_l. + rewrite Zmult_1_l. + reflexivity. + intro H2. + rewrite H2. + ring. rewrite Zmult_1_l in H1. - simpl in H1. - elim H0. - auto. - intro p. - unfold Zsgn in |- *. - intro H1. - elim H0. - apply Zopp_inj. - simpl in |- *. - transitivity (-1 * y)%Z; auto. - intro p. - unfold Zsgn at 1 in |- *. - unfold Zsgn at 2 in |- *. - intro H1. - transitivity y. - rewrite Zmult_1_l. - reflexivity. - transitivity (Zsgn b * (Zsgn b * y))%Z. - case (Zsgn_1 b). - intro H2. - case H2. - intro H3. - elim H. - rewrite H3 in H1. - change ((1 * x)%Z = 0%Z) in H1. - rewrite Zmult_1_l in H1. - assumption. - intro H3. - rewrite H3. - rewrite Zmult_1_l. - rewrite Zmult_1_l. + rewrite H1. reflexivity. - intro H2. - rewrite H2. - ring. - rewrite Zmult_1_l in H1. - rewrite H1. - reflexivity. intro p. unfold Zsgn at 1 in |- *. unfold Zsgn at 2 in |- *. intro H1. transitivity (Zsgn b * (-1 * (Zsgn b * y)))%Z. - case (Zsgn_1 b). + case (Zsgn_1 b). + intro H2. + case H2. + intro H3. + elim H. + apply Zopp_inj. + transitivity (-1 * x)%Z. + ring. + unfold Zopp in |- *. + rewrite H3 in H1. + transitivity (0 * y)%Z; auto. + intro H3. + rewrite H3. + ring. intro H2. - case H2. - intro H3. - elim H. - apply Zopp_inj. - transitivity (-1 * x)%Z. - ring. - unfold Zopp in |- *. - rewrite H3 in H1. - transitivity (0 * y)%Z; auto. - intro H3. - rewrite H3. + rewrite H2. ring. - intro H2. - rewrite H2. - ring. rewrite <- H1. ring. Qed. @@ -1564,155 +1562,155 @@ Qed. Lemma nat_nat_pos : forall m n : nat, ((m + 1) * (n + 1) > 0)%Z. Proof. -intros m n. -apply Zlt_gt. -cut (Z_of_nat m + 1 > 0)%Z. -intro H. -cut (0 < Z_of_nat n + 1)%Z. -intro H0. -cut ((Z_of_nat m + 1) * 0 < (Z_of_nat m + 1) * (Z_of_nat n + 1))%Z. -rewrite Zmult_0_r. -auto. -apply Zlt_reg_mult_l; auto. -change (0 < Zsucc (Z_of_nat n))%Z in |- *. -apply Zle_lt_succ. -change (Z_of_nat 0 <= Z_of_nat n)%Z in |- *. -apply Znat.inj_le. -apply le_O_n. -apply Zlt_gt. -change (0 < Zsucc (Z_of_nat m))%Z in |- *. -apply Zle_lt_succ. -change (Z_of_nat 0 <= Z_of_nat m)%Z in |- *. -apply Znat.inj_le. -apply le_O_n. + intros m n. + apply Zlt_gt. + cut (Z_of_nat m + 1 > 0)%Z. + intro H. + cut (0 < Z_of_nat n + 1)%Z. + intro H0. + cut ((Z_of_nat m + 1) * 0 < (Z_of_nat m + 1) * (Z_of_nat n + 1))%Z. + rewrite Zmult_0_r. + auto. + apply Zlt_reg_mult_l; auto. + change (0 < Zsucc (Z_of_nat n))%Z in |- *. + apply Zle_lt_succ. + change (Z_of_nat 0 <= Z_of_nat n)%Z in |- *. + apply Znat.inj_le. + apply le_O_n. + apply Zlt_gt. + change (0 < Zsucc (Z_of_nat m))%Z in |- *. + apply Zle_lt_succ. + change (Z_of_nat 0 <= Z_of_nat m)%Z in |- *. + apply Znat.inj_le. + apply le_O_n. Qed. Theorem S_predn : forall m : nat, m <> 0 -> S (pred m) = m. Proof. -intros m H. -symmetry in |- *. -apply S_pred with 0. -omega. + intros m H. + symmetry in |- *. + apply S_pred with 0. + omega. Qed. Lemma absolu_1 : forall x : Z, Zabs_nat x = 0 -> x = 0%Z. Proof. -intros x H. -case (dec_eq x 0). -auto. -intro H0. -apply False_ind. -ElimCompare x 0%Z. -intro H2. -apply H0. -elim (Zcompare_Eq_iff_eq x 0%nat). -intros H3 H4. -auto. -intro H2. -cut (exists h : nat, Zabs_nat x = S h). -intro H3. -case H3. -rewrite H. -exact O_S. -change (x < 0)%Z in H2. -set (H3 := Zlt_gt _ _ H2) in *. -elim (Zcompare_Gt_spec _ _ H3). -intros x0 H5. -cut (exists q : positive, x = Zneg q). -intro H6. -case H6. -intros x1 H7. -rewrite H7. -unfold Zabs_nat in |- *. -generalize x1. -exact ZL4. -cut (x = (- Zpos x0)%Z). -simpl in |- *. -intro H6. -exists x0. -assumption. -rewrite <- (Zopp_involutive x). -exact (f_equal Zopp H5). -intro H2. -cut (exists h : nat, Zabs_nat x = S h). -intro H3. -case H3. -rewrite H. -exact O_S. -elim (Zcompare_Gt_spec _ _ H2). -simpl in |- *. -rewrite Zplus_0_r. -intros x0 H4. -rewrite H4. -unfold Zabs_nat in |- *. -generalize x0. -exact ZL4. + intros x H. + case (dec_eq x 0). + auto. + intro H0. + apply False_ind. + ElimCompare x 0%Z. + intro H2. + apply H0. + elim (Zcompare_Eq_iff_eq x 0%nat). + intros H3 H4. + auto. + intro H2. + cut (exists h : nat, Zabs_nat x = S h). + intro H3. + case H3. + rewrite H. + exact O_S. + change (x < 0)%Z in H2. + set (H3 := Zlt_gt _ _ H2) in *. + elim (Zcompare_Gt_spec _ _ H3). + intros x0 H5. + cut (exists q : positive, x = Zneg q). + intro H6. + case H6. + intros x1 H7. + rewrite H7. + unfold Zabs_nat in |- *. + generalize x1. + exact ZL4. + cut (x = (- Zpos x0)%Z). + simpl in |- *. + intro H6. + exists x0. + assumption. + rewrite <- (Zopp_involutive x). + exact (f_equal Zopp H5). + intro H2. + cut (exists h : nat, Zabs_nat x = S h). + intro H3. + case H3. + rewrite H. + exact O_S. + elim (Zcompare_Gt_spec _ _ H2). + simpl in |- *. + rewrite Zplus_0_r. + intros x0 H4. + rewrite H4. + unfold Zabs_nat in |- *. + generalize x0. + exact ZL4. Qed. Lemma absolu_2 : forall x : Z, x <> 0%Z -> Zabs_nat x <> 0. Proof. -intros x H. -intro H0. -apply H. -apply absolu_1. -assumption. + intros x H. + intro H0. + apply H. + apply absolu_1. + assumption. Qed. Lemma Zgt_mult_conv_absorb_l : forall a x y : Z, (a < 0)%Z -> (a * x > a * y)%Z -> (x < y)%Z. Proof. -intros a x y H H0. -case (dec_eq x y). -intro H1. -apply False_ind. -rewrite H1 in H0. -cut ((a * y)%Z = (a * y)%Z). -change ((a * y)%Z <> (a * y)%Z) in |- *. -apply Zgt_not_eq. -assumption. -trivial. -intro H1. -case (not_Zeq x y H1). -trivial. -intro H2. -apply False_ind. -cut (a * y > a * x)%Z. -apply Zgt_asym with (m := (a * y)%Z) (n := (a * x)%Z). -assumption. -apply Zlt_conv_mult_l. -assumption. -assumption. + intros a x y H H0. + case (dec_eq x y). + intro H1. + apply False_ind. + rewrite H1 in H0. + cut ((a * y)%Z = (a * y)%Z). + change ((a * y)%Z <> (a * y)%Z) in |- *. + apply Zgt_not_eq. + assumption. + trivial. + intro H1. + case (not_Zeq x y H1). + trivial. + intro H2. + apply False_ind. + cut (a * y > a * x)%Z. + apply Zgt_asym with (m := (a * y)%Z) (n := (a * x)%Z). + assumption. + apply Zlt_conv_mult_l. + assumption. + assumption. Qed. Lemma Zgt_mult_reg_absorb_l : forall a x y : Z, (a > 0)%Z -> (a * x > a * y)%Z -> (x > y)%Z. Proof. -intros a x y H H0. -cut (- a < - (0))%Z. -rewrite <- (Zopp_involutive a) in H. -rewrite <- (Zopp_involutive 0) in H. -simpl in |- *. -intro H1. -rewrite <- (Zopp_involutive x). -rewrite <- (Zopp_involutive y). -apply Zlt_opp. -apply Zgt_mult_conv_absorb_l with (a := (- a)%Z) (x := (- x)%Z). -assumption. -rewrite Zopp_mult_distr_l_reverse. -rewrite Zopp_mult_distr_l_reverse. -apply Zlt_opp. -rewrite <- Zopp_mult_distr_r. -rewrite <- Zopp_mult_distr_r. -apply Zgt_lt. -apply Zlt_opp. -apply Zgt_lt. -assumption. -omega. + intros a x y H H0. + cut (- a < - (0))%Z. + rewrite <- (Zopp_involutive a) in H. + rewrite <- (Zopp_involutive 0) in H. + simpl in |- *. + intro H1. + rewrite <- (Zopp_involutive x). + rewrite <- (Zopp_involutive y). + apply Zlt_opp. + apply Zgt_mult_conv_absorb_l with (a := (- a)%Z) (x := (- x)%Z). + assumption. + rewrite Zopp_mult_distr_l_reverse. + rewrite Zopp_mult_distr_l_reverse. + apply Zlt_opp. + rewrite <- Zopp_mult_distr_r. + rewrite <- Zopp_mult_distr_r. + apply Zgt_lt. + apply Zlt_opp. + apply Zgt_lt. + assumption. + omega. Qed. Lemma Zmult_Sm_Sn : forall m n : Z, ((m + 1) * (n + 1))%Z = (m * n + (m + n) + 1)%Z. Proof. -intros. -ring. + intros. + ring. Qed. diff --git a/logic/Classic.v b/logic/Classic.v index d583b2204..56444f9d5 100644 --- a/logic/Classic.v +++ b/logic/Classic.v @@ -27,7 +27,7 @@ This section introduces the classical logic connectives, "classical or" and "classical exists" through their double negation translation. Induction principles are given that allow you to destruct these formulas as you would their constructive counter parts, so long as the conclusion -is double negataion stable. +is double negataion stable. No classical axioms are assumed. *) @@ -42,21 +42,21 @@ Definition orC (P Q:Prop) := ~((~P)/\(~Q)). Lemma orWeaken : forall P Q, ({P}+{Q}) -> orC P Q. Proof. -unfold orC. -tauto. + unfold orC. + tauto. Qed. Lemma orC_ind : forall (P Q G:Prop), (~~G -> G) -> (P -> G) -> (Q -> G) -> (orC P Q) -> G. Proof. -unfold orC. -tauto. + unfold orC. + tauto. Qed. Lemma orC_stable : forall P Q, ~~(orC P Q) -> orC P Q. Proof. -unfold orC. -auto. + unfold orC. + auto. Qed. End ClassicOr. @@ -74,28 +74,28 @@ Definition existsC : Prop := Lemma existsWeaken : (exists x:A, P x) -> existsC. Proof. -intros [x Hx] H. -apply (H x). -assumption. + intros [x Hx] H. + apply (H x). + assumption. Qed. Lemma existsC_ind : forall (Q:Prop), (~~Q -> Q) -> (forall x:A, P x -> Q) -> existsC -> Q. Proof. -intros Q HQ H ex. -apply HQ. -intros Z. -apply ex. -intros x Hx. -apply Z. -apply H with x. -assumption. + intros Q HQ H ex. + apply HQ. + intros Z. + apply ex. + intros x Hx. + apply Z. + apply H with x. + assumption. Qed. Lemma existsC_stable : ~~existsC -> existsC. Proof. -unfold existsC. -auto. + unfold existsC. + auto. Qed. End ClassicExists. @@ -110,48 +110,47 @@ the list are selected, there classically exists an item that is selected a classically infinite number of times. *) -Lemma infinitePidgeonHolePrinicple : +Lemma infinitePidgeonHolePrinicple : forall (X:Type) (l:list X) (P:nat -> X -> Prop), (forall n, existsC X (fun x => ~~In x l /\ P n x)) -> existsC X (fun x => In x l /\ forall n, existsC nat (fun m => (n <= m)%nat /\ (P m x))). Proof. -intros X l. -induction l; - intros P HP G. - apply (HP O). - intros x [Hx _]. - auto with *. -apply (G a). -split; auto with *. -intros n Hn. -set (P':= fun m => P (m+n)%nat). -assert (HP' : forall m : nat, existsC X (fun x => ~~In x l /\ P' m x)). - intros m. - unfold P'. - destruct (HP (m + n)%nat) as [HG | y [Hy0 Hy1]] using existsC_ind. + intros X l. + induction l; intros P HP G. + apply (HP O). + intros x [Hx _]. + auto with *. + apply (G a). + split; auto with *. + intros n Hn. + set (P':= fun m => P (m+n)%nat). + assert (HP' : forall m : nat, existsC X (fun x => ~~In x l /\ P' m x)). + intros m. + unfold P'. + destruct (HP (m + n)%nat) as [HG | y [Hy0 Hy1]] using existsC_ind. + apply existsC_stable; auto. + apply existsWeaken. + exists y. + split; auto. + revert Hy0. + cut (In y (a :: l) -> In y l);[tauto|]. + intros Hy0. + destruct Hy0; auto. + elim (Hn (m + n)%nat). + rewrite H. + auto with *. + destruct (IHl P' HP') as [HG | x [Hx0 Hx1]] using existsC_ind. + tauto. + apply (G x). + split; auto with *. + unfold P' in Hx1. + intros n0. + destruct (Hx1 n0) as [HG | m [Hm0 Hm1]] using existsC_ind. apply existsC_stable; auto. apply existsWeaken. - exists y. + exists (m + n)%nat. split; auto. - revert Hy0. - cut (In y (a :: l) -> In y l);[tauto|]. - intros Hy0. - destruct Hy0; auto. - elim (Hn (m + n)%nat). - rewrite H. auto with *. -destruct (IHl P' HP') as [HG | x [Hx0 Hx1]] using existsC_ind. - tauto. -apply (G x). -split; auto with *. -unfold P' in Hx1. -intros n0. -destruct (Hx1 n0) as [HG | m [Hm0 Hm1]] using existsC_ind. - apply existsC_stable; auto. -apply existsWeaken. -exists (m + n)%nat. -split; auto. -auto with *. Qed. (** @@ -159,16 +158,16 @@ This weaker version of the pidgen hole principle uses a function to select elements from a list instead of a releation. It may be more convienent to use at times. *) -Lemma infinitePidgeonHolePrinicpleB : +Lemma infinitePidgeonHolePrinicpleB : forall (X:Type) (l:list X) (f:nat -> X), (forall n, In (f n) l) -> existsC X (fun x => In x l /\ forall n, existsC nat (fun m => (n <= m)%nat /\ (f m)=x)). Proof. -intros X l f H. -apply infinitePidgeonHolePrinicple. -intros n. -apply existsWeaken. -exists (f n). -auto with *. + intros X l f H. + apply infinitePidgeonHolePrinicple. + intros n. + apply existsWeaken. + exists (f n). + auto with *. Qed. diff --git a/logic/PropDecid.v b/logic/PropDecid.v index dc6361672..e1c55b887 100644 --- a/logic/PropDecid.v +++ b/logic/PropDecid.v @@ -23,7 +23,8 @@ Here we show the decidability of logical connectives. *) Lemma imp_dec : (forall A B, ({A} + {~A}) -> ({B} + {~B}) -> ({A -> B} + {~(A -> B)})). -tauto. +Proof. + tauto. Qed. -(* TODO: other connectives *) \ No newline at end of file +(* TODO: other connectives *) diff --git a/metric2/Classification.v b/metric2/Classification.v index fd5ac4b5a..dea52c064 100644 --- a/metric2/Classification.v +++ b/metric2/Classification.v @@ -29,57 +29,55 @@ There is a heirarchy of properties that a metric space can possess. At the lowest level a metric space is stable if its ball relation is double negation stable. Arguablely this could be made a requirement of metric spaces. *) -Definition stableMetric (ms:MetricSpace) := +Definition stableMetric (ms:MetricSpace) := forall e (x y:ms), ~~(ball e x y) -> ball e x y. Lemma stableEq : forall (ms:MetricSpace) (stable:stableMetric ms) (x y:ms), ~~(st_eq x y) -> st_eq x y. Proof. -intros ms stable x y Hxy. -apply ball_eq. -intros e. -apply stable. -revert Hxy. -cut (st_eq x y -> ball (m:=ms) e x y). - tauto. -intros H. -rewrite H. -apply ball_refl. + intros ms stable x y Hxy. + apply ball_eq. + intros e. + apply stable. + revert Hxy. + cut (st_eq x y -> ball (m:=ms) e x y). + tauto. + intros H. + rewrite H. + apply ball_refl. Qed. (** At the next level up a metric space is located if you can choose between ball d x y and ~ball e x y for e < d. Every located metric is a stable metric. *) -Definition locatedMetric (ms:MetricSpace) := +Definition locatedMetric (ms:MetricSpace) := forall (e d:Qpos) (x y:ms), e < d -> {ball d x y}+{~ball e x y}. (** At the top level a metric space is decidable if its ball relation is decidable. Every decidable metric is a located metric. *) -Definition decidableMetric (ms:MetricSpace) := +Definition decidableMetric (ms:MetricSpace) := forall e (x y:ms), {ball e x y}+{~ball e x y}. Lemma decidable_located : forall ms, decidableMetric ms -> locatedMetric ms. Proof. -intros ms H e d x y Hed. -destruct (H e x y). - left. - abstract ( - apply ball_weak_le with e; try assumption; - apply Qlt_le_weak; assumption). -right; assumption. + intros ms H e d x y Hed. + destruct (H e x y). + left. + abstract ( apply ball_weak_le with e; try assumption; apply Qlt_le_weak; assumption). + right; assumption. Defined. Lemma located_stable : forall ms, locatedMetric ms -> stableMetric ms. Proof. -intros ms H e x y Hxy. -apply ball_closed. -intros d. -destruct (H e (e+d)%Qpos x y); try (assumption || contradiction). -autorewrite with QposElim. -rewrite Qlt_minus_iff; ring_simplify; auto with *. + intros ms H e x y Hxy. + apply ball_closed. + intros d. + destruct (H e (e+d)%Qpos x y); try (assumption || contradiction). + autorewrite with QposElim. + rewrite Qlt_minus_iff; ring_simplify; auto with *. Qed. (* begin hide *) Hint Resolve decidable_located located_stable : classification. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/metric2/Compact.v b/metric2/Compact.v index d1832c799..28f4437ca 100644 --- a/metric2/Compact.v +++ b/metric2/Compact.v @@ -79,312 +79,308 @@ Hypothesis stableX : stableMetric X. of (classically) some member of a finite enumeration. We won't know which point it is close to. *) Fixpoint almostIn (e:Qpos) (x:X) (l:FinEnum stableX) : Prop := -match l with +match l with | nil => False | y::ys => orC (ball e x y) (almostIn e x ys) end. Lemma almostIn_stable : forall e x l, ~~almostIn e x l -> almostIn e x l. Proof. -intros e x l. -induction l. + intros e x l. + induction l. + tauto. + intros H. + simpl in *. + unfold orC in *. tauto. -intros H. -simpl in *. -unfold orC in *. -tauto. Qed. Lemma almostIn_weak_le : forall (e1 e2:Qpos) x l, (e1 <= e2) -> almostIn e1 x l -> almostIn e2 x l. Proof. -induction l; intros He H. - apply H. -destruct H as [G | H | H] using orC_ind. - auto using almostIn_stable. + induction l; intros He H. + apply H. + destruct H as [G | H | H] using orC_ind. + auto using almostIn_stable. + apply orWeaken. + left. + eapply ball_weak_le. + apply He. + assumption. apply orWeaken. - left. - eapply ball_weak_le. - apply He. - assumption. -apply orWeaken. -right. -apply IHl; assumption. + right. + apply IHl; assumption. Qed. (** If you are almost in for every e, then you are infact in the finite enumeration *) Lemma InAlmostIn : forall x l, (forall e, almostIn e x l)<->(InFinEnumC x l). Proof. -induction l. + induction l. + split. + intros H. + apply (H (1#1)%Qpos). + contradiction. split. - intros H. - apply (H (1#1)%Qpos). - contradiction. -split. - intros H [A B]. - assert (existsC Qpos (fun e => ~ball e x a)). + intros H [A B]. + assert (existsC Qpos (fun e => ~ball e x a)). + intros C. + apply A. + apply ball_eq. + intros d. + apply stableX. + apply C. + destruct H0 as [ G | z Hz] using existsC_ind. + tauto. + apply B. + apply -> IHl. + intros e. + apply almostIn_stable. intros C. - apply A. - apply ball_eq. - intros d. - apply stableX. - apply C. - destruct H0 as [ G | z Hz] using existsC_ind. - tauto. - apply B. - apply -> IHl. - intros e. - apply almostIn_stable. - intros C. - destruct (Qlt_le_dec e z). - apply (H e). + destruct (Qlt_le_dec e z). + apply (H e). + split; try assumption. + intros D. + apply Hz. + eapply ball_weak_le. + apply Qlt_le_weak. + apply q. + assumption. + apply (H z). split; try assumption. intros D. - apply Hz. - eapply ball_weak_le. - apply Qlt_le_weak. + apply C. + eapply almostIn_weak_le. apply q. assumption. - apply (H z). - split; try assumption. - intros D. - apply C. - eapply almostIn_weak_le. - apply q. - assumption. -intros H e. -move H after e. -destruct H as [ G | H | H] using orC_ind. - auto using almostIn_stable. + intros H e. + move H after e. + destruct H as [ G | H | H] using orC_ind. + auto using almostIn_stable. + apply orWeaken. + left. + rewrite H. + apply ball_refl. + rewrite <- IHl in H. apply orWeaken. - left. - rewrite H. - apply ball_refl. -rewrite <- IHl in H. -apply orWeaken. -right. -apply H. + right. + apply H. Qed. Lemma almostIn_closed : forall e x l, (forall d, almostIn (e+d) x l) -> almostIn e x l. Proof. -induction l. + induction l. + intros H. + apply (H (1#1)%Qpos). intros H. - apply (H (1#1)%Qpos). -intros H. -intros [A B]. -apply B. -clear B. -apply IHl. -intros d. -assert (existsC Qpos (fun d => ~ball (e+d) x a)). - intros Y. - apply A. - apply ball_closed. - intros d0. - apply stableX. - apply Y. -destruct H0 as [G | d0 Hd0] using existsC_ind. - auto using almostIn_stable. -apply almostIn_stable. -intros Z. -destruct (Qlt_le_dec d0 d). - apply Z. - apply (@almostIn_weak_le (e + d0)%Qpos). - autorewrite with QposElim. - apply Qlt_le_weak. - rewrite -> Qlt_minus_iff in *. - replace RHS with (d + - d0) by ring. - assumption. + intros [A B]. + apply B. + clear B. + apply IHl. + intros d. + assert (existsC Qpos (fun d => ~ball (e+d) x a)). + intros Y. + apply A. + apply ball_closed. + intros d0. + apply stableX. + apply Y. + destruct H0 as [G | d0 Hd0] using existsC_ind. + auto using almostIn_stable. apply almostIn_stable. - intros Y. - apply (H d0). - split; try assumption. -apply (H d). -split. - intros Y. - apply Hd0. - apply (@ball_weak_le X (e + d)%Qpos). - autorewrite with QposElim. - rewrite -> Qle_minus_iff in *. - replace RHS with (d0 + - d) by ring. + intros Z. + destruct (Qlt_le_dec d0 d). + apply Z. + apply (@almostIn_weak_le (e + d0)%Qpos). + autorewrite with QposElim. + apply Qlt_le_weak. + rewrite -> Qlt_minus_iff in *. + replace RHS with (d + - d0) by ring. + assumption. + apply almostIn_stable. + intros Y. + apply (H d0). + split; try assumption. + apply (H d). + split. + intros Y. + apply Hd0. + apply (@ball_weak_le X (e + d)%Qpos). + autorewrite with QposElim. + rewrite -> Qle_minus_iff in *. + replace RHS with (d0 + - d) by ring. + assumption. assumption. assumption. -assumption. Qed. (** Left and right triangle laws for balls and [almostIn]. *) Lemma almostIn_triangle_l : forall e1 e2 x1 x2 l, (ball e1 x1 x2) -> almostIn e2 x2 l -> almostIn (e1 + e2) x1 l. Proof. -induction l; intros H1 H2. - apply H2. -destruct H2 as [G | H2 | H2] using orC_ind. - auto using almostIn_stable. + induction l; intros H1 H2. + apply H2. + destruct H2 as [G | H2 | H2] using orC_ind. + auto using almostIn_stable. + apply orWeaken. + left. + eapply ball_triangle. + apply H1. + apply H2. apply orWeaken. - left. - eapply ball_triangle. - apply H1. - apply H2. -apply orWeaken. -right. -apply IHl; assumption. + right. + apply IHl; assumption. Qed. Lemma almostIn_triangle_r : forall e1 e2 x l1 l2, almostIn e1 x l1 -> (ball e2 l1 l2) -> almostIn (e1 + e2) x l2. Proof. -intros e1 e2 x l1 l2 H1 [H2 _]. -revert l2 H1 H2. -induction l1; intros l2 H1 H2. - contradiction. -unfold hemiMetric in *. -destruct H1 as [G | H1 | H1] using orC_ind. - auto using almostIn_stable. - assert (Z:InFinEnumC a (a :: l1)). - apply orWeaken. - left; reflexivity. - destruct (H2 a Z) as [ G | z [Hz0 Hz1]] using existsC_ind. - auto using almostIn_stable. - clear - H1 Hz0 Hz1. - apply almostIn_closed. - intros d. - rewrite <- InAlmostIn in Hz0. - apply almostIn_triangle_l with z. - apply ball_triangle with a; assumption. - apply Hz0. -apply IHl1. - assumption. -intros y Hy. -apply H2. -apply orWeaken. -right; assumption. + intros e1 e2 x l1 l2 H1 [H2 _]. + revert l2 H1 H2. + induction l1; intros l2 H1 H2. + contradiction. + unfold hemiMetric in *. + destruct H1 as [G | H1 | H1] using orC_ind. + auto using almostIn_stable. + assert (Z:InFinEnumC a (a :: l1)). + apply orWeaken. + left; reflexivity. + destruct (H2 a Z) as [ G | z [Hz0 Hz1]] using existsC_ind. + auto using almostIn_stable. + clear - H1 Hz0 Hz1. + apply almostIn_closed. + intros d. + rewrite <- InAlmostIn in Hz0. + apply almostIn_triangle_l with z. + apply ball_triangle with a; assumption. + apply Hz0. + apply IHl1. + assumption. + intros y Hy. + apply H2. + apply orWeaken. + right; assumption. Qed. -(** If you are almost in a finite enumeration then you are close to +(** If you are almost in a finite enumeration then you are close to (classically) some point that is in the enumeration. *) Lemma almostInExistsC : forall e x s, almostIn e x s <-> existsC X (fun y => ball e x y /\ InFinEnumC y s). Proof. -intros e x s. -induction s. - split; try contradiction. - intros H. - apply H. - intros y [_ Hy]. - apply Hy. -split. - intros H. - destruct H as [G | H | H] using orC_ind. + intros e x s. + induction s. + split; try contradiction. + intros H. + apply H. + intros y [_ Hy]. + apply Hy. + split. + intros H. + destruct H as [G | H | H] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists a. + split; auto. + apply orWeaken. + left; reflexivity. + rewrite -> IHs in H. + destruct H as [G | y [Hy0 Hy1]] using existsC_ind. auto using existsC_stable. apply existsWeaken. - exists a. + exists y. split; auto. apply orWeaken. - left; reflexivity. - rewrite -> IHs in H. + right; auto. + intros H. destruct H as [G | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. - apply existsWeaken. - exists y. - split; auto. - apply orWeaken. - right; auto. -intros H. -destruct H as [G | y [Hy0 Hy1]] using existsC_ind. - auto using almostIn_stable. -destruct Hy1 as [G | Hy1 | Hy1] using orC_ind. auto using almostIn_stable. + destruct Hy1 as [G | Hy1 | Hy1] using orC_ind. + auto using almostIn_stable. + apply orWeaken. + left. + rewrite <- Hy1. + auto. apply orWeaken. - left. - rewrite <- Hy1. + right. + change (almostIn e x s). + rewrite IHs. + apply existsWeaken. + exists y. auto. -apply orWeaken. -right. -change (almostIn e x s). -rewrite IHs. -apply existsWeaken. -exists y. -auto. -Qed. +Qed. End AlmostIn. (* begin hide *) Add Parametric Morphism X stableX : (@almostIn X stableX) with signature QposEq ==> (@st_eq _) ==> (@st_eq _) ==> iff as almostIn_wd. Proof. -unfold FinEnum_eq. -assert (Y:forall x1 x2 : Qpos, - QposEq x1 x2 -> - forall y1 y2 : X, - st_eq y1 y2 ->forall z : FinEnum stableX, - (almostIn x1 y1 z -> almostIn x2 y2 z)). + unfold FinEnum_eq. + assert (Y:forall x1 x2 : Qpos, QposEq x1 x2 -> forall y1 y2 : X, + st_eq y1 y2 ->forall z : FinEnum stableX, (almostIn x1 y1 z -> almostIn x2 y2 z)). + intros x1 x2 Hx y1 y2 Hy. + induction z. + auto. + intros H. + destruct H as [G | H | H] using orC_ind. + auto using almostIn_stable. + apply orWeaken. + left. + rewrite <- Hx, <- Hy. + assumption. + apply orWeaken. + right. + apply IHz; assumption. intros x1 x2 Hx y1 y2 Hy. - induction z. - auto. + cut (forall z1 x3 : FinEnum stableX, (forall x : X, InFinEnumC x z1 -> InFinEnumC x x3) -> + (almostIn x1 y1 z1 -> almostIn x2 y2 x3)). + intros Z z1 z2 Hz. + split. + apply Z. + intros x H. + simpl in Hz. + unfold FinEnum_eq in Hz. + apply -> Hz. + assumption. + intros H. + eapply Y. + unfold QposEq. + simpl; symmetry. + apply Hx. + symmetry. + apply Hy. + eapply Z. + intros a Ha. + simpl in Hz; unfold FinEnum_eq in Hz. + apply <- Hz. + apply Ha. + eapply Y. + unfold QposEq. + simpl; symmetry. + apply Hx. + symmetry. + apply Hy. + assumption. + induction z1; intros z2 Hz. + contradiction. intros H. destruct H as [G | H | H] using orC_ind. auto using almostIn_stable. + assert (Z:InFinEnumC a z2). + apply Hz. + apply orWeaken. + left; reflexivity. + rewrite -> Hx, Hy in H. + clear - H Z. + induction z2. + apply Z. + destruct Z as [G | Z | Z] using orC_ind. + auto using almostIn_stable. + rewrite -> Z in H. + apply orWeaken. + left; assumption. apply orWeaken. - left. - rewrite <- Hx, <- Hy. - assumption. - apply orWeaken. - right. - apply IHz; assumption. -intros x1 x2 Hx y1 y2 Hy. -cut (forall z1 x3 : FinEnum stableX, -(forall x : X, InFinEnumC x z1 -> InFinEnumC x x3) -> -(almostIn x1 y1 z1 -> almostIn x2 y2 x3)). - intros Z z1 z2 Hz. - split. - apply Z. - intros x H. - simpl in Hz. - unfold FinEnum_eq in Hz. - apply -> Hz. - assumption. - intros H. - eapply Y. - unfold QposEq. - simpl; symmetry. - apply Hx. - symmetry. - apply Hy. - eapply Z. - intros a Ha. - simpl in Hz; unfold FinEnum_eq in Hz. - apply <- Hz. - apply Ha. - eapply Y. - unfold QposEq. - simpl; symmetry. - apply Hx. - symmetry. - apply Hy. - assumption. -induction z1; intros z2 Hz. - contradiction. -intros H. -destruct H as [G | H | H] using orC_ind. - auto using almostIn_stable. - assert (Z:InFinEnumC a z2). + right; apply IHz2; auto. + apply IHz1. + intros b Hb. apply Hz. apply orWeaken. - left; reflexivity. - rewrite -> Hx, Hy in H. - clear - H Z. - induction z2. - apply Z. - destruct Z as [G | Z | Z] using orC_ind. - auto using almostIn_stable. - rewrite -> Z in H. - apply orWeaken. - left; assumption. - apply orWeaken. - right; apply IHz2; auto. -apply IHz1. - intros b Hb. - apply Hz. - apply orWeaken. - right; assumption. -assumption. + right; assumption. + assumption. Qed. (* end hide *) (** @@ -400,24 +396,22 @@ Definition inCompact X stableX (x:Complete X) (s:Compact stableX) := (* begin hide *) Add Parametric Morphism X stableX : (@inCompact X stableX) with signature (@st_eq _) ==> (@st_eq _) ==> iff as inCompact_wd. Proof. -cut (forall x1 x2 : Complete X, - st_eq x1 x2 -> - forall x3 x4 : Complete (FinEnum stableX), - st_eq x3 x4 -> (inCompact x1 x3 -> inCompact x2 x4)). - intros Z x1 x2 Hx y1 y2 Hy. - split. - apply Z; assumption. - apply Z; symmetry; assumption. -intros x1 x2 Hx y1 y2 Hy H e1 e2. -apply almostIn_closed. -intros d. -set (d':=((1 # 4) * d)%Qpos). -setoid_replace (e1 + e2 + d)%Qpos - with ((e1 + d') + (d' + d') + (d' + e2))%Qpos by (unfold d';QposRing). -apply almostIn_triangle_r with (approximate y1 d');[|apply Hy]. -symmetry in Hx. -apply almostIn_triangle_l with (approximate x1 d');[apply Hx|]. -apply H. + cut (forall x1 x2 : Complete X, st_eq x1 x2 -> forall x3 x4 : Complete (FinEnum stableX), + st_eq x3 x4 -> (inCompact x1 x3 -> inCompact x2 x4)). + intros Z x1 x2 Hx y1 y2 Hy. + split. + apply Z; assumption. + apply Z; symmetry; assumption. + intros x1 x2 Hx y1 y2 Hy H e1 e2. + apply almostIn_closed. + intros d. + set (d':=((1 # 4) * d)%Qpos). + setoid_replace (e1 + e2 + d)%Qpos + with ((e1 + d') + (d' + d') + (d' + e2))%Qpos by (unfold d';QposRing). + apply almostIn_triangle_r with (approximate y1 d');[|apply Hy]. + symmetry in Hx. + apply almostIn_triangle_l with (approximate x1 d');[apply Hx|]. + apply H. Qed. (* end hide *) Section Compact. @@ -430,13 +424,13 @@ Let inCompact := @inCompact X stableX. Lemma inCompact_stable : forall x s, ~~inCompact x s -> inCompact x s. Proof. -intros x s H e1 e2. -apply almostIn_stable. -intros H0. -apply H. -intros H1. -apply H0. -apply H1. + intros x s H e1 e2. + apply almostIn_stable. + intros H0. + apply H. + intros H1. + apply H0. + apply H1. Qed. (** @@ -448,18 +442,12 @@ First we show that our compact sets are complete. Lemma CompactCompleteSubset : forall x, CompleteSubset _ (fun z => inCompact z x). Proof. -intros x a H. -exists (Cjoin a). - abstract ( - intros e1 e2; - unfold inCompact in H; - eapply almostIn_weak_le; - [|apply (H ((1#2)*e1) ((1#2)*e1) e2)%Qpos]; - autorewrite with QposElim; - rewrite Qle_minus_iff; - ring_simplify; - auto with *). -apply CunitCjoin. + intros x a H. + exists (Cjoin a). + abstract ( intros e1 e2; unfold inCompact in H; eapply almostIn_weak_le; + [|apply (H ((1#2)*e1) ((1#2)*e1) e2)%Qpos]; autorewrite with QposElim; rewrite Qle_minus_iff; + ring_simplify; auto with *). + apply CunitCjoin. Defined. Section CompactTotallyBounded. @@ -474,26 +462,23 @@ Hypothesis locatedX : locatedMetric X. a point in the enumeration in a constructive sense. *) Lemma AlmostInExists: forall (e d:Qpos) x (s:FinEnum stableX), e < d -> almostIn e x s -> {y | In y s /\ ball d x y}. Proof. -intros e d x s Hed. -induction s. - contradiction. -intros H. -destruct (locatedX x a Hed). - exists a. - abstract (auto with *). -destruct IHs as [y Hy]. - abstract ( - apply almostIn_stable; - intros H0; - apply H; split; auto). -exists y. -abstract (destruct Hy; auto with *). + intros e d x s Hed. + induction s. + contradiction. + intros H. + destruct (locatedX x a Hed). + exists a. + abstract (auto with *). + destruct IHs as [y Hy]. + abstract ( apply almostIn_stable; intros H0; apply H; split; auto). + exists y. + abstract (destruct Hy; auto with *). Defined. (** The limit of this stream is going to be used to construct a point inside the compact set close to a suitable starting point. *) CoFixpoint CompactTotallyBoundedStream (s:Compact) (k d1 d2:Qpos) (pt:X) Hpt : Stream X := -Cons pt +Cons pt (let (f,_) := HausdorffBallHausdorffBallStrong locatedX (regFun_prf s d1 (k*d1)%Qpos) in let (pt',HptX) := f pt Hpt d2 in @@ -553,64 +538,62 @@ Lemma CompactTotallyBoundedStreamCauchyLemma : forall n (k d:Qpos), k < 1 -> 0 < (d*(1-k^(S n))/(1-k)). Proof. -intros n k d Hk. -repeat (apply: mult_resp_pos; simpl); auto with *. - unfold Qminus. - rewrite <- Qlt_minus_iff. - induction n. + intros n k d Hk. + repeat (apply: mult_resp_pos; simpl); auto with *. + unfold Qminus. + rewrite <- Qlt_minus_iff. + induction n. + assumption. + simpl. + rewrite Pplus_one_succ_l. + rewrite Qpower_plus_positive. + apply Qlt_trans with (k*1). + apply: mult_resp_less_lft;simpl; auto with *. + ring_simplify. + assumption. + apply Qlt_shift_inv_l. + unfold Qminus. + rewrite <- Qlt_minus_iff. assumption. - simpl. - rewrite Pplus_one_succ_l. - rewrite Qpower_plus_positive. - apply Qlt_trans with (k*1). - apply: mult_resp_less_lft;simpl; auto with *. ring_simplify. - assumption. -apply Qlt_shift_inv_l. - unfold Qminus. - rewrite <- Qlt_minus_iff. - assumption. -ring_simplify. -constructor. + constructor. Qed. Lemma CompactTotallyBoundedStreamCauchy1 : forall n s (k d1 d2:Qpos) pt Hpt (Hd:0 < ((((1#1)+k)*d1+d2)%Qpos*(1-k^(S n))/(1-k))), k < 1 -> ball (mkQpos Hd) pt (Str_nth n (CompactTotallyBoundedStream s k d1 d2 pt Hpt)). Proof. -induction n; - intros s k d1 d2 pt Hpt Hd Hk. - apply ball_refl. -unfold Str_nth. -set (e:=(((1#1) + k) * d1 + d2)%Qpos * (1 - k ^ S (S n)) / (1 - k)) in *. -set (e':=(mkQpos Hd)). -set (e0:=((d1 + k * d1 + d2) + mkQpos - (CompactTotallyBoundedStreamCauchyLemma n (((1#1)+k)*(k*d1) + (k*d2)) Hk))%Qpos). -setoid_replace e' with e0. - simpl. - destruct (HausdorffBallHausdorffBallStrong locatedX - (regFun_prf s d1 (k * d1)%Qpos)) as [f _]. - destruct (f pt Hpt d2) as [pt' [Hpt' Hpt'']]. - unfold e0. - apply ball_triangle with pt'. - assumption. - apply IHn; assumption. -unfold e', e0, e. -unfold QposEq. -autorewrite with QposElim. -change (S (S n)) with (1+(S n))%nat. -change (S n) with (1 + n)%nat. -repeat rewrite inj_plus. -assert (~k==0). - apply Qpos_nonzero. -repeat rewrite Qpower_plus; auto. -simpl; field. -intros H0. -apply (Qlt_not_le _ _ Hk). -rewrite Qle_minus_iff. -replace RHS with (-(1-k)) by ring. -rewrite H0. -discriminate. + induction n; intros s k d1 d2 pt Hpt Hd Hk. + apply ball_refl. + unfold Str_nth. + set (e:=(((1#1) + k) * d1 + d2)%Qpos * (1 - k ^ S (S n)) / (1 - k)) in *. + set (e':=(mkQpos Hd)). + set (e0:=((d1 + k * d1 + d2) + mkQpos + (CompactTotallyBoundedStreamCauchyLemma n (((1#1)+k)*(k*d1) + (k*d2)) Hk))%Qpos). + setoid_replace e' with e0. + simpl. + destruct (HausdorffBallHausdorffBallStrong locatedX (regFun_prf s d1 (k * d1)%Qpos)) as [f _]. + destruct (f pt Hpt d2) as [pt' [Hpt' Hpt'']]. + unfold e0. + apply ball_triangle with pt'. + assumption. + apply IHn; assumption. + unfold e', e0, e. + unfold QposEq. + autorewrite with QposElim. + change (S (S n)) with (1+(S n))%nat. + change (S n) with (1 + n)%nat. + repeat rewrite inj_plus. + assert (~k==0). + apply Qpos_nonzero. + repeat rewrite Qpower_plus; auto. + simpl; field. + intros H0. + apply (Qlt_not_le _ _ Hk). + rewrite Qle_minus_iff. + replace RHS with (-(1-k)) by ring. + rewrite H0. + discriminate. Qed. Lemma CompactTotallyBoundedStreamCauchy2 : forall (m n:nat) s (k d1 d2:Qpos) pt Hpt @@ -619,61 +602,57 @@ Lemma CompactTotallyBoundedStreamCauchy2 : forall (m n:nat) s (k d1 d2:Qpos) pt (Str_nth m (CompactTotallyBoundedStream s k d1 d2 pt Hpt)) (Str_nth (m + n) (CompactTotallyBoundedStream s k d1 d2 pt Hpt)). Proof. -induction m; - intros n s k d1 d2 pt Hpt Hd Hk. - setoid_replace (k^0 * (mkQpos Hd))%Qpos with (mkQpos Hd) by QposRing. - apply CompactTotallyBoundedStreamCauchy1; assumption. -pose (e':=(CompactTotallyBoundedStreamCauchyLemma n (((1#1)+k)*(k*d1) + (k*d2)) Hk)%Qpos). -setoid_replace (k^S m*mkQpos Hd)%Qpos with (k^m*mkQpos e')%Qpos. - replace (S m + n)%nat with (S (m + n))%nat by omega. - unfold Str_nth. - simpl. - destruct (HausdorffBallHausdorffBallStrong locatedX - (regFun_prf s d1 (k * d1)%Qpos)) as [f _]. - destruct (f pt Hpt d2) as [pt' [Hpt' _]]. - simpl. - apply (IHm n s k (k*d1)%Qpos (k*d2)%Qpos pt' Hpt' e'); - assumption. -unfold QposEq. -autorewrite with QposElim. -change (S n) with (1 + n)%nat. -change (S m) with (1 + m)%nat. -repeat rewrite inj_plus. -assert (~k==0). - apply Qpos_nonzero. -repeat rewrite Qpower_plus; auto. -simpl; field. -intros H0. -apply (Qlt_not_le _ _ Hk). -rewrite Qle_minus_iff. -replace RHS with (-(1-k)) by ring. -rewrite H0. -discriminate. + induction m; intros n s k d1 d2 pt Hpt Hd Hk. + setoid_replace (k^0 * (mkQpos Hd))%Qpos with (mkQpos Hd) by QposRing. + apply CompactTotallyBoundedStreamCauchy1; assumption. + pose (e':=(CompactTotallyBoundedStreamCauchyLemma n (((1#1)+k)*(k*d1) + (k*d2)) Hk)%Qpos). + setoid_replace (k^S m*mkQpos Hd)%Qpos with (k^m*mkQpos e')%Qpos. + replace (S m + n)%nat with (S (m + n))%nat by omega. + unfold Str_nth. + simpl. + destruct (HausdorffBallHausdorffBallStrong locatedX (regFun_prf s d1 (k * d1)%Qpos)) as [f _]. + destruct (f pt Hpt d2) as [pt' [Hpt' _]]. + simpl. + apply (IHm n s k (k*d1)%Qpos (k*d2)%Qpos pt' Hpt' e'); assumption. + unfold QposEq. + autorewrite with QposElim. + change (S n) with (1 + n)%nat. + change (S m) with (1 + m)%nat. + repeat rewrite inj_plus. + assert (~k==0). + apply Qpos_nonzero. + repeat rewrite Qpower_plus; auto. + simpl; field. + intros H0. + apply (Qlt_not_le _ _ Hk). + rewrite Qle_minus_iff. + replace RHS with (-(1-k)) by ring. + rewrite H0. + discriminate. Qed. Lemma StreamInCompactApprox : forall n s k d1 d2 pt Hpt, {q:Qpos | InFinEnumC (Str_nth n (CompactTotallyBoundedStream s k d1 d2 pt Hpt)) (approximate s q) & q==k^n*d1}. Proof. -induction n. + induction n. + intros. + exists d1. + assumption. + simpl; ring. intros. - exists d1. - assumption. - simpl; ring. -intros. -unfold Str_nth. -simpl. -destruct (HausdorffBallHausdorffBallStrong locatedX - (regFun_prf s d1 (k * d1)%Qpos)) as [f _]. -destruct (f pt Hpt d2) as [pt' [Hpt' _]]. -destruct (IHn s k (k*d1) (k*d2) pt' Hpt')%Qpos as [q Hq Hq0]. -exists q. - apply Hq. -change (q==k^(P_of_succ_nat n)*d1). -rewrite Zpos_P_of_succ_nat. -unfold Zsucc. -rewrite Qpower_plus;[|apply Qpos_nonzero]. -autorewrite with QposElim in Hq0. -ring [Hq0]. + unfold Str_nth. + simpl. + destruct (HausdorffBallHausdorffBallStrong locatedX (regFun_prf s d1 (k * d1)%Qpos)) as [f _]. + destruct (f pt Hpt d2) as [pt' [Hpt' _]]. + destruct (IHn s k (k*d1) (k*d2) pt' Hpt')%Qpos as [q Hq Hq0]. + exists q. + apply Hq. + change (q==k^(P_of_succ_nat n)*d1). + rewrite Zpos_P_of_succ_nat. + unfold Zsucc. + rewrite Qpower_plus;[|apply Qpos_nonzero]. + autorewrite with QposElim in Hq0. + ring [Hq0]. Qed. Definition CompactTotallyBoundedIndex (e d1 d2:Qpos) : nat := @@ -686,133 +665,126 @@ end. Lemma CompactTotallyBoundedIndexLemma : forall (e d1 d2:Qpos), ((1+(1#4))*d1 + d2)*(1#4)^(CompactTotallyBoundedIndex e d1 d2)/(1-(1#4)) <= e. Proof. -intros e d1 d2. -unfold CompactTotallyBoundedIndex. -set (a:=((1 + (1 # 4)) * d1 + d2)). -set (b:=(1 - (1 # 4))). -rewrite Qmake_Qdiv. -rewrite Qdiv_power. -rewrite Qpower_1. -unfold Qdiv. -ring_simplify. -rewrite <- Qmult_assoc. -rewrite Qmult_comm. -rewrite <- Qmult_assoc. -rewrite Qmult_comm. -apply Qle_shift_div_r. - induction (let (n, d) := a * / e * / b in - match Zsucc (n / d) with - | Z0 => 0%nat - | Zpos p => div2 (S (Z_to_nat (z:=log_sup p) (log_sup_correct1 p))) - | Zneg _ => 0%nat - end). + intros e d1 d2. + unfold CompactTotallyBoundedIndex. + set (a:=((1 + (1 # 4)) * d1 + d2)). + set (b:=(1 - (1 # 4))). + rewrite Qmake_Qdiv. + rewrite Qdiv_power. + rewrite Qpower_1. + unfold Qdiv. + ring_simplify. + rewrite <- Qmult_assoc. + rewrite Qmult_comm. + rewrite <- Qmult_assoc. + rewrite Qmult_comm. + apply Qle_shift_div_r. + induction (let (n, d) := a * / e * / b in match Zsucc (n / d) with | Z0 => 0%nat + | Zpos p => div2 (S (Z_to_nat (z:=log_sup p) (log_sup_correct1 p))) | Zneg _ => 0%nat end). + constructor. + change (S n) with (1+n)%nat. + rewrite inj_plus. + rewrite Qpower_plus;[|discriminate]. + change 0 with (4*0). + apply: mult_resp_less_lft; auto. constructor. - change (S n) with (1+n)%nat. - rewrite inj_plus. - rewrite Qpower_plus;[|discriminate]. - change 0 with (4*0). - apply: mult_resp_less_lft; auto. - constructor. -assert (He:~e==0). - apply Qpos_nonzero. -set (z:=a * / e * / b). -rewrite <- (Qinv_involutive e). -rewrite (Qmult_comm (/ /e)). -apply Qle_shift_div_l. - auto with *. -replace LHS with z by (unfold z;ring). -assert (Hz:0 < z). - unfold z. - auto with *. -destruct z as [[|n|n] d]. - elim (Qlt_not_le _ _ Hz). - discriminate. - apply Qle_trans with (Zsucc (n/d)). - rewrite Qmake_Qdiv. - apply Qle_shift_div_r; auto with *. - unfold Zsucc, Qle. - simpl. - rewrite Zpos_mult_morphism. - ring_simplify. - rewrite Zmult_comm. - replace LHS with (d * (n / d) + n mod d)%Z - by (apply Z_div_mod_eq; auto with *). - apply Zplus_le_compat_l. - destruct (Z_mod_lt n d); auto with *. - generalize (Zsucc (n/d)). - intros z. - clear -z. - destruct z. + assert (He:~e==0). + apply Qpos_nonzero. + set (z:=a * / e * / b). + rewrite <- (Qinv_involutive e). + rewrite (Qmult_comm (/ /e)). + apply Qle_shift_div_l. + auto with *. + replace LHS with z by (unfold z;ring). + assert (Hz:0 < z). + unfold z. + auto with *. + destruct z as [[|n|n] d]. + elim (Qlt_not_le _ _ Hz). discriminate. - change (4%positive:Z) with (2^2)%Z. - rewrite Zpower_Qpower;[|discriminate]. - rewrite <- Qpower_mult. - apply Qle_trans with (two_p (log_sup p)). - unfold Qle; simpl. - rewrite Pmult_comm;simpl. - ring_simplify. - destruct (log_sup_correct2 p). - auto. - generalize (log_sup p) (log_sup_correct1 p). - intros z Hz. - clear p. - cut (z <= (2 * div2 (S (Z_to_nat (z:=z) Hz))))%Z. - generalize ((2 * div2 (S (Z_to_nat (z:=z) Hz))))%Z. - intros y Hy. - rewrite <- Zpower_Qpower; - auto with *. - unfold Qle. + apply Qle_trans with (Zsucc (n/d)). + rewrite Qmake_Qdiv. + apply Qle_shift_div_r; auto with *. + unfold Zsucc, Qle. simpl. + rewrite Zpos_mult_morphism. ring_simplify. - replace y with (z + (y-z))%Z by ring. - rewrite Zpower_exp; auto with *. - replace (two_p z) with (2^z)%Z. - replace LHS with ((2^z)*1)%Z by ring. - apply Zmult_le_compat_l. - assert (H:(0 <= y - z)%Z) by auto with *. - destruct (y -z)%Z; try discriminate. + rewrite Zmult_comm. + replace LHS with (d * (n / d) + n mod d)%Z by (apply Z_div_mod_eq; auto with *). + apply Zplus_le_compat_l. + destruct (Z_mod_lt n d); auto with *. + generalize (Zsucc (n/d)). + intros z. + clear -z. + destruct z. + discriminate. + change (4%positive:Z) with (2^2)%Z. + rewrite Zpower_Qpower;[|discriminate]. + rewrite <- Qpower_mult. + apply Qle_trans with (two_p (log_sup p)). + unfold Qle; simpl. + rewrite Pmult_comm;simpl. + ring_simplify. + destruct (log_sup_correct2 p). + auto. + generalize (log_sup p) (log_sup_correct1 p). + intros z Hz. + clear p. + cut (z <= (2 * div2 (S (Z_to_nat (z:=z) Hz))))%Z. + generalize ((2 * div2 (S (Z_to_nat (z:=z) Hz))))%Z. + intros y Hy. + rewrite <- Zpower_Qpower; auto with *. + unfold Qle. + simpl. + ring_simplify. + replace y with (z + (y-z))%Z by ring. + rewrite Zpower_exp; auto with *. + replace (two_p z) with (2^z)%Z. + replace LHS with ((2^z)*1)%Z by ring. + apply Zmult_le_compat_l. + assert (H:(0 <= y - z)%Z) by auto with *. + destruct (y -z)%Z; try discriminate. + simpl. + change 1%Z with (Zsucc 0)%Z. + apply Zlt_le_succ. + apply Zpower_pos_pos; constructor. + elim H; reflexivity. + destruct z as [|z|z]. + discriminate. simpl. - change 1%Z with (Zsucc 0)%Z. - apply Zlt_le_succ. + apply Zlt_le_weak. apply Zpower_pos_pos; constructor. - elim H; reflexivity. + elim Hz; constructor. destruct z as [|z|z]. - discriminate. - simpl. - apply Zlt_le_weak. - apply Zpower_pos_pos; constructor. - elim Hz; constructor. - destruct z as [|z|z]. - reflexivity. - simpl. - clear - z. - induction z using Pind; simpl. + reflexivity. + simpl. + clear - z. + induction z using Pind; simpl. + reflexivity. + rewrite Pplus_one_succ_l. + rewrite Zpower_pos_is_exp. + rewrite two_power_pos_is_exp. + rewrite IHz. reflexivity. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite two_power_pos_is_exp. - rewrite IHz. - reflexivity. - elim Hz; constructor. - replace LHS with (Z_to_nat Hz:Z) - by (apply Z_to_nat_correct). - generalize (Z_to_nat (z:=z) Hz). - intros n. - clear - n. - change 2%Z with (2%nat:Z). - rewrite <- inj_mult. - apply inj_le. - replace RHS with (double (div2 (S n))) by (unfold double; omega). - destruct (even_or_odd n). - apply le_S_n. - rewrite <- odd_double; auto with *. - rewrite <- even_double; auto with *. - discriminate. -discriminate Hz. + elim Hz; constructor. + replace LHS with (Z_to_nat Hz:Z) by (apply Z_to_nat_correct). + generalize (Z_to_nat (z:=z) Hz). + intros n. + clear - n. + change 2%Z with (2%nat:Z). + rewrite <- inj_mult. + apply inj_le. + replace RHS with (double (div2 (S n))) by (unfold double; omega). + destruct (even_or_odd n). + apply le_S_n. + rewrite <- odd_double; auto with *. + rewrite <- even_double; auto with *. + discriminate. + discriminate Hz. Qed. Definition CompactTotallyBounded_raw (s:Compact) (d1 d2:Qpos) (pt:X) Hpt (e:QposInf) : X := -match e with +match e with |QposInfinity => pt |Qpos2QposInf e' => (Str_nth (CompactTotallyBoundedIndex e' d1 d2) (CompactTotallyBoundedStream s (1#4) d1 d2 pt Hpt)) @@ -833,51 +805,48 @@ Qed. Lemma CompactTotallyBounded_prf : forall (s:Compact) (d1 d2:Qpos) (pt:X) Hpt, is_RegularFunction (CompactTotallyBounded_raw s d1 d2 pt Hpt). Proof. -unfold CompactTotallyBounded_raw, is_RegularFunction. -cut (forall (s : Compact) (d1 d2 : Qpos) (pt : X) - (Hpt : InFinEnumC pt (approximate s d1)) (e1 e2 : Qpos), - ((CompactTotallyBoundedIndex e1 d1 d2) <= (CompactTotallyBoundedIndex e2 d1 d2))%nat -> - ball (m:=X) (e1 + e2) - (Str_nth (CompactTotallyBoundedIndex e1 d1 d2) - (CompactTotallyBoundedStream s (1 # 4) d1 d2 pt Hpt)) - (Str_nth (CompactTotallyBoundedIndex e2 d1 d2) - (CompactTotallyBoundedStream s (1 # 4) d1 d2 pt Hpt))). - intros Z s d1 d2 pt Hpt e1 e2. - destruct (le_lt_dec (CompactTotallyBoundedIndex e1 d1 d2) (CompactTotallyBoundedIndex e2 d1 d2)). - apply Z; auto. - setoid_replace (e1 + e2)%Qpos with (e2 + e1)%Qpos by QposRing. - apply ball_sym. - apply Z; auto with *. -intros s d1 d2 pt Hpt e1 e2 H. -set (A:=CompactTotallyBoundedIndex e1 d1 d2) in *. -set (B:=CompactTotallyBoundedIndex e2 d1 d2) in *. -rewrite (le_plus_minus _ _ H). -assert (Y:(1#4)%Qpos < 1). - constructor. -assert (Y0:= - (CompactTotallyBoundedStreamCauchyLemma (B-A) (((1#1)+(1#4))*d1 + d2) Y)%Qpos). -eapply ball_weak_le; - [|apply (CompactTotallyBoundedStreamCauchy2 A _ s pt Hpt Y0);constructor]. -autorewrite with QposElim. -unfold Qdiv. -set (C:=(((1 + (1 # 4)) * d1 + d2) * (1 # 4) ^ A * / (1 - (1 # 4)))). -replace LHS with ((1 - (1 # 4) ^ S (B - A)) * C) by (unfold C; ring). -apply Qle_trans with (1*C). - apply: mult_resp_leEq_rht;simpl. - rewrite Qle_minus_iff. - ring_simplify. - apply Qpower_pos_positive. + unfold CompactTotallyBounded_raw, is_RegularFunction. + cut (forall (s : Compact) (d1 d2 : Qpos) (pt : X) + (Hpt : InFinEnumC pt (approximate s d1)) (e1 e2 : Qpos), + ((CompactTotallyBoundedIndex e1 d1 d2) <= (CompactTotallyBoundedIndex e2 d1 d2))%nat -> + ball (m:=X) (e1 + e2) (Str_nth (CompactTotallyBoundedIndex e1 d1 d2) + (CompactTotallyBoundedStream s (1 # 4) d1 d2 pt Hpt)) + (Str_nth (CompactTotallyBoundedIndex e2 d1 d2) + (CompactTotallyBoundedStream s (1 # 4) d1 d2 pt Hpt))). + intros Z s d1 d2 pt Hpt e1 e2. + destruct (le_lt_dec (CompactTotallyBoundedIndex e1 d1 d2) (CompactTotallyBoundedIndex e2 d1 d2)). + apply Z; auto. + setoid_replace (e1 + e2)%Qpos with (e2 + e1)%Qpos by QposRing. + apply ball_sym. + apply Z; auto with *. + intros s d1 d2 pt Hpt e1 e2 H. + set (A:=CompactTotallyBoundedIndex e1 d1 d2) in *. + set (B:=CompactTotallyBoundedIndex e2 d1 d2) in *. + rewrite (le_plus_minus _ _ H). + assert (Y:(1#4)%Qpos < 1). + constructor. + assert (Y0:= (CompactTotallyBoundedStreamCauchyLemma (B-A) (((1#1)+(1#4))*d1 + d2) Y)%Qpos). + eapply ball_weak_le; [|apply (CompactTotallyBoundedStreamCauchy2 A _ s pt Hpt Y0);constructor]. + autorewrite with QposElim. + unfold Qdiv. + set (C:=(((1 + (1 # 4)) * d1 + d2) * (1 # 4) ^ A * / (1 - (1 # 4)))). + replace LHS with ((1 - (1 # 4) ^ S (B - A)) * C) by (unfold C; ring). + apply Qle_trans with (1*C). + apply: mult_resp_leEq_rht;simpl. + rewrite Qle_minus_iff. + ring_simplify. + apply Qpower_pos_positive. + discriminate. + unfold C. + change (1-(1#4)) with (3#4). + Qauto_nonneg. + apply Qpower_pos. discriminate. - unfold C. - change (1-(1#4)) with (3#4). - Qauto_nonneg. - apply Qpower_pos. - discriminate. -ring_simplify. -apply Qle_trans with e1. - apply CompactTotallyBoundedIndexLemma. -Qauto_le. -Qed. + ring_simplify. + apply Qle_trans with e1. + apply CompactTotallyBoundedIndexLemma. + Qauto_le. +Qed. Definition CompactTotallyBounded_fun (s:Compact) (d1 d2:Qpos) (pt:X) Hpt : Complete X := Build_RegularFunction (CompactTotallyBounded_prf s d1 d2 pt Hpt). @@ -886,109 +855,132 @@ Definition CompactTotallyBounded_fun (s:Compact) (d1 d2:Qpos) (pt:X) Hpt : Comp Lemma CompactTotallyBoundedInCompact : forall (s:Compact) (d1 d2:Qpos) (pt:X) Hpt, inCompact (CompactTotallyBounded_fun s d1 d2 pt Hpt) s. Proof. -intros s d1 d2 pt Hpt e1 e2. -simpl. -destruct (StreamInCompactApprox (CompactTotallyBoundedIndex e1 d1 d2) s (1#4) d1 d2 pt Hpt) - as [q Hq Hq0]. -apply almostIn_closed. -intros d. -apply almostIn_weak_le with (d + (q + e2))%Qpos. - autorewrite with QposElim. - rewrite Qle_minus_iff. - replace RHS with (e1 + - q) by ring. - rewrite <- Qle_minus_iff. - rewrite Hq0. - eapply Qle_trans;[|apply (CompactTotallyBoundedIndexLemma e1 d1 d2)]. - autorewrite with QposElim. - cut (0 <= (1 # 4) ^ CompactTotallyBoundedIndex e1 d1 d2). - generalize ( (1 # 4) ^ CompactTotallyBoundedIndex e1 d1 d2). - intros z Hz. - clear - Hz. + intros s d1 d2 pt Hpt e1 e2. + simpl. + destruct (StreamInCompactApprox (CompactTotallyBoundedIndex e1 d1 d2) s (1#4) d1 d2 pt Hpt) + as [q Hq Hq0]. + apply almostIn_closed. + intros d. + apply almostIn_weak_le with (d + (q + e2))%Qpos. + autorewrite with QposElim. rewrite Qle_minus_iff. - replace RHS with (z*((d1 + 2*d2)/(3#2))) by field. - Qauto_nonneg. - apply Qpower_pos. - discriminate. -eapply almostIn_triangle_r;[|apply regFun_prf]. -apply <- InAlmostIn. -assumption. + replace RHS with (e1 + - q) by ring. + rewrite <- Qle_minus_iff. + rewrite Hq0. + eapply Qle_trans;[|apply (CompactTotallyBoundedIndexLemma e1 d1 d2)]. + autorewrite with QposElim. + cut (0 <= (1 # 4) ^ CompactTotallyBoundedIndex e1 d1 d2). + generalize ( (1 # 4) ^ CompactTotallyBoundedIndex e1 d1 d2). + intros z Hz. + clear - Hz. + rewrite Qle_minus_iff. + replace RHS with (z*((d1 + 2*d2)/(3#2))) by field. + Qauto_nonneg. + apply Qpower_pos. + discriminate. + eapply almostIn_triangle_r;[|apply regFun_prf]. + apply <- InAlmostIn. + assumption. Qed. (** The limit is close to the initial starting point *) Lemma CompactTotallyBoundedNotFar : forall (s:Compact) (d1 d2:Qpos) (pt:X) Hpt, ball ((5#3)*d1 + (4#3)*d2) (Cunit pt) (CompactTotallyBounded_fun s d1 d2 pt Hpt). Proof. -intros s d1 d2 pt Hpt e1 e2. -simpl. -assert (Z:(1#4)%Qpos < 1) by constructor. -assert (Z0:=(CompactTotallyBoundedStreamCauchyLemma (CompactTotallyBoundedIndex e2 d1 d2) (((1#1)+(1#4))*(d1) + (d2)) Z)%Qpos). -eapply ball_weak_le; - [|apply (CompactTotallyBoundedStreamCauchy1 (CompactTotallyBoundedIndex e2 d1 d2) s pt Hpt Z0);constructor]. -autorewrite with QposElim. -apply Qle_trans with (((1 + (1 # 4)) * d1 + d2) / (1 - (1 # 4))). - apply: mult_resp_leEq_rht; try discriminate. - replace RHS with (((1 + (1 # 4)) * d1 + d2)*1) by ring. - apply mult_resp_leEq_lft;simpl;[|Qauto_pos]. + intros s d1 d2 pt Hpt e1 e2. + simpl. + assert (Z:(1#4)%Qpos < 1) by constructor. + assert (Z0:=(CompactTotallyBoundedStreamCauchyLemma (CompactTotallyBoundedIndex e2 d1 d2) (((1#1)+(1#4))*(d1) + (d2)) Z)%Qpos). + eapply ball_weak_le; + [|apply (CompactTotallyBoundedStreamCauchy1 (CompactTotallyBoundedIndex e2 d1 d2) s pt Hpt Z0);constructor]. + autorewrite with QposElim. + apply Qle_trans with (((1 + (1 # 4)) * d1 + d2) / (1 - (1 # 4))). + apply: mult_resp_leEq_rht; try discriminate. + replace RHS with (((1 + (1 # 4)) * d1 + d2)*1) by ring. + apply mult_resp_leEq_lft;simpl;[|Qauto_pos]. + rewrite Qle_minus_iff. + ring_simplify. + apply (Qpower_pos (1#4) (P_of_succ_nat (CompactTotallyBoundedIndex e2 d1 d2))). + discriminate. rewrite Qle_minus_iff. + unfold Qdiv. + change (/(1-(1#4))) with (4#3). ring_simplify. - apply (Qpower_pos (1#4) (P_of_succ_nat (CompactTotallyBoundedIndex e2 d1 d2))). - discriminate. -rewrite Qle_minus_iff. -unfold Qdiv. -change (/(1-(1#4))) with (4#3). -ring_simplify. -auto with *. + auto with *. Qed. (** Using CompactTotallyBounded_fun we can map the approximation of a compact set to a new enumeration that contains only points inside the compact sets, without moving the points too much *) Definition CompactTotalBound (s:Compact) (e:Qpos) : list (Complete X). -intros s e. -generalize (CompactTotallyBounded_fun s ((1#5)*e) ((1#5)*e)). -induction (approximate s ((1 # 5) * e)%Qpos). - intros _. - exact nil. -intros H. -apply cons. - apply H with a. - apply InFinEnumC_weaken; auto with *. -apply IHs0. -intros pt Hpt. -apply H with pt. -apply orWeaken;right;assumption. +Proof. + intros s e. + generalize (CompactTotallyBounded_fun s ((1#5)*e) ((1#5)*e)). + induction (approximate s ((1 # 5) * e)%Qpos). + intros _. + exact nil. + intros H. + apply cons. + apply H with a. + apply InFinEnumC_weaken; auto with *. + apply IHs0. + intros pt Hpt. + apply H with pt. + apply orWeaken;right;assumption. Defined. Lemma CompactTotalBoundNotFar : forall SCX (s:Compact) (e:Qpos), ball ((3#5)*e) (map Cunit (approximate s ((1#5)*e)%Qpos):FinEnum SCX) (CompactTotalBound s e). Proof. -intros SCX s e. -unfold CompactTotalBound. -generalize (CompactTotallyBoundedNotFar s ((1#5)*e) ((1#5)*e)). -generalize (CompactTotallyBounded_fun s ((1 # 5) * e) ((1 # 5) * e)). -induction (approximate s ((1 # 5) * e)%Qpos); - intros H L. - apply ball_refl. -split; - intros x Hx. - destruct Hx as [G | Hx | Hx] using orC_ind. - auto using existsC_stable. + intros SCX s e. + unfold CompactTotalBound. + generalize (CompactTotallyBoundedNotFar s ((1#5)*e) ((1#5)*e)). + generalize (CompactTotallyBounded_fun s ((1 # 5) * e) ((1 # 5) * e)). + induction (approximate s ((1 # 5) * e)%Qpos); intros H L. + apply ball_refl. + split; intros x Hx. + destruct Hx as [G | Hx | Hx] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists (H a (InFinEnumC_weaken X a (a :: s0) (in_eq a s0))). + split. + apply: orWeaken. + left. + reflexivity. + rewrite Hx. + setoid_replace ((3 # 5) * e)%Qpos with ((5 # 3) * ((1 # 5) * e) + (4 # 3) * ((1 # 5) * e))%Qpos by QposRing. + apply L. + set (H':=(fun pt (Hpt : InFinEnumC pt s0) => H pt (orWeaken _ _ (right _ Hpt)))). + assert (L':forall (pt : X) (Hpt : InFinEnumC pt s0), + ball (m:=Complete X) ((5 # 3) * ((1 # 5) * e) + (4 # 3) * ((1 # 5) * e)) (Cunit pt) (H' pt Hpt)). + intros pt Hpt. + apply L. + destruct (IHs0 H' L') as [A _]. + destruct (A x Hx) as [G | y [Hy0 Hy1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists y. + split; auto. + apply: orWeaken. + right; assumption. + destruct Hx as [G | Hx | Hx] using orC_ind. + auto using existsC_stable. apply existsWeaken. - exists (H a (InFinEnumC_weaken X a (a :: s0) (in_eq a s0))). + exists (Cunit a). split. apply: orWeaken. left. reflexivity. rewrite Hx. setoid_replace ((3 # 5) * e)%Qpos with ((5 # 3) * ((1 # 5) * e) + (4 # 3) * ((1 # 5) * e))%Qpos by QposRing. + apply ball_sym. apply L. set (H':=(fun pt (Hpt : InFinEnumC pt s0) => H pt (orWeaken _ _ (right _ Hpt)))). assert (L':forall (pt : X) (Hpt : InFinEnumC pt s0), - ball (m:=Complete X) ((5 # 3) * ((1 # 5) * e) + (4 # 3) * ((1 # 5) * e)) - (Cunit pt) (H' pt Hpt)). + ball (m:=Complete X) ((5 # 3) * ((1 # 5) * e) + (4 # 3) * ((1 # 5) * e)) (Cunit pt) (H' pt Hpt)). intros pt Hpt. apply L. - destruct (IHs0 H' L') as [A _]. + destruct (IHs0 H' L') as [_ A]. destruct (A x Hx) as [G | y [Hy0 Hy1]] using existsC_ind. auto using existsC_stable. apply existsWeaken. @@ -996,100 +988,74 @@ split; split; auto. apply: orWeaken. right; assumption. -destruct Hx as [G | Hx | Hx] using orC_ind. - auto using existsC_stable. - apply existsWeaken. - exists (Cunit a). - split. - apply: orWeaken. - left. - reflexivity. - rewrite Hx. - setoid_replace ((3 # 5) * e)%Qpos with ((5 # 3) * ((1 # 5) * e) + (4 # 3) * ((1 # 5) * e))%Qpos by QposRing. - apply ball_sym. - apply L. -set (H':=(fun pt (Hpt : InFinEnumC pt s0) => H pt (orWeaken _ _ (right _ Hpt)))). -assert (L':forall (pt : X) (Hpt : InFinEnumC pt s0), - ball (m:=Complete X) ((5 # 3) * ((1 # 5) * e) + (4 # 3) * ((1 # 5) * e)) - (Cunit pt) (H' pt Hpt)). - intros pt Hpt. - apply L. -destruct (IHs0 H' L') as [_ A]. -destruct (A x Hx) as [G | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. -apply existsWeaken. -exists y. -split; auto. -apply: orWeaken. -right; assumption. Qed. (** This means that our compact sets are totally bounded. *) Lemma CompactTotallyBoundedA : forall s e y, In y (CompactTotalBound s e) -> inCompact y s. Proof. -intros s e y. -unfold CompactTotalBound. -generalize (CompactTotallyBoundedInCompact s ((1#5)*e) ((1#5)*e)). -generalize (CompactTotallyBounded_fun s ((1#5)*e) ((1#5)*e)). -generalize (approximate s ((1 # 5) * e)%Qpos). -intros l. -induction l. - contradiction. -intros F L [H|H]. - rewrite <- H. - apply L. -eapply (IHl);[|apply H]. -intros pt Hpt. -apply L. -Qed. - -Lemma CompactTotallyBoundedB : forall s e x, (inCompact x s) -> exists y, In y (CompactTotalBound s e) /\ ball e x y. -Proof. -intros s e x Hx. -assert (Z:((1 # 20) * e + (1 # 5) * e)%Qpos < ((7 # 20) * e)%Qpos). - rewrite Qlt_minus_iff. - autorewrite with QposElim. - ring_simplify. - Qauto_pos. -destruct (AlmostInExists (approximate x ((1#20)*e)%Qpos) (approximate s ((1#5)*e)%Qpos) Z (Hx _ _)) - as [y [Hy0 Hy1]]. -clear Z. -unfold CompactTotalBound. -revert Hy0. -cut (forall pt Hpt, ball ((3#5)*e) (Cunit pt) (CompactTotallyBounded_fun s ((1#5)*e) ((1#5)*e) pt Hpt)). + intros s e y. + unfold CompactTotalBound. + generalize (CompactTotallyBoundedInCompact s ((1#5)*e) ((1#5)*e)). generalize (CompactTotallyBounded_fun s ((1#5)*e) ((1#5)*e)). generalize (approximate s ((1 # 5) * e)%Qpos). intros l. induction l. contradiction. - intros F HF [H|H]. - econstructor. - split. - left. - reflexivity. - rewrite <- H in Hy1. - clear - Hy1 HF. - setoid_replace e with ((1#20)*e + (7#20)*e + (3#5)*e)%Qpos by QposRing. - apply ball_triangle with (Cunit a);[|apply HF]. - apply ball_triangle with (Cunit (approximate x ((1#20)*e)%Qpos)). - apply ball_approx_r. - rewrite ball_Cunit. - assumption. - edestruct (fun F HF => IHl F HF H) as [y' [Hy'0 Hy'1]]; - [|exists y';split;[right;apply Hy'0|assumption]]. + intros F L [H|H]. + rewrite <- H. + apply L. + eapply (IHl);[|apply H]. + intros pt Hpt. + apply L. +Qed. + +Lemma CompactTotallyBoundedB : forall s e x, (inCompact x s) -> exists y, In y (CompactTotalBound s e) /\ ball e x y. +Proof. + intros s e x Hx. + assert (Z:((1 # 20) * e + (1 # 5) * e)%Qpos < ((7 # 20) * e)%Qpos). + rewrite Qlt_minus_iff. + autorewrite with QposElim. + ring_simplify. + Qauto_pos. + destruct (AlmostInExists (approximate x ((1#20)*e)%Qpos) (approximate s ((1#5)*e)%Qpos) Z (Hx _ _)) + as [y [Hy0 Hy1]]. + clear Z. + unfold CompactTotalBound. + revert Hy0. + cut (forall pt Hpt, ball ((3#5)*e) (Cunit pt) (CompactTotallyBounded_fun s ((1#5)*e) ((1#5)*e) pt Hpt)). + generalize (CompactTotallyBounded_fun s ((1#5)*e) ((1#5)*e)). + generalize (approximate s ((1 # 5) * e)%Qpos). + intros l. + induction l. + contradiction. + intros F HF [H|H]. + econstructor. + split. + left. + reflexivity. + rewrite <- H in Hy1. + clear - Hy1 HF. + setoid_replace e with ((1#20)*e + (7#20)*e + (3#5)*e)%Qpos by QposRing. + apply ball_triangle with (Cunit a);[|apply HF]. + apply ball_triangle with (Cunit (approximate x ((1#20)*e)%Qpos)). + apply ball_approx_r. + rewrite ball_Cunit. + assumption. + edestruct (fun F HF => IHl F HF H) as [y' [Hy'0 Hy'1]]; + [|exists y';split;[right;apply Hy'0|assumption]]. + intros pt Hpt. + apply: HF. intros pt Hpt. - apply: HF. -intros pt Hpt. -setoid_replace ((3#5)*e)%Qpos with ((5#3)*((1#5)*e) + (4#3)*((1#5)*e))%Qpos by QposRing. -apply CompactTotallyBoundedNotFar. + setoid_replace ((3#5)*e)%Qpos with ((5#3)*((1#5)*e) + (4#3)*((1#5)*e))%Qpos by QposRing. + apply CompactTotallyBoundedNotFar. Qed. Lemma CompactTotallyBounded : forall s, TotallyBoundedSubset _ (fun z => inCompact z s). Proof. -intros s e. -exists (CompactTotalBound s e). - apply CompactTotallyBoundedA. -apply CompactTotallyBoundedB. + intros s e. + exists (CompactTotalBound s e). + apply CompactTotallyBoundedA. + apply CompactTotallyBoundedB. Defined. @@ -1097,15 +1063,11 @@ Defined. (** And hence our compact sets are Bishop compact. *) Lemma CompactAsBishopCompact : forall s, CompactSubset _ (fun z => inCompact z s). Proof. -intros s. -split. - apply CompactCompleteSubset. - apply CompactTotallyBounded. -abstract ( -intros a b Hab; -unfold inCompact; -rewrite Hab; -reflexivity). + intros s. + split. + apply CompactCompleteSubset. + apply CompactTotallyBounded. + abstract ( intros a b Hab; unfold inCompact; rewrite Hab; reflexivity). Defined. End CompactTotallyBounded. @@ -1117,7 +1079,7 @@ definition. Given a Bishop compact set we construct finite enumerations that approximate that set. *) -Definition BishopCompactAsCompact_raw +Definition BishopCompactAsCompact_raw (P:Complete X->Prop) (HP:CompactSubset _ P) (e:QposInf) : (FinEnum stableX) := match e with |QposInfinity => nil @@ -1127,77 +1089,71 @@ match e with end. (** These approximations are coherent *) -Lemma BishopCompactAsCompact_prf : +Lemma BishopCompactAsCompact_prf : forall P (HP:CompactSubset _ P), is_RegularFunction (BishopCompactAsCompact_raw HP). Proof. -cut (forall (P : RegularFunction X -> Prop) (HP : CompactSubset (Complete X) P) - (e1 e2 : Qpos), -hemiMetric X (e1 + e2) - (fun a : X => - InFinEnumC a + cut (forall (P : RegularFunction X -> Prop) (HP : CompactSubset (Complete X) P) (e1 e2 : Qpos), + hemiMetric X (e1 + e2) (fun a : X => InFinEnumC a (let (l, _, _) := totallyBoundedSubset HP ((1 # 2) * e1)%Qpos in - map (fun x : RegularFunction X => approximate x ((1 # 2) * e1)%Qpos) l)) - (fun a : X => - InFinEnumC a - (let (l, _, _) := totallyBoundedSubset HP ((1 # 2) * e2)%Qpos in - map (fun x : RegularFunction X => approximate x ((1 # 2) * e2)%Qpos) l))). - intros Z P [HP0 HP HP1] e1 e2. - split. + map (fun x : RegularFunction X => approximate x ((1 # 2) * e1)%Qpos) l)) (fun a : X => + InFinEnumC a (let (l, _, _) := totallyBoundedSubset HP ((1 # 2) * e2)%Qpos in + map (fun x : RegularFunction X => approximate x ((1 # 2) * e2)%Qpos) l))). + intros Z P [HP0 HP HP1] e1 e2. + split. + apply Z. + apply (hemiMetric_wd1 X (e2+e1)%Qpos). + QposRing. apply Z. - apply (hemiMetric_wd1 X (e2+e1)%Qpos). - QposRing. - apply Z. -intros P [HP0 HP HP1] e1 e2 x Hx. -simpl in *. -destruct (HP ((1 # 2) * e1)%Qpos) as [l Hl0 Hl1]. -destruct (HP ((1 # 2) * e2)%Qpos) as [r Hr0 Hr1]. -simpl in *. -assert (Z0:existsC (Complete X) (fun x' => In x' l /\ ball ((1#2)*e1) (Cunit x) x')). - clear - Hx HP1. - induction l. - elim Hx. - destruct Hx as [ G | Hx | Hx] using orC_ind. + intros P [HP0 HP HP1] e1 e2 x Hx. + simpl in *. + destruct (HP ((1 # 2) * e1)%Qpos) as [l Hl0 Hl1]. + destruct (HP ((1 # 2) * e2)%Qpos) as [r Hr0 Hr1]. + simpl in *. + assert (Z0:existsC (Complete X) (fun x' => In x' l /\ ball ((1#2)*e1) (Cunit x) x')). + clear - Hx HP1. + induction l. + elim Hx. + destruct Hx as [ G | Hx | Hx] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists a. + split; auto with *. + rewrite Hx. + apply ball_approx_l. + destruct (IHl Hx) as [G | z [Hz0 Hz1]] using existsC_ind. auto using existsC_stable. apply existsWeaken. - exists a. - split; auto with *. - rewrite Hx. - apply ball_approx_l. - destruct (IHl Hx) as [G | z [Hz0 Hz1]] using existsC_ind. + exists z. + auto with *. + destruct Z0 as [ G | z [Hz0 Hz1] ] using existsC_ind. auto using existsC_stable. + destruct (Hr1 _ (Hl0 _ Hz0)) as [ y [Hy0 Hy1]]. apply existsWeaken. - exists z. - auto with *. -destruct Z0 as [ G | z [Hz0 Hz1] ] using existsC_ind. - auto using existsC_stable. -destruct (Hr1 _ (Hl0 _ Hz0)) as [ y [Hy0 Hy1]]. -apply existsWeaken. -exists (approximate y ((1#2)%Qpos*e2)). -split. - clear - Hy0. - induction r. - elim Hy0. - destruct Hy0 as [Hy0 | Hy0]. - rewrite Hy0. + exists (approximate y ((1#2)%Qpos*e2)). + split. + clear - Hy0. + induction r. + elim Hy0. + destruct Hy0 as [Hy0 | Hy0]. + rewrite Hy0. + apply: orWeaken. + left. + reflexivity. apply: orWeaken. - left. - reflexivity. - apply: orWeaken. - right. - apply IHr; auto. -setoid_replace (e1+e2)%Qpos with ((1#2)*e1 + (1#2)*e2 + (1#2)*e2 + (1#2)*e1)%Qpos - by QposRing. -apply ball_weak. -rewrite <- ball_Cunit. -repeat eapply ball_triangle. - apply Hz1. - change (ball ((1 # 2) * e2) z y) in Hy1. - apply Hy1. -apply ball_approx_r. + right. + apply IHr; auto. + setoid_replace (e1+e2)%Qpos with ((1#2)*e1 + (1#2)*e2 + (1#2)*e2 + (1#2)*e1)%Qpos by QposRing. + apply ball_weak. + rewrite <- ball_Cunit. + repeat eapply ball_triangle. + apply Hz1. + change (ball ((1 # 2) * e2) z y) in Hy1. + apply Hy1. + apply ball_approx_r. Qed. (** Hence Bishop compact sets are compact in our sense. *) -Definition BishopCompactAsCompact +Definition BishopCompactAsCompact (P:Complete X->Prop) (HP:CompactSubset _ P) : Compact := Build_RegularFunction (BishopCompactAsCompact_prf HP). @@ -1215,162 +1171,159 @@ Lemma BishopCompact_Compact_BishopCompact1 : forall (P:Complete X->Prop) (HP:CompactSubset _ P) x, P x -> inCompact x (BishopCompactAsCompact HP). Proof. -intros P [HP1 HP2 HP3] x Hx e1 e2. -simpl. -destruct (HP2 ((1 # 2) * e2)%Qpos) as [l Hl0 Hl1]. -destruct (Hl1 x Hx) as [y [Hy0 Hy1]]. -clear - Hy0 Hy1. -induction l. - contradiction. -destruct Hy0 as [Hy0|Hy0]. - rewrite Hy0. + intros P [HP1 HP2 HP3] x Hx e1 e2. + simpl. + destruct (HP2 ((1 # 2) * e2)%Qpos) as [l Hl0 Hl1]. + destruct (Hl1 x Hx) as [y [Hy0 Hy1]]. + clear - Hy0 Hy1. + induction l. + contradiction. + destruct Hy0 as [Hy0|Hy0]. + rewrite Hy0. + apply: orWeaken. + left. + rewrite <- ball_Cunit. + setoid_replace (e1+e2)%Qpos with (e1 + ((1 # 2) * e2 + (1 # 2) * e2))%Qpos by QposRing. + apply ball_triangle with x. + apply ball_approx_l. + apply ball_triangle with y. + assumption. + apply ball_approx_r. apply: orWeaken. - left. - rewrite <- ball_Cunit. - setoid_replace (e1+e2)%Qpos with (e1 + ((1 # 2) * e2 + (1 # 2) * e2))%Qpos by QposRing. - apply ball_triangle with x. - apply ball_approx_l. - apply ball_triangle with y. - assumption. - apply ball_approx_r. -apply: orWeaken. -right. -apply IHl. -auto with *. + right. + apply IHl. + auto with *. Qed. Lemma BishopCompact_Compact_BishopCompact2 : forall (P:Complete X->Prop) (HP:CompactSubset _ P) x, inCompact x (BishopCompactAsCompact HP) -> P x. Proof. -intros P [HP1 HP2 HP3] x Hx. -assert (Y:forall e:Qpos, ((7#8)*e)%Qpos < e). - intros. - rewrite Qlt_minus_iff. - autorewrite with QposElim. - ring_simplify. - Qauto_pos. -assert (A:forall e, {y | P y /\ ball (m:=Complete X) e x y}). - intros e. - assert (Hx':=Hx ((1#16)*e)%Qpos ((1#2)*e)%Qpos). - simpl in Hx'. - clear - Hx' locatedX Y. - destruct (HP2 ((1 # 2) * ((1 # 2) * e))%Qpos) as [l Hl0 Hl1]. - clear Hl1. - induction l. - contradiction. - destruct (Complete_located locatedX x a (Y e)) as [A|A]. - exists a. - split; auto. - apply Hl0; auto with *. - apply IHl. - intros y Hy. - apply Hl0; auto with *. - destruct Hx' as [G | Hx' | Hx'] using orC_ind. - auto using almostIn_stable. - elim A. - clear - Hx'. - rewrite <- ball_Cunit in Hx'. - setoid_replace ((7 # 8) * e)%Qpos with ((1#16)*e + ((1 # 16) * e + (1 # 2) * e) + (((1 # 2) * ((1 # 2) * e))))%Qpos - by QposRing. - eapply ball_triangle. + intros P [HP1 HP2 HP3] x Hx. + assert (Y:forall e:Qpos, ((7#8)*e)%Qpos < e). + intros. + rewrite Qlt_minus_iff. + autorewrite with QposElim. + ring_simplify. + Qauto_pos. + assert (A:forall e, {y | P y /\ ball (m:=Complete X) e x y}). + intros e. + assert (Hx':=Hx ((1#16)*e)%Qpos ((1#2)*e)%Qpos). + simpl in Hx'. + clear - Hx' locatedX Y. + destruct (HP2 ((1 # 2) * ((1 # 2) * e))%Qpos) as [l Hl0 Hl1]. + clear Hl1. + induction l. + contradiction. + destruct (Complete_located locatedX x a (Y e)) as [A|A]. + exists a. + split; auto. + apply Hl0; auto with *. + apply IHl. + intros y Hy. + apply Hl0; auto with *. + destruct Hx' as [G | Hx' | Hx'] using orC_ind. + auto using almostIn_stable. + elim A. + clear - Hx'. + rewrite <- ball_Cunit in Hx'. + setoid_replace ((7 # 8) * e)%Qpos with ((1#16)*e + ((1 # 16) * e + (1 # 2) * e) + (((1 # 2) * ((1 # 2) * e))))%Qpos + by QposRing. eapply ball_triangle. - apply ball_approx_r. - apply Hx'. - apply ball_approx_l. - assumption. -set (f:=fun e => (let (y,_):= (A e) in y)). -assert (Hf0:forall e, ball (m:=Complete X) (e) (f e) x). - intros e. - unfold f. - destruct (A e) as [y [_ Hy]]. - apply ball_sym. - assumption. -assert (Hf:is_RegularFunction (fun e => match e with QposInfinity => f (1#1)%Qpos | Qpos2QposInf e' => f e' end)). - intros e1 e2. - apply ball_triangle with x. + eapply ball_triangle. + apply ball_approx_r. + apply Hx'. + apply ball_approx_l. + assumption. + set (f:=fun e => (let (y,_):= (A e) in y)). + assert (Hf0:forall e, ball (m:=Complete X) (e) (f e) x). + intros e. + unfold f. + destruct (A e) as [y [_ Hy]]. + apply ball_sym. + assumption. + assert (Hf:is_RegularFunction (fun e => match e with QposInfinity => f (1#1)%Qpos | Qpos2QposInf e' => f e' end)). + intros e1 e2. + apply ball_triangle with x. + apply Hf0. + apply ball_sym. apply Hf0. + set (f':=(Build_RegularFunction Hf)). + assert (Hf1 : forall (e:Qpos), P (approximate f' e)). + intros e. + simpl; unfold f. + destruct (A e). + tauto. + destruct (HP1 f') as [y Hy]. + intros [e|]; apply: Hf1. + unfold ExtSubset in HP3. + rewrite (HP3 x y); auto. + rewrite <- Cunit_eq. + rewrite -> s. + intros e1 e2. apply ball_sym. + setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. + apply ball_weak. apply Hf0. -set (f':=(Build_RegularFunction Hf)). -assert (Hf1 : forall (e:Qpos), P (approximate f' e)). - intros e. - simpl; unfold f. - destruct (A e). - tauto. -destruct (HP1 f') as [y Hy]. - intros [e|]; apply: Hf1. -unfold ExtSubset in HP3. -rewrite (HP3 x y); auto. -rewrite <- Cunit_eq. -rewrite -> s. -intros e1 e2. -apply ball_sym. -setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. -apply ball_weak. -apply Hf0. Qed. Lemma BishopCompact_Compact_BishopCompact : forall (P:Complete X->Prop) (HP:CompactSubset _ P) x, P x <-> inCompact x (BishopCompactAsCompact HP). Proof. -intros P HP x. -split. - apply BishopCompact_Compact_BishopCompact1. -apply BishopCompact_Compact_BishopCompact2. + intros P HP x. + split. + apply BishopCompact_Compact_BishopCompact1. + apply BishopCompact_Compact_BishopCompact2. Qed. Lemma Compact_BishopCompact_Compact : forall s, st_eq s (BishopCompactAsCompact (CompactAsBishopCompact locatedX s)). Proof. -intros s e1 e2. -setoid_replace (e1 + e2)%Qpos with (e1 + (1#5)*((1#2)*e2) + ((3#5)*((1#2)*e2) + (1#2)*e2) + (1#10)*e2)%Qpos by QposRing. -apply ball_weak. -apply ball_triangle with (approximate s ((1#5)*((1#2)*e2))%Qpos). - apply regFun_prf. -clear e1. -rewrite (@FinEnum_map_Cunit _ stableX (Complete_stable stableX)). -apply ball_triangle with (CompactTotalBound locatedX s ((1 # 2) * e2)). - apply CompactTotalBoundNotFar. -simpl. -change (FinEnum_ball (Complete X)) with (@ball (FinEnum (Complete_stable stableX))). -induction (CompactTotalBound locatedX s ((1 # 2) * e2)). - apply ball_refl. -destruct IHl as [IHlA IHlB]. -split; intros x Hx; - (destruct Hx as [G | Hx | Hx] using orC_ind; - [auto using existsC_stable - |apply existsWeaken - |]). - exists (Cunit (approximate a ((1 # 2) * e2)%Qpos)). - split. - apply: orWeaken. - left; reflexivity. - rewrite Hx. - apply ball_approx_r. - destruct (IHlA x Hx) as [ G | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. - apply existsWeaken. - exists y. - split; auto. - apply: orWeaken. - right. - assumption. - exists a. - split. - apply orWeaken. - left; reflexivity. - rewrite Hx. - apply: ball_approx_l. -destruct (IHlB x Hx) as [ G | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. -apply existsWeaken. -exists y. -split; auto. -apply orWeaken. -right. -assumption. + intros s e1 e2. + setoid_replace (e1 + e2)%Qpos with (e1 + (1#5)*((1#2)*e2) + ((3#5)*((1#2)*e2) + (1#2)*e2) + (1#10)*e2)%Qpos by QposRing. + apply ball_weak. + apply ball_triangle with (approximate s ((1#5)*((1#2)*e2))%Qpos). + apply regFun_prf. + clear e1. + rewrite (@FinEnum_map_Cunit _ stableX (Complete_stable stableX)). + apply ball_triangle with (CompactTotalBound locatedX s ((1 # 2) * e2)). + apply CompactTotalBoundNotFar. + simpl. + change (FinEnum_ball (Complete X)) with (@ball (FinEnum (Complete_stable stableX))). + induction (CompactTotalBound locatedX s ((1 # 2) * e2)). + apply ball_refl. + destruct IHl as [IHlA IHlB]. + split; intros x Hx; (destruct Hx as [G | Hx | Hx] using orC_ind; [auto using existsC_stable + |apply existsWeaken |]). + exists (Cunit (approximate a ((1 # 2) * e2)%Qpos)). + split. + apply: orWeaken. + left; reflexivity. + rewrite Hx. + apply ball_approx_r. + destruct (IHlA x Hx) as [ G | y [Hy0 Hy1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists y. + split; auto. + apply: orWeaken. + right. + assumption. + exists a. + split. + apply orWeaken. + left; reflexivity. + rewrite Hx. + apply: ball_approx_l. + destruct (IHlB x Hx) as [ G | y [Hy0 Hy1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists y. + split; auto. + apply orWeaken. + right. + assumption. Qed. End Isomorphism. @@ -1385,10 +1338,10 @@ Variable X : MetricSpace. Hypothesis stableX : stableMetric X. Hypothesis stableCX : stableMetric (Complete X). -(** +(** ** FinEnum distributes over Complete The FiniteEnumeration monad distributes over the Completion monad. -This corresponds to a function from FinEnum (Complete X) to +This corresponds to a function from FinEnum (Complete X) to Complete (FinEnum X). *) Definition FinCompact_raw (x: FinEnum stableCX) (e:QposInf) : FinEnum stableX := @@ -1396,34 +1349,33 @@ map (fun x => approximate x e) x. Lemma FinCompact_prf : forall x, is_RegularFunction (FinCompact_raw x). Proof. -intros x. -cut (forall e1 e2, hemiMetric X (e1 + e2) - (fun a : X => InFinEnumC a (FinCompact_raw x e1)) - (fun a : X => InFinEnumC a (FinCompact_raw x e2))). - intros L e1 e2. - split; auto. - eapply hemiMetric_wd1;[|apply L]. - QposRing. -intros e1 e2. -induction x. - apply hemiMetric_refl. -intros b Hb. -destruct Hb as [G | Hb | Hb] using orC_ind. + intros x. + cut (forall e1 e2, hemiMetric X (e1 + e2) (fun a : X => InFinEnumC a (FinCompact_raw x e1)) + (fun a : X => InFinEnumC a (FinCompact_raw x e2))). + intros L e1 e2. + split; auto. + eapply hemiMetric_wd1;[|apply L]. + QposRing. + intros e1 e2. + induction x. + apply hemiMetric_refl. + intros b Hb. + destruct Hb as [G | Hb | Hb] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists (approximate a e2). + split. + apply: orWeaken. + left; reflexivity. + rewrite Hb. + apply regFun_prf. + destruct (IHx b Hb) as [G | y [Hy0 Hy1]] using existsC_ind. auto using existsC_stable. apply existsWeaken. - exists (approximate a e2). - split. - apply: orWeaken. - left; reflexivity. - rewrite Hb. - apply regFun_prf. -destruct (IHx b Hb) as [G | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. -apply existsWeaken. -exists y. -split; auto. -apply: orWeaken. -right; auto. + exists y. + split; auto. + apply: orWeaken. + right; auto. Qed. Definition FinCompact_fun (x: FinEnum stableCX) : Compact stableX := @@ -1431,59 +1383,56 @@ Definition FinCompact_fun (x: FinEnum stableCX) : Compact stableX := Lemma FinCompact_uc : is_UniformlyContinuousFunction FinCompact_fun Qpos2QposInf. Proof. -cut (forall e d1 d2 (a b : FinEnum stableCX), - (hemiMetric (Complete X) e - (fun a0 : Complete X => InFinEnumC a0 a) - (fun a : Complete X => InFinEnumC a b)) -> - (hemiMetric X (d1 + e + d2) - (fun a0 : X => InFinEnumC a0 (approximate (FinCompact_fun a) d1)) - (fun a0 : X => InFinEnumC a0 (approximate (FinCompact_fun b) d2)))). - intros L e a b [Hab0 Hab1] d1 d2. - split; auto. - eapply hemiMetric_wd1;[|apply L;apply Hab1]. - QposRing. -intros e d1 d2 a b Hab c Hc. -simpl in Hc. -unfold FinCompact_raw in Hc. -assert (existsC (Complete X) (fun d => InFinEnumC d a /\ st_eq c (approximate d d1))). - clear - Hc. - induction a. - contradiction. - destruct Hc as [ G | Hc | Hc] using orC_ind. + cut (forall e d1 d2 (a b : FinEnum stableCX), (hemiMetric (Complete X) e + (fun a0 : Complete X => InFinEnumC a0 a) (fun a : Complete X => InFinEnumC a b)) -> + (hemiMetric X (d1 + e + d2) (fun a0 : X => InFinEnumC a0 (approximate (FinCompact_fun a) d1)) + (fun a0 : X => InFinEnumC a0 (approximate (FinCompact_fun b) d2)))). + intros L e a b [Hab0 Hab1] d1 d2. + split; auto. + eapply hemiMetric_wd1;[|apply L;apply Hab1]. + QposRing. + intros e d1 d2 a b Hab c Hc. + simpl in Hc. + unfold FinCompact_raw in Hc. + assert (existsC (Complete X) (fun d => InFinEnumC d a /\ st_eq c (approximate d d1))). + clear - Hc. + induction a. + contradiction. + destruct Hc as [ G | Hc | Hc] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists a. + split; auto. + apply orWeaken; left; reflexivity. + destruct (IHa Hc) as [G | y [Hy0 Hy1]] using existsC_ind. auto using existsC_stable. apply existsWeaken. - exists a. + exists y. split; auto. - apply orWeaken; left; reflexivity. - destruct (IHa Hc) as [G | y [Hy0 Hy1]] using existsC_ind. + apply orWeaken; right; auto. + destruct H as [ G | d [Hd0 Hd1]] using existsC_ind. + auto using existsC_stable. + destruct (Hab d Hd0) as [ G | z [Hz0 Hz1]] using existsC_ind. + auto using existsC_stable. + clear - Hd1 Hz0 Hz1. + induction b. + contradiction. + destruct Hz0 as [ G | Hz0 | Hz0] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists (approximate a d2). + split. + apply: orWeaken. + left; reflexivity. + rewrite -> Hz0 in Hz1. + rewrite Hd1. + apply Hz1. + destruct (IHb Hz0) as [G | y [Hy0 Hy1]] using existsC_ind. auto using existsC_stable. apply existsWeaken. exists y. split; auto. - apply orWeaken; right; auto. -destruct H as [ G | d [Hd0 Hd1]] using existsC_ind. - auto using existsC_stable. -destruct (Hab d Hd0) as [ G | z [Hz0 Hz1]] using existsC_ind. - auto using existsC_stable. -clear - Hd1 Hz0 Hz1. -induction b. - contradiction. -destruct Hz0 as [ G | Hz0 | Hz0] using orC_ind. - auto using existsC_stable. - apply existsWeaken. - exists (approximate a d2). - split. - apply: orWeaken. - left; reflexivity. - rewrite -> Hz0 in Hz1. - rewrite Hd1. - apply Hz1. -destruct (IHb Hz0) as [G | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. -apply existsWeaken. -exists y. -split; auto. -apply: orWeaken; right; auto. + apply: orWeaken; right; auto. Qed. Open Local Scope uc_scope. @@ -1491,126 +1440,124 @@ Open Local Scope uc_scope. Definition FinCompact : FinEnum stableCX --> Compact stableX := Build_UniformlyContinuousFunction FinCompact_uc. -Lemma FinCompact_correct : forall x (s:FinEnum stableCX), +Lemma FinCompact_correct : forall x (s:FinEnum stableCX), InFinEnumC x s <-> inCompact x (FinCompact s). Proof. -intros x s. -split. - intros H e1 e2. - simpl. - induction s. - contradiction. - move H after IHs. - destruct H as [G | H | H] using orC_ind. - auto using almostIn_stable. + intros x s. + split. + intros H e1 e2. + simpl. + induction s. + contradiction. + move H after IHs. + destruct H as [G | H | H] using orC_ind. + auto using almostIn_stable. + apply: orWeaken. + left; auto. apply: orWeaken. - left; auto. - apply: orWeaken. - right. - apply IHs; auto. -intros H. -induction s. - apply (H (1#1) (1#1))%Qpos. -unfold inCompact in H. -simpl in H. -set (P:= fun n (b:bool) => if b - then (let e1 := (1#P_of_succ_nat n)%Qpos in let e2 := e1 in (ball (m:=X) (e1 + e2) (approximate x e1) (approximate a e2))) - else (let e1 := (1#P_of_succ_nat n)%Qpos in let e2 := e1 in (almostIn (e1 + e2) (approximate x e1) (FinCompact_raw s e2)))). -assert (L: - (forall n : nat, existsC bool (fun x => ~ ~ In x (true :: false :: nil) /\ P n x))). - intros n. - destruct (H (1#P_of_succ_nat n)%Qpos (1#P_of_succ_nat n)%Qpos) - as [ G | L | L] using orC_ind. - auto using existsC_stable. + right. + apply IHs; auto. + intros H. + induction s. + apply (H (1#1) (1#1))%Qpos. + unfold inCompact in H. + simpl in H. + set (P:= fun n (b:bool) => if b + then (let e1 := (1#P_of_succ_nat n)%Qpos in let e2 := e1 in (ball (m:=X) (e1 + e2) (approximate x e1) (approximate a e2))) + else (let e1 := (1#P_of_succ_nat n)%Qpos in let e2 := e1 in (almostIn (e1 + e2) (approximate x e1) (FinCompact_raw s e2)))). + assert (L: (forall n : nat, existsC bool (fun x => ~ ~ In x (true :: false :: nil) /\ P n x))). + intros n. + destruct (H (1#P_of_succ_nat n)%Qpos (1#P_of_succ_nat n)%Qpos) as [ G | L | L] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists true. + split; auto with *. apply existsWeaken. - exists true. + exists false. split; auto with *. - apply existsWeaken. - exists false. - split; auto with *. -destruct (infinitePidgeonHolePrinicple _ _ _ L) as [G | c [_ Hc]] using existsC_ind. - auto using InFinEnumC_stable. -destruct c. + destruct (infinitePidgeonHolePrinicple _ _ _ L) as [G | c [_ Hc]] using existsC_ind. + auto using InFinEnumC_stable. + destruct c. + apply orWeaken. + left. + unfold P in Hc. + apply ball_eq. + intros e. + case_eq ((1#4)*e)%Qpos. + intros en ed He. + destruct (Hc (pred (nat_of_P ed))) as [G | m [Hm0 Hm1]] using existsC_ind. + auto using stableCX. + set (m' := (1#P_of_succ_nat m)%Qpos). + apply ball_weak_le with (m' + (m' + m') + m')%Qpos. + unfold m'. + autorewrite with QposElim. + replace LHS with ((1#P_of_succ_nat m)/(1#4)) by field. + apply Qle_shift_div_r. + constructor. + rewrite Qmult_comm. + change ((1#4)*e) with (((1#4)*e)%Qpos:Q). + rewrite He. + unfold Qle; simpl. + rewrite Zpos_mult_morphism. + apply Zle_trans with (en * ed)%Z; auto with *. + apply Zmult_le_compat_l; auto with *. + rewrite (anti_convert_pred_convert ed). + do 2 rewrite <- POS_anti_convert. + do 2 rewrite inj_S. + rewrite -> inj_le_iff in Hm0. + auto with *. + eapply ball_triangle;[|apply ball_approx_l]. + eapply ball_triangle;[apply ball_approx_r|]. + rewrite ball_Cunit. + apply Hm1. apply orWeaken. - left. + right. + apply IHs. unfold P in Hc. - apply ball_eq. - intros e. - case_eq ((1#4)*e)%Qpos. - intros en ed He. - destruct (Hc (pred (nat_of_P ed))) as [G | m [Hm0 Hm1]] using existsC_ind. - auto using stableCX. + intros e1 e2. + apply almostIn_closed. + intros d. + case_eq ((1#4)*d)%Qpos. + intros dn dd Hd. + destruct (Hc (pred (nat_of_P dd))) as [G | m [Hm0 Hm1]] using existsC_ind. + auto using almostIn_stable. set (m' := (1#P_of_succ_nat m)%Qpos). - apply ball_weak_le with (m' + (m' + m') + m')%Qpos. + apply almostIn_weak_le with ((e1 + m') + (m' + m') + (m' + e2))%Qpos. + autorewrite with QposElim. + rewrite Qle_minus_iff. + replace RHS with (d + - (m' + (m' + m') + m')) by ring. + rewrite <- Qle_minus_iff. unfold m'. autorewrite with QposElim. replace LHS with ((1#P_of_succ_nat m)/(1#4)) by field. apply Qle_shift_div_r. constructor. rewrite Qmult_comm. - change ((1#4)*e) with (((1#4)*e)%Qpos:Q). - rewrite He. + change ((1#4)*d) with (((1#4)*d)%Qpos:Q). + rewrite Hd. unfold Qle; simpl. rewrite Zpos_mult_morphism. - apply Zle_trans with (en * ed)%Z; auto with *. + apply Zle_trans with (dn * dd)%Z; auto with *. apply Zmult_le_compat_l; auto with *. - rewrite (anti_convert_pred_convert ed). + rewrite (anti_convert_pred_convert dd). do 2 rewrite <- POS_anti_convert. do 2 rewrite inj_S. rewrite -> inj_le_iff in Hm0. auto with *. - eapply ball_triangle;[|apply ball_approx_l]. - eapply ball_triangle;[apply ball_approx_r|]. - rewrite ball_Cunit. + eapply almostIn_triangle_r;[|apply regFun_prf]. + eapply almostIn_triangle_l;[apply regFun_prf|]. apply Hm1. -apply orWeaken. -right. -apply IHs. -unfold P in Hc. -intros e1 e2. -apply almostIn_closed. -intros d. -case_eq ((1#4)*d)%Qpos. -intros dn dd Hd. -destruct (Hc (pred (nat_of_P dd))) as [G | m [Hm0 Hm1]] using existsC_ind. - auto using almostIn_stable. -set (m' := (1#P_of_succ_nat m)%Qpos). -apply almostIn_weak_le with ((e1 + m') + (m' + m') + (m' + e2))%Qpos. - autorewrite with QposElim. - rewrite Qle_minus_iff. - replace RHS with (d + - (m' + (m' + m') + m')) by ring. - rewrite <- Qle_minus_iff. - unfold m'. - autorewrite with QposElim. - replace LHS with ((1#P_of_succ_nat m)/(1#4)) by field. - apply Qle_shift_div_r. - constructor. - rewrite Qmult_comm. - change ((1#4)*d) with (((1#4)*d)%Qpos:Q). - rewrite Hd. - unfold Qle; simpl. - rewrite Zpos_mult_morphism. - apply Zle_trans with (dn * dd)%Z; auto with *. - apply Zmult_le_compat_l; auto with *. - rewrite (anti_convert_pred_convert dd). - do 2 rewrite <- POS_anti_convert. - do 2 rewrite inj_S. - rewrite -> inj_le_iff in Hm0. - auto with *. -eapply almostIn_triangle_r;[|apply regFun_prf]. -eapply almostIn_triangle_l;[apply regFun_prf|]. -apply Hm1. Qed. Lemma CompactCompleteCompact_prf : forall x, is_RegularFunction (Cmap_raw FinCompact x). Proof. -intros x e1 e2. -unfold Cmap_raw. -simpl. -apply FinCompact_uc. -unfold ball_ex. -apply regFun_prf. + intros x e1 e2. + unfold Cmap_raw. + simpl. + apply FinCompact_uc. + unfold ball_ex. + apply regFun_prf. Qed. Definition CompactCompleteCompact_fun x : Complete (Compact stableX) := @@ -1619,10 +1566,10 @@ Definition CompactCompleteCompact_fun x : Complete (Compact stableX) := Lemma CompactCompleteCompact_uc : is_UniformlyContinuousFunction CompactCompleteCompact_fun Qpos2QposInf. Proof. -intros e a b H d1 d2. -simpl in *. -apply FinCompact_uc. -apply H. + intros e a b H d1 d2. + simpl in *. + apply FinCompact_uc. + apply H. Qed. Definition CompactCompleteCompact : Compact stableCX --> Compact stableX := @@ -1631,63 +1578,62 @@ Definition CompactCompleteCompact : Compact stableCX --> Compact stableX := Lemma CompactCompleteCompact_correct : forall x s, inCompact x s <-> inCompact (Cjoin x) (CompactCompleteCompact s). Proof. -intros x s. -split. + intros x s. + split. + intros H e1 e2. + simpl. + unfold Cjoin_raw. + simpl. + assert (Z:=(H ((1#2)*e1) ((1#2)*e2))%Qpos). + rewrite -> almostInExistsC in Z. + destruct Z as [G | z [Hz0 Hz1]] using existsC_ind. + auto using almostIn_stable. + rewrite -> FinCompact_correct in Hz1. + apply almostIn_closed. + intros d. + assert (Z0:=(Hz0 ((1#2)*e1) ((1#2)*d))%Qpos). + assert (Z1:=(Hz1 ((1#2)*d) ((1#2)*e2))%Qpos). + simpl in Z1. + set (w0:=((1 # 2) * e1 + ((1 # 2) * e1 + (1 # 2) * e2) + (1 # 2) * d)%Qpos) in *. + set (w1:= ((1 # 2) * d + (1 # 2) * e2)%Qpos) in *. + setoid_replace (e1 + e2 + d)%Qpos with (w0 + w1)%Qpos by (unfold w0, w1; QposRing). + eapply almostIn_triangle_l. + apply Z0. + apply Z1. intros H e1 e2. - simpl. - unfold Cjoin_raw. - simpl. - assert (Z:=(H ((1#2)*e1) ((1#2)*e2))%Qpos). - rewrite -> almostInExistsC in Z. - destruct Z as [G | z [Hz0 Hz1]] using existsC_ind. - auto using almostIn_stable. - rewrite -> FinCompact_correct in Hz1. apply almostIn_closed. intros d. - assert (Z0:=(Hz0 ((1#2)*e1) ((1#2)*d))%Qpos). - assert (Z1:=(Hz1 ((1#2)*d) ((1#2)*e2))%Qpos). - simpl in Z1. - set (w0:=((1 # 2) * e1 + ((1 # 2) * e1 + (1 # 2) * e2) + (1 # 2) * d)%Qpos) in *. - set (w1:= ((1 # 2) * d + (1 # 2) * e2)%Qpos) in *. - setoid_replace (e1 + e2 + d)%Qpos with (w0 + w1)%Qpos by (unfold w0, w1; QposRing). + set (d':=((1#4)*d)%Qpos). + setoid_replace (e1 + e2 + d)%Qpos with ((e1 + (1#2)*d' + (1#2)*d') + (((d' + d') + (1#2)*d') + ((1#2)*d' + e2)))%Qpos by (unfold d'; QposRing). eapply almostIn_triangle_l. - apply Z0. - apply Z1. -intros H e1 e2. -apply almostIn_closed. -intros d. -set (d':=((1#4)*d)%Qpos). -setoid_replace (e1 + e2 + d)%Qpos with ((e1 + (1#2)*d' + (1#2)*d') + (((d' + d') + (1#2)*d') + ((1#2)*d' + e2)))%Qpos by (unfold d'; QposRing). -eapply almostIn_triangle_l. - eapply ball_triangle. - apply regFun_prf. - apply ball_approx_r. -eapply almostIn_triangle_r;[|apply regFun_prf]. -assert (Z:= (H d' d')). -simpl in Z. -unfold Cjoin_raw in Z. -rewrite -> almostInExistsC in Z. -simpl in Z. -destruct Z as [G | z [Hz0 Hz1]] using existsC_ind. - auto using almostIn_stable. -change (InFinEnumC (X:=X) z - (approximate (FinCompact (approximate s ((1 # 2) * d')%Qpos)) - ((1 # 2) * d')%Qpos)) in Hz1. -apply almostIn_triangle_l with (Cunit z). - rewrite ball_Cunit. - assumption. -clear - Hz1. -induction ((approximate s ((1 # 2) * d')%Qpos)). - auto. -destruct Hz1 as [G | Hz1 | Hz1] using orC_ind. + eapply ball_triangle. + apply regFun_prf. + apply ball_approx_r. + eapply almostIn_triangle_r;[|apply regFun_prf]. + assert (Z:= (H d' d')). + simpl in Z. + unfold Cjoin_raw in Z. + rewrite -> almostInExistsC in Z. + simpl in Z. + destruct Z as [G | z [Hz0 Hz1]] using existsC_ind. auto using almostIn_stable. + change (InFinEnumC (X:=X) z (approximate (FinCompact (approximate s ((1 # 2) * d')%Qpos)) + ((1 # 2) * d')%Qpos)) in Hz1. + apply almostIn_triangle_l with (Cunit z). + rewrite ball_Cunit. + assumption. + clear - Hz1. + induction ((approximate s ((1 # 2) * d')%Qpos)). + auto. + destruct Hz1 as [G | Hz1 | Hz1] using orC_ind. + auto using almostIn_stable. + apply orWeaken. + left. + rewrite Hz1. + apply ball_approx_l. apply orWeaken. - left. - rewrite Hz1. - apply ball_approx_l. -apply orWeaken. -right. -apply IHs0; auto. + right. + apply IHs0; auto. Qed. End CompactDistr. @@ -1713,78 +1659,75 @@ Variable f : X --> Y. Lemma almostIn_map : forall (e d:Qpos) a (b:FinEnum stableX), (QposInf_le d (mu f e)) -> almostIn d a b -> almostIn e (f a) (FinEnum_map z stableX stableY f b). Proof. -intros e d a b Hd Hab. -induction b. - contradiction. -destruct Hab as [G | Hab | Hab] using orC_ind. - auto using almostIn_stable. + intros e d a b Hd Hab. + induction b. + contradiction. + destruct Hab as [G | Hab | Hab] using orC_ind. + auto using almostIn_stable. + apply: orWeaken. + left. + apply uc_prf. + eapply ball_ex_weak_le. + apply Hd. + assumption. apply: orWeaken. - left. - apply uc_prf. - eapply ball_ex_weak_le. - apply Hd. - assumption. -apply: orWeaken. -right. -apply IHb. -auto. + right. + apply IHb. + auto. Qed. Lemma almostIn_map2 : forall (e1 e2 d:Qpos) a (b:FinEnum stableX), (QposInf_le d ((mu f e1) + (mu f e2))) -> almostIn d a b -> almostIn (e1 + e2) (f a) (FinEnum_map z stableX stableY f b). Proof. -intros e1 e2 d a b Hd Hab. -induction b. - contradiction. -destruct Hab as [G | Hab | Hab] using orC_ind. - auto using almostIn_stable. + intros e1 e2 d a b Hd Hab. + induction b. + contradiction. + destruct Hab as [G | Hab | Hab] using orC_ind. + auto using almostIn_stable. + apply: orWeaken. + left. + apply (mu_sum plX e2 (e1::nil) f). + eapply ball_ex_weak_le. + apply Hd. + assumption. apply: orWeaken. - left. - apply (mu_sum plX e2 (e1::nil) f). - eapply ball_ex_weak_le. - apply Hd. - assumption. -apply: orWeaken. -right. -apply IHb. -auto. + right. + apply IHb. + auto. Qed. Definition CompactImage : Compact stableX --> Compact stableY := Cmap plFEX (FinEnum_map z stableX stableY f). -Lemma CompactImage_correct1 : forall x s, +Lemma CompactImage_correct1 : forall x s, (inCompact x s) -> (inCompact (Cmap plX f x) (CompactImage s)). Proof. -intros x s H e1 e2. -apply almostIn_closed. -intros d1. -setoid_replace (e1 + e2 + d1)%Qpos - with ((e1 + (1#4)*d1) + ((1#4)*d1 + ((1#4)*d1)) + ((1#4)*d1 + e2))%Qpos - by QposRing. -apply almostIn_triangle_r with (approximate (CompactImage s) ((1#4)*d1)%Qpos); - [|apply regFun_prf]. -apply almostIn_triangle_l with (approximate (Cmap plX f x) ((1#4)*d1)%Qpos); - [apply regFun_prf|]. -simpl. -unfold FinEnum_map_modulus. -case_eq (mu f ((1#4)*d1)). - intros d Hd. - apply: almostIn_map2;[|apply H]. - rewrite Hd. - apply: Qle_refl. -intros H0. -assert (Z:=H z z). -destruct (approximate s z). - contradiction. -apply: orWeaken. -left. -set (d:=((1 # 4) * d1)%Qpos). -apply (mu_sum plX d (d::nil) f). -simpl. -unfold d. -rewrite H0. -constructor. + intros x s H e1 e2. + apply almostIn_closed. + intros d1. + setoid_replace (e1 + e2 + d1)%Qpos + with ((e1 + (1#4)*d1) + ((1#4)*d1 + ((1#4)*d1)) + ((1#4)*d1 + e2))%Qpos by QposRing. + apply almostIn_triangle_r with (approximate (CompactImage s) ((1#4)*d1)%Qpos); [|apply regFun_prf]. + apply almostIn_triangle_l with (approximate (Cmap plX f x) ((1#4)*d1)%Qpos); [apply regFun_prf|]. + simpl. + unfold FinEnum_map_modulus. + case_eq (mu f ((1#4)*d1)). + intros d Hd. + apply: almostIn_map2;[|apply H]. + rewrite Hd. + apply: Qle_refl. + intros H0. + assert (Z:=H z z). + destruct (approximate s z). + contradiction. + apply: orWeaken. + left. + set (d:=((1 # 4) * d1)%Qpos). + apply (mu_sum plX d (d::nil) f). + simpl. + unfold d. + rewrite H0. + constructor. Qed. (* @@ -1814,18 +1757,18 @@ Variable f : X --> Complete Y. Definition CompactImage_b : Compact stableX --> Compact stableY := uc_compose (CompactCompleteCompact _ _) (CompactImage z (Complete_stable stableY) plFEX f). -Lemma CompactImage_b_correct1 : forall x s, +Lemma CompactImage_b_correct1 : forall x s, (inCompact x s) -> (inCompact (Cbind plX f x) (CompactImage_b s)). Proof. -intros x s H. -change (inCompact (Cjoin (Cmap_fun plX f x)) - (CompactCompleteCompact stableY _ (CompactImage z (Complete_stable stableY) plFEX f s))). -rewrite <- CompactCompleteCompact_correct. -apply: CompactImage_correct1;assumption. + intros x s H. + change (inCompact (Cjoin (Cmap_fun plX f x)) + (CompactCompleteCompact stableY _ (CompactImage z (Complete_stable stableY) plFEX f s))). + rewrite <- CompactCompleteCompact_correct. + apply: CompactImage_correct1;assumption. Qed. (* Lemma CompactImage_b_correctC *) -End CompactImageBind. \ No newline at end of file +End CompactImageBind. diff --git a/metric2/Complete.v b/metric2/Complete.v index 75570f954..b94c89951 100644 --- a/metric2/Complete.v +++ b/metric2/Complete.v @@ -64,57 +64,56 @@ Definition regFunEq (f g : RegularFunction) := Lemma regFunEq_e : forall (f g : RegularFunction), (forall e, ball (m:=X) (e+e) (approximate f e) (approximate g e)) -> (regFunEq f g). Proof. -unfold regFunEq. -intros f g H e1 e2. -apply ball_closed. -intros d. -setoid_replace (e1+e2+d)%Qpos with ((e1 + ((1#4)*d) + (((1#4)*d)+((1#4)*d)) +(((1#4)*d)+e2)))%Qpos by (QposRing). -eapply ball_triangle. -eapply ball_triangle. -apply regFun_prf. -apply H. -apply regFun_prf. + unfold regFunEq. + intros f g H e1 e2. + apply ball_closed. + intros d. + setoid_replace (e1+e2+d)%Qpos with ((e1 + ((1#4)*d) + (((1#4)*d)+((1#4)*d)) +(((1#4)*d)+e2)))%Qpos by (QposRing). + eapply ball_triangle. + eapply ball_triangle. + apply regFun_prf. + apply H. + apply regFun_prf. Qed. Lemma regFunEq_e_small : forall (f g : RegularFunction) (E:Qpos), (forall (e:Qpos), e <= E -> ball (m:=X) (e+e) (approximate f e) (approximate g e)) -> (regFunEq f g). Proof. -intros f g E H. -apply regFunEq_e. -intros e. -apply ball_closed. -intros d. -set (e':=Qpos_min ((1#4)*d) E). -apply ball_weak_le with ((e+e')+(e'+e')+(e'+e))%Qpos. -autorewrite with QposElim. -setoid_replace (e+e+d) with ((e+(1#4)*d)+((1#4)*d+(1#4)*d)+((1#4)*d+e)) by QposRing. -repeat apply: plus_resp_leEq_both;simpl; -try apply: Qpos_min_lb_l; auto with *. -apply ball_triangle with (approximate g e'). -apply ball_triangle with (approximate f e'). -apply regFun_prf. -apply H. -apply Qpos_min_lb_r. -apply regFun_prf. + intros f g E H. + apply regFunEq_e. + intros e. + apply ball_closed. + intros d. + set (e':=Qpos_min ((1#4)*d) E). + apply ball_weak_le with ((e+e')+(e'+e')+(e'+e))%Qpos. + autorewrite with QposElim. + setoid_replace (e+e+d) with ((e+(1#4)*d)+((1#4)*d+(1#4)*d)+((1#4)*d+e)) by QposRing. + repeat apply: plus_resp_leEq_both;simpl; try apply: Qpos_min_lb_l; auto with *. + apply ball_triangle with (approximate g e'). + apply ball_triangle with (approximate f e'). + apply regFun_prf. + apply H. + apply Qpos_min_lb_r. + apply regFun_prf. Qed. Lemma regFun_is_setoid : Setoid_Theory RegularFunction regFunEq. Proof. -split. -unfold Reflexive. -intros; apply regFunEq_e; intros; apply ball_refl. -unfold Symmetric, regFunEq. -intros. -apply ball_sym. -setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. -auto. -unfold Transitive, regFunEq. -intros. -apply ball_closed. -intros. -setoid_replace (e1+e2+d)%Qpos with ((e1 + (1#2)*d) + ((1#2)*d+e2))%Qpos by QposRing. -eapply ball_triangle. -apply H. -apply H0. + split. + unfold Reflexive. + intros; apply regFunEq_e; intros; apply ball_refl. + unfold Symmetric, regFunEq. + intros. + apply ball_sym. + setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. + auto. + unfold Transitive, regFunEq. + intros. + apply ball_closed. + intros. + setoid_replace (e1+e2+d)%Qpos with ((e1 + (1#2)*d) + ((1#2)*d+e2))%Qpos by QposRing. + eapply ball_triangle. + apply H. + apply H0. Qed. Definition regFun_Setoid := Build_Setoid regFun_is_setoid. @@ -122,80 +121,76 @@ Definition regFun_Setoid := Build_Setoid regFun_is_setoid. Definition regFunBall e (f g : RegularFunction) := forall d1 d2, ball (m:=X) (d1+e+d2)%Qpos (approximate f d1) (approximate g d2). -Lemma regFunBall_wd : forall (e1 e2:Qpos), (QposEq e1 e2) -> - forall (x1 x2 : regFun_Setoid), (st_eq x1 x2) -> - forall (y1 y2 : regFun_Setoid), (st_eq y1 y2) -> +Lemma regFunBall_wd : forall (e1 e2:Qpos), (QposEq e1 e2) -> + forall (x1 x2 : regFun_Setoid), (st_eq x1 x2) -> + forall (y1 y2 : regFun_Setoid), (st_eq y1 y2) -> (regFunBall e1 x1 y1 <-> regFunBall e2 x2 y2). Proof. -assert (forall x1 x2 : Qpos, -QposEq x1 x2 -> -forall x3 x4 : RegularFunction , -regFunEq x3 x4 -> -forall x5 x6 : RegularFunction , -regFunEq x5 x6 -> (regFunBall x1 x3 x5 -> regFunBall x2 x4 x6)). -unfold regFunBall. -unfold regFunEq. -intros a1 a2 Ha f1 f2 Hf g1 g2 Hg H d1 d2. -rewrite <- Ha. -clear a2 Ha. -apply ball_closed. -intros d. -setoid_replace (d1 + a1 + d2 + d)%Qpos with (((1#4)*d+d1)+((1#4)*d + a1 + (1#4)*d)+((1#4)*d+d2))%Qpos by QposRing. -eapply ball_triangle. -eapply ball_triangle. -apply ball_sym. -apply Hf. -apply H. -apply Hg. -intros; split. -intros; eapply H. -apply H0. -apply H1. -apply H2. -auto. -destruct (regFun_is_setoid). -intros; eapply H. -unfold QposEq. symmetry. -apply H0. -apply Seq_sym. -apply regFun_is_setoid. -apply H1. -apply Seq_sym. -apply regFun_is_setoid. -apply H2. -auto. + assert (forall x1 x2 : Qpos, QposEq x1 x2 -> forall x3 x4 : RegularFunction , regFunEq x3 x4 -> + forall x5 x6 : RegularFunction , regFunEq x5 x6 -> (regFunBall x1 x3 x5 -> regFunBall x2 x4 x6)). + unfold regFunBall. + unfold regFunEq. + intros a1 a2 Ha f1 f2 Hf g1 g2 Hg H d1 d2. + rewrite <- Ha. + clear a2 Ha. + apply ball_closed. + intros d. + setoid_replace (d1 + a1 + d2 + d)%Qpos with (((1#4)*d+d1)+((1#4)*d + a1 + (1#4)*d)+((1#4)*d+d2))%Qpos by QposRing. + eapply ball_triangle. + eapply ball_triangle. + apply ball_sym. + apply Hf. + apply H. + apply Hg. + intros; split. + intros; eapply H. + apply H0. + apply H1. + apply H2. + auto. + destruct (regFun_is_setoid). + intros; eapply H. + unfold QposEq. symmetry. + apply H0. + apply Seq_sym. + apply regFun_is_setoid. + apply H1. + apply Seq_sym. + apply regFun_is_setoid. + apply H2. + auto. Qed. Lemma regFun_is_MetricSpace : is_MetricSpace regFun_Setoid regFunBall. Proof. -unfold regFunBall. -split. -intros e f d1 d2. -setoid_replace (d1 + e + d2)%Qpos with (d1+d2+e)%Qpos by QposRing. -apply ball_weak. -apply regFun_prf. -intros e f g H d1 d2. -apply ball_sym. -setoid_replace (d1 + e + d2)%Qpos with (d2+e+d1)%Qpos by QposRing. -auto. -intros e1 e2 a b c Hab Hbc d1 d2. -apply ball_closed. -intros d3. -setoid_replace (d1+(e1+e2)+d2+d3)%Qpos with ((d1 + e1 + (1#2)*d3)+((1#2)*d3 + e2 + d2))%Qpos by QposRing. -eapply ball_triangle. -apply Hab. -apply Hbc. -intros e a b H d1 d2. -apply ball_closed. -intros d. -setoid_replace (d1+e+d2+d)%Qpos with (d1 + (e+d) + d2)%Qpos by QposRing. -auto. -unfold regFunEq. -intros a b H e1 e2. -apply ball_closed. -intros d. -setoid_replace (e1+e2+d)%Qpos with (e1+d+e2)%Qpos by QposRing. -auto. + unfold regFunBall. + split. + intros e f d1 d2. + setoid_replace (d1 + e + d2)%Qpos with (d1+d2+e)%Qpos by QposRing. + apply ball_weak. + apply regFun_prf. + intros e f g H d1 d2. + apply ball_sym. + setoid_replace (d1 + e + d2)%Qpos with (d2+e+d1)%Qpos by QposRing. + auto. + intros e1 e2 a b c Hab Hbc d1 d2. + apply ball_closed. + intros d3. + setoid_replace (d1+(e1+e2)+d2+d3)%Qpos with ((d1 + e1 + (1#2)*d3)+((1#2)*d3 + e2 + d2))%Qpos by QposRing. + eapply ball_triangle. + apply Hab. + apply Hbc. + intros e a b H d1 d2. + apply ball_closed. + intros d. + setoid_replace (d1+e+d2+d)%Qpos with (d1 + (e+d) + d2)%Qpos by QposRing. + auto. + unfold regFunEq. + intros a b H e1 e2. + apply ball_closed. + intros d. + setoid_replace (e1+e2+d)%Qpos with (e1+d+e2)%Qpos by QposRing. + auto. Qed. (** We define the completion of a metric space to be the space of @@ -206,22 +201,24 @@ Build_MetricSpace regFunBall_wd regFun_is_MetricSpace. (** The ball of regular functions is related to the underlying ball in ways that you would expect. *) Lemma regFunBall_ball : forall (x y:Complete) (e0 e1 e2:Qpos), ball e0 (approximate x e1) (approximate y e2) -> ball (e1 + e0 + e2) x y. -intros x y e0 e1 e2 H d1 d2. -setoid_replace (d1+(e1+e0+e2)+d2)%Qpos with ((d1+e1)+e0+(e2+d2))%Qpos by QposRing. -eapply ball_triangle. -eapply ball_triangle. -apply regFun_prf. -apply H. -apply regFun_prf. +Proof. + intros x y e0 e1 e2 H d1 d2. + setoid_replace (d1+(e1+e0+e2)+d2)%Qpos with ((d1+e1)+e0+(e2+d2))%Qpos by QposRing. + eapply ball_triangle. + eapply ball_triangle. + apply regFun_prf. + apply H. + apply regFun_prf. Qed. Lemma regFunBall_e : forall (x y:Complete) e, (forall d, ball (d + e + d) (approximate x d) (approximate y d)) -> ball e x y. -intros x y e H. -apply ball_closed. -intros d. -setoid_replace (e + d)%Qpos with ((1#4)*d + ((1#4)*d+e+(1#4)*d) + (1#4)*d)%Qpos by QposRing. -apply regFunBall_ball. -apply H. +Proof. + intros x y e H. + apply ball_closed. + intros d. + setoid_replace (e + d)%Qpos with ((1#4)*d + ((1#4)*d+e+(1#4)*d) + (1#4)*d)%Qpos by QposRing. + apply regFunBall_ball. + apply H. Qed. (** @@ -230,20 +227,20 @@ There is an injection from the original space to the complete space given by the constant regular function. *) Lemma Cunit_fun_prf (x:X) : is_RegularFunction (fun _ => x). Proof. -intros x d1 d2. -apply ball_refl. + intros x d1 d2. + apply ball_refl. Qed. -Definition Cunit_fun (x:X) : Complete := +Definition Cunit_fun (x:X) : Complete := Build_RegularFunction (Cunit_fun_prf x). Lemma Cunit_prf : is_UniformlyContinuousFunction Cunit_fun Qpos2QposInf. Proof. -intros e a b Hab d1 d2. -simpl in *. -setoid_replace (d1+e+d2)%Qpos with (e+(d1+d2))%Qpos by QposRing. -apply ball_weak. -assumption. + intros e a b Hab d1 d2. + simpl in *. + setoid_replace (d1+e+d2)%Qpos with (e+(d1+d2))%Qpos by QposRing. + apply ball_weak. + assumption. Qed. Definition Cunit : X --> Complete := @@ -252,68 +249,65 @@ Build_UniformlyContinuousFunction Cunit_prf. (** This injection preserves the metric *) Lemma ball_Cunit : forall e a b, ball e (Cunit a) (Cunit b) <-> ball e a b. Proof. -intros e a b. -simpl. -unfold regFunBall. -simpl. -split. -intros H. -do 2 (apply ball_closed; intro). -setoid_replace (e+d+d0)%Qpos with (d+e+d0)%Qpos by QposRing. -apply H. -intros H d1 d2. -apply: Cunit_prf. -assumption. + intros e a b. + simpl. + unfold regFunBall. + simpl. + split. + intros H. + do 2 (apply ball_closed; intro). + setoid_replace (e+d+d0)%Qpos with (d+e+d0)%Qpos by QposRing. + apply H. + intros H d1 d2. + apply: Cunit_prf. + assumption. Qed. Lemma Cunit_eq : forall a b, st_eq (Cunit a) (Cunit b) <-> st_eq a b. Proof. -intros a b. -do 2 rewrite <- ball_eq_iff. -split; intros H e; -[rewrite <- ball_Cunit | rewrite ball_Cunit]; -apply H. + intros a b. + do 2 rewrite <- ball_eq_iff. + split; intros H e; [rewrite <- ball_Cunit | rewrite ball_Cunit]; apply H. Qed. Lemma ball_approx_r : forall (x:Complete) e, ball e x (Cunit (approximate x e)). Proof. -intros x e d1 d2. -simpl. -apply ball_weak. -apply regFun_prf. + intros x e d1 d2. + simpl. + apply ball_weak. + apply regFun_prf. Qed. Lemma ball_approx_l : forall (x:Complete) e, ball e (Cunit (approximate x e)) x. Proof. -(* -Set Firstorder Depth 6. -firstorder fail with ball_sym ball_approx_r. -*) -pose ball_approx_r. -pose ball_sym. -auto. + (* Set Firstorder Depth 6. + firstorder fail with ball_sym ball_approx_r. + *) + pose ball_approx_r. + pose ball_sym. + auto. Qed. Lemma ball_ex_approx_r : forall (x:Complete) e, ball_ex e x (Cunit (approximate x e)). Proof. -intros x [e|]; simpl. -apply ball_approx_r. -constructor. + intros x [e|]; simpl. + apply ball_approx_r. + constructor. Qed. Lemma ball_ex_approx_l : forall (x:Complete) e, ball_ex e (Cunit (approximate x e)) x. Proof. -intros x [e|]; simpl. -apply ball_approx_l. -constructor. + intros x [e|]; simpl. + apply ball_approx_l. + constructor. Qed. -Lemma regFun_prf_ex : +Lemma regFun_prf_ex : forall (r : Complete) (e1 e2 : QposInf), ball_ex (e1 + e2) (approximate r e1) (approximate r e2). Proof. -intros r [e1|] [e2|]; try constructor. -apply: regFun_prf. + intros r [e1|] [e2|]; try constructor. + apply: regFun_prf. Qed. End RegularFunction. @@ -325,7 +319,8 @@ Implicit Arguments is_RegularFunction [X]. Implicit Arguments Cunit [X]. Add Parametric Morphism X : (@Cunit_fun X) with signature (@st_eq _) ==> (@st_eq _) as Cunit_wd. -exact (@uc_wd _ _ Cunit). +Proof. + exact (@uc_wd _ _ Cunit). Qed. (* end hide *) @@ -346,35 +341,35 @@ Hypothesis Hf : forall x, (f x) <= x. Lemma fasterIsRegular : is_RegularFunction (fun e => (approximate x (QposInf_bind f e))). Proof. -intros e1 e2. -simpl. -apply ball_weak_le with (f e1 + f e2)%Qpos. -autorewrite with QposElim. -apply: plus_resp_leEq_both; apply Hf. -apply regFun_prf. + intros e1 e2. + simpl. + apply ball_weak_le with (f e1 + f e2)%Qpos. + autorewrite with QposElim. + apply: plus_resp_leEq_both; apply Hf. + apply regFun_prf. Qed. Definition faster : Complete X := Build_RegularFunction fasterIsRegular. Lemma fasterIsEq : st_eq faster x. Proof. -apply: regFunEq_e. -intros e. -simpl. -apply ball_weak_le with (f e + e)%Qpos. -autorewrite with QposElim. -apply: plus_resp_leEq. -apply Hf. -apply regFun_prf. + apply: regFunEq_e. + intros e. + simpl. + apply ball_weak_le with (f e + e)%Qpos. + autorewrite with QposElim. + apply: plus_resp_leEq. + apply Hf. + apply regFun_prf. Qed. End FasterInGeneral. Lemma QreduceApprox_prf : forall (e:Qpos), QposRed e <= e. Proof. -intros e. -rewrite QposRed_correct. -apply Qle_refl. + intros e. + rewrite QposRed_correct. + apply Qle_refl. Qed. Definition QreduceApprox := faster QposRed QreduceApprox_prf. @@ -385,16 +380,16 @@ Proof (fasterIsEq _ _). case. *) Lemma doubleSpeed_prf : forall (e:Qpos), ((1#2)*e)%Qpos <= e. Proof. -intros e. -autorewrite with QposElim. -rewrite Qle_minus_iff. -ring_simplify. -apply: mult_resp_nonneg. -discriminate. -apply Qpos_nonneg. + intros e. + autorewrite with QposElim. + rewrite Qle_minus_iff. + ring_simplify. + apply: mult_resp_nonneg. + discriminate. + apply Qpos_nonneg. Qed. -Definition doubleSpeed := faster (Qpos_mult (1#2)) doubleSpeed_prf. +Definition doubleSpeed := faster (Qpos_mult (1#2)) doubleSpeed_prf. Lemma doubleSpeed_Eq : st_eq doubleSpeed x. Proof (fasterIsEq _ _). @@ -416,14 +411,14 @@ Definition Cjoin_raw (x:Complete (Complete X)) (e:QposInf) := Lemma Cjoin_fun_prf (x:Complete (Complete X)) : is_RegularFunction (Cjoin_raw x). Proof. -intros x d1 d2. -rewrite <- ball_Cunit. -setoid_replace (d1 + d2)%Qpos with ((1#2)*d1 + ((1#2)*d1+(1#2)*d2) + (1#2)*d2)%Qpos by QposRing. -apply ball_triangle with (approximate x ((1#2)*d2))%Qpos. -apply ball_triangle with (approximate x ((1#2)*d1))%Qpos. -apply ball_approx_l. -apply regFun_prf. -apply ball_approx_r. + intros x d1 d2. + rewrite <- ball_Cunit. + setoid_replace (d1 + d2)%Qpos with ((1#2)*d1 + ((1#2)*d1+(1#2)*d2) + (1#2)*d2)%Qpos by QposRing. + apply ball_triangle with (approximate x ((1#2)*d2))%Qpos. + apply ball_triangle with (approximate x ((1#2)*d1))%Qpos. + apply ball_approx_l. + apply regFun_prf. + apply ball_approx_r. Qed. Definition Cjoin_fun (x:Complete (Complete X)) : Complete X := @@ -431,20 +426,20 @@ Build_RegularFunction (Cjoin_fun_prf x). Lemma Cjoin_prf : is_UniformlyContinuousFunction Cjoin_fun Qpos2QposInf. Proof. -intros e x y Hab d1 d2. -do 2 rewrite <- ball_Cunit. -setoid_replace (d1 + e + d2)%Qpos with (((1#2)*d1 + (1#2)*d1) + e + (((1#2)*d2) + (1#2)*d2))%Qpos by QposRing. -apply ball_triangle with y. -apply ball_triangle with x. -apply ball_triangle with (Cunit (approximate x ((1 # 2) * d1)%Qpos)). -rewrite ball_Cunit. -apply: ball_approx_l. -apply ball_approx_l. -assumption. -eapply ball_triangle. -apply ball_approx_r. -rewrite ball_Cunit. -apply: ball_approx_r. + intros e x y Hab d1 d2. + do 2 rewrite <- ball_Cunit. + setoid_replace (d1 + e + d2)%Qpos with (((1#2)*d1 + (1#2)*d1) + e + (((1#2)*d2) + (1#2)*d2))%Qpos by QposRing. + apply ball_triangle with y. + apply ball_triangle with x. + apply ball_triangle with (Cunit (approximate x ((1 # 2) * d1)%Qpos)). + rewrite ball_Cunit. + apply: ball_approx_l. + apply ball_approx_l. + assumption. + eapply ball_triangle. + apply ball_approx_r. + rewrite ball_Cunit. + apply: ball_approx_r. Qed. Definition Cjoin : (Complete (Complete X)) --> (Complete X) := @@ -472,68 +467,68 @@ f (approximate x (QposInf_mult (1#2)%Qpos (QposInf_bind (mu f) e))). Lemma Cmap_slow_raw_strongInf : forall (x:Complete X) (d:QposInf) (e:QposInf), QposInf_le d (QposInf_mult (1#2)%Qpos (QposInf_bind (mu f) e)) -> ball_ex e (f (approximate x d)) (Cmap_slow_raw x e). Proof. -intros x [d|] [e|] Hd; try constructor. + intros x [d|] [e|] Hd; try constructor. + apply uc_prf. + simpl. + case_eq (mu f e); simpl; trivial. + intros q Hq. + simpl in Hd. + rewrite Hq in Hd. + eapply ball_weak_le;[|apply regFun_prf]. + rewrite Q_Qpos_plus. + replace RHS with (((1 # 2) * q)%Qpos + ((1 # 2) * q)%Qpos) by QposRing. + apply: plus_resp_leEq. + assumption. + unfold Cmap_slow_raw. + simpl in *. apply uc_prf. - simpl. - case_eq (mu f e); simpl; trivial. - intros q Hq. - simpl in Hd. - rewrite Hq in Hd. - eapply ball_weak_le;[|apply regFun_prf]. - rewrite Q_Qpos_plus. - replace RHS with (((1 # 2) * q)%Qpos + ((1 # 2) * q)%Qpos) by QposRing. - apply: plus_resp_leEq. - assumption. -unfold Cmap_slow_raw. -simpl in *. -apply uc_prf. -destruct (mu f e) as [q|]. - contradiction. -constructor. + destruct (mu f e) as [q|]. + contradiction. + constructor. Qed. Lemma Cmap_slow_raw_strong : forall (x:Complete X) (d:QposInf) (e:Qpos), QposInf_le d (QposInf_mult (1#2)%Qpos (mu f e)) -> ball e (f (approximate x d)) (Cmap_slow_raw x e). Proof. -intros. -apply (Cmap_slow_raw_strongInf x d e). -assumption. + intros. + apply (Cmap_slow_raw_strongInf x d e). + assumption. Qed. Lemma Cmap_slow_fun_prf (x:Complete X) : is_RegularFunction (Cmap_slow_raw x). Proof. -intros x e1 e2. -unfold Cmap_slow_raw. -cut (forall (e1 e2:Qpos), (QposInf_le (mu f e2) (mu f e1)) -> ball (m:=Y) (e1 + e2) - (f (approximate x (QposInf_mult (1 # 2)%Qpos (QposInf_bind (mu f) e1)))) - (f (approximate x (QposInf_mult (1 # 2)%Qpos (QposInf_bind (mu f) e2))))). - intros H. - (* move this out *) - assert (forall a b, {QposInf_le a b}+{QposInf_le b a}). - intros [a|] [b|]; simpl; try tauto. - apply Qle_total. - destruct (H0 (mu f e2) (mu f e1)). - auto. + intros x e1 e2. + unfold Cmap_slow_raw. + cut (forall (e1 e2:Qpos), (QposInf_le (mu f e2) (mu f e1)) -> ball (m:=Y) (e1 + e2) + (f (approximate x (QposInf_mult (1 # 2)%Qpos (QposInf_bind (mu f) e1)))) + (f (approximate x (QposInf_mult (1 # 2)%Qpos (QposInf_bind (mu f) e2))))). + intros H. + (* move this out *) + assert (forall a b, {QposInf_le a b}+{QposInf_le b a}). + intros [a|] [b|]; simpl; try tauto. + apply Qle_total. + destruct (H0 (mu f e2) (mu f e1)). + auto. + apply ball_sym. + setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. + auto. + clear e1 e2. + intros e1 e2 H. + apply ball_weak. apply ball_sym. - setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. - auto. -clear e1 e2. -intros e1 e2 H. -apply ball_weak. -apply ball_sym. -simpl. -apply Cmap_slow_raw_strong. -simpl. -destruct (mu f e1). -simpl. -destruct (mu f e2). -simpl. -autorewrite with QposElim. -apply: mult_resp_leEq_lft. -assumption. -discriminate. -elim H. -constructor. + simpl. + apply Cmap_slow_raw_strong. + simpl. + destruct (mu f e1). + simpl. + destruct (mu f e2). + simpl. + autorewrite with QposElim. + apply: mult_resp_leEq_lft. + assumption. + discriminate. + elim H. + constructor. Qed. Definition Cmap_slow_fun (x:Complete X) : Complete Y := @@ -541,49 +536,43 @@ Build_RegularFunction (Cmap_slow_fun_prf x). Definition Cmap_slow_prf : is_UniformlyContinuousFunction Cmap_slow_fun (fun e => (QposInf_mult (1#2)(mu f e))%Qpos). Proof. -intros e0 x y Hxy. -intros e1 e2. -simpl. -unfold Cmap_slow_raw. -set (d1:=(QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e1))). -set (d2:=(QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e2))). -set (d0:=(QposInf_bind (fun y' : Qpos => ((1 # 4) * y')%Qpos) (mu f e0))). -apply ball_triangle with (f (approximate y (QposInf_min d0 d2 ))). - apply ball_triangle with (f (approximate x (QposInf_min d0 d1))). + intros e0 x y Hxy. + intros e1 e2. + simpl. + unfold Cmap_slow_raw. + set (d1:=(QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e1))). + set (d2:=(QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e2))). + set (d0:=(QposInf_bind (fun y' : Qpos => ((1 # 4) * y')%Qpos) (mu f e0))). + apply ball_triangle with (f (approximate y (QposInf_min d0 d2 ))). + apply ball_triangle with (f (approximate x (QposInf_min d0 d1))). + apply uc_prf. + eapply ball_ex_weak_le;[|apply regFun_prf_ex]. + unfold d1. + simpl. + destruct (mu f e1); try constructor. + destruct d0; simpl; autorewrite with QposElim; + (replace RHS with (((1 # 2) * q + (1 # 2) * q)) by ring); try rewrite Qmin_plus_distr_r; + auto with *. apply uc_prf. - eapply ball_ex_weak_le;[|apply regFun_prf_ex]. - unfold d1. - simpl. - destruct (mu f e1); try constructor. - destruct d0; - simpl; - autorewrite with QposElim; - (replace RHS with (((1 # 2) * q + (1 # 2) * q)) by ring); - try rewrite Qmin_plus_distr_r; - auto with *. - apply uc_prf. - destruct (mu f e0); try constructor. - cut (forall z0 z1:Qpos, (z0 <= (1#4)*q) -> (z1 <= (1#4)*q) -> ball q (approximate x z0) (approximate y z1)). - intros H. - destruct d1; destruct d2; simpl; apply H; autorewrite with QposElim; auto with *. - intros z0 z1 Hz0 Hz1. - eapply ball_weak_le. - 2:apply Hxy. - autorewrite with QposElim. - rewrite -> Qle_minus_iff in *. - replace RHS with (((1 # 4) * q + - z0) + ((1 # 4) * q + - z1)) by ring. - Qauto_nonneg. -apply: uc_prf. -eapply ball_ex_weak_le;[|apply regFun_prf_ex]. -unfold d2. -simpl. -destruct (mu f e2); try constructor. -destruct d0; - simpl; - autorewrite with QposElim; - (replace RHS with (((1 # 2) * q + (1 # 2) * q)) by ring); - try rewrite Qmin_plus_distr_l; - auto with *. + destruct (mu f e0); try constructor. + cut (forall z0 z1:Qpos, (z0 <= (1#4)*q) -> (z1 <= (1#4)*q) -> ball q (approximate x z0) (approximate y z1)). + intros H. + destruct d1; destruct d2; simpl; apply H; autorewrite with QposElim; auto with *. + intros z0 z1 Hz0 Hz1. + eapply ball_weak_le. + 2:apply Hxy. + autorewrite with QposElim. + rewrite -> Qle_minus_iff in *. + replace RHS with (((1 # 4) * q + - z0) + ((1 # 4) * q + - z1)) by ring. + Qauto_nonneg. + apply: uc_prf. + eapply ball_ex_weak_le;[|apply regFun_prf_ex]. + unfold d2. + simpl. + destruct (mu f e2); try constructor. + destruct d0; simpl; autorewrite with QposElim; + (replace RHS with (((1 # 2) * q + (1 # 2) * q)) by ring); try rewrite Qmin_plus_distr_l; + auto with *. Qed. Definition Cmap_slow : (Complete X) --> (Complete Y) := @@ -604,61 +593,89 @@ Notation "a =m b" := (st_eq a b) (at level 70, no associativity). Lemma MonadLaw1 : forall a, Cmap_slow_fun (uc_id X) a =m a. Proof. -intros x e1 e2. -simpl. -apply: ball_weak_le;[|apply regFun_prf]. -autorewrite with QposElim. -Qauto_le. + intros x e1 e2. + simpl. + apply: ball_weak_le;[|apply regFun_prf]. + autorewrite with QposElim. + Qauto_le. Qed. Lemma MonadLaw2 : forall (f:Y --> Z) (g:X --> Y) a, Cmap_slow_fun (uc_compose f g) a =m (Cmap_slow_fun f (Cmap_slow_fun g a)). Proof. -simpl. -intros f g x e1 e2. -set (a := approximate (Cmap_slow_fun (uc_compose f g) x) e1). -set (b:=(approximate (Cmap_slow_fun f (Cmap_slow_fun g x)) e2)). -set (d0 := (QposInf_min (QposInf_mult (1#2)%Qpos (mu (uc_compose f g) e1)) ((1 # 2)%Qpos * QposInf_bind (mu g) (QposInf_mult (1 # 2)%Qpos (mu f e2))))). -apply ball_triangle with ((uc_compose f g) (approximate x d0)). - apply ball_sym. - apply Cmap_slow_raw_strong. - unfold d0. - apply QposInf_min_lb_l. -unfold b; simpl. -unfold Cmap_slow_raw. -apply uc_prf. -simpl. -destruct (mu f e2) as [q|]; try constructor. -simpl. -apply ball_weak_le with ((1#2)*q)%Qpos. - autorewrite with QposElim. - Qauto_le. -apply (Cmap_slow_raw_strong g x d0). -apply QposInf_min_lb_r. + simpl. + intros f g x e1 e2. + set (a := approximate (Cmap_slow_fun (uc_compose f g) x) e1). + set (b:=(approximate (Cmap_slow_fun f (Cmap_slow_fun g x)) e2)). + set (d0 := (QposInf_min (QposInf_mult (1#2)%Qpos (mu (uc_compose f g) e1)) ((1 # 2)%Qpos * QposInf_bind (mu g) (QposInf_mult (1 # 2)%Qpos (mu f e2))))). + apply ball_triangle with ((uc_compose f g) (approximate x d0)). + apply ball_sym. + apply Cmap_slow_raw_strong. + unfold d0. + apply QposInf_min_lb_l. + unfold b; simpl. + unfold Cmap_slow_raw. + apply uc_prf. + simpl. + destruct (mu f e2) as [q|]; try constructor. + simpl. + apply ball_weak_le with ((1#2)*q)%Qpos. + autorewrite with QposElim. + Qauto_le. + apply (Cmap_slow_raw_strong g x d0). + apply QposInf_min_lb_r. Qed. Lemma MonadLaw3 : forall (f:X --> Y) a, (Cmap_slow_fun f (Cunit_fun _ a)) =m (Cunit_fun _ (f a)). Proof. -intros f x e1 e2. -apply: regFun_prf. + intros f x e1 e2. + apply: regFun_prf. Qed. Lemma MonadLaw4 : forall (f:X --> Y) a, (Cmap_slow_fun f (Cjoin_fun a)) =m (Cjoin_fun ((Cmap_slow_fun (Cmap_slow f)) a)). Proof. -intros f x e1 e2. -set (e2' := ((1#2)*e2)%Qpos). -set (d0 := (QposInf_min ((1#4)%Qpos*(mu f e1)) ((1#8)%Qpos*(mu f ((1#2)*e2))))%QposInf). -simpl. -unfold Cmap_slow_raw; simpl. -unfold Cjoin_raw; simpl. -unfold Cmap_slow_raw; simpl. -apply ball_triangle with (f (approximate (approximate x d0) d0)). + intros f x e1 e2. + set (e2' := ((1#2)*e2)%Qpos). + set (d0 := (QposInf_min ((1#4)%Qpos*(mu f e1)) ((1#8)%Qpos*(mu f ((1#2)*e2))))%QposInf). + simpl. + unfold Cmap_slow_raw; simpl. + unfold Cjoin_raw; simpl. + unfold Cmap_slow_raw; simpl. + apply ball_triangle with (f (approximate (approximate x d0) d0)). + apply uc_prf. + destruct (mu f e1) as [q|]; try constructor. + simpl. + do 2 rewrite <- ball_Cunit. + set (b:= (approximate (approximate x ((1 # 2) * ((1 # 2) * q))%Qpos) + ((1 # 2) * ((1 # 2) * q))%Qpos)). + setoid_replace q with (((1#4)*q + (1#4)*q)+ ((1#4)*q+ (1#4)*q))%Qpos by QposRing. + unfold b; clear b. + apply ball_triangle with x. + apply ball_triangle with (Cunit (approximate x ((1 # 2) * ((1 # 2) * q))%Qpos)). + rewrite ball_Cunit. + apply ball_approx_l. + apply ball_approx_l. + apply ball_triangle with (Cunit (approximate x d0)). + change (ball_ex ((1 # 4) * q)%Qpos x (Cunit (approximate x d0))). + apply ball_ex_weak_le with (d0)%QposInf. + apply QposInf_min_lb_l. + destruct d0 as [d0|]; try constructor. + apply ball_approx_r. + rewrite ball_Cunit. + change (ball_ex ((1 # 4) * q)%Qpos (approximate x d0) (Cunit (approximate (approximate x d0) d0))). + apply ball_ex_weak_le with (d0)%QposInf. + apply QposInf_min_lb_l. + destruct d0 as [d0|]; try constructor. + apply ball_approx_r. + apply ball_sym. + apply ball_weak_le with ((1#2)*e2)%Qpos. + autorewrite with QposElim. + Qauto_le. apply uc_prf. - destruct (mu f e1) as [q|]; try constructor. + destruct (mu f ((1#2)*e2)) as [q|]; try constructor. simpl. do 2 rewrite <- ball_Cunit. - set (b:= (approximate (approximate x ((1 # 2) * ((1 # 2) * q))%Qpos) - ((1 # 2) * ((1 # 2) * q))%Qpos)). - setoid_replace q with (((1#4)*q + (1#4)*q)+ ((1#4)*q+ (1#4)*q))%Qpos by QposRing. + set (b:= (approximate (approximate x ((1 # 2) * ((1 # 2) * q))%Qpos) ((1 # 2) * q)%Qpos)). + setoid_replace q with (((1#2)*q + (1#4)*q)+ ((1#8)*q+ (1#8)*q))%Qpos by QposRing. unfold b; clear b. apply ball_triangle with x. apply ball_triangle with (Cunit (approximate x ((1 # 2) * ((1 # 2) * q))%Qpos)). @@ -666,92 +683,62 @@ apply ball_triangle with (f (approximate (approximate x d0) d0)). apply ball_approx_l. apply ball_approx_l. apply ball_triangle with (Cunit (approximate x d0)). - change (ball_ex ((1 # 4) * q)%Qpos x (Cunit (approximate x d0))). + change (ball_ex ((1 # 8) * q)%Qpos x (Cunit (approximate x d0))). apply ball_ex_weak_le with (d0)%QposInf. - apply QposInf_min_lb_l. + apply QposInf_min_lb_r. destruct d0 as [d0|]; try constructor. apply ball_approx_r. rewrite ball_Cunit. - change (ball_ex ((1 # 4) * q)%Qpos (approximate x d0) - (Cunit (approximate (approximate x d0) d0))). - apply ball_ex_weak_le with (d0)%QposInf. - apply QposInf_min_lb_l. - destruct d0 as [d0|]; try constructor. - apply ball_approx_r. -apply ball_sym. -apply ball_weak_le with ((1#2)*e2)%Qpos. - autorewrite with QposElim. - Qauto_le. -apply uc_prf. -destruct (mu f ((1#2)*e2)) as [q|]; try constructor. -simpl. -do 2 rewrite <- ball_Cunit. -set (b:= (approximate (approximate x ((1 # 2) * ((1 # 2) * q))%Qpos) - ((1 # 2) * q)%Qpos)). -setoid_replace q with (((1#2)*q + (1#4)*q)+ ((1#8)*q+ (1#8)*q))%Qpos by QposRing. -unfold b; clear b. -apply ball_triangle with x. - apply ball_triangle with (Cunit (approximate x ((1 # 2) * ((1 # 2) * q))%Qpos)). - rewrite ball_Cunit. - apply ball_approx_l. - apply ball_approx_l. -apply ball_triangle with (Cunit (approximate x d0)). - change (ball_ex ((1 # 8) * q)%Qpos x (Cunit (approximate x d0))). + change (ball_ex ((1 # 8) * q)%Qpos (approximate x d0) (Cunit (approximate (approximate x d0) d0))). apply ball_ex_weak_le with (d0)%QposInf. apply QposInf_min_lb_r. destruct d0 as [d0|]; try constructor. apply ball_approx_r. -rewrite ball_Cunit. -change (ball_ex ((1 # 8) * q)%Qpos (approximate x d0) - (Cunit (approximate (approximate x d0) d0))). -apply ball_ex_weak_le with (d0)%QposInf. - apply QposInf_min_lb_r. -destruct d0 as [d0|]; try constructor. -apply ball_approx_r. Qed. Lemma MonadLaw5 : forall a, (Cjoin_fun (X:=X) (Cunit_fun _ a)) =m a. -intros x e1 e2. -simpl. -setoid_replace (e1+e2)%Qpos with ((1#2)*e1 + e2 + (1#2)*e1)%Qpos by QposRing. -apply ball_weak. -apply regFun_prf. +Proof. + intros x e1 e2. + simpl. + setoid_replace (e1+e2)%Qpos with ((1#2)*e1 + e2 + (1#2)*e1)%Qpos by QposRing. + apply ball_weak. + apply regFun_prf. Qed. Lemma MonadLaw6 : forall a, Cjoin_fun ((Cmap_slow_fun (X:=X) Cunit) a) =m a. Proof. -intros a e1 e2. -simpl. -setoid_replace (e1+e2)%Qpos with ((1#2)*((1#2)*e1) + e2 + (3#4)*e1)%Qpos by QposRing. -apply ball_weak. -apply: regFun_prf. + intros a e1 e2. + simpl. + setoid_replace (e1+e2)%Qpos with ((1#2)*((1#2)*e1) + e2 + (3#4)*e1)%Qpos by QposRing. + apply ball_weak. + apply: regFun_prf. Qed. Lemma MonadLaw7 : forall a, Cjoin_fun ((Cmap_slow_fun (X:=Complete (Complete X)) Cjoin) a) =m Cjoin_fun (Cjoin_fun a). Proof. -intros x e1 e2. -pose (half := fun e:Qpos => ((1#2)*e)%Qpos). -apply ball_weak_le with ((half (half e1)) + ((half (half e1)) + (half (half e1) + (half (half e2))) + (half (half e2))) + (half e2))%Qpos. - unfold half. - autorewrite with QposElim. - Qauto_le. -apply (regFun_prf x). + intros x e1 e2. + pose (half := fun e:Qpos => ((1#2)*e)%Qpos). + apply ball_weak_le with ((half (half e1)) + ((half (half e1)) + (half (half e1) + (half (half e2))) + (half (half e2))) + (half e2))%Qpos. + unfold half. + autorewrite with QposElim. + Qauto_le. + apply (regFun_prf x). Qed. (** This final law isn't a monad law, rather it completes the isomorphism between a twice completed metric space and a one completed metric space. *) Lemma CunitCjoin : forall a, (Cunit_fun _ (Cjoin_fun (X:=X) a)) =m a. Proof. -intros x e1 e2 d1 d2. -change (ball (d1 + (e1 + e2) + d2) - (approximate (approximate x ((1 # 2) * d1)%Qpos) ((1 # 2) * d1)%Qpos) - (approximate (approximate x e2) d2)). -apply ball_weak_le with (((1 # 2) * d1 + ((1 # 2) * d1 + e2) + d2))%Qpos. - autorewrite with QposElim. - rewrite Qle_minus_iff. - ring_simplify. - auto with *. -apply (regFun_prf x). + intros x e1 e2 d1 d2. + change (ball (d1 + (e1 + e2) + d2) + (approximate (approximate x ((1 # 2) * d1)%Qpos) ((1 # 2) * d1)%Qpos) + (approximate (approximate x e2) d2)). + apply ball_weak_le with (((1 # 2) * d1 + ((1 # 2) * d1 + e2) + d2))%Qpos. + autorewrite with QposElim. + rewrite Qle_minus_iff. + ring_simplify. + auto with *. + apply (regFun_prf x). Qed. End Monad_Laws. @@ -759,28 +746,28 @@ End Monad_Laws. (** The monad laws are sometimes expressed in terms of bind and unit. *) Lemma BindLaw1 : forall X Y (f:X--> Complete Y) a, (st_eq (Cbind_slow f (Cunit_fun _ a)) (f a)). Proof. -intros X Y f a. -change (st_eq (Cjoin (Cmap_slow_fun f (Cunit_fun X a))) (f a)). -rewrite (MonadLaw3 f a). -apply MonadLaw5. + intros X Y f a. + change (st_eq (Cjoin (Cmap_slow_fun f (Cunit_fun X a))) (f a)). + rewrite (MonadLaw3 f a). + apply MonadLaw5. Qed. Lemma BindLaw2 : forall X a, (st_eq (Cbind_slow (Cunit:X --> Complete X) a) a). Proof. -apply MonadLaw6. + apply MonadLaw6. Qed. Lemma BindLaw3 : forall X Y Z (a:Complete X) (f:X --> Complete Y) (g:Y-->Complete Z), (st_eq (Cbind_slow g (Cbind_slow f a)) (Cbind_slow (uc_compose (Cbind_slow g) f) a)). Proof. -intros X Y Z a f g. -change (st_eq (Cjoin (Cmap_slow_fun g (Cjoin_fun (Cmap_slow f a)))) - (Cjoin (Cmap_slow_fun (uc_compose (Cbind_slow g) f) a))). -rewrite (MonadLaw2 (Cbind_slow g) f). -unfold Cbind_slow. -rewrite (MonadLaw4 g). -rewrite (MonadLaw2 (Cjoin (X:=Z)) (Cmap_slow g)). -symmetry. -apply MonadLaw7. + intros X Y Z a f g. + change (st_eq (Cjoin (Cmap_slow_fun g (Cjoin_fun (Cmap_slow f a)))) + (Cjoin (Cmap_slow_fun (uc_compose (Cbind_slow g) f) a))). + rewrite (MonadLaw2 (Cbind_slow g) f). + unfold Cbind_slow. + rewrite (MonadLaw4 g). + rewrite (MonadLaw2 (Cjoin (X:=Z)) (Cmap_slow g)). + symmetry. + apply MonadLaw7. Qed. (** @@ -795,33 +782,33 @@ Let CX_CY := UniformlyContinuousSpace (Complete X) (Complete Y). Lemma Cmap_strong_slow_prf : is_UniformlyContinuousFunction ((Cmap_slow (Y:=Y)):(X_Y -> CX_CY)) Qpos2QposInf. Proof. -intros e f g H x. -apply ball_closed. -intros e0. -set (he0 := ((1#2)*e0)%Qpos). -set (d0 := QposInf_min ((1#2)%Qpos*(mu f he0)) ((1#2)%Qpos*(mu g he0))). -set (a0 := approximate x d0). -setoid_replace (e+e0)%Qpos with (he0 + e + he0)%Qpos by (unfold he0;QposRing). -apply ball_triangle with (Cunit (g a0)). -apply ball_triangle with (Cunit (f a0)). -rewrite <- (MonadLaw3 f a0). -apply: uc_prf. -simpl. -destruct (mu f he0) as [d1|];[|constructor]. -eapply ball_ex_weak_le with d0. -apply QposInf_min_lb_l. -destruct d0 as [d0|];[|constructor]. -apply ball_approx_r. -rewrite ball_Cunit. -apply H. -rewrite <- (MonadLaw3 g a0). -apply: (uc_prf (Cmap_slow g)). -simpl. -destruct (mu g he0) as [d2|];[|constructor]. -eapply ball_ex_weak_le with d0. -apply QposInf_min_lb_r. -destruct d0 as [d0|];[|constructor]. -apply: ball_approx_l. + intros e f g H x. + apply ball_closed. + intros e0. + set (he0 := ((1#2)*e0)%Qpos). + set (d0 := QposInf_min ((1#2)%Qpos*(mu f he0)) ((1#2)%Qpos*(mu g he0))). + set (a0 := approximate x d0). + setoid_replace (e+e0)%Qpos with (he0 + e + he0)%Qpos by (unfold he0;QposRing). + apply ball_triangle with (Cunit (g a0)). + apply ball_triangle with (Cunit (f a0)). + rewrite <- (MonadLaw3 f a0). + apply: uc_prf. + simpl. + destruct (mu f he0) as [d1|];[|constructor]. + eapply ball_ex_weak_le with d0. + apply QposInf_min_lb_l. + destruct d0 as [d0|];[|constructor]. + apply ball_approx_r. + rewrite ball_Cunit. + apply H. + rewrite <- (MonadLaw3 g a0). + apply: (uc_prf (Cmap_slow g)). + simpl. + destruct (mu g he0) as [d2|];[|constructor]. + eapply ball_ex_weak_le with d0. + apply QposInf_min_lb_r. + destruct d0 as [d0|];[|constructor]. + apply: ball_approx_l. Qed. Definition Cmap_strong_slow : (X --> Y) --> (Complete X --> Complete Y) := @@ -829,66 +816,66 @@ Build_UniformlyContinuousFunction Cmap_strong_slow_prf. (** Using strength we can show that [Complete] forms an applicative functor. The [ap] function is useful for making multiple argument maps. -*) +*) Definition Cap_slow_raw (f:Complete (X --> Y)) (x:Complete X) (e:QposInf) := approximate (Cmap_slow (approximate f ((1#2)%Qpos*e)%QposInf) x) ((1#2)%Qpos*e)%QposInf. Lemma Cap_slow_fun_prf (f:Complete (X --> Y)) (x:Complete X) : is_RegularFunction (Cap_slow_raw f x). Proof. -intros f x e1 e2. -unfold Cap_slow_raw. -unfold QposInf_mult, QposInf_bind. -set (he1 := ((1 # 2) * e1)%Qpos). -set (he2 := ((1 # 2) * e2)%Qpos). -set (f1 := (approximate f he1)). -set (f2 := (approximate f he2)). -change (Cmap_slow (Y:=Y) f1) with (Cmap_strong_slow f1). -change (Cmap_slow (Y:=Y) f2) with (Cmap_strong_slow f2). -set (y1 :=(Cmap_strong_slow f1 x)). -set (y2 :=(Cmap_strong_slow f2 x)). -setoid_replace (e1 + e2)%Qpos with (he1 + (he1 + he2) + he2)%Qpos by (unfold he1, he2; QposRing). -rewrite <- ball_Cunit. -apply ball_triangle with y2;[|apply ball_approx_r]. -apply ball_triangle with y1;[apply ball_approx_l|]. -apply (uc_prf Cmap_strong_slow). -apply: regFun_prf. + intros f x e1 e2. + unfold Cap_slow_raw. + unfold QposInf_mult, QposInf_bind. + set (he1 := ((1 # 2) * e1)%Qpos). + set (he2 := ((1 # 2) * e2)%Qpos). + set (f1 := (approximate f he1)). + set (f2 := (approximate f he2)). + change (Cmap_slow (Y:=Y) f1) with (Cmap_strong_slow f1). + change (Cmap_slow (Y:=Y) f2) with (Cmap_strong_slow f2). + set (y1 :=(Cmap_strong_slow f1 x)). + set (y2 :=(Cmap_strong_slow f2 x)). + setoid_replace (e1 + e2)%Qpos with (he1 + (he1 + he2) + he2)%Qpos by (unfold he1, he2; QposRing). + rewrite <- ball_Cunit. + apply ball_triangle with y2;[|apply ball_approx_r]. + apply ball_triangle with y1;[apply ball_approx_l|]. + apply (uc_prf Cmap_strong_slow). + apply: regFun_prf. Qed. Definition Cap_slow_fun (f:Complete (X --> Y)) (x:Complete X) : Complete Y := Build_RegularFunction (Cap_slow_fun_prf f x). -Lemma Cap_slow_help (f:Complete (X --> Y)) (x:Complete X) (e:Qpos) : +Lemma Cap_slow_help (f:Complete (X --> Y)) (x:Complete X) (e:Qpos) : ball e (Cap_slow_fun f x) (Cmap_slow (approximate f e) x). Proof. -intros f x e d1 d2. -set (d1' := ((1 # 2) * d1)%Qpos). -set (f1 := (approximate f d1')). -set (f2 := (approximate f e)). -set (y1 := (Cmap_slow f1 x)). -set (y2 := (Cmap_slow f2 x)). -change (ball (d1 + e + d2) (approximate y1 d1') (approximate y2 d2)). -setoid_replace (d1 + e + d2)%Qpos with (d1' + (d1' + e) + d2)%Qpos by (unfold d1'; QposRing). -rewrite <- ball_Cunit. -apply ball_triangle with y2;[|apply ball_approx_r]. -apply ball_triangle with y1;[apply ball_approx_l|]. -apply: (uc_prf Cmap_strong_slow). -apply: regFun_prf. + intros f x e d1 d2. + set (d1' := ((1 # 2) * d1)%Qpos). + set (f1 := (approximate f d1')). + set (f2 := (approximate f e)). + set (y1 := (Cmap_slow f1 x)). + set (y2 := (Cmap_slow f2 x)). + change (ball (d1 + e + d2) (approximate y1 d1') (approximate y2 d2)). + setoid_replace (d1 + e + d2)%Qpos with (d1' + (d1' + e) + d2)%Qpos by (unfold d1'; QposRing). + rewrite <- ball_Cunit. + apply ball_triangle with y2;[|apply ball_approx_r]. + apply ball_triangle with y1;[apply ball_approx_l|]. + apply: (uc_prf Cmap_strong_slow). + apply: regFun_prf. Qed. Definition Cap_slow_modulus (f:Complete (X --> Y)) (e:Qpos) : QposInf := ((1#2)%Qpos*(mu (approximate f ((1#3)*e)%Qpos) ((1#3)*e)))%QposInf. Lemma Cap_weak_slow_prf (f:Complete (X --> Y)) : is_UniformlyContinuousFunction (Cap_slow_fun f) (Cap_slow_modulus f). Proof. -intros f e x y H. -set (e' := ((1#3)*e)%Qpos). -setoid_replace e with (e'+e'+e')%Qpos by (unfold e';QposRing). -apply ball_triangle with (Cmap_slow (approximate f e') y). -apply ball_triangle with (Cmap_slow (approximate f e') x). -apply Cap_slow_help. -apply (uc_prf). -apply H. -apply ball_sym. -apply Cap_slow_help. + intros f e x y H. + set (e' := ((1#3)*e)%Qpos). + setoid_replace e with (e'+e'+e')%Qpos by (unfold e';QposRing). + apply ball_triangle with (Cmap_slow (approximate f e') y). + apply ball_triangle with (Cmap_slow (approximate f e') x). + apply Cap_slow_help. + apply (uc_prf). + apply H. + apply ball_sym. + apply Cap_slow_help. Qed. Definition Cap_weak_slow (f:Complete (X --> Y)) : Complete X --> Complete Y := @@ -896,17 +883,17 @@ Build_UniformlyContinuousFunction (Cap_weak_slow_prf f). Lemma Cap_slow_prf : is_UniformlyContinuousFunction Cap_weak_slow Qpos2QposInf. Proof. -intros e f1 f2 H x. -apply ball_closed. -intros d. -setoid_replace (e+d)%Qpos with ((1#4)*d + ((1#4)*d + e + (1#4)*d) + (1#4)*d)%Qpos by QposRing. -apply ball_triangle with (Cmap_strong_slow (approximate f2 ((1#4)*d)%Qpos) x). -apply ball_triangle with (Cmap_strong_slow (approximate f1 ((1#4)*d)%Qpos) x). -apply: Cap_slow_help. -apply (uc_prf Cmap_strong_slow). -apply: H. -apply ball_sym. -apply: Cap_slow_help. + intros e f1 f2 H x. + apply ball_closed. + intros d. + setoid_replace (e+d)%Qpos with ((1#4)*d + ((1#4)*d + e + (1#4)*d) + (1#4)*d)%Qpos by QposRing. + apply ball_triangle with (Cmap_strong_slow (approximate f2 ((1#4)*d)%Qpos) x). + apply ball_triangle with (Cmap_strong_slow (approximate f1 ((1#4)*d)%Qpos) x). + apply: Cap_slow_help. + apply (uc_prf Cmap_strong_slow). + apply: H. + apply ball_sym. + apply: Cap_slow_help. Qed. Definition Cap_slow : Complete (X --> Y) --> Complete X --> Complete Y := @@ -914,16 +901,16 @@ Build_UniformlyContinuousFunction Cap_slow_prf. Lemma StrongMonadLaw1 : forall a b, st_eq (Cap_slow_fun (Cunit_fun _ a) b) (Cmap_strong_slow a b). Proof. -intros f x. -apply:regFunEq_e. -intros e. -apply ball_weak_le with ((1#2)*e+e)%Qpos. -autorewrite with QposElim. -rewrite Qle_minus_iff; ring_simplify. -apply: mult_resp_nonneg. -discriminate. -apply Qpos_nonneg. -apply:regFun_prf. + intros f x. + apply:regFunEq_e. + intros e. + apply ball_weak_le with ((1#2)*e+e)%Qpos. + autorewrite with QposElim. + rewrite Qle_minus_iff; ring_simplify. + apply: mult_resp_nonneg. + discriminate. + apply Qpos_nonneg. + apply:regFun_prf. Qed. End Strong_Monad. @@ -932,25 +919,28 @@ End Strong_Monad. Opaque Complete. Add Parametric Morphism X Y : (@Cmap_slow_fun X Y) with signature (@st_eq _) ==> (@st_eq _) ==> (@st_eq _) as Cmap_slow_wd. -intros x1 x2 Hx y1 y2 Hy. -transitivity (Cmap_slow_fun x1 y2). -apply (@uc_wd _ _ (Cmap_slow x1) _ _ Hy). -generalize y2. -apply:(@uc_wd _ _ (Cmap_strong_slow X Y)). -assumption. +Proof. + intros x1 x2 Hx y1 y2 Hy. + transitivity (Cmap_slow_fun x1 y2). + apply (@uc_wd _ _ (Cmap_slow x1) _ _ Hy). + generalize y2. + apply:(@uc_wd _ _ (Cmap_strong_slow X Y)). + assumption. Qed. Add Parametric Morphism X Y : (@Cap_weak_slow X Y) with signature (@st_eq _) ==> (@st_eq _) as Cap_weak_slow_wd. -intros x1 x2 Hx. -apply:(@uc_wd _ _ (Cap_slow X Y));assumption. +Proof. + intros x1 x2 Hx. + apply:(@uc_wd _ _ (Cap_slow X Y));assumption. Qed. Add Parametric Morphism X Y : (@Cap_slow_fun X Y) with signature (@st_eq _) ==> (@st_eq _) ==> (@st_eq _) as Cap_slow_wd. -intros x1 x2 Hx y1 y2 Hy. -transitivity (Cap_slow_fun x1 y2). -apply (@uc_wd _ _ (Cap_weak_slow x1) _ _ Hy). -generalize y2. -apply:(@uc_wd _ _ (Cap_slow X Y));assumption. +Proof. + intros x1 x2 Hx y1 y2 Hy. + transitivity (Cap_slow_fun x1 y2). + apply (@uc_wd _ _ (Cap_weak_slow x1) _ _ Hy). + generalize y2. + apply:(@uc_wd _ _ (Cap_slow X Y));assumption. Qed. Transparent Complete. (* end hide *) @@ -965,40 +955,30 @@ it does not preserve the decidability. *) Lemma Complete_stable : forall X, stableMetric X -> stableMetric (Complete X). Proof. -intros X HX e x y Hb e1 e2. -apply HX. -intros H. -apply Hb. -intros H0. -apply H. -apply H0. + intros X HX e x y Hb e1 e2. + apply HX. + intros H. + apply Hb. + intros H0. + apply H. + apply H0. Qed. Lemma Complete_located : forall X, locatedMetric X -> locatedMetric (Complete X). Proof. -intros X Hx e d x y Hed. -destruct (Qpos_lt_plus Hed) as [c Hc]. -set (c':=((1#5)*c)%Qpos). -assert (H:(c'+e+c')%Qpos < (e+(3#1)*c')%Qpos). - abstract ( - rewrite Qlt_minus_iff; - autorewrite with QposElim; - ring_simplify; - auto with *). -destruct (Hx _ _ (approximate x c') (approximate y c') H) as [H0 | H0]. - left. - abstract ( - change (QposEq d (e+c)) in Hc; - rewrite Hc; - rewrite <- ball_Cunit in H0; - (setoid_replace (e+c)%Qpos with (c' + (e + (3 # 1) * c') + c')%Qpos by (unfold c';QposRing)); - eapply ball_triangle;[eapply ball_triangle;[|apply H0]|]; - [apply ball_approx_r|apply ball_approx_l]). -right. -abstract ( -intros H1; -apply H0; -rewrite <- ball_Cunit; -eapply ball_triangle;[eapply ball_triangle;[|apply H1]|]; - [apply ball_approx_l|apply ball_approx_r]). + intros X Hx e d x y Hed. + destruct (Qpos_lt_plus Hed) as [c Hc]. + set (c':=((1#5)*c)%Qpos). + assert (H:(c'+e+c')%Qpos < (e+(3#1)*c')%Qpos). + abstract ( rewrite Qlt_minus_iff; autorewrite with QposElim; ring_simplify; auto with *). + destruct (Hx _ _ (approximate x c') (approximate y c') H) as [H0 | H0]. + left. + abstract ( change (QposEq d (e+c)) in Hc; rewrite Hc; rewrite <- ball_Cunit in H0; + (setoid_replace (e+c)%Qpos with (c' + (e + (3 # 1) * c') + c')%Qpos by (unfold c';QposRing)); + eapply ball_triangle;[eapply ball_triangle;[|apply H0]|]; + [apply ball_approx_r|apply ball_approx_l]). + right. + abstract ( intros H1; apply H0; rewrite <- ball_Cunit; + eapply ball_triangle;[eapply ball_triangle;[|apply H1]|]; + [apply ball_approx_l|apply ball_approx_r]). Defined. diff --git a/metric2/CompleteProduct.v b/metric2/CompleteProduct.v index d4d78f3b1..43a783ad4 100644 --- a/metric2/CompleteProduct.v +++ b/metric2/CompleteProduct.v @@ -36,8 +36,8 @@ Let XY := ProductMS X Y. (** The projection operations are uniformly continuous *) Lemma fst_uc : is_UniformlyContinuousFunction (fun p:XY => fst p) Qpos2QposInf. Proof. -intros e a b [H _]. -assumption. + intros e a b [H _]. + assumption. Qed. Open Local Scope uc_scope. @@ -47,8 +47,8 @@ Build_UniformlyContinuousFunction fst_uc. Lemma snd_uc : is_UniformlyContinuousFunction (fun p:XY => snd p) Qpos2QposInf. Proof. -intros e a b [_ H]. -assumption. + intros e a b [_ H]. + assumption. Qed. Definition pi2 : XY --> Y := @@ -62,16 +62,16 @@ Definition Csnd_raw (p:Complete XY) (e:QposInf) : Y := Lemma Cfst_prf : forall p, is_RegularFunction (Cfst_raw p). Proof. -intros p e1 e2. -destruct (regFun_prf p e1 e2). -auto. + intros p e1 e2. + destruct (regFun_prf p e1 e2). + auto. Qed. Lemma Csnd_prf : forall p, is_RegularFunction (Csnd_raw p). Proof. -intros p e1 e2. -destruct (regFun_prf p e1 e2). -auto. + intros p e1 e2. + destruct (regFun_prf p e1 e2). + auto. Qed. Definition Cfst_fun (p:Complete XY) : Complete X := @@ -82,16 +82,16 @@ Build_RegularFunction (Csnd_prf p). Lemma Cfst_uc : is_UniformlyContinuousFunction Cfst_fun Qpos2QposInf. Proof. -intros e a b H e1 e2. -destruct (H e1 e2). -auto. + intros e a b H e1 e2. + destruct (H e1 e2). + auto. Qed. Lemma Csnd_uc : is_UniformlyContinuousFunction Csnd_fun Qpos2QposInf. Proof. -intros e a b H e1 e2. -destruct (H e1 e2). -auto. + intros e a b H e1 e2. + destruct (H e1 e2). + auto. Qed. Definition Cfst : Complete XY --> Complete X := @@ -103,16 +103,16 @@ Build_UniformlyContinuousFunction Csnd_uc. (** The pairing function is uniformly continuous *) Lemma pair_uc_l : forall y:Y, @is_UniformlyContinuousFunction X XY (fun x => (x,y)) Qpos2QposInf. Proof. -intros y e a b H. -split; auto. -apply ball_refl. + intros y e a b H. + split; auto. + apply ball_refl. Qed. Lemma pair_uc_r : forall x:X, @is_UniformlyContinuousFunction Y XY (fun y => (x,y)) Qpos2QposInf. Proof. -intros x e a b H. -split; auto. -apply ball_refl. + intros x e a b H. + split; auto. + apply ball_refl. Qed. (** C(X*Y) is isomorphic to (C X)*(C Y) *) @@ -121,8 +121,8 @@ Definition Couple_raw (p: ProductMS (Complete X) (Complete Y)) (e:QposInf): XY : Lemma Couple_prf : forall p, is_RegularFunction (Couple_raw p). Proof. -intros [p1 p2] e1 e2. -split; simpl; apply regFun_prf. + intros [p1 p2] e1 e2. + split; simpl; apply regFun_prf. Qed. Definition Couple_fun (p: ProductMS (Complete X) (Complete Y)) : Complete XY := @@ -130,8 +130,8 @@ Build_RegularFunction (Couple_prf p). Lemma Couple_uc : is_UniformlyContinuousFunction Couple_fun Qpos2QposInf. Proof. -intros e a b [Hl Hr] e1 e2. -split; simpl; auto. + intros e a b [Hl Hr] e1 e2. + split; simpl; auto. Qed. Definition Couple : (ProductMS (Complete X) (Complete Y)) --> (Complete (ProductMS X Y)) := @@ -140,23 +140,23 @@ Build_UniformlyContinuousFunction Couple_uc. Lemma CoupleCorrect1 : forall p, st_eq (Couple ((Cfst p), (Csnd p))) p. Proof. -intros p e1 e2. -destruct (regFun_prf p e1 e2). -split; simpl; auto. + intros p e1 e2. + destruct (regFun_prf p e1 e2). + split; simpl; auto. Qed. Lemma CoupleCorrect2 : forall p q, st_eq (Cfst (Couple (p,q))) p. Proof. -intros p q e1 e2. -apply (regFun_prf p e1 e2). + intros p q e1 e2. + apply (regFun_prf p e1 e2). Qed. Lemma CoupleCorrect3 : forall p q, st_eq (Csnd (Couple (p,q))) q. Proof. -intros p q e1 e2. -apply (regFun_prf q e1 e2). + intros p q e1 e2. + apply (regFun_prf q e1 e2). Qed. End CompleteProduct. @@ -165,4 +165,4 @@ End CompleteProduct. Implicit Arguments Couple [X Y]. Implicit Arguments Cfst [X Y]. Implicit Arguments Csnd [X Y]. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/metric2/FinEnum.v b/metric2/FinEnum.v index 466563939..2079d8204 100644 --- a/metric2/FinEnum.v +++ b/metric2/FinEnum.v @@ -42,99 +42,99 @@ Here we define a classical in predicate for lists. Being classically in a list doesn't tell you which element in the list you are. *) Fixpoint InFinEnumC (x:X) (l:list X) : Prop := -match l with +match l with | nil => False | y::ys => orC (st_eq x y) (InFinEnumC x ys) end. Lemma InFinEnumC_weaken : forall x l, (In x l) -> InFinEnumC x l. Proof. -induction l. - contradiction. -intros [H0|H0]; apply orWeaken. - left. - rewrite H0. - reflexivity. -right. -apply IHl. -assumption. + induction l. + contradiction. + intros [H0|H0]; apply orWeaken. + left. + rewrite H0. + reflexivity. + right. + apply IHl. + assumption. Qed. Lemma InFinEnumC_wd1 : forall x y l, (st_eq x y) -> (InFinEnumC x l <-> InFinEnumC y l). Proof. -induction l. - simpl; tauto. -intros H. -simpl. -cut ((st_eq x a)<->(st_eq y a)). - unfold orC; tauto. -rewrite H. -reflexivity. + induction l. + simpl; tauto. + intros H. + simpl. + cut ((st_eq x a)<->(st_eq y a)). + unfold orC; tauto. + rewrite H. + reflexivity. Qed. Lemma InFinEnumC_stable : forall x l, ~~(InFinEnumC x l) -> InFinEnumC x l. Proof. -induction l. - simpl; auto. -intros H H0. -apply H. -clear H. -intros H. -destruct H as [HG | H | H] using orC_ind; tauto. + induction l. + simpl; auto. + intros H H0. + apply H. + clear H. + intros H. + destruct H as [HG | H | H] using orC_ind; tauto. Qed. Lemma InFinEnumC_app_l : forall x l1 l2, InFinEnumC x l1 -> InFinEnumC x (l1 ++ l2). Proof. -intros x l1 l2 H. -induction l1. - contradiction. -destruct H as [ G | H | H] using orC_ind. - auto using InFinEnumC_stable. + intros x l1 l2 H. + induction l1. + contradiction. + destruct H as [ G | H | H] using orC_ind. + auto using InFinEnumC_stable. + apply: orWeaken. + left. + auto. apply: orWeaken. - left. - auto. -apply: orWeaken. -right. -apply IHl1. -assumption. + right. + apply IHl1. + assumption. Qed. Lemma InFinEnumC_app_r : forall x l1 l2, InFinEnumC x l2 -> InFinEnumC x (l1 ++ l2). Proof. -intros x l1 l2 H. -induction l1. - assumption. -apply: orWeaken. -right. -apply IHl1. + intros x l1 l2 H. + induction l1. + assumption. + apply: orWeaken. + right. + apply IHl1. Qed. (* begin hide *) Hint Resolve InFinEnumC_app_l InFinEnumC_app_r. (* end hide *) Lemma InFinEnumC_app_orC : forall x l1 l2, InFinEnumC x (l1 ++ l2) -> orC (InFinEnumC x l1) (InFinEnumC x l2). Proof. -intros x l1 l2 H. -induction l1. - apply orWeaken. - right. - assumption. -destruct H as [ G | H | H] using orC_ind. - auto using orC_stable. - apply orWeaken. - left. - apply orWeaken. - left. - assumption. -destruct (IHl1 H) as [ G | IH | IH] using orC_ind. - auto using orC_stable. - apply orWeaken. - left. + intros x l1 l2 H. + induction l1. + apply orWeaken. + right. + assumption. + destruct H as [ G | H | H] using orC_ind. + auto using orC_stable. + apply orWeaken. + left. + apply orWeaken. + left. + assumption. + destruct (IHl1 H) as [ G | IH | IH] using orC_ind. + auto using orC_stable. + apply orWeaken. + left. + apply orWeaken. + right. + assumption. apply orWeaken. right. assumption. -apply orWeaken. -right. -assumption. Qed. (** @@ -147,30 +147,31 @@ Definition FinEnum_eq (a b:list X) : Prop := Lemma FinEnum_eq_refl : forall a, FinEnum_eq a a. Proof. -unfold FinEnum_eq. -reflexivity. + unfold FinEnum_eq. + reflexivity. Qed. Lemma FinEnum_eq_sym : forall a b, FinEnum_eq a b -> FinEnum_eq b a. Proof. -unfold FinEnum_eq. -symmetry. -auto. + unfold FinEnum_eq. + symmetry. + auto. Qed. Lemma FinEnum_eq_trans : forall a b c, FinEnum_eq a b -> FinEnum_eq b c -> FinEnum_eq a c. Proof. -unfold FinEnum_eq. -intros a b c H0 H1 x. -transitivity (InFinEnumC x b); auto. + unfold FinEnum_eq. + intros a b c H0 H1 x. + transitivity (InFinEnumC x b); auto. Qed. (* begin hide *) Hint Resolve FinEnum_eq_refl FinEnum_eq_sym FinEnum_eq_trans : FinEnum. (* end hide *) Lemma FinEnum_is_Setoid : Setoid_Theory _ FinEnum_eq. -split; unfold Reflexive, Symmetric, Transitive; auto with *. -apply FinEnum_eq_trans. +Proof. + split; unfold Reflexive, Symmetric, Transitive; auto with *. + apply FinEnum_eq_trans. Qed. Definition FinEnumS : Setoid := Build_Setoid FinEnum_is_Setoid. @@ -180,16 +181,16 @@ Definition FinEnumS : Setoid := Build_Setoid FinEnum_is_Setoid. Finite enumerations form a metric space under the Hausdorff metric for any stable metric space X. *) -Definition FinEnum_ball (e:Qpos) (x y:list X) := +Definition FinEnum_ball (e:Qpos) (x y:list X) := hausdorffBall X e (fun a => InFinEnumC a x) (fun a => InFinEnumC a y). -Lemma FinEnum_ball_wd : forall (e1 e2:Qpos), (e1==e2) -> +Lemma FinEnum_ball_wd : forall (e1 e2:Qpos), (e1==e2) -> forall (a1 a2 : FinEnumS), st_eq a1 a2 -> forall (b1 b2 : FinEnumS), st_eq b1 b2 -> (FinEnum_ball e1 a1 b1 <-> FinEnum_ball e2 a2 b2). Proof. -intros e1 e2 He a1 a2 Ha b1 b2 Hb. -apply hausdorffBall_wd; auto with *. + intros e1 e2 He a1 a2 Ha b1 b2 Hb. + apply hausdorffBall_wd; auto with *. Qed. Hypothesis Xstable : stableMetric X. @@ -198,139 +199,135 @@ Lemma hemiMetric_closed : forall e A b, (forall d, hemiMetric X (e+d) A (fun a => InFinEnumC a b)) -> hemiMetric X e A (fun a => InFinEnumC a b). Proof. -intros e A b H x Hx. -set (P:=fun n y => ball (e+(1#(P_of_succ_nat n)))%Qpos x y). -assert (HP:(forall n, existsC X (fun x => ~~In x b /\ P n x))). - intros n. - unfold P. - destruct (H (1#(P_of_succ_nat n))%Qpos x Hx) as [HG | y [Hy0 Hy1]] using existsC_ind. - apply existsC_stable; auto. - clear - Hy0 Hy1. - induction b. - contradiction. - destruct (Hy0) as [HG | Hy0 | Hy0] using orC_ind. + intros e A b H x Hx. + set (P:=fun n y => ball (e+(1#(P_of_succ_nat n)))%Qpos x y). + assert (HP:(forall n, existsC X (fun x => ~~In x b /\ P n x))). + intros n. + unfold P. + destruct (H (1#(P_of_succ_nat n))%Qpos x Hx) as [HG | y [Hy0 Hy1]] using existsC_ind. + apply existsC_stable; auto. + clear - Hy0 Hy1. + induction b. + contradiction. + destruct (Hy0) as [HG | Hy0 | Hy0] using orC_ind. + apply existsC_stable; auto. + apply existsWeaken. + exists a. + split; auto 7 with *. + rewrite <- Hy0. + assumption. + destruct (IHb Hy0) as [HG | z [Hz0 Hz1]] using existsC_ind. apply existsC_stable; auto. apply existsWeaken. - exists a. + exists z. split; auto 7 with *. - rewrite <- Hy0. - assumption. - destruct (IHb Hy0) as [HG | z [Hz0 Hz1]] using existsC_ind. + destruct (infinitePidgeonHolePrinicple _ _ P HP) as [HG | y [Hy0 Hy1]] using existsC_ind. apply existsC_stable; auto. apply existsWeaken. - exists z. - split; auto 7 with *. -destruct - (infinitePidgeonHolePrinicple _ _ P HP) as [HG | y [Hy0 Hy1]] using existsC_ind. - apply existsC_stable; auto. -apply existsWeaken. -exists y. -split; auto using InFinEnumC_weaken. -apply ball_closed. -intros [n d]. -destruct (Hy1 (nat_of_P d)) as [HG | m [Hmd Hm]] using existsC_ind. - apply Xstable; assumption. -eapply ball_weak_le;[|apply Hm]. -autorewrite with QposElim. -rewrite Qle_minus_iff. -ring_simplify. -rewrite <- Qle_minus_iff. -apply Zmult_le_compat; auto with *. -simpl. -repeat rewrite <- inject_nat_convert. -apply inj_le. -apply le_trans with m; auto. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -auto. + exists y. + split; auto using InFinEnumC_weaken. + apply ball_closed. + intros [n d]. + destruct (Hy1 (nat_of_P d)) as [HG | m [Hmd Hm]] using existsC_ind. + apply Xstable; assumption. + eapply ball_weak_le;[|apply Hm]. + autorewrite with QposElim. + rewrite Qle_minus_iff. + ring_simplify. + rewrite <- Qle_minus_iff. + apply Zmult_le_compat; auto with *. + simpl. + repeat rewrite <- inject_nat_convert. + apply inj_le. + apply le_trans with m; auto. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + auto. Qed. Lemma FinEnum_ball_closed : forall e a b, (forall d, FinEnum_ball (e+d) a b) -> FinEnum_ball e a b. Proof. -unfold FinEnum_ball, hausdorffBall. -intros e a b Hab. -split; - apply hemiMetric_closed; - firstorder. + unfold FinEnum_ball, hausdorffBall. + intros e a b Hab. + split; apply hemiMetric_closed; firstorder. Qed. - -Lemma FinEnum_ball_eq : + +Lemma FinEnum_ball_eq : forall a b : list X, (forall e : Qpos, FinEnum_ball e a b) -> FinEnum_eq a b. Proof. -unfold FinEnum_ball, FinEnum_eq. -cut (forall a b : list X, - (forall e : Qpos, hemiMetric X e (fun a0 : X => InFinEnumC a0 a) - (fun a0 : X => InFinEnumC a0 b)) -> - forall x : X, InFinEnumC x a -> InFinEnumC x b). - unfold hausdorffBall. - split; apply H; firstorder. -induction a. - contradiction. -intros b H x Hx. -destruct Hx as [HG | Hx | Hx] using orC_ind. - auto using InFinEnumC_stable. - assert (H':forall n :nat , - existsC X (fun y : X => InFinEnumC y b /\ ball (m:=X) (1#(P_of_succ_nat n)) x y)). - intros e. - apply H. - apply: orWeaken. - left; assumption. - assert (H'':forall n :nat , - existsC X (fun y : X => ~~In y b /\ ball (m:=X) (1#(P_of_succ_nat n)) x y)). - intros n. - destruct (H' n) as [HG | z [Hz0 Hz1]] using existsC_ind. - auto using existsC_stable. - clear - Hz1 Hz0. - induction b. - contradiction. - destruct (Hz0) as [Hg | Hz0 | Hz0] using orC_ind. + unfold FinEnum_ball, FinEnum_eq. + cut (forall a b : list X, (forall e : Qpos, hemiMetric X e (fun a0 : X => InFinEnumC a0 a) + (fun a0 : X => InFinEnumC a0 b)) -> forall x : X, InFinEnumC x a -> InFinEnumC x b). + unfold hausdorffBall. + split; apply H; firstorder. + induction a. + contradiction. + intros b H x Hx. + destruct Hx as [HG | Hx | Hx] using orC_ind. + auto using InFinEnumC_stable. + assert (H':forall n :nat , + existsC X (fun y : X => InFinEnumC y b /\ ball (m:=X) (1#(P_of_succ_nat n)) x y)). + intros e. + apply H. + apply: orWeaken. + left; assumption. + assert (H'':forall n :nat , + existsC X (fun y : X => ~~In y b /\ ball (m:=X) (1#(P_of_succ_nat n)) x y)). + intros n. + destruct (H' n) as [HG | z [Hz0 Hz1]] using existsC_ind. + auto using existsC_stable. + clear - Hz1 Hz0. + induction b. + contradiction. + destruct (Hz0) as [Hg | Hz0 | Hz0] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists a. + split; auto with *. + rewrite <- Hz0. + assumption. + destruct (IHb Hz0) as [HG | y [Hy0 Hy1]] using existsC_ind. auto using existsC_stable. apply existsWeaken. - exists a. - split; auto with *. - rewrite <- Hz0. - assumption. - destruct (IHb Hz0) as [HG | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. - apply existsWeaken. - exists y. - split; auto 7 with *. - destruct (infinitePidgeonHolePrinicple _ _ _ H'') as [HG | y [Hy0 Hy1]] using existsC_ind. - auto using InFinEnumC_stable. - rewrite (InFinEnumC_wd1 x y). - auto using InFinEnumC_weaken. - apply ball_eq. - intros [n d]. - rewrite (anti_convert_pred_convert d). - destruct (Hy1 (pred (nat_of_P d))) as [HG | z [Hz0 Hz1]] using existsC_ind. - auto using Xstable. - apply ball_weak_le with (1 # P_of_succ_nat z)%Qpos; auto. - apply Zmult_le_compat; auto with *. - simpl. - repeat rewrite <- POS_anti_convert. - apply inj_le. - auto with *. -apply IHa; auto. -intros e y Hy. -apply H. -apply orWeaken. -right. -assumption. + exists y. + split; auto 7 with *. + destruct (infinitePidgeonHolePrinicple _ _ _ H'') as [HG | y [Hy0 Hy1]] using existsC_ind. + auto using InFinEnumC_stable. + rewrite (InFinEnumC_wd1 x y). + auto using InFinEnumC_weaken. + apply ball_eq. + intros [n d]. + rewrite (anti_convert_pred_convert d). + destruct (Hy1 (pred (nat_of_P d))) as [HG | z [Hz0 Hz1]] using existsC_ind. + auto using Xstable. + apply ball_weak_le with (1 # P_of_succ_nat z)%Qpos; auto. + apply Zmult_le_compat; auto with *. + simpl. + repeat rewrite <- POS_anti_convert. + apply inj_le. + auto with *. + apply IHa; auto. + intros e y Hy. + apply H. + apply orWeaken. + right. + assumption. Qed. Lemma FinEnum_is_MetricSpace : is_MetricSpace FinEnumS FinEnum_ball. -split. - intros e x. - apply hausdorffBall_refl. - intros e x y. - apply hausdorffBall_sym. - intros e d x y z. - apply hausdorffBall_triangle. - intros e x y. - unfold FinEnum_ball. - apply FinEnum_ball_closed. -apply FinEnum_ball_eq. +Proof. + split. + intros e x. + apply hausdorffBall_refl. + intros e x y. + apply hausdorffBall_sym. + intros e d x y z. + apply hausdorffBall_triangle. + intros e x y. + unfold FinEnum_ball. + apply FinEnum_ball_closed. + apply FinEnum_ball_eq. Qed. Definition FinEnum : MetricSpace := @@ -339,46 +336,42 @@ Build_MetricSpace FinEnum_ball_wd FinEnum_is_MetricSpace. (** Our definition preserves stability *) Lemma FinEnum_stable : stableMetric FinEnum. Proof. -intros e x y. -apply: hausdorffBall_stable. + intros e x y. + apply: hausdorffBall_stable. Qed. -Lemma FinEum_map_ball : forall (f:X -> X) e (s:FinEnum), +Lemma FinEum_map_ball : forall (f:X -> X) e (s:FinEnum), (forall x, ball e x (f x)) -> ball e s (map f s). Proof. -intros f e s H. -induction s. - split; intros a b; contradiction. -destruct IHs as [IHs0 IHs1]. -split; - intros x y; - (destruct y as [G | y | y] using orC_ind; - [auto using existsC_stable - |apply existsWeaken - |]). - exists (f a);split. - apply: orWeaken; left; reflexivity. - rewrite y; apply H. - destruct (IHs0 x y) as [G | z [Hz0 Hz1]] using existsC_ind. - auto using existsC_stable. - apply existsWeaken. - exists z. - split; auto. - apply: orWeaken. - right; assumption. - exists a. - split. - apply orWeaken; left; reflexivity. - apply ball_sym. - rewrite y. - apply H. -destruct (IHs1 x y) as [G | z [Hz0 Hz1]] using existsC_ind. - auto using existsC_stable. -apply existsWeaken. -exists z. -split; auto. -apply orWeaken. -right; assumption. + intros f e s H. + induction s. + split; intros a b; contradiction. + destruct IHs as [IHs0 IHs1]. + split; intros x y; (destruct y as [G | y | y] using orC_ind; [auto using existsC_stable + |apply existsWeaken |]). + exists (f a);split. + apply: orWeaken; left; reflexivity. + rewrite y; apply H. + destruct (IHs0 x y) as [G | z [Hz0 Hz1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists z. + split; auto. + apply: orWeaken. + right; assumption. + exists a. + split. + apply orWeaken; left; reflexivity. + apply ball_sym. + rewrite y. + apply H. + destruct (IHs1 x y) as [G | z [Hz0 Hz1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists z. + split; auto. + apply orWeaken. + right; assumption. Qed. Section Strong. @@ -392,159 +385,102 @@ Hypothesis almostDecideX : locatedMetric X. Lemma HemiMetricHemiMetricStrong : forall (e:Qpos) A b, hemiMetric X e A (fun a => InFinEnumC a b) -> hemiMetricStrong X e A (fun a => InFinEnumC a b). Proof. -intros e A b H x Hx. -generalize (H x Hx). -clear H. -revert x Hx. -induction b; intros x Hx H d. - elimtype False. - clear -H. - abstract ( - generalize H; - apply existsC_ind;[tauto|]; - intros y [Hy0 Hy1]; - apply Hy0). -destruct (@almostDecideX e (e+d)%Qpos x a). - clear - e d. - abstract ( - autorewrite with QposElim; - rewrite Qlt_minus_iff; - ring_simplify; - auto with * ). - exists a. - clear - b0. - abstract (auto using InFinEnumC_weaken with *). -assert (Z:existsC X (fun y : X => InFinEnumC y b /\ ball (m:=X) e x y)). - clear - H n. - abstract ( - destruct (H) as [HG | y [Hy0 Hy1]] using existsC_ind; - [auto using existsC_stable|]; - apply existsWeaken; - exists y; - split; auto; - destruct Hy0 as [HG | Hy | Hy] using orC_ind; - [auto using InFinEnumC_stable - |rewrite -> Hy in Hy1; contradiction - |assumption]). -exists (let (y,_) := (IHb x Hx Z d) in y). -clear - IHb. -abstract ( -destruct (IHb x Hx Z d) as [y [Hy0 Hy1]]; -split; auto; -apply orWeaken; -auto). + intros e A b H x Hx. + generalize (H x Hx). + clear H. + revert x Hx. + induction b; intros x Hx H d. + elimtype False. + clear -H. + abstract ( generalize H; apply existsC_ind;[tauto|]; intros y [Hy0 Hy1]; apply Hy0). + destruct (@almostDecideX e (e+d)%Qpos x a). + clear - e d. + abstract ( autorewrite with QposElim; rewrite Qlt_minus_iff; ring_simplify; auto with * ). + exists a. + clear - b0. + abstract (auto using InFinEnumC_weaken with *). + assert (Z:existsC X (fun y : X => InFinEnumC y b /\ ball (m:=X) e x y)). + clear - H n. + abstract ( destruct (H) as [HG | y [Hy0 Hy1]] using existsC_ind; [auto using existsC_stable|]; + apply existsWeaken; exists y; split; auto; destruct Hy0 as [HG | Hy | Hy] using orC_ind; + [auto using InFinEnumC_stable |rewrite -> Hy in Hy1; contradiction |assumption]). + exists (let (y,_) := (IHb x Hx Z d) in y). + clear - IHb. + abstract ( destruct (IHb x Hx Z d) as [y [Hy0 Hy1]]; split; auto; apply orWeaken; auto). Defined. Lemma HausdorffBallHausdorffBallStrong : forall (e:Qpos) (a b:FinEnum), - ball e a b -> + ball e a b -> hausdorffBallStrong X e (fun x => InFinEnumC x a) (fun x => InFinEnumC x b). Proof. -intros e a b [H0 H1]. -split; apply HemiMetricHemiMetricStrong; assumption. + intros e a b [H0 H1]. + split; apply HemiMetricHemiMetricStrong; assumption. Defined. -Lemma HemiMetricStrongAlmostDecidableBody : +Lemma HemiMetricStrongAlmostDecidableBody : forall (e d:Qpos) a (b : FinEnum), - e < d -> - {hemiMetric X d (fun x => st_eq x a) (fun x => InFinEnumC x b)} + + e < d -> + {hemiMetric X d (fun x => st_eq x a) (fun x => InFinEnumC x b)} + {~hemiMetric X e (fun x => st_eq x a) (fun x => InFinEnumC x b)}. Proof. -intros e d a b. -induction b. + intros e d a b. + induction b. + intros Hed. + right. + abstract ( intros H; apply (H a); try reflexivity; intros x [Hx0 Hx1]; + auto using InFinEnumC_weaken with *). intros Hed. + destruct (IHb Hed) as [H|H]. + left. + abstract ( intros x Hx; destruct (H x Hx) as [HG | z [Hz0 Hz1]] using existsC_ind; + [apply existsC_stable; auto|]; apply existsWeaken; exists z; split; try assumption; apply orWeaken; + auto). + destruct (almostDecideX a a0 Hed). + left. + abstract ( intros x Hx; apply existsWeaken; exists a0; rewrite Hx; + auto using InFinEnumC_weaken with *). right. - abstract ( - intros H; - apply (H a); try reflexivity; - intros x [Hx0 Hx1]; - auto using InFinEnumC_weaken with *). -intros Hed. -destruct (IHb Hed) as [H|H]. - left. - abstract ( - intros x Hx; - destruct (H x Hx) as [HG | z [Hz0 Hz1]] using existsC_ind; - [apply existsC_stable; auto|]; - apply existsWeaken; - exists z; - split; try assumption; - apply orWeaken; - auto). -destruct (almostDecideX a a0 Hed). - left. - abstract ( - intros x Hx; - apply existsWeaken; - exists a0; - rewrite Hx; - auto using InFinEnumC_weaken with *). -right. -abstract ( -intros H0; -assert (Haa:st_eq a a) by reflexivity; -destruct (H0 a Haa) as [HG | z [Hz0 Hz1]] using existsC_ind; - [tauto|]; -destruct (Hz0) as [HG | Hz0 | Hz0] using orC_ind; - [tauto - |rewrite -> Hz0 in Hz1; contradiction - |]; -apply H; -intros x Hx; -apply existsWeaken; -exists z; -rewrite Hx; -auto). + abstract ( intros H0; assert (Haa:st_eq a a) by reflexivity; + destruct (H0 a Haa) as [HG | z [Hz0 Hz1]] using existsC_ind; [tauto|]; + destruct (Hz0) as [HG | Hz0 | Hz0] using orC_ind; [tauto |rewrite -> Hz0 in Hz1; contradiction + |]; apply H; intros x Hx; apply existsWeaken; exists z; rewrite Hx; auto). Defined. - -Lemma HemiMetricStrongAlmostDecidable : + +Lemma HemiMetricStrongAlmostDecidable : forall (e d:Qpos) (a b : FinEnum), - e < d -> - {hemiMetric X d (fun x => InFinEnumC x a) (fun x => InFinEnumC x b)} + + e < d -> + {hemiMetric X d (fun x => InFinEnumC x a) (fun x => InFinEnumC x b)} + {~hemiMetric X e (fun x => InFinEnumC x a) (fun x => InFinEnumC x b)}. Proof. -induction a. - intros a _. - left. - intros x Hx _. - apply Hx. -intros b Hed. -destruct (IHa b Hed) as [I|I]. - destruct (HemiMetricStrongAlmostDecidableBody a b Hed) as [J|J]. + induction a. + intros a _. left. - abstract ( - intros x Hx; - destruct (Hx) as [HG | Hx | Hx] using orC_ind; - [auto using existsC_stable - |apply J; assumption - |apply I; assumption]). + intros x Hx _. + apply Hx. + intros b Hed. + destruct (IHa b Hed) as [I|I]. + destruct (HemiMetricStrongAlmostDecidableBody a b Hed) as [J|J]. + left. + abstract ( intros x Hx; destruct (Hx) as [HG | Hx | Hx] using orC_ind; [auto using existsC_stable + |apply J; assumption |apply I; assumption]). + right. + abstract ( intros H; apply J; intros x Hx; apply H; apply orWeaken; left; assumption). right. - abstract ( - intros H; - apply J; - intros x Hx; - apply H; - apply orWeaken; left; assumption). -right. -abstract ( -intros H; -apply I; -intros x Hx; -apply H; -apply orWeaken; right; assumption). + abstract ( intros H; apply I; intros x Hx; apply H; apply orWeaken; right; assumption). Defined. (** Finite Enumerations preserve the locatedness property. *) Lemma FinEnum_located : locatedMetric FinEnum. Proof. -intros e d a b Hed. -destruct (HemiMetricStrongAlmostDecidable a b Hed). - destruct (HemiMetricStrongAlmostDecidable b a Hed). - left. - split; assumption. + intros e d a b Hed. + destruct (HemiMetricStrongAlmostDecidable a b Hed). + destruct (HemiMetricStrongAlmostDecidable b a Hed). + left. + split; assumption. + right. + abstract (intros [_ H]; contradiction). right. - abstract (intros [_ H]; contradiction). -right. -abstract (intros [H _]; contradiction). + abstract (intros [H _]; contradiction). Defined. (** Finite Enumerations preserve the prelength property assuming X @@ -558,113 +494,68 @@ Hypothesis preLengthX : PrelengthSpace X. Lemma FinEnum_prelength : PrelengthSpace FinEnum. Proof. -intros a b e. -revert a b. -cut (forall d1 d2 : Qpos, - e < d1 + d2 -> - forall (a b:FinEnum), hemiMetricStrong X e (fun x : X => InFinEnumC x a) - (fun x : X => InFinEnumC x b) -> -exists2 c : FinEnum, ball d1 a c & hemiMetric X d2 (fun x : X => InFinEnumC x c) (fun x : X => InFinEnumC x b)). - intros Z a b d1 d2 He H. - destruct (HausdorffBallHausdorffBallStrong H) as [Hl Hr]. + intros a b e. + revert a b. + cut (forall d1 d2 : Qpos, e < d1 + d2 -> + forall (a b:FinEnum), hemiMetricStrong X e (fun x : X => InFinEnumC x a) + (fun x : X => InFinEnumC x b) -> + exists2 c : FinEnum, ball d1 a c & hemiMetric X d2 (fun x : X => InFinEnumC x c) (fun x : X => InFinEnumC x b)). + intros Z a b d1 d2 He H. + destruct (HausdorffBallHausdorffBallStrong H) as [Hl Hr]. + clear H. + destruct (Z _ _ He _ _ Hl) as [c0 Hc0 Hc0c]. + assert (He0:e < d2 + d1). + clear - He. + abstract (rewrite Qplus_comm; assumption). + destruct (Z _ _ He0 _ _ Hr) as [c1 Hc1 Hc1c]. + clear Z Hl Hr. + exists (c0 ++ c1). + abstract ( destruct Hc0 as [Hc0a Hc0b]; destruct Hc1 as [Hc1a Hc1b]; split; intros x Hx; + [destruct (Hc0a x Hx) as [ G | y [Hya Hyb]] using existsC_ind; + [auto using existsC_stable | apply existsWeaken; exists y; auto] + |destruct (InFinEnumC_app_orC _ _ _ Hx) as [G | Hxl | Hxr] using orC_ind; + [auto using existsC_stable |destruct (Hc0b x Hxl) as [ G | y [Hya Hyb]] using existsC_ind; + [auto using existsC_stable | apply existsWeaken; exists y; auto] + |destruct (Hc1c x Hxr) as [ G | y [Hya Hyb]] using existsC_ind; + [auto using existsC_stable | apply existsWeaken; exists y; auto]]]). + abstract ( destruct Hc0 as [Hc0a Hc0b]; destruct Hc1 as [Hc1a Hc1b]; split; intros x Hx; + [destruct (InFinEnumC_app_orC _ _ _ Hx) as [G | Hxl | Hxr] using orC_ind; + [auto using existsC_stable |destruct (Hc0c x Hxl) as [ G | y [Hya Hyb]] using existsC_ind; + [auto using existsC_stable | apply existsWeaken; exists y; auto] + |destruct (Hc1b x Hxr) as [ G | y [Hya Hyb]] using existsC_ind; + [auto using existsC_stable | apply existsWeaken; exists y; auto]] + |destruct (Hc1a x Hx) as [ G | y [Hya Hyb]] using existsC_ind; + [auto using existsC_stable | apply existsWeaken; exists y; auto]]). + intros d1 d2 He a b H. + induction a. + exists nil. + apply ball_refl. + intros x Hx; elim Hx. + destruct IHa as [c1 Hc1a Hc1b]. + abstract ( intros x Hx d; apply (H x); apply orWeaken; right; auto). + destruct (Qpos_lt_plus He) as [g Hg]. + destruct (fun z => H a z ((1#2)*g)%Qpos) as [b0 Hb0]. + abstract (apply orWeaken; left; reflexivity). clear H. - destruct (Z _ _ He _ _ Hl) as [c0 Hc0 Hc0c]. - assert (He0:e < d2 + d1). - clear - He. - abstract (rewrite Qplus_comm; assumption). - destruct (Z _ _ He0 _ _ Hr) as [c1 Hc1 Hc1c]. - clear Z Hl Hr. - exists (c0 ++ c1). - abstract ( - destruct Hc0 as [Hc0a Hc0b]; - destruct Hc1 as [Hc1a Hc1b]; - split; intros x Hx; - [destruct (Hc0a x Hx) as [ G | y [Hya Hyb]] using existsC_ind; - [auto using existsC_stable | apply existsWeaken; exists y; auto] - |destruct (InFinEnumC_app_orC _ _ _ Hx) as [G | Hxl | Hxr] using orC_ind; - [auto using existsC_stable - |destruct (Hc0b x Hxl) as [ G | y [Hya Hyb]] using existsC_ind; - [auto using existsC_stable | apply existsWeaken; exists y; auto] - |destruct (Hc1c x Hxr) as [ G | y [Hya Hyb]] using existsC_ind; - [auto using existsC_stable | apply existsWeaken; exists y; auto]]]). - abstract ( - destruct Hc0 as [Hc0a Hc0b]; - destruct Hc1 as [Hc1a Hc1b]; - split; intros x Hx; - [destruct (InFinEnumC_app_orC _ _ _ Hx) as [G | Hxl | Hxr] using orC_ind; - [auto using existsC_stable - |destruct (Hc0c x Hxl) as [ G | y [Hya Hyb]] using existsC_ind; - [auto using existsC_stable | apply existsWeaken; exists y; auto] - |destruct (Hc1b x Hxr) as [ G | y [Hya Hyb]] using existsC_ind; - [auto using existsC_stable | apply existsWeaken; exists y; auto]] - |destruct (Hc1a x Hx) as [ G | y [Hya Hyb]] using existsC_ind; - [auto using existsC_stable | apply existsWeaken; exists y; auto]]). -intros d1 d2 He a b H. -induction a. - exists nil. - apply ball_refl. - intros x Hx; elim Hx. -destruct IHa as [c1 Hc1a Hc1b]. - abstract ( - intros x Hx d; - apply (H x); - apply orWeaken; - right; auto). -destruct (Qpos_lt_plus He) as [g Hg]. -destruct (fun z => H a z ((1#2)*g)%Qpos) as [b0 Hb0]. - abstract (apply orWeaken; left; reflexivity). -clear H. -destruct (@preLengthX a b0 (e + (1 # 2) * g)%Qpos d1 d2) as [c Hc0 Hc1]. - abstract ( clear - Hg; - rewrite Hg; - autorewrite with QposElim; - rewrite Qlt_minus_iff; - ring_simplify; - Qauto_pos). - abstract (clear - Hb0; destruct Hb0; auto). -exists (c :: c1). - abstract ( - split; intros x Hx; - [destruct Hx as [ G | Hx | Hx ] using orC_ind; - [auto using existsC_stable - |apply existsWeaken; - exists c; - split; - [apply orWeaken;left; reflexivity - |rewrite Hx; auto] - |destruct Hc1a as [Hc1a _]; - destruct (Hc1a x Hx) as [ G | y [Hy0 Hy1]] using existsC_ind; - [auto using existsC_stable|]; - apply existsWeaken; - exists y; - split; auto; - apply orWeaken; - right; auto] - |destruct Hx as [ G | Hx | Hx ] using orC_ind; - [auto using existsC_stable - |apply existsWeaken; - exists a; - split; - [apply orWeaken;left; reflexivity - |rewrite Hx; auto with *] - |destruct Hc1a as [_ Hc1a]; - destruct (Hc1a x Hx) as [ G | y [Hy0 Hy1]] using existsC_ind; - [auto using existsC_stable|]; - apply existsWeaken; - exists y; - split; auto; - apply orWeaken; - right; auto]]). -abstract ( -destruct Hb0 as [Hb0a Hb0b]; -intros x Hx; -destruct Hx as [ G | Hx | Hx ] using orC_ind; -[auto using existsC_stable -|apply existsWeaken; - exists b0; - split; auto; - rewrite Hx; auto -|apply Hc1b; auto]). + destruct (@preLengthX a b0 (e + (1 # 2) * g)%Qpos d1 d2) as [c Hc0 Hc1]. + abstract ( clear - Hg; rewrite Hg; autorewrite with QposElim; rewrite Qlt_minus_iff; ring_simplify; + Qauto_pos). + abstract (clear - Hb0; destruct Hb0; auto). + exists (c :: c1). + abstract ( split; intros x Hx; [destruct Hx as [ G | Hx | Hx ] using orC_ind; + [auto using existsC_stable |apply existsWeaken; exists c; split; [apply orWeaken;left; reflexivity + |rewrite Hx; auto] |destruct Hc1a as [Hc1a _]; + destruct (Hc1a x Hx) as [ G | y [Hy0 Hy1]] using existsC_ind; [auto using existsC_stable|]; + apply existsWeaken; exists y; split; auto; apply orWeaken; right; auto] + |destruct Hx as [ G | Hx | Hx ] using orC_ind; [auto using existsC_stable + |apply existsWeaken; exists a; split; [apply orWeaken;left; reflexivity + |rewrite Hx; auto with *] |destruct Hc1a as [_ Hc1a]; + destruct (Hc1a x Hx) as [ G | y [Hy0 Hy1]] using existsC_ind; + [auto using existsC_stable|]; apply existsWeaken; exists y; split; auto; + apply orWeaken; right; auto]]). + abstract ( destruct Hb0 as [Hb0a Hb0b]; intros x Hx; destruct Hx as [ G | Hx | Hx ] using orC_ind; + [auto using existsC_stable |apply existsWeaken; exists b0; split; auto; rewrite Hx; auto + |apply Hc1b; auto]). Defined. @@ -678,47 +569,48 @@ Implicit Arguments InFinEnumC [X]. Lemma FinEnum_eq_rev : forall X (stable: stableMetric X) (f:FinEnum stable), st_eq f (rev f). Proof. -induction f. - change (st_eq (nil:FinEnum stable) (nil:FinEnum stable)). - reflexivity. -intros x. -destruct (IHf x) as [H0 H1]. -split; simpl; intros H. - destruct H as [G|H|H] using orC_ind. - auto using InFinEnumC_stable. - apply InFinEnumC_app_r. + induction f. + change (st_eq (nil:FinEnum stable) (nil:FinEnum stable)). + reflexivity. + intros x. + destruct (IHf x) as [H0 H1]. + split; simpl; intros H. + destruct H as [G|H|H] using orC_ind. + auto using InFinEnumC_stable. + apply InFinEnumC_app_r. + apply orWeaken. + left; auto. + apply InFinEnumC_app_l. + auto. + destruct (InFinEnumC_app_orC _ _ _ _ H) as [G |A | A] using orC_ind. + auto using orC_stable. + apply orWeaken. + right. + auto. + destruct A as [G | A| A] using orC_ind. + auto using orC_stable. apply orWeaken. left; auto. - apply InFinEnumC_app_l. - auto. -destruct (InFinEnumC_app_orC _ _ _ _ H) as [G |A | A] using orC_ind. - auto using orC_stable. - apply orWeaken. - right. - auto. -destruct A as [G | A| A] using orC_ind. - auto using orC_stable. - apply orWeaken. - left; auto. -contradiction. + contradiction. Qed. Open Local Scope uc_scope. (** [map] is compatable with classical in *) Lemma InFinEnumC_map : forall (X Y:MetricSpace) (f:X --> Y) a l, InFinEnumC a l -> InFinEnumC (f a) (map f l). -induction l. - auto. -intros Ha. -destruct Ha as [G | Ha | Ha] using orC_ind. - auto using InFinEnumC_stable. +Proof. + induction l. + auto. + intros Ha. + destruct Ha as [G | Ha | Ha] using orC_ind. + auto using InFinEnumC_stable. + apply: orWeaken. + left. + rewrite Ha; reflexivity. apply: orWeaken. - left. - rewrite Ha; reflexivity. -apply: orWeaken. -right. -apply IHl. -auto. + right. + apply IHl. + auto. Qed. (** The map function for finite enumerations is uniformly continuous *) @@ -732,50 +624,49 @@ end. even if f is the constant function *) Lemma FinEnum_map_uc : forall z X Y (SX:stableMetric X) (SY:stableMetric Y) (f:X --> Y), is_UniformlyContinuousFunction (map f:FinEnum SX -> FinEnum SY) (FinEnum_map_modulus z (mu f)). Proof. -intros z X Y SX SY f e. -cut (forall (a b : FinEnum SX) (d:Qpos), (QposInf_le d (mu f e)) -> - ball d a b -> ball (m:=FinEnum SY) e (map f a) (map f b)). - intros Z a b. - unfold FinEnum_map_modulus. - case_eq (mu f e). - intros d Hd H. - apply Z with d; auto. - rewrite Hd. - simpl; auto with *. - intros He H. - apply Z with z; auto. - rewrite He. - constructor. -revert e. -cut (forall (e d:Qpos), (QposInf_le d (mu f e)) -> forall (s1 s2 : FinEnum SX), - hemiMetric X d (fun a => InFinEnumC a s1) (fun a => InFinEnumC a s2) -> - hemiMetric Y e (fun a => InFinEnumC a (map f s1:FinEnum SY)) - (fun a => InFinEnumC a (map f s2))). - intros Z e s1 s2 d Hd [H0 H1]. - split; apply (Z e d Hd); assumption. -intros e d Hd s1 s2. -intros H a Ha. -induction s1. - contradiction. -destruct Ha as [G | Ha | Ha] using orC_ind. - auto using existsC_stable. - assert (Ha0:InFinEnumC a0 (a0::s1)). - apply orWeaken. - left; reflexivity. - destruct (H a0 Ha0) as [G | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. - apply existsWeaken. - exists (f y). - split. - apply InFinEnumC_map; assumption. - rewrite Ha. - apply (uc_prf f). - apply ball_ex_weak_le with d; auto. -apply IHs1; auto. -intros b Hb. + intros z X Y SX SY f e. + cut (forall (a b : FinEnum SX) (d:Qpos), (QposInf_le d (mu f e)) -> + ball d a b -> ball (m:=FinEnum SY) e (map f a) (map f b)). + intros Z a b. + unfold FinEnum_map_modulus. + case_eq (mu f e). + intros d Hd H. + apply Z with d; auto. + rewrite Hd. + simpl; auto with *. + intros He H. + apply Z with z; auto. + rewrite He. + constructor. + revert e. + cut (forall (e d:Qpos), (QposInf_le d (mu f e)) -> forall (s1 s2 : FinEnum SX), + hemiMetric X d (fun a => InFinEnumC a s1) (fun a => InFinEnumC a s2) -> + hemiMetric Y e (fun a => InFinEnumC a (map f s1:FinEnum SY)) (fun a => InFinEnumC a (map f s2))). + intros Z e s1 s2 d Hd [H0 H1]. + split; apply (Z e d Hd); assumption. + intros e d Hd s1 s2. + intros H a Ha. + induction s1. + contradiction. + destruct Ha as [G | Ha | Ha] using orC_ind. + auto using existsC_stable. + assert (Ha0:InFinEnumC a0 (a0::s1)). + apply orWeaken. + left; reflexivity. + destruct (H a0 Ha0) as [G | y [Hy0 Hy1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists (f y). + split. + apply InFinEnumC_map; assumption. + rewrite Ha. + apply (uc_prf f). + apply ball_ex_weak_le with d; auto. + apply IHs1; auto. + intros b Hb. apply H. -apply orWeaken. -right; assumption. + apply orWeaken. + right; assumption. Qed. (* begin hide *) Implicit Arguments FinEnum_map_uc [X Y]. @@ -787,54 +678,54 @@ Definition FinEnum_map z X Y (SX:stableMetric X) (SY:stableMetric Y) (f:X --> Y) preserves the metric *) Lemma FinEnum_map_Cunit : forall X (SX:stableMetric X) SCX (s1 s2:FinEnum SX) e, ball e s1 s2 <-> ball e (map Cunit s1:FinEnum SCX) (map Cunit s2). Proof. -intros X SX SCX s1 s2 e. -split. - intros H. - apply (@FinEnum_map_uc (1#1) _ _ SX SCX). - assumption. -revert s1 s2. -cut (forall (s1 s2 : FinEnum SX) , + intros X SX SCX s1 s2 e. + split. + intros H. + apply (@FinEnum_map_uc (1#1) _ _ SX SCX). + assumption. + revert s1 s2. + cut (forall (s1 s2 : FinEnum SX) , hemiMetric (Complete X) e (fun a => InFinEnumC a (map Cunit s1:FinEnum SCX)) - (fun a => InFinEnumC a (map Cunit s2)) -> - hemiMetric X e (fun a => InFinEnumC a s1) (fun a => InFinEnumC a s2)). - intros Z s1 s2. - intros [H0 H1]. - split; apply Z; assumption. -intros s1 s2 H a Ha. -induction s1. - contradiction. -destruct Ha as [G | Ha | Ha] using orC_ind. - auto using existsC_stable. - clear IHs1. - assert (Ha0:InFinEnumC (Cunit a0) (map Cunit (a0::s1))). - apply: orWeaken. - left; reflexivity. - destruct (H _ Ha0) as [G | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. - clear - Ha Hy0 Hy1. - induction s2. + (fun a => InFinEnumC a (map Cunit s2)) -> + hemiMetric X e (fun a => InFinEnumC a s1) (fun a => InFinEnumC a s2)). + intros Z s1 s2. + intros [H0 H1]. + split; apply Z; assumption. + intros s1 s2 H a Ha. + induction s1. contradiction. - destruct Hy0 as [G | Hy0 | Hy0] using orC_ind. + destruct Ha as [G | Ha | Ha] using orC_ind. auto using existsC_stable. - apply existsWeaken. - exists a1. - split. - apply orWeaken. + clear IHs1. + assert (Ha0:InFinEnumC (Cunit a0) (map Cunit (a0::s1))). + apply: orWeaken. left; reflexivity. - rewrite Ha. - rewrite <- ball_Cunit. - rewrite <- Hy0. - assumption. - destruct (IHs2 Hy0) as [G | z [Hz0 Hz1]] using existsC_ind. - auto using existsC_stable. - apply existsWeaken. - exists z. - split; auto. - apply orWeaken. + destruct (H _ Ha0) as [G | y [Hy0 Hy1]] using existsC_ind. + auto using existsC_stable. + clear - Ha Hy0 Hy1. + induction s2. + contradiction. + destruct Hy0 as [G | Hy0 | Hy0] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists a1. + split. + apply orWeaken. + left; reflexivity. + rewrite Ha. + rewrite <- ball_Cunit. + rewrite <- Hy0. + assumption. + destruct (IHs2 Hy0) as [G | z [Hz0 Hz1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists z. + split; auto. + apply orWeaken. + right; assumption. + apply IHs1; auto. + intros b Hb. + apply H. + apply: orWeaken. right; assumption. -apply IHs1; auto. -intros b Hb. -apply H. -apply: orWeaken. -right; assumption. -Qed. \ No newline at end of file +Qed. diff --git a/metric2/Graph.v b/metric2/Graph.v index 04104056a..db4df7064 100644 --- a/metric2/Graph.v +++ b/metric2/Graph.v @@ -51,7 +51,7 @@ Open Local Scope uc_scope. Variable f : X --> Y. -Definition graphPoint_modulus (e:Qpos) : Qpos := +Definition graphPoint_modulus (e:Qpos) : Qpos := match (mu f e) with | QposInfinity => e | Qpos2QposInf d => Qpos_min e d @@ -59,19 +59,19 @@ end. Lemma graphPoint_uc : is_UniformlyContinuousFunction (graphPoint_raw f) graphPoint_modulus. Proof. -intros e a b H. -unfold graphPoint_modulus in *. -split. - change (ball_ex e a b). + intros e a b H. + unfold graphPoint_modulus in *. + split. + change (ball_ex e a b). + eapply ball_ex_weak_le;[|apply H]. + destruct (mu f e) as [d|]. + apply Qpos_min_lb_l. + apply Qle_refl. + apply: uc_prf. eapply ball_ex_weak_le;[|apply H]. destruct (mu f e) as [d|]. - apply Qpos_min_lb_l. - apply Qle_refl. -apply: uc_prf. -eapply ball_ex_weak_le;[|apply H]. -destruct (mu f e) as [d|]. - apply Qpos_min_lb_r. -constructor. + apply Qpos_min_lb_r. + constructor. Qed. Definition graphPoint : X --> XY := @@ -87,199 +87,191 @@ CompactImage (1#1) _ plFEX graphPoint. Lemma CompactGraph_correct1 : forall plX plFEX x s, (inCompact x s) -> inCompact (Couple (x,(Cmap plX f x))) (CompactGraph plFEX s). -intros plX plFEX x s Hs. -unfold CompactGraph. -setoid_replace (Couple (X:=X) (Y:=Y) (x, (Cmap plX f x))) with (Cmap plX graphPoint x). - auto using CompactImage_correct1. -intros e1 e2. -split;simpl. +Proof. + intros plX plFEX x s Hs. + unfold CompactGraph. + setoid_replace (Couple (X:=X) (Y:=Y) (x, (Cmap plX f x))) with (Cmap plX graphPoint x). + auto using CompactImage_correct1. + intros e1 e2. + split;simpl. + unfold graphPoint_modulus. + eapply ball_weak_le;[|apply regFun_prf]. + destruct (mu f e2); autorewrite with QposElim. + assert (Qmin e2 q <= e2) by auto with *. + rewrite -> Qle_minus_iff in *. + Qauto_le. + apply Qle_refl. + apply (mu_sum plX e2 (e1::nil) f). + simpl. unfold graphPoint_modulus. - eapply ball_weak_le;[|apply regFun_prf]. - destruct (mu f e2); - autorewrite with QposElim. - assert (Qmin e2 q <= e2) by auto with *. - rewrite -> Qle_minus_iff in *. - Qauto_le. - apply Qle_refl. -apply (mu_sum plX e2 (e1::nil) f). -simpl. -unfold graphPoint_modulus. -eapply ball_ex_weak_le;[|apply regFun_prf_ex]. -destruct (mu f e1) as [d0|]; try constructor. -destruct (mu f e2) as [d|]; try constructor. -simpl. -autorewrite with QposElim. -assert (Qmin e2 d <= d) by auto with *. -rewrite -> Qle_minus_iff in *. -Qauto_le. + eapply ball_ex_weak_le;[|apply regFun_prf_ex]. + destruct (mu f e1) as [d0|]; try constructor. + destruct (mu f e2) as [d|]; try constructor. + simpl. + autorewrite with QposElim. + assert (Qmin e2 d <= d) by auto with *. + rewrite -> Qle_minus_iff in *. + Qauto_le. Qed. Lemma CompactGraph_correct2 : forall plFEX p s, inCompact p (CompactGraph plFEX s) -> inCompact (Cfst p) s. Proof. -intros plFEX p s H e1 e2. -simpl. -unfold Cfst_raw. -apply almostIn_closed. -intros d. -set (d':=((1#2)*d)%Qpos). -setoid_replace (e1 + e2 + d)%Qpos with ((e1 + d') + (d'+ e2))%Qpos by (unfold d';QposRing). -assert (H':=H e1 d'). -clear H. -unfold XY in *. -destruct (approximate p e1) as [a b]. -simpl in *. -unfold FinEnum_map_modulus, graphPoint_modulus in H'. -set (d2:=match mu f d' with - | Qpos2QposInf d => Qpos_min d' d - | QposInfinity => d' - end) in *. -eapply almostIn_triangle_r with (approximate s d2). - clear - H'. - induction (approximate s d2). - contradiction. - destruct H' as [G | [H' _] | H'] using orC_ind. - auto using almostIn_stable. + intros plFEX p s H e1 e2. + simpl. + unfold Cfst_raw. + apply almostIn_closed. + intros d. + set (d':=((1#2)*d)%Qpos). + setoid_replace (e1 + e2 + d)%Qpos with ((e1 + d') + (d'+ e2))%Qpos by (unfold d';QposRing). + assert (H':=H e1 d'). + clear H. + unfold XY in *. + destruct (approximate p e1) as [a b]. + simpl in *. + unfold FinEnum_map_modulus, graphPoint_modulus in H'. + set (d2:=match mu f d' with | Qpos2QposInf d => Qpos_min d' d | QposInfinity => d' end) in *. + eapply almostIn_triangle_r with (approximate s d2). + clear - H'. + induction (approximate s d2). + contradiction. + destruct H' as [G | [H' _] | H'] using orC_ind. + auto using almostIn_stable. + apply orWeaken. + left. + assumption. apply orWeaken. - left. + right. + apply IHs0. assumption. - apply orWeaken. - right. - apply IHs0. - assumption. -eapply ball_weak_le;[|apply regFun_prf]. -unfold d2. -destruct (mu f d') as [d0|]; auto with *. -autorewrite with QposElim. -assert (Qmin d' d0 <= d') by auto with *. -rewrite -> Qle_minus_iff in *. -Qauto_le. + eapply ball_weak_le;[|apply regFun_prf]. + unfold d2. + destruct (mu f d') as [d0|]; auto with *. + autorewrite with QposElim. + assert (Qmin d' d0 <= d') by auto with *. + rewrite -> Qle_minus_iff in *. + Qauto_le. Qed. Lemma CompactGraph_correct3 : forall plX plFEX p s, inCompact p (CompactGraph plFEX s) -> st_eq (Cmap plX f (Cfst p)) (Csnd p). Proof. -intros plX plFEX p s H. -apply ball_eq. -intros e1. -apply regFunBall_e. -intros e2. -set (e':=((1#6)*e1)%Qpos). -setoid_replace (e2 + e1 + e2)%Qpos with ((e2 + e') + ((e' + e') + (e' + e')) + (e2 + e'))%Qpos by (unfold e';QposRing). -set (d' := graphPoint_modulus e'). -assert (Hd'1 : d' <= e'). - unfold d', graphPoint_modulus. - destruct (mu f e'); auto with *. - apply Qpos_min_lb_l. -assert (Hd'2 : QposInf_le d' (mu f e')). - unfold d', graphPoint_modulus. - destruct (mu f e'). - apply Qpos_min_lb_r. - constructor. -assert (H':= H d' d'). -apply ball_triangle with (approximate (Csnd p) d'). - apply ball_triangle with (f (Cfst_raw p d')). - apply: (mu_sum plX e' (e2::nil) f). - simpl. - apply ball_ex_weak_le with (mu f e2 + d')%QposInf. + intros plX plFEX p s H. + apply ball_eq. + intros e1. + apply regFunBall_e. + intros e2. + set (e':=((1#6)*e1)%Qpos). + setoid_replace (e2 + e1 + e2)%Qpos with ((e2 + e') + ((e' + e') + (e' + e')) + (e2 + e'))%Qpos by (unfold e';QposRing). + set (d' := graphPoint_modulus e'). + assert (Hd'1 : d' <= e'). + unfold d', graphPoint_modulus. + destruct (mu f e'); auto with *. + apply Qpos_min_lb_l. + assert (Hd'2 : QposInf_le d' (mu f e')). + unfold d', graphPoint_modulus. + destruct (mu f e'). + apply Qpos_min_lb_r. + constructor. + assert (H':= H d' d'). + apply ball_triangle with (approximate (Csnd p) d'). + apply ball_triangle with (f (Cfst_raw p d')). + apply: (mu_sum plX e' (e2::nil) f). + simpl. + apply ball_ex_weak_le with (mu f e2 + d')%QposInf. + destruct (mu f e2); try constructor. + destruct (mu f e'); try constructor. + clear - Hd'2. + simpl in *. + autorewrite with QposElim. + rewrite -> Qle_minus_iff in *. + Qauto_le. + unfold Cfst_raw. + simpl. + assert (Z:=regFun_prf_ex p (mu f e2) d'). destruct (mu f e2); try constructor. - destruct (mu f e'); try constructor. - clear - Hd'2. - simpl in *. - autorewrite with QposElim. - rewrite -> Qle_minus_iff in *. - Qauto_le. - unfold Cfst_raw. - simpl. - assert (Z:=regFun_prf_ex p (mu f e2) d'). - destruct (mu f e2); try constructor. - destruct Z; auto. - assert (L:existsC X (fun x => ball (d' + d') (approximate p d') (x, (f x)))). - clear -H'. - simpl in H'. - unfold FinEnum_map_modulus, graphPoint_modulus in H'. - induction (@approximate (@FinEnum X stableX) s - (Qpos2QposInf - match @mu X Y f d' return Qpos with - | Qpos2QposInf d => Qpos_min d' d - | QposInfinity => d' - end)). - contradiction. - destruct H' as [G | H | H] using orC_ind. - auto using existsC_stable. - apply existsWeaken. - exists a. - apply H. - auto. - clear - L Hd'1 Hd'2 plX stableXY. - destruct L as [G | a [Hl Hr]] using existsC_ind. - apply (@ProductMS_stableY X). - apply (approximate (Cfst p) (1#1)%Qpos). - apply stableXY. - auto. - apply ball_triangle with (f a). - simpl. - apply (mu_sum plX e' (e'::nil) f). - simpl. - unfold graphPoint_modulus in d'. - apply ball_ex_weak_le with (d' + d')%Qpos. - clear - Hd'2. - destruct (mu f e'); try constructor. - simpl in *. - autorewrite with QposElim. - rewrite -> Qle_minus_iff in *. - replace RHS with ((q + - d') + (q + - d')) by ring. - Qauto_nonneg. - apply Hl. - apply ball_sym. - eapply ball_weak_le;[|apply Hr]. + destruct Z; auto. + assert (L:existsC X (fun x => ball (d' + d') (approximate p d') (x, (f x)))). + clear -H'. + simpl in H'. + unfold FinEnum_map_modulus, graphPoint_modulus in H'. + induction (@approximate (@FinEnum X stableX) s (Qpos2QposInf match @mu X Y f d' return Qpos with + | Qpos2QposInf d => Qpos_min d' d | QposInfinity => d' end)). + contradiction. + destruct H' as [G | H | H] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists a. + apply H. + auto. + clear - L Hd'1 Hd'2 plX stableXY. + destruct L as [G | a [Hl Hr]] using existsC_ind. + apply (@ProductMS_stableY X). + apply (approximate (Cfst p) (1#1)%Qpos). + apply stableXY. + auto. + apply ball_triangle with (f a). + simpl. + apply (mu_sum plX e' (e'::nil) f). + simpl. + unfold graphPoint_modulus in d'. + apply ball_ex_weak_le with (d' + d')%Qpos. + clear - Hd'2. + destruct (mu f e'); try constructor. + simpl in *. + autorewrite with QposElim. + rewrite -> Qle_minus_iff in *. + replace RHS with ((q + - d') + (q + - d')) by ring. + Qauto_nonneg. + apply Hl. + apply ball_sym. + eapply ball_weak_le;[|apply Hr]. + autorewrite with QposElim. + clear - Hd'1. + rewrite -> Qle_minus_iff in *. + replace RHS with ((e' + - d') + (e' + - d')) by ring. + Qauto_nonneg. + eapply ball_weak_le;[|apply regFun_prf]. autorewrite with QposElim. - clear - Hd'1. rewrite -> Qle_minus_iff in *. - replace RHS with ((e' + - d') + (e' + - d')) by ring. - Qauto_nonneg. -eapply ball_weak_le;[|apply regFun_prf]. -autorewrite with QposElim. -rewrite -> Qle_minus_iff in *. -Qauto_le. + Qauto_le. Qed. -Lemma CompactGraph_graph : forall (plX : PrelengthSpace X) plFEX p q1 q2 s, +Lemma CompactGraph_graph : forall (plX : PrelengthSpace X) plFEX p q1 q2 s, inCompact (Couple (p,q1)) (CompactGraph plFEX s) -> inCompact (Couple (p,q2)) (CompactGraph plFEX s) -> st_eq q1 q2. Proof. -intros plX plFEX p q1 q2 s Hq1 Hq2. -transitivity (Cmap plX f p). - symmetry. - rewrite <- (CoupleCorrect2 p q1). + intros plX plFEX p q1 q2 s Hq1 Hq2. + transitivity (Cmap plX f p). + symmetry. + rewrite <- (CoupleCorrect2 p q1). + apply: CompactGraph_correct3. + apply Hq1. + rewrite <- (CoupleCorrect2 p q2). apply: CompactGraph_correct3. - apply Hq1. -rewrite <- (CoupleCorrect2 p q2). -apply: CompactGraph_correct3. -apply Hq2. + apply Hq2. Qed. -Lemma CompactGraph_correct : forall plX plFEX x y s, +Lemma CompactGraph_correct : forall plX plFEX x y s, inCompact (Couple (x,y)) (CompactGraph plFEX s) <-> (inCompact x s /\ st_eq y (Cmap plX f x)). Proof. -intros plX plFEX x y s. -split; intros H. - split; - rewrite <- (CoupleCorrect2 x y). - apply (@CompactGraph_correct2 plFEX). - exact H. - symmetry. - transitivity (Csnd (Couple (x,y))). - apply: CompactGraph_correct3. - apply H. - apply CoupleCorrect3. -destruct H as [H0 H1]. -change (x, y) with (PairMS x y). -rewrite H1. -apply: CompactGraph_correct1. -auto. + intros plX plFEX x y s. + split; intros H. + split; rewrite <- (CoupleCorrect2 x y). + apply (@CompactGraph_correct2 plFEX). + exact H. + symmetry. + transitivity (Csnd (Couple (x,y))). + apply: CompactGraph_correct3. + apply H. + apply CoupleCorrect3. + destruct H as [H0 H1]. + change (x, y) with (PairMS x y). + rewrite H1. + apply: CompactGraph_correct1. + auto. Qed. End Graph. @@ -310,29 +302,29 @@ Variable f : X --> Complete Y. Lemma graphPoint_b_uc : is_UniformlyContinuousFunction (graphPoint_b_raw f) (graphPoint_modulus f). Proof. -intros e a b H d1 d2. -split. - change (ball_ex (d1 + e + d2) a b). - eapply ball_ex_weak_le;[|apply H]. - unfold graphPoint_modulus. - destruct (mu f e) as [d|]. + intros e a b H d1 d2. + split. + change (ball_ex (d1 + e + d2) a b). + eapply ball_ex_weak_le;[|apply H]. + unfold graphPoint_modulus. + destruct (mu f e) as [d|]. + simpl. + apply Qle_trans with e. + apply: Qpos_min_lb_l. + autorewrite with QposElim. + Qauto_le. simpl. - apply Qle_trans with e. - apply: Qpos_min_lb_l. autorewrite with QposElim. Qauto_le. simpl. - autorewrite with QposElim. - Qauto_le. -simpl. -revert d1 d2. -change (ball e (f a) (f b)). -apply: uc_prf. -eapply ball_ex_weak_le;[|apply H]. -unfold graphPoint_modulus. -destruct (mu f e) as [d|]. - apply: Qpos_min_lb_r. -constructor. + revert d1 d2. + change (ball e (f a) (f b)). + apply: uc_prf. + eapply ball_ex_weak_le;[|apply H]. + unfold graphPoint_modulus. + destruct (mu f e) as [d|]. + apply: Qpos_min_lb_r. + constructor. Qed. Definition graphPoint_b : X --> Complete XY := @@ -347,252 +339,244 @@ CompactImage_b (1#1) _ plFEX graphPoint_b. Require Import Qordfield. Lemma CompactGraph_b_correct1 : forall plX plFEX x s, (inCompact x s) -> inCompact (Couple (x,(Cbind plX f x))) (CompactGraph_b plFEX s). -intros plX plFEX x s Hs. -unfold CompactGraph_b. -setoid_replace (Couple (X:=X) (Y:=Y) (x, (Cbind plX f x))) with (Cbind plX graphPoint_b x). - auto using CompactImage_b_correct1. -intros e1 e2. -split;simpl. - eapply ball_weak_le;[|apply regFun_prf]. - unfold graphPoint_modulus. - destruct (mu f ((1#2)*e2)); - autorewrite with QposElim. - assert (Qmin ((1#2)*e2) q <= ((1#2)*e2)) by auto with *. - rewrite -> Qle_minus_iff in *. - replace RHS with ((1 # 2) * e2 + ((1 # 2) * e2 + - Qmin ((1 # 2) * e2) q)) by ring. - Qauto_nonneg. - Qauto_le. -unfold Cjoin_raw. -rewrite <- ball_Cunit. -setoid_replace (e1 + e2)%Qpos with ((1#2)*e1 + ((1#2)*e1 + (1#2)*e2) + (1#2)*e2)%Qpos by QposRing. -eapply ball_triangle;[|apply ball_approx_r]. -eapply ball_triangle. - apply (ball_approx_l (approximate (Cmap_fun plX f x) ((1 # 2)%Qpos * e1)) ((1#2)*e1)). -set (e1':=((1 # 2) * e1)%Qpos). -set (e2':=((1 # 2) * e2)%Qpos). -simpl. -apply (mu_sum plX e2' (e1'::nil) f). -simpl. +Proof. + intros plX plFEX x s Hs. + unfold CompactGraph_b. + setoid_replace (Couple (X:=X) (Y:=Y) (x, (Cbind plX f x))) with (Cbind plX graphPoint_b x). + auto using CompactImage_b_correct1. + intros e1 e2. + split;simpl. + eapply ball_weak_le;[|apply regFun_prf]. + unfold graphPoint_modulus. + destruct (mu f ((1#2)*e2)); autorewrite with QposElim. + assert (Qmin ((1#2)*e2) q <= ((1#2)*e2)) by auto with *. + rewrite -> Qle_minus_iff in *. + replace RHS with ((1 # 2) * e2 + ((1 # 2) * e2 + - Qmin ((1 # 2) * e2) q)) by ring. + Qauto_nonneg. + Qauto_le. + unfold Cjoin_raw. + rewrite <- ball_Cunit. + setoid_replace (e1 + e2)%Qpos with ((1#2)*e1 + ((1#2)*e1 + (1#2)*e2) + (1#2)*e2)%Qpos by QposRing. + eapply ball_triangle;[|apply ball_approx_r]. + eapply ball_triangle. + apply (ball_approx_l (approximate (Cmap_fun plX f x) ((1 # 2)%Qpos * e1)) ((1#2)*e1)). + set (e1':=((1 # 2) * e1)%Qpos). + set (e2':=((1 # 2) * e2)%Qpos). + simpl. + apply (mu_sum plX e2' (e1'::nil) f). + simpl. eapply ball_ex_weak_le;[|apply regFun_prf_ex]. -unfold e1'. -unfold graphPoint_modulus. -destruct (mu f ((1#2)*e1)) as [d0|]; try constructor. -destruct (mu f e2') as [d|]; try constructor. -simpl. -autorewrite with QposElim. -assert (Qmin e2' d <= d) by auto with *. -rewrite -> Qle_minus_iff in *. Qauto_le. + unfold e1'. + unfold graphPoint_modulus. + destruct (mu f ((1#2)*e1)) as [d0|]; try constructor. + destruct (mu f e2') as [d|]; try constructor. + simpl. + autorewrite with QposElim. + assert (Qmin e2' d <= d) by auto with *. + rewrite -> Qle_minus_iff in *. Qauto_le. Qed. Lemma CompactGraph_b_correct2 : forall plFEX p s, inCompact p (CompactGraph_b plFEX s) -> inCompact (Cfst p) s. Proof. -intros plFEX p s H e1 e2. -simpl. -unfold Cfst_raw. -apply almostIn_closed. -intros d. -set (d':=((1#2)*d)%Qpos). -setoid_replace (e1 + e2 + d)%Qpos with ((e1 + d') + (d'+ e2))%Qpos by (unfold d';QposRing). -assert (H':=H e1 d'). -clear H. -unfold XY in *. -destruct (approximate p e1) as [a b]. -simpl in *. -unfold Cjoin_raw in H'. -simpl in *. -unfold FinEnum_map_modulus, graphPoint_modulus in H'. -set (d2:=match mu f ((1#2)*d') with - | Qpos2QposInf d => Qpos_min ((1#2)*d') d - | QposInfinity => ((1#2)*d')%Qpos - end) in *. -eapply almostIn_triangle_r with (approximate s d2). - clear - H'. - induction (approximate s d2). - contradiction. - destruct H' as [G | [H' _] | H'] using orC_ind. - auto using almostIn_stable. + intros plFEX p s H e1 e2. + simpl. + unfold Cfst_raw. + apply almostIn_closed. + intros d. + set (d':=((1#2)*d)%Qpos). + setoid_replace (e1 + e2 + d)%Qpos with ((e1 + d') + (d'+ e2))%Qpos by (unfold d';QposRing). + assert (H':=H e1 d'). + clear H. + unfold XY in *. + destruct (approximate p e1) as [a b]. + simpl in *. + unfold Cjoin_raw in H'. + simpl in *. + unfold FinEnum_map_modulus, graphPoint_modulus in H'. + set (d2:=match mu f ((1#2)*d') with | Qpos2QposInf d => Qpos_min ((1#2)*d') d + | QposInfinity => ((1#2)*d')%Qpos end) in *. + eapply almostIn_triangle_r with (approximate s d2). + clear - H'. + induction (approximate s d2). + contradiction. + destruct H' as [G | [H' _] | H'] using orC_ind. + auto using almostIn_stable. + apply orWeaken. + left. + assumption. apply orWeaken. - left. + right. + apply IHs0. assumption. - apply orWeaken. - right. - apply IHs0. - assumption. -eapply ball_weak_le;[|apply regFun_prf]. -unfold d2. -destruct (mu f ((1#2)*d')) as [d0|]. + eapply ball_weak_le;[|apply regFun_prf]. + unfold d2. + destruct (mu f ((1#2)*d')) as [d0|]. + autorewrite with QposElim. + assert (Qmin ((1#2)*d') d0 <= ((1#2)*d')) by auto with *. + rewrite -> Qle_minus_iff in *. + replace RHS with ((1 # 2) * d' + - Qmin ((1 # 2) * d') d0 + (1#2)*d') by ring. + Qauto_nonneg. autorewrite with QposElim. - assert (Qmin ((1#2)*d') d0 <= ((1#2)*d')) by auto with *. - rewrite -> Qle_minus_iff in *. - replace RHS with ((1 # 2) * d' + - Qmin ((1 # 2) * d') d0 + (1#2)*d') by ring. - Qauto_nonneg. -autorewrite with QposElim. -replace RHS with ((1 # 2) * d' + e2 + (1#2)*d') by ring. -Qauto_le. + replace RHS with ((1 # 2) * d' + e2 + (1#2)*d') by ring. + Qauto_le. Qed. Lemma CompactGraph_b_correct3 : forall plX plFEX p s, inCompact p (CompactGraph_b plFEX s) -> st_eq (Cbind plX f (Cfst p)) (Csnd p). Proof. -intros plX plFEX p s H. -apply ball_eq. -intros e1. -apply regFunBall_e. -intros e2. -set (e':=((1#6)*e1)%Qpos). -setoid_replace (e2 + e1 + e2)%Qpos with ((e2 + e') + ((e' + e') + (e' + e')) + (e2 + e'))%Qpos by (unfold e';QposRing). -set (d' := graphPoint_modulus f ((1#2)*e')). -assert (Hd'1 : d' <= e'). - unfold d', graphPoint_modulus. - destruct (mu f ((1#2)*e')); - autorewrite with QposElim. - apply Qle_trans with ((1#2)*e'); auto with *. + intros plX plFEX p s H. + apply ball_eq. + intros e1. + apply regFunBall_e. + intros e2. + set (e':=((1#6)*e1)%Qpos). + setoid_replace (e2 + e1 + e2)%Qpos with ((e2 + e') + ((e' + e') + (e' + e')) + (e2 + e'))%Qpos by (unfold e';QposRing). + set (d' := graphPoint_modulus f ((1#2)*e')). + assert (Hd'1 : d' <= e'). + unfold d', graphPoint_modulus. + destruct (mu f ((1#2)*e')); autorewrite with QposElim. + apply Qle_trans with ((1#2)*e'); auto with *. + rewrite Qle_minus_iff. + ring_simplify. + Qauto_nonneg. rewrite Qle_minus_iff. ring_simplify. Qauto_nonneg. - rewrite Qle_minus_iff. - ring_simplify. - Qauto_nonneg. -assert (Hd'2 : QposInf_le (d') (mu f ((1#2)*e'))). - unfold d', graphPoint_modulus. - destruct (mu f ((1#2)*e')). - apply Qpos_min_lb_r. - constructor. -assert (H':= H ((1#2)*d')%Qpos d'). -apply ball_triangle with (approximate (Csnd p) ((1#2)%Qpos*d')). - simpl (approximate (Cbind plX f (Cfst (X:=X) (Y:=Y) p)) e2). - apply ball_triangle with (approximate (f (Cfst_raw p ((1#2)*d'))) ((1#2)*d'))%Qpos. - unfold Cjoin_raw. - simpl. - apply ball_weak_le with ((1#2)*e2 + ((1#2)*e2 + (1#2)*e') + (1#2)*d')%Qpos. - autorewrite with QposElim. - clear - Hd'1. - rewrite -> Qle_minus_iff in *. - replace RHS with ((1 # 2) * (e' + - d')) by ring. - Qauto_nonneg. - cut (ball ((1 # 2) * e2 + (1 # 2) * e') - (f (Cfst_raw p (mu f ((1 # 2) * e2)))) - (f (Cfst_raw p ((1 # 2) * d')%Qpos))). - intros L. - apply L. - apply (mu_sum plX ((1#2)*e') (((1#2)*e2)::nil) f)%Qpos. - simpl. - apply ball_ex_weak_le with (QposInf_plus (mu f ((1#2)*e2)) ((1#2)*d'))%Qpos. + assert (Hd'2 : QposInf_le (d') (mu f ((1#2)*e'))). + unfold d', graphPoint_modulus. + destruct (mu f ((1#2)*e')). + apply Qpos_min_lb_r. + constructor. + assert (H':= H ((1#2)*d')%Qpos d'). + apply ball_triangle with (approximate (Csnd p) ((1#2)%Qpos*d')). + simpl (approximate (Cbind plX f (Cfst (X:=X) (Y:=Y) p)) e2). + apply ball_triangle with (approximate (f (Cfst_raw p ((1#2)*d'))) ((1#2)*d'))%Qpos. + unfold Cjoin_raw. + simpl. + apply ball_weak_le with ((1#2)*e2 + ((1#2)*e2 + (1#2)*e') + (1#2)*d')%Qpos. + autorewrite with QposElim. + clear - Hd'1. + rewrite -> Qle_minus_iff in *. + replace RHS with ((1 # 2) * (e' + - d')) by ring. + Qauto_nonneg. + cut (ball ((1 # 2) * e2 + (1 # 2) * e') (f (Cfst_raw p (mu f ((1 # 2) * e2)))) + (f (Cfst_raw p ((1 # 2) * d')%Qpos))). + intros L. + apply L. + apply (mu_sum plX ((1#2)*e') (((1#2)*e2)::nil) f)%Qpos. + simpl. + apply ball_ex_weak_le with (QposInf_plus (mu f ((1#2)*e2)) ((1#2)*d'))%Qpos. + destruct (mu f ((1#2)*e2)); try constructor. + destruct (mu f ((1#2)*e')); try constructor. + clear - Hd'2. + simpl in *. + autorewrite with QposElim. + rewrite -> Qle_minus_iff in *. + replace RHS with (q0 + - d' + (1#2)*d') by ring. + Qauto_nonneg. + unfold Cfst_raw. + simpl. + assert (Z:=regFun_prf_ex p (mu f ((1#2)*e2)) ((1#2)%Qpos*d')). destruct (mu f ((1#2)*e2)); try constructor. - destruct (mu f ((1#2)*e')); try constructor. - clear - Hd'2. - simpl in *. - autorewrite with QposElim. - rewrite -> Qle_minus_iff in *. - replace RHS with (q0 + - d' + (1#2)*d') by ring. - Qauto_nonneg. - unfold Cfst_raw. - simpl. - assert (Z:=regFun_prf_ex p (mu f ((1#2)*e2)) ((1#2)%Qpos*d')). - destruct (mu f ((1#2)*e2)); try constructor. - destruct Z; auto. - assert (L:existsC X (fun x => ball (((1#2)*d') + d') (approximate p ((1#2)%Qpos*d')) (Couple_raw ((Cunit x), (f x)) ((1#2)*d')%Qpos))). - clear -H'. - simpl in H'. - unfold Cjoin_raw in H'. - simpl in H'. - unfold FinEnum_map_modulus, graphPoint_modulus in H'. - induction (@approximate (@FinEnum X stableX) s - (Qpos2QposInf - match @mu X _ f ((1#2)*d') return Qpos with - | Qpos2QposInf d => Qpos_min ((1#2)*d') d - | QposInfinity => ((1#2)*d')%Qpos - end)). - contradiction. - destruct H' as [G | H | H] using orC_ind. - auto using existsC_stable. - apply existsWeaken. - exists a. - apply H. - auto. - clear - L Hd'1 Hd'2 plX stableXY. - destruct L as [G | a [Hl Hr]] using existsC_ind. - apply (@ProductMS_stableY X). - apply (approximate (Cfst p) (1#1)%Qpos). - apply stableXY. - auto. - apply ball_triangle with (approximate (f a) ((1#2)%Qpos*d')). - apply ball_weak_le with ((1#2)*d' + ((1#2)*e' + (1#2)*e') + (1#2)*d')%Qpos. - clear - Hd'1. + destruct Z; auto. + assert (L:existsC X (fun x => ball (((1#2)*d') + d') (approximate p ((1#2)%Qpos*d')) (Couple_raw ((Cunit x), (f x)) ((1#2)*d')%Qpos))). + clear -H'. + simpl in H'. + unfold Cjoin_raw in H'. + simpl in H'. + unfold FinEnum_map_modulus, graphPoint_modulus in H'. + induction (@approximate (@FinEnum X stableX) s (Qpos2QposInf + match @mu X _ f ((1#2)*d') return Qpos with | Qpos2QposInf d => Qpos_min ((1#2)*d') d + | QposInfinity => ((1#2)*d')%Qpos end)). + contradiction. + destruct H' as [G | H | H] using orC_ind. + auto using existsC_stable. + apply existsWeaken. + exists a. + apply H. + auto. + clear - L Hd'1 Hd'2 plX stableXY. + destruct L as [G | a [Hl Hr]] using existsC_ind. + apply (@ProductMS_stableY X). + apply (approximate (Cfst p) (1#1)%Qpos). + apply stableXY. + auto. + apply ball_triangle with (approximate (f a) ((1#2)%Qpos*d')). + apply ball_weak_le with ((1#2)*d' + ((1#2)*e' + (1#2)*e') + (1#2)*d')%Qpos. + clear - Hd'1. + autorewrite with QposElim. + rewrite -> Qle_minus_iff in *. + replace RHS with (e' + - d') by ring. + auto. + simpl. + rewrite <- ball_Cunit. + eapply ball_triangle;[|apply ball_approx_r]. + eapply ball_triangle;[apply ball_approx_l|]. + apply (mu_sum plX ((1#2)*e') (((1#2)*e')::nil) f)%Qpos. + simpl. + unfold graphPoint_modulus in d'. + apply ball_ex_weak_le with (d' + d')%Qpos. + clear - Hd'2. + destruct (mu f ((1#2)*e')); try constructor. + simpl in *. + autorewrite with QposElim. + rewrite -> Qle_minus_iff in *. + replace RHS with ((q + - d') + (q + - d')) by ring. + Qauto_nonneg. + simpl. + eapply ball_weak_le;[|apply Hl]. autorewrite with QposElim. - rewrite -> Qle_minus_iff in *. - replace RHS with (e' + - d') by ring. - auto. - simpl. - rewrite <- ball_Cunit. - eapply ball_triangle;[|apply ball_approx_r]. - eapply ball_triangle;[apply ball_approx_l|]. - apply (mu_sum plX ((1#2)*e') (((1#2)*e')::nil) f)%Qpos. - simpl. - unfold graphPoint_modulus in d'. - apply ball_ex_weak_le with (d' + d')%Qpos. - clear - Hd'2. - destruct (mu f ((1#2)*e')); try constructor. - simpl in *. - autorewrite with QposElim. - rewrite -> Qle_minus_iff in *. - replace RHS with ((q + - d') + (q + - d')) by ring. - Qauto_nonneg. - simpl. - eapply ball_weak_le;[|apply Hl]. + Qauto_le. + apply ball_sym. + eapply ball_weak_le;[|apply Hr]. autorewrite with QposElim. - Qauto_le. - apply ball_sym. - eapply ball_weak_le;[|apply Hr]. + clear - Hd'1. + rewrite -> Qle_minus_iff in *. + replace RHS with ((e' + - d') + (e' + - d') + (1#2)*d') by ring. + Qauto_nonneg. + eapply ball_weak_le;[|apply (regFun_prf (Csnd p) ((1#2)*d')%Qpos)]. autorewrite with QposElim. - clear - Hd'1. rewrite -> Qle_minus_iff in *. - replace RHS with ((e' + - d') + (e' + - d') + (1#2)*d') by ring. + replace RHS with ((e' + - d') + (1#2)*d') by ring. Qauto_nonneg. -eapply ball_weak_le;[|apply (regFun_prf (Csnd p) ((1#2)*d')%Qpos)]. -autorewrite with QposElim. -rewrite -> Qle_minus_iff in *. -replace RHS with ((e' + - d') + (1#2)*d') by ring. -Qauto_nonneg. Qed. -Lemma CompactGraph_b_graph : forall (plX : PrelengthSpace X) plFEX p q1 q2 s, +Lemma CompactGraph_b_graph : forall (plX : PrelengthSpace X) plFEX p q1 q2 s, inCompact (Couple (p,q1)) (CompactGraph_b plFEX s) -> inCompact (Couple (p,q2)) (CompactGraph_b plFEX s) -> st_eq q1 q2. Proof. -intros plX plFEX p q1 q2 s Hq1 Hq2. -transitivity (Cbind plX f p). - symmetry. - rewrite <- (CoupleCorrect2 p q1). + intros plX plFEX p q1 q2 s Hq1 Hq2. + transitivity (Cbind plX f p). + symmetry. + rewrite <- (CoupleCorrect2 p q1). + apply: CompactGraph_b_correct3. + apply Hq1. + rewrite <- (CoupleCorrect2 p q2). apply: CompactGraph_b_correct3. - apply Hq1. -rewrite <- (CoupleCorrect2 p q2). -apply: CompactGraph_b_correct3. -apply Hq2. + apply Hq2. Qed. -Lemma CompactGraph_b_correct : forall plX plFEX x y s, +Lemma CompactGraph_b_correct : forall plX plFEX x y s, inCompact (Couple (x,y)) (CompactGraph_b plFEX s) <-> (inCompact x s /\ st_eq y (Cbind plX f x)). Proof. -intros plX plFEX x y s. -split; intros H. - split; - rewrite <- (CoupleCorrect2 x y). - apply (@CompactGraph_b_correct2 plFEX). - exact H. - symmetry. - transitivity (Csnd (Couple (x,y))). - apply: CompactGraph_b_correct3. - apply H. - apply CoupleCorrect3. -destruct H as [H0 H1]. -change (x, y) with (PairMS x y). -rewrite H1. -apply CompactGraph_b_correct1. -auto. + intros plX plFEX x y s. + split; intros H. + split; rewrite <- (CoupleCorrect2 x y). + apply (@CompactGraph_b_correct2 plFEX). + exact H. + symmetry. + transitivity (Csnd (Couple (x,y))). + apply: CompactGraph_b_correct3. + apply H. + apply CoupleCorrect3. + destruct H as [H0 H1]. + change (x, y) with (PairMS x y). + rewrite H1. + apply CompactGraph_b_correct1. + auto. Qed. End GraphBind. diff --git a/metric2/Hausdorff.v b/metric2/Hausdorff.v index c5df98b7a..2af04c9a1 100644 --- a/metric2/Hausdorff.v +++ b/metric2/Hausdorff.v @@ -44,8 +44,8 @@ Variable X : MetricSpace. (** This is the (weak) hemiMetric, which makes an asymmetric metric. We make use of the classical quantifer in this definition. *) -Definition hemiMetric (e:Qpos) (A B: X -> Prop) := - forall x:X, A x -> +Definition hemiMetric (e:Qpos) (A B: X -> Prop) := + forall x:X, A x -> existsC X (fun y => B y /\ ball e x y). (** This (weak) metric, makes the full symmetric metric. *) @@ -55,66 +55,66 @@ Definition hausdorffBall (e:Qpos) (A B: X -> Prop) := Lemma hemiMetric_wd1 : forall (e0 e1:Qpos) A B, (QposEq e0 e1) -> hemiMetric e0 A B -> hemiMetric e1 A B. Proof. -intros e0 e1 A B He H x Hx. -destruct (H x Hx) as [HG | y [Hy Hxy]] using existsC_ind. - apply existsC_stable; assumption. -apply existsWeaken. -exists y. -rewrite -> He in Hxy; auto. + intros e0 e1 A B He H x Hx. + destruct (H x Hx) as [HG | y [Hy Hxy]] using existsC_ind. + apply existsC_stable; assumption. + apply existsWeaken. + exists y. + rewrite -> He in Hxy; auto. Qed. Lemma hausdorffBall_wd1 : forall (e0 e1:Qpos) A B, (QposEq e0 e1) -> hausdorffBall e0 A B -> hausdorffBall e1 A B. Proof. -intros e0 e1 A B He [H0 H1]. -split; apply hemiMetric_wd1 with e0; assumption. + intros e0 e1 A B He [H0 H1]. + split; apply hemiMetric_wd1 with e0; assumption. Qed. Lemma hemiMetric_refl : forall e A, hemiMetric e A A. Proof. -intros e A x Hx. -apply existsWeaken. -exists x. -split; try assumption. -apply ball_refl. + intros e A x Hx. + apply existsWeaken. + exists x. + split; try assumption. + apply ball_refl. Qed. Lemma hausdorffBall_refl : forall e A, hausdorffBall e A A. Proof. -intros e A. -split; apply hemiMetric_refl. + intros e A. + split; apply hemiMetric_refl. Qed. -Lemma hausdorffBall_sym : forall e A B, +Lemma hausdorffBall_sym : forall e A B, hausdorffBall e A B -> hausdorffBall e B A. Proof. -intros e A B [H0 H1]. -split; assumption. + intros e A B [H0 H1]. + split; assumption. Qed. Lemma hemiMetric_triangle : forall e0 e1 A B C, hemiMetric e0 A B -> hemiMetric e1 B C -> hemiMetric (e0 + e1) A C. Proof. -intros e0 e1 A B C H0 H1 x Hx. -destruct (H0 x Hx) as [HG | y [Hy Hxy]] using existsC_ind. - apply existsC_stable; assumption. -destruct (H1 y Hy) as [HG | z [Hz Hyz]] using existsC_ind. - apply existsC_stable; assumption. -apply existsWeaken. -exists z. -split; try assumption. -apply ball_triangle with y; assumption. + intros e0 e1 A B C H0 H1 x Hx. + destruct (H0 x Hx) as [HG | y [Hy Hxy]] using existsC_ind. + apply existsC_stable; assumption. + destruct (H1 y Hy) as [HG | z [Hz Hyz]] using existsC_ind. + apply existsC_stable; assumption. + apply existsWeaken. + exists z. + split; try assumption. + apply ball_triangle with y; assumption. Qed. Lemma hausdorffBall_triangle : forall e0 e1 A B C, hausdorffBall e0 A B -> hausdorffBall e1 B C -> hausdorffBall (e0 + e1) A C. Proof. -intros e0 e1 A B C [H0A H0B] [H1A H1B]. -split. + intros e0 e1 A B C [H0A H0B] [H1A H1B]. + split. + apply hemiMetric_triangle with B; assumption. + apply hemiMetric_wd1 with (e1 + e0)%Qpos. + QposRing. apply hemiMetric_triangle with B; assumption. -apply hemiMetric_wd1 with (e1 + e0)%Qpos. - QposRing. -apply hemiMetric_triangle with B; assumption. Qed. (** Unfortunately this isn't a metric for an aribitrary predicate. More @@ -125,58 +125,54 @@ Hypothesis stableX : stableMetric X. Lemma hemiMetric_stable :forall e A B, ~~(hemiMetric e A B) -> hemiMetric e A B. Proof. -unfold hemiMetric. -auto 7 using existsC_stable. + unfold hemiMetric. + auto 7 using existsC_stable. Qed. Lemma hausdorffBall_stable :forall e A B, ~~(hausdorffBall e A B) -> hausdorffBall e A B. Proof. -unfold hausdorffBall. -firstorder using hemiMetric_stable. + unfold hausdorffBall. + firstorder using hemiMetric_stable. Qed. -Lemma hemiMetric_wd :forall (e1 e2:Qpos), (e1==e2) -> +Lemma hemiMetric_wd :forall (e1 e2:Qpos), (e1==e2) -> forall A1 A2, (forall x, A1 x <-> A2 x) -> forall B1 B2, (forall x, B1 x <-> B2 x) -> (hemiMetric e1 A1 B1 <-> hemiMetric e2 A2 B2). Proof. -cut (forall e1 e2 : Qpos, -e1 == e2 -> -forall A1 A2 : X -> Prop, -(forall x : X, A1 x <-> A2 x) -> -forall B1 B2 : X -> Prop, -(forall x : X, B1 x <-> B2 x) -> -(hemiMetric e1 A1 B1 -> hemiMetric e2 A2 B2)). - intros; split. + cut (forall e1 e2 : Qpos, e1 == e2 -> forall A1 A2 : X -> Prop, (forall x : X, A1 x <-> A2 x) -> + forall B1 B2 : X -> Prop, (forall x : X, B1 x <-> B2 x) -> + (hemiMetric e1 A1 B1 -> hemiMetric e2 A2 B2)). + intros; split. + eauto. + symmetry in H0. + assert (H1':forall x : X, A2 x <-> A1 x) by firstorder. + assert (H2':forall x : X, B2 x <-> B1 x) by firstorder. eauto. - symmetry in H0. - assert (H1':forall x : X, A2 x <-> A1 x) by firstorder. - assert (H2':forall x : X, B2 x <-> B1 x) by firstorder. - eauto. -intros e1 e2 He A1 A2 HA B1 B2 HB H x Hx. -rewrite <- HA in Hx. -destruct (H x Hx) as [HG | y [Hy0 Hy1]] using existsC_ind. - auto using existsC_stable. -apply existsWeaken. -exists y. -change (QposEq e1 e2) in He. -rewrite <- HB. -rewrite <- He. -auto. + intros e1 e2 He A1 A2 HA B1 B2 HB H x Hx. + rewrite <- HA in Hx. + destruct (H x Hx) as [HG | y [Hy0 Hy1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists y. + change (QposEq e1 e2) in He. + rewrite <- HB. + rewrite <- He. + auto. Qed. -Lemma hausdorffBall_wd :forall (e1 e2:Qpos), (e1==e2) -> +Lemma hausdorffBall_wd :forall (e1 e2:Qpos), (e1==e2) -> forall A1 A2, (forall x, A1 x <-> A2 x) -> forall B1 B2, (forall x, B1 x <-> B2 x) -> (hausdorffBall e1 A1 B1 <-> hausdorffBall e2 A2 B2). Proof. -intros. -unfold hausdorffBall. -setoid_replace (hemiMetric e1 A1 B1) with (hemiMetric e2 A2 B2). - setoid_replace (hemiMetric e1 B1 A1) with (hemiMetric e2 B2 A2). - reflexivity. + intros. + unfold hausdorffBall. + setoid_replace (hemiMetric e1 A1 B1) with (hemiMetric e2 A2 B2). + setoid_replace (hemiMetric e1 B1 A1) with (hemiMetric e2 B2 A2). + reflexivity. + apply hemiMetric_wd; auto. apply hemiMetric_wd; auto. -apply hemiMetric_wd; auto. Qed. End HausdorffMetric. @@ -190,8 +186,8 @@ This section introduces an alternative stronger notition of Haudorff metric that uses a constructive existential. *) -Definition hemiMetricStrong (e:Qpos) (A B: X -> Prop) := - forall x:X, A x -> +Definition hemiMetricStrong (e:Qpos) (A B: X -> Prop) := + forall x:X, A x -> forall d:Qpos, {y:X | B y /\ ball (e+d) x y}. Definition hausdorffBallStrong (e:Qpos) (A B: X -> Prop) := @@ -200,61 +196,61 @@ Definition hausdorffBallStrong (e:Qpos) (A B: X -> Prop) := Lemma hemiMetricStrong_wd1 : forall (e0 e1:Qpos) A B, (QposEq e0 e1) -> hemiMetricStrong e0 A B -> hemiMetricStrong e1 A B. Proof. -intros e0 e1 A B He H x Hx d. -destruct (H x Hx d) as [y [Hy Hxy]]. -exists y. -rewrite -> He in Hxy; auto. + intros e0 e1 A B He H x Hx d. + destruct (H x Hx d) as [y [Hy Hxy]]. + exists y. + rewrite -> He in Hxy; auto. Qed. Lemma hausdorffBallStrong_wd1 : forall (e0 e1:Qpos) A B, (QposEq e0 e1) -> hausdorffBallStrong e0 A B -> hausdorffBallStrong e1 A B. Proof. -intros e0 e1 A B He [H0 H1]. -split; apply hemiMetricStrong_wd1 with e0; assumption. + intros e0 e1 A B He [H0 H1]. + split; apply hemiMetricStrong_wd1 with e0; assumption. Qed. Lemma hemiMetricStrong_refl : forall e A, hemiMetricStrong e A A. Proof. -intros e A x Hx d. -exists x. -split; try assumption. -apply ball_refl. + intros e A x Hx d. + exists x. + split; try assumption. + apply ball_refl. Qed. Lemma hausdorffBallStrong_refl : forall e A, hausdorffBallStrong e A A. Proof. -intros e A. -split; apply hemiMetricStrong_refl. + intros e A. + split; apply hemiMetricStrong_refl. Qed. -Lemma hausdorffBallStrong_sym : forall e A B, +Lemma hausdorffBallStrong_sym : forall e A B, hausdorffBallStrong e A B -> hausdorffBallStrong e B A. Proof. -intros e A B [H0 H1]. -split; assumption. + intros e A B [H0 H1]. + split; assumption. Qed. Lemma hemiMetricStrong_triangle : forall e0 e1 A B C, hemiMetricStrong e0 A B -> hemiMetricStrong e1 B C -> hemiMetricStrong (e0 + e1) A C. Proof. -intros e0 e1 A B C H0 H1 x Hx d. -destruct (H0 x Hx ((1#2)*d)%Qpos) as [y [Hy Hxy]]. -destruct (H1 y Hy ((1#2)*d)%Qpos) as [z [Hz Hyz]]. -exists z. -split; try assumption. -setoid_replace (e0 + e1 + d)%Qpos with ((e0 + (1 # 2) * d) +(e1 + (1 # 2) * d))%Qpos by QposRing. -apply ball_triangle with y; assumption. + intros e0 e1 A B C H0 H1 x Hx d. + destruct (H0 x Hx ((1#2)*d)%Qpos) as [y [Hy Hxy]]. + destruct (H1 y Hy ((1#2)*d)%Qpos) as [z [Hz Hyz]]. + exists z. + split; try assumption. + setoid_replace (e0 + e1 + d)%Qpos with ((e0 + (1 # 2) * d) +(e1 + (1 # 2) * d))%Qpos by QposRing. + apply ball_triangle with y; assumption. Qed. Lemma hausdorffBallStrong_triangle : forall e0 e1 A B C, hausdorffBallStrong e0 A B -> hausdorffBallStrong e1 B C -> hausdorffBallStrong (e0 + e1) A C. Proof. -intros e0 e1 A B C [H0A H0B] [H1A H1B]. -split. + intros e0 e1 A B C [H0A H0B] [H1A H1B]. + split. + apply hemiMetricStrong_triangle with B; assumption. + apply hemiMetricStrong_wd1 with (e1 + e0)%Qpos. + QposRing. apply hemiMetricStrong_triangle with B; assumption. -apply hemiMetricStrong_wd1 with (e1 + e0)%Qpos. - QposRing. -apply hemiMetricStrong_triangle with B; assumption. Qed. (* @@ -277,8 +273,8 @@ Lemma hausdorffBallStrong_closed : forall e A B, hausdorffBallStrong e A B. Proof. intros e A B HA HB H. -split; - apply hemiMetricStrong_closed; +split; + apply hemiMetricStrong_closed; try assumption; intros d; destruct (H d); @@ -286,7 +282,7 @@ split; Qed. *) (* -Lemma HemiMetricStrongHemiMetric : stableMetric X -> +Lemma HemiMetricStrongHemiMetric : stableMetric X -> forall (e:Qpos) A B, SubFinite X B -> hemiMetricStrong e A B -> hemiMetric X e A B. @@ -301,7 +297,7 @@ exists y. assumption. Qed. -Lemma HausdorffBallStrongHausdorffBall : stableMetric X -> +Lemma HausdorffBallStrongHausdorffBall : stableMetric X -> forall (e:Qpos) A B, SubFinite X A -> SubFinite X B -> hausdorffBallStrong e A B -> hausdorffBall X e A B. @@ -369,7 +365,7 @@ intros e A B HA HB [H0 H1]. split; auto using HemiMetricHemiMetricStrong. Defined. -Definition HemiMetricStrongAlmostDecidable : +Definition HemiMetricStrongAlmostDecidable : forall (e d:Qpos) A B, FinitelyEnumerable X A -> FinitelyEnumerable X B -> e < d -> hemiMetricStrong d A B + {hemiMetricStrong e A B->False}. @@ -460,7 +456,7 @@ induction lA. destruct (HA x) as [HAx _]. elim (HAx Hx). auto with *. -intros A Ha HB Hed. +intros A Ha HB Hed. pose (A':=fun x => ~~In x lA). destruct (IHlA A') as [I|I]; try assumption. unfold A'; tauto. @@ -491,7 +487,7 @@ destruct (IHlA A') as [I|I]; try assumption. apply H. rewrite Ha. rewrite Hx. - auto with *. + auto with *. right. intros H. apply I. @@ -503,7 +499,7 @@ unfold A'. auto 7 with *. Defined. -Definition HausdorffBallStrongAlmostDecidable : +Definition HausdorffBallStrongAlmostDecidable : forall (e d:Qpos) A B, FinitelyEnumerable X A -> FinitelyEnumerable X B -> e < d -> hausdorffBallStrong d A B + {hausdorffBallStrong e A B->False}. @@ -523,7 +519,7 @@ Defined. End HausdorffMetricStrong. (* -Definition HausdorffBallAlmostDecidable : +Definition HausdorffBallAlmostDecidable : forall X, locatedMetric X -> forall (e d:Qpos) A B, FinitelyEnumerable X A -> FinitelyEnumerable X B -> @@ -541,4 +537,4 @@ intros H; apply Z; apply HausdorffBallHausdorffBallStrong; assumption). Defined. -*) \ No newline at end of file +*) diff --git a/metric2/Limit.v b/metric2/Limit.v index 498dedda8..a33f47a65 100644 --- a/metric2/Limit.v +++ b/metric2/Limit.v @@ -59,40 +59,38 @@ else fun (n : P s -> False) => cons (hd s) Lemma takeUntil_wd : forall (A B:Type) (P : Stream A -> bool)(s:Stream A)(ex1 ex2:LazyExists P s) (cons: A -> B -> B) (nil:B), takeUntil P ex1 cons nil = takeUntil P ex2 cons nil. Proof. -intros A B P s ex1 ex2 cons nil. -assert (H:=ex1). -induction H; -case ex1; clear ex1; case ex2; clear ex2; -simpl; -destruct (P x); try contradiction; auto. -intros ex2 ex1. -rewrite (H0 tt (ex1 tt) (ex2 tt)). -reflexivity. + intros A B P s ex1 ex2 cons nil. + assert (H:=ex1). + induction H; case ex1; clear ex1; case ex2; clear ex2; simpl; + destruct (P x); try contradiction; auto. + intros ex2 ex1. + rewrite (H0 tt (ex1 tt) (ex2 tt)). + reflexivity. Qed. Lemma takeUntil_end : forall (A B:Type) (P:Stream A -> bool) seq (ex:LazyExists P seq) (cons:A -> B -> B) (nil : B), P seq -> takeUntil P ex cons nil = nil. Proof. -intros A B P seq ex cons nil H. -rewrite <- (takeUntil_wd (B:=B) P (LazyHere P _ H)). -unfold takeUntil. -destruct (P seq);[|contradiction]. -reflexivity. + intros A B P seq ex cons nil H. + rewrite <- (takeUntil_wd (B:=B) P (LazyHere P _ H)). + unfold takeUntil. + destruct (P seq);[|contradiction]. + reflexivity. Qed. Lemma takeUntil_step : forall (A B:Type) (P:Stream A -> bool) seq (ex:LazyExists P seq) (cons: A -> B -> B) (nil: B), ~P seq -> exists ex':(LazyExists P (tl seq)), takeUntil P ex cons nil = cons (hd seq) (takeUntil P ex' cons nil). Proof. -intros A B P seq ex cons nil H. -assert (ex':=ex). -destruct ex' as [H0|ex']. -elim H; assumption. -exists (ex' tt). -rewrite <- (takeUntil_wd (B:=B) P (LazyFurther seq ex')). -simpl. -destruct (P seq). -elim H; constructor. -reflexivity. + intros A B P seq ex cons nil H. + assert (ex':=ex). + destruct ex' as [H0|ex']. + elim H; assumption. + exists (ex' tt). + rewrite <- (takeUntil_wd (B:=B) P (LazyFurther seq ex')). + simpl. + destruct (P seq). + elim H; constructor. + reflexivity. Qed. Lemma takeUntil_elim : forall (A B:Type) (P:Stream A -> bool) (cons: A -> B -> B) (nil: B) @@ -101,28 +99,28 @@ Lemma takeUntil_elim : forall (A B:Type) (P:Stream A -> bool) (cons: A -> B -> B (forall seq x, Q (tl seq) x -> ~P seq -> Q seq (cons (hd seq) x)) -> forall seq (ex:LazyExists P seq), Q seq (takeUntil P ex cons nil). Proof. -intros A B P cons nil Q c1 c2 seq ex. -assert (ex':=ex). -induction ex'. - rewrite takeUntil_end; try assumption. - eapply c1. - apply H. -assert (Z0:=takeUntil_end P ex cons nil). -assert (Z1:=takeUntil_step P ex cons nil). -assert (Z0':=c1 x). -assert (Z1':=c2 x). -destruct (P x). - clear Z1. - rewrite Z0; try constructor. - apply Z0'. + intros A B P cons nil Q c1 c2 seq ex. + assert (ex':=ex). + induction ex'. + rewrite takeUntil_end; try assumption. + eapply c1. + apply H. + assert (Z0:=takeUntil_end P ex cons nil). + assert (Z1:=takeUntil_step P ex cons nil). + assert (Z0':=c1 x). + assert (Z1':=c2 x). + destruct (P x). + clear Z1. + rewrite Z0; try constructor. + apply Z0'. + constructor. + clear Z0 Z0'. + destruct (Z1 (fun x => x)) as [ex' Z]. + rewrite Z. + clear Z Z1. + eapply Z1'; auto. + apply H0. constructor. -clear Z0 Z0'. -destruct (Z1 (fun x => x)) as [ex' Z]. -rewrite Z. -clear Z Z1. -eapply Z1'; auto. -apply H0. -constructor. Qed. End TakeUntil. @@ -136,44 +134,41 @@ Definition NearBy (l:X)(e:QposInf) := ForAll (fun (s:Stream X) => ball_ex e (hd Lemma NearBy_comp: forall l1 l2, st_eq l1 l2 -> forall (e1 e2:Qpos), QposEq e1 e2 -> forall s, (NearBy l1 e1 s <-> NearBy l2 e2 s). Proof. -cut (forall l1 l2 : X, -st_eq l1 l2 -> -forall e1 e2 : Qpos, -QposEq e1 e2 -> forall s : Stream X, NearBy l1 e1 s -> NearBy l2 e2 s). -intros. -split. -firstorder. -intros. -eapply H. -symmetry. -apply H0. -unfold QposEq; symmetry. -apply H1. -assumption. - -unfold NearBy; simpl. -intros l1 l2 Hl e1 e2 He. -cofix. -intros s [H0 H]. -constructor. -simpl. -rewrite <- Hl. -rewrite <- He. -assumption. -auto. + cut (forall l1 l2 : X, st_eq l1 l2 -> forall e1 e2 : Qpos, + QposEq e1 e2 -> forall s : Stream X, NearBy l1 e1 s -> NearBy l2 e2 s). + intros. + split. + firstorder. + intros. + eapply H. + symmetry. + apply H0. + unfold QposEq; symmetry. + apply H1. + assumption. + unfold NearBy; simpl. + intros l1 l2 Hl e1 e2 He. + cofix. + intros s [H0 H]. + constructor. + simpl. + rewrite <- Hl. + rewrite <- He. + assumption. + auto. Qed. Lemma NearBy_weak: forall l (e1 e2:Qpos), e1 <= e2 -> forall s, NearBy l e1 s -> NearBy l e2 s. Proof. -unfold NearBy; simpl. -intros l e1 e2 He. -cofix. -intros s [H0 H]. -constructor. -eapply ball_weak_le. -apply He. -assumption. -auto. + unfold NearBy; simpl. + intros l e1 e2 He. + cofix. + intros s [H0 H]. + constructor. + eapply ball_weak_le. + apply He. + assumption. + auto. Qed. (** l is the limit if for every e there exists a point where the stream is @@ -182,26 +177,26 @@ Definition Limit (s:Stream X)(l:X) := forall e, LazyExists (NearBy l e) s. Lemma Limit_tl : forall s l, Limit s l -> Limit (tl s) l. Proof. -intros s l H e. -destruct (H e) as [[_ H']|H']. -left; auto. -apply H'. -constructor. + intros s l H e. + destruct (H e) as [[_ H']|H']. + left; auto. + apply H'. + constructor. Defined. Lemma Limit_Str_nth_tl : forall n s l, Limit s l -> Limit (Str_nth_tl n s) l. Proof. -induction n. - tauto. -intros. -simpl. -apply IHn. -apply Limit_tl. -assumption. + induction n. + tauto. + intros. + simpl. + apply IHn. + apply Limit_tl. + assumption. Defined. End Limit. (* begin hide *) Implicit Arguments NearBy [X]. Implicit Arguments Limit [X]. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/metric2/Metric.v b/metric2/Metric.v index 30f1aa6ea..412ce4fe1 100644 --- a/metric2/Metric.v +++ b/metric2/Metric.v @@ -50,9 +50,9 @@ Record is_MetricSpace (X:Setoid) (B: Qpos -> relation X) : Prop := Record MetricSpace : Type := { msp_is_setoid :> Setoid ; ball : Qpos -> msp_is_setoid -> msp_is_setoid -> Prop -; ball_wd : forall (e1 e2:Qpos), (QposEq e1 e2) -> - forall x1 x2, (st_eq x1 x2) -> - forall y1 y2, (st_eq y1 y2) -> +; ball_wd : forall (e1 e2:Qpos), (QposEq e1 e2) -> + forall x1 x2, (st_eq x1 x2) -> + forall y1 y2, (st_eq y1 y2) -> (ball e1 x1 y1 <-> ball e2 x2 y2) ; msp : is_MetricSpace msp_is_setoid ball }. @@ -66,7 +66,8 @@ Definition ms_id (m:MetricSpace) (x:m) : m := x. Implicit Arguments ms_id [m]. Add Parametric Morphism (m:MetricSpace) : (@ball m) with signature QposEq ==> (@st_eq m) ==> (@st_eq m) ==> iff as ball_compat. -exact (@ball_wd m). +Proof. + exact (@ball_wd m). Qed. (* end hide *) @@ -78,41 +79,41 @@ Section Metric_Space. Variable X : MetricSpace. -(** These lemmas give direct access to the ball axioms of a metric space +(** These lemmas give direct access to the ball axioms of a metric space *) Lemma ball_refl : forall e (a:X), ball e a a. Proof. -apply (msp_refl (msp X)). + apply (msp_refl (msp X)). Qed. Lemma ball_sym : forall e (a b:X), ball e a b -> ball e b a. Proof. -apply (msp_sym (msp X)). + apply (msp_sym (msp X)). Qed. Lemma ball_triangle : forall e1 e2 (a b c:X), ball e1 a b -> ball e2 b c -> ball (e1+e2) a c. Proof. -apply (msp_triangle (msp X)). + apply (msp_triangle (msp X)). Qed. Lemma ball_closed : forall e (a b:X), (forall d, ball (e+d) a b) -> ball e a b. Proof. -apply (msp_closed (msp X)). + apply (msp_closed (msp X)). Qed. Lemma ball_eq : forall (a b:X), (forall e, ball e a b) -> st_eq a b. Proof. -apply (msp_eq (msp X)). + apply (msp_eq (msp X)). Qed. Lemma ball_eq_iff : forall (a b:X), (forall e, ball e a b) <-> st_eq a b. Proof. -split. -apply ball_eq. -intros H e. -rewrite H. -apply ball_refl. + split. + apply ball_eq. + intros H e. + rewrite H. + apply ball_refl. Qed. (** The ball constraint on a and b can always be weakened. Here are @@ -121,29 +122,29 @@ two forms of the weakening lemma. Lemma ball_weak : forall e d (a b:X), ball e a b -> ball (e+d) a b. Proof. -intros e d a b B1. -eapply ball_triangle. -apply B1. -apply ball_refl. + intros e d a b B1. + eapply ball_triangle. + apply B1. + apply ball_refl. Qed. Hint Resolve ball_refl ball_triangle ball_weak : metric. Lemma ball_weak_le : forall (e d:Qpos) (a b:X), e<=d -> ball e a b -> ball d a b. Proof. -intros e d a b Hed B1. -destruct (Qle_lt_or_eq _ _ Hed). -destruct (Qpos_lt_plus H) as [c Hc]. -rewrite <- Q_Qpos_plus in Hc. -change (QposEq d (e+c)) in Hc. -rewrite Hc; clear - B1. -auto with *. -change (QposEq e d) in H. -rewrite <- H. -assumption. + intros e d a b Hed B1. + destruct (Qle_lt_or_eq _ _ Hed). + destruct (Qpos_lt_plus H) as [c Hc]. + rewrite <- Q_Qpos_plus in Hc. + change (QposEq d (e+c)) in Hc. + rewrite Hc; clear - B1. + auto with *. + change (QposEq e d) in H. + rewrite <- H. + assumption. Qed. End Metric_Space. (* begin hide *) Hint Resolve ball_refl ball_sym ball_triangle ball_weak : metric. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/metric2/Prelength.v b/metric2/Prelength.v index bec3437c6..c5a2b8a0c 100644 --- a/metric2/Prelength.v +++ b/metric2/Prelength.v @@ -52,7 +52,7 @@ Variable X:MetricSpace. (** The notion of a prelength space is neatly characterized by the following simple definition. *) Definition PrelengthSpace := -forall (a b:X) (e d1 d2:Qpos), e < d1+d2 -> ball e a b -> +forall (a b:X) (e d1 d2:Qpos), e < d1+d2 -> ball e a b -> exists2 c:X, ball d1 a c & ball d2 c b. (** There is some evidence that we should be using the classical @@ -67,81 +67,78 @@ Hypothesis prelength : PrelengthSpace. that is arbitarily close to e and with arbitrarily short hops. *) Lemma trail : forall dl e (a b:X), ball e a b -> - e < QposSum dl -> + e < QposSum dl -> let n := length dl in - (exists2 f : nat -> X, f 0 = a /\ f n = b + (exists2 f : nat -> X, f 0 = a /\ f n = b & forall i z, i < n -> ball (nth i dl z) (f i) (f (S i)))%nat. Proof. -induction dl. -intros e a b H H1. -simpl in *. -elim (less_antisymmetric_unfolded _ (e:Q) 0);solve[assumption|apply Qpos_prf]. - -rename a into x. -intros e a b B pe. -simpl in pe. - -destruct dl. -simpl in *. -pose (f:= (fun n => match n with O => a | S _ => b end)). -exists f; auto. -intros [|i] z H;[|elimtype False; auto with *]. -clear z H. -ring_simplify in pe. -apply ball_weak_le with e. -apply Qlt_le_weak; assumption. -assumption. - -set (Sigma := QposSum (q::dl)). -pose (g := ((Qmax 0 (e-x))+Sigma)/2). -assert ((Qmax 0 (e-x))Q). -apply QposAsmkQpos. -assert (e match n with O => a | S n' => f' n' end). -auto. -intros [|i] z Hi. -simpl. -congruence. -apply Hf'3. -auto with *. + induction dl. + intros e a b H H1. + simpl in *. + elim (less_antisymmetric_unfolded _ (e:Q) 0);solve[assumption|apply Qpos_prf]. + rename a into x. + intros e a b B pe. + simpl in pe. + destruct dl. + simpl in *. + pose (f:= (fun n => match n with O => a | S _ => b end)). + exists f; auto. + intros [|i] z H;[|elimtype False; auto with *]. + clear z H. + ring_simplify in pe. + apply ball_weak_le with e. + apply Qlt_le_weak; assumption. + assumption. + set (Sigma := QposSum (q::dl)). + pose (g := ((Qmax 0 (e-x))+Sigma)/2). + assert ((Qmax 0 (e-x))Q). + apply QposAsmkQpos. + assert (e match n with O => a | S n' => f' n' end). + auto. + intros [|i] z Hi. + simpl. + congruence. + apply Hf'3. + auto with *. Qed. Variable Y:MetricSpace. (** The major applicaiton of prelength spaces is that it allows one to -reduce the problem of [ball (e1 + e2) (f a) (f b)] to +reduce the problem of [ball (e1 + e2) (f a) (f b)] to [ball (mu f e1 + mu f e2) a b] instead of reduceing it to [ball (mu f (e1 + e2)) a b]. This new reduction allows one to continue reasoning by making use of the triangle law. @@ -152,134 +149,128 @@ Lemma mu_sum : forall e0 (es : list Qpos) (f:UniformlyContinuousFunction X Y) a ball_ex (fold_right QposInf_plus (mu f e0) (map (mu f) es)) a b -> ball (fold_right Qpos_plus e0 es) (f a) (f b). Proof. -intros e0 es f a b Hab. -apply ball_closed. -intros e'. -setoid_replace (fold_right Qpos_plus e0 es + e')%Qpos with (fold_right Qpos_plus e0 (e'::es)) by (simpl;QposRing). -set (ds := map (mu f) es) in *. -set (d0 := (mu f e0)) in *. -set (d' := (mu f e')) in *. - -assert (H:{ds' | (map Qpos2QposInf ds')=d0::d'::ds}+{In QposInfinity (d0::d'::ds)}). -generalize (d0::d'::ds); clear. -induction l as [|[d|] ds]. -left. -exists (@nil Qpos). -reflexivity. -destruct IHds as [[ds' Hds']|Hds]. -left. -exists (d::ds'). -rewrite <- Hds'. -reflexivity. -firstorder. -firstorder. - -destruct H as [[ds' Hds']|Hds]. - -destruct ds' as [|g0 [|g' gs]]; try discriminate Hds'. -inversion Hds'. -clear Hds'. -unfold d0 in *; clear d0. -unfold d' in *; clear d'. -unfold ds in *; clear ds. -replace (fold_right QposInf_plus (mu f e0) (map (mu f) es)) - with (Qpos2QposInf (fold_right Qpos_plus g0 gs)) in Hab. -simpl in Hab. -assert (H:(fold_right Qpos_plus g0 gs < QposSum ((g' :: gs)++(g0::nil)))). -simpl. -replace LHS with (QposSum (gs ++ g0::nil)). -rewrite Qlt_minus_iff. -ring_simplify. -apply Qpos_prf. -clear - g0. -induction gs. -simpl; ring. -simpl. -rewrite Q_Qpos_plus. -rewrite IHgs. -reflexivity. -case (trail _ _ _ Hab H). -clear Hab H. -cut (map Qpos2QposInf (g' :: gs) = map (mu f) (e' :: es)). -clear H2 H1. -generalize (e'::es) (g'::gs) a. -clear gs g' es e' a. -induction l as [|e es]; intros gs a Hes x [Ha Hb] H; -destruct gs; try discriminate Hes. -simpl in *. -apply uc_prf. -rewrite <- H0. -rewrite <- Hb. -rewrite <- Ha. -simpl. -apply (H 0%nat g0). -auto with *. -simpl. -inversion Hes; clear Hes. -eapply ball_triangle. -apply uc_prf. -rewrite <- H2. -rewrite <- Ha. -simpl; apply (H 0%nat g0). -simpl; auto with *. -apply (IHes _ (x 1%nat) H3 (fun i => x (S i))); try auto with *. -intros. -apply (H (S i) z). -simpl; auto with *. -simpl; congruence. -rewrite <- H2. -rewrite <- H0. -clear - gs. -induction gs. -reflexivity. -simpl. -rewrite <- IHgs. -reflexivity. - -assert (H:forall (e:Qpos) es, e < (fold_right Qpos_plus e0 es)%Qpos -> (mu f e)=QposInfinity -> ball (m:=Y) (fold_right Qpos_plus e0 es) (f a) (f b)). -intros e esx He Hmu. -apply ball_weak_le with e;[apply Qlt_le_weak; assumption|]. -apply uc_prf. -rewrite Hmu. -constructor. - -case (in_inv Hds). -intros Hd0. -apply H with e0. -clear - es. -induction es. -simpl. -rewrite Q_Qpos_plus. -rewrite Qlt_minus_iff. -ring_simplify. -apply Qpos_prf. -simpl. -replace RHS with (a+(fold_right Qpos_plus e0 (e'::es))) by (simpl;QposRing). -eapply Qlt_trans. -apply IHes. -rewrite Qlt_minus_iff. -ring_simplify. -apply Qpos_prf. -assumption. -clear Hds. -change (d'::ds) with (map (mu f) (e'::es)). -induction (e'::es); intros Hds. -elim Hds. -simpl in Hds. -destruct Hds as [Ha0|Hds]. -apply H with a0. -simpl. -rewrite Q_Qpos_plus. -rewrite Qlt_minus_iff. -ring_simplify. -apply Qpos_prf. -assumption. -simpl. -eapply ball_weak_le with (fold_right Qpos_plus e0 l). -rewrite Q_Qpos_plus. -rewrite Qle_minus_iff; ring_simplify. -auto with *. -auto. + intros e0 es f a b Hab. + apply ball_closed. + intros e'. + setoid_replace (fold_right Qpos_plus e0 es + e')%Qpos with (fold_right Qpos_plus e0 (e'::es)) by (simpl;QposRing). + set (ds := map (mu f) es) in *. + set (d0 := (mu f e0)) in *. + set (d' := (mu f e')) in *. + assert (H:{ds' | (map Qpos2QposInf ds')=d0::d'::ds}+{In QposInfinity (d0::d'::ds)}). + generalize (d0::d'::ds); clear. + induction l as [|[d|] ds]. + left. + exists (@nil Qpos). + reflexivity. + destruct IHds as [[ds' Hds']|Hds]. + left. + exists (d::ds'). + rewrite <- Hds'. + reflexivity. + firstorder. + firstorder. + destruct H as [[ds' Hds']|Hds]. + destruct ds' as [|g0 [|g' gs]]; try discriminate Hds'. + inversion Hds'. + clear Hds'. + unfold d0 in *; clear d0. + unfold d' in *; clear d'. + unfold ds in *; clear ds. + replace (fold_right QposInf_plus (mu f e0) (map (mu f) es)) + with (Qpos2QposInf (fold_right Qpos_plus g0 gs)) in Hab. + simpl in Hab. + assert (H:(fold_right Qpos_plus g0 gs < QposSum ((g' :: gs)++(g0::nil)))). + simpl. + replace LHS with (QposSum (gs ++ g0::nil)). + rewrite Qlt_minus_iff. + ring_simplify. + apply Qpos_prf. + clear - g0. + induction gs. + simpl; ring. + simpl. + rewrite Q_Qpos_plus. + rewrite IHgs. + reflexivity. + case (trail _ _ _ Hab H). + clear Hab H. + cut (map Qpos2QposInf (g' :: gs) = map (mu f) (e' :: es)). + clear H2 H1. + generalize (e'::es) (g'::gs) a. + clear gs g' es e' a. + induction l as [|e es]; intros gs a Hes x [Ha Hb] H; destruct gs; try discriminate Hes. + simpl in *. + apply uc_prf. + rewrite <- H0. + rewrite <- Hb. + rewrite <- Ha. + simpl. + apply (H 0%nat g0). + auto with *. + simpl. + inversion Hes; clear Hes. + eapply ball_triangle. + apply uc_prf. + rewrite <- H2. + rewrite <- Ha. + simpl; apply (H 0%nat g0). + simpl; auto with *. + apply (IHes _ (x 1%nat) H3 (fun i => x (S i))); try auto with *. + intros. + apply (H (S i) z). + simpl; auto with *. + simpl; congruence. + rewrite <- H2. + rewrite <- H0. + clear - gs. + induction gs. + reflexivity. + simpl. + rewrite <- IHgs. + reflexivity. + assert (H:forall (e:Qpos) es, e < (fold_right Qpos_plus e0 es)%Qpos -> (mu f e)=QposInfinity -> ball (m:=Y) (fold_right Qpos_plus e0 es) (f a) (f b)). + intros e esx He Hmu. + apply ball_weak_le with e;[apply Qlt_le_weak; assumption|]. + apply uc_prf. + rewrite Hmu. + constructor. + case (in_inv Hds). + intros Hd0. + apply H with e0. + clear - es. + induction es. + simpl. + rewrite Q_Qpos_plus. + rewrite Qlt_minus_iff. + ring_simplify. + apply Qpos_prf. + simpl. + replace RHS with (a+(fold_right Qpos_plus e0 (e'::es))) by (simpl;QposRing). + eapply Qlt_trans. + apply IHes. + rewrite Qlt_minus_iff. + ring_simplify. + apply Qpos_prf. + assumption. + clear Hds. + change (d'::ds) with (map (mu f) (e'::es)). + induction (e'::es); intros Hds. + elim Hds. + simpl in Hds. + destruct Hds as [Ha0|Hds]. + apply H with a0. + simpl. + rewrite Q_Qpos_plus. + rewrite Qlt_minus_iff. + ring_simplify. + apply Qpos_prf. + assumption. + simpl. + eapply ball_weak_le with (fold_right Qpos_plus e0 l). + rewrite Q_Qpos_plus. + rewrite Qle_minus_iff; ring_simplify. + auto with *. + auto. Qed. End Prelength_Space. @@ -305,15 +296,15 @@ f (approximate x (QposInf_bind (mu f) e)). Lemma Cmap_fun_prf (x:Complete X) : is_RegularFunction (fun e => f (approximate x (QposInf_bind (mu f) e))). Proof. -intros x e1 e2. -simpl. -apply (@mu_sum X plX Y e2 (e1::nil)). -simpl. -destruct (mu f e1) as [d1|]. -destruct (mu f e2) as [d2|]. -apply: regFun_prf. -constructor. -constructor. + intros x e1 e2. + simpl. + apply (@mu_sum X plX Y e2 (e1::nil)). + simpl. + destruct (mu f e1) as [d1|]. + destruct (mu f e2) as [d2|]. + apply: regFun_prf. + constructor. + constructor. Qed. Definition Cmap_fun (x:Complete X) : Complete Y := @@ -321,17 +312,17 @@ Build_RegularFunction (Cmap_fun_prf x). Lemma Cmap_prf : is_UniformlyContinuousFunction Cmap_fun (mu f). Proof. -intros e0 x y Hxy e1 e2. -simpl. -setoid_replace (e1+e0+e2)%Qpos with (e1+(e0+e2))%Qpos by QposRing. -apply (@mu_sum X plX Y e2 (e1::e0::nil)). -simpl. -destruct (mu f e1) as [d1|];[|constructor]. -destruct (mu f e0) as [d0|];[|constructor]. -destruct (mu f e2) as [d2|];[|constructor]. -simpl in *. -setoid_replace (d1+(d0+d2))%Qpos with (d1+d0+d2)%Qpos by QposRing. -apply Hxy. + intros e0 x y Hxy e1 e2. + simpl. + setoid_replace (e1+e0+e2)%Qpos with (e1+(e0+e2))%Qpos by QposRing. + apply (@mu_sum X plX Y e2 (e1::e0::nil)). + simpl. + destruct (mu f e1) as [d1|];[|constructor]. + destruct (mu f e0) as [d0|];[|constructor]. + destruct (mu f e2) as [d2|];[|constructor]. + simpl in *. + setoid_replace (d1+(d0+d2))%Qpos with (d1+d0+d2)%Qpos by QposRing. + apply Hxy. Qed. Definition Cmap : (Complete X) --> (Complete Y) := @@ -340,22 +331,22 @@ Build_UniformlyContinuousFunction Cmap_prf. (** [Cmap] is equivalent to the original [Cmap_slow] *) Lemma Cmap_correct : st_eq Cmap (Cmap_slow f). Proof. -intros x e1 e2. -simpl. -unfold Cmap_slow_raw. -apply (@mu_sum X plX Y e2 (e1::nil)). -simpl. -destruct (mu f e1) as [d1|]; try constructor. -destruct (mu f e2) as [d2|]; try constructor. -simpl. -eapply ball_weak_le;[|apply regFun_prf]. -autorewrite with QposElim. -Qauto_le. + intros x e1 e2. + simpl. + unfold Cmap_slow_raw. + apply (@mu_sum X plX Y e2 (e1::nil)). + simpl. + destruct (mu f e1) as [d1|]; try constructor. + destruct (mu f e2) as [d2|]; try constructor. + simpl. + eapply ball_weak_le;[|apply regFun_prf]. + autorewrite with QposElim. + Qauto_le. Qed. Lemma Cmap_fun_correct : forall x, st_eq (Cmap_fun x) (Cmap_slow_fun f x). Proof. -apply Cmap_correct. + apply Cmap_correct. Qed. End Map. @@ -367,25 +358,25 @@ Definition Cbind X Y plX (f:X-->Complete Y) := uc_compose Cjoin (Cmap plX f). Lemma Cbind_correct : forall X Y plX (f:X-->Complete Y), st_eq (Cbind plX f) (Cbind_slow f). Proof. -unfold Cbind, Cbind_slow. -intros X Y plX f. -rewrite (Cmap_correct). -reflexivity. + unfold Cbind, Cbind_slow. + intros X Y plX f. + rewrite (Cmap_correct). + reflexivity. Qed. Lemma Cbind_fun_correct : forall X Y plX (f:X-->Complete Y) x, st_eq (Cbind plX f x) (Cbind_slow f x). Proof. -apply Cbind_correct. + apply Cbind_correct. Qed. (** Similarly we define a new Cmap_strong *) Lemma Cmap_strong_prf : forall (X Y:MetricSpace) (plX:PrelengthSpace X), is_UniformlyContinuousFunction (@Cmap X Y plX) Qpos2QposInf. Proof. -intros X Y plX e a b Hab. -do 2 rewrite Cmap_correct. -apply Cmap_strong_slow_prf. -auto. + intros X Y plX e a b Hab. + do 2 rewrite Cmap_correct. + apply Cmap_strong_slow_prf. + auto. Qed. Definition Cmap_strong X Y plX : (X --> Y) --> (Complete X --> Complete Y) := @@ -393,8 +384,8 @@ Build_UniformlyContinuousFunction (@Cmap_strong_prf X Y plX). Lemma Cmap_strong_correct : forall X Y plX, st_eq (@Cmap_strong X Y plX) (@Cmap_strong_slow X Y). Proof. -intros X Y plX. -apply: Cmap_correct. + intros X Y plX. + apply: Cmap_correct. Qed. (** Similarly we define a new Cap *) @@ -403,24 +394,24 @@ Definition Cap_raw X Y plX (f:Complete (X --> Y)) (x:Complete X) (e:QposInf) := Lemma Cap_fun_prf X Y plX (f:Complete (X --> Y)) (x:Complete X) : is_RegularFunction (Cap_raw plX f x). Proof. -intros X Y plX f x e1 e2. -unfold Cap_raw. -unfold Cap_raw. -unfold QposInf_mult, QposInf_bind. -set (he1 := ((1 # 2) * e1)%Qpos). -set (he2 := ((1 # 2) * e2)%Qpos). -set (f1 := (approximate f he1)). -set (f2 := (approximate f he2)). -change (Cmap (Y:=Y) plX f1) with (Cmap_strong Y plX f1). -change (Cmap (Y:=Y) plX f2) with (Cmap_strong Y plX f2). -set (y1 :=(Cmap_strong Y plX f1 x)). -set (y2 :=(Cmap_strong Y plX f2 x)). -setoid_replace (e1 + e2)%Qpos with (he1 + (he1 + he2) + he2)%Qpos by (unfold he1, he2; QposRing). -rewrite <- ball_Cunit. -apply ball_triangle with y2;[|apply ball_approx_r]. -apply ball_triangle with y1;[apply ball_approx_l|]. -apply (uc_prf (Cmap_strong Y plX)). -apply: regFun_prf. + intros X Y plX f x e1 e2. + unfold Cap_raw. + unfold Cap_raw. + unfold QposInf_mult, QposInf_bind. + set (he1 := ((1 # 2) * e1)%Qpos). + set (he2 := ((1 # 2) * e2)%Qpos). + set (f1 := (approximate f he1)). + set (f2 := (approximate f he2)). + change (Cmap (Y:=Y) plX f1) with (Cmap_strong Y plX f1). + change (Cmap (Y:=Y) plX f2) with (Cmap_strong Y plX f2). + set (y1 :=(Cmap_strong Y plX f1 x)). + set (y2 :=(Cmap_strong Y plX f2 x)). + setoid_replace (e1 + e2)%Qpos with (he1 + (he1 + he2) + he2)%Qpos by (unfold he1, he2; QposRing). + rewrite <- ball_Cunit. + apply ball_triangle with y2;[|apply ball_approx_r]. + apply ball_triangle with y1;[apply ball_approx_l|]. + apply (uc_prf (Cmap_strong Y plX)). + apply: regFun_prf. Qed. Definition Cap_fun X Y plX (f:Complete (X --> Y)) (x:Complete X) : Complete Y := @@ -428,46 +419,44 @@ Build_RegularFunction (Cap_fun_prf plX f x). Lemma Cap_fun_correct : forall X Y plX (f:Complete (X --> Y)) x, st_eq (Cap_fun plX f x) (Cap_slow_fun f x). Proof. -intros X Y plX f x e1 e2. -simpl. -unfold Cap_raw, Cap_slow_raw. -set (e1':=((1 # 2)%Qpos * e1)%Qpos). -set (e2':=((1 # 2)%Qpos * e2)%Qpos). -change (ball (e1 + e2) - (approximate (Cmap plX (approximate f ((1 # 2) * e1)%Qpos) x) e1') - (approximate (Cmap_slow (approximate f ((1 # 2) * e2)%Qpos) x) e2')). -setoid_replace (e1 + e2)%Qpos with (e1' + (((1 # 2) * e1)%Qpos + ((1 # 2) * e2)%Qpos) + e2')%Qpos by (unfold e1', e2'; QposRing). -generalize x e1' e2'. -change (ball ((1 # 2) * e1 + (1 # 2) * e2) - (Cmap plX (approximate f ((1 # 2) * e1)%Qpos)) - (Cmap_slow (approximate f ((1 # 2) * e2)%Qpos))). -rewrite Cmap_correct. -set (f1:=(approximate f ((1 # 2) * e1)%Qpos)). -set (f2:=(approximate f ((1 # 2) * e2)%Qpos)). -apply Cmap_strong_slow_prf. -apply regFun_prf. + intros X Y plX f x e1 e2. + simpl. + unfold Cap_raw, Cap_slow_raw. + set (e1':=((1 # 2)%Qpos * e1)%Qpos). + set (e2':=((1 # 2)%Qpos * e2)%Qpos). + change (ball (e1 + e2) (approximate (Cmap plX (approximate f ((1 # 2) * e1)%Qpos) x) e1') + (approximate (Cmap_slow (approximate f ((1 # 2) * e2)%Qpos) x) e2')). + setoid_replace (e1 + e2)%Qpos with (e1' + (((1 # 2) * e1)%Qpos + ((1 # 2) * e2)%Qpos) + e2')%Qpos by (unfold e1', e2'; QposRing). + generalize x e1' e2'. + change (ball ((1 # 2) * e1 + (1 # 2) * e2) (Cmap plX (approximate f ((1 # 2) * e1)%Qpos)) + (Cmap_slow (approximate f ((1 # 2) * e2)%Qpos))). + rewrite Cmap_correct. + set (f1:=(approximate f ((1 # 2) * e1)%Qpos)). + set (f2:=(approximate f ((1 # 2) * e2)%Qpos)). + apply Cmap_strong_slow_prf. + apply regFun_prf. Qed. Definition Cap_modulus X Y (f:Complete (X --> Y)) (e:Qpos) : QposInf := (mu (approximate f ((1#3)*e)%Qpos) ((1#3)*e)). Lemma Cap_weak_prf X Y plX (f:Complete (X --> Y)) : is_UniformlyContinuousFunction (Cap_fun plX f) (Cap_modulus f). Proof. -intros X Y plX f e x y H. -set (e' := ((1#3)*e)%Qpos). -setoid_replace e with (e'+e'+e')%Qpos by (unfold e';QposRing). -apply ball_triangle with (Cmap plX (approximate f e') y). -apply ball_triangle with (Cmap plX (approximate f e') x). -rewrite Cap_fun_correct. -simpl (Cmap plX (approximate f e') x). -rewrite Cmap_fun_correct. -apply Cap_slow_help. -apply (uc_prf). -apply H. -apply ball_sym. -rewrite Cap_fun_correct. -simpl (Cmap plX (approximate f e') y). -rewrite Cmap_fun_correct. -apply Cap_slow_help. + intros X Y plX f e x y H. + set (e' := ((1#3)*e)%Qpos). + setoid_replace e with (e'+e'+e')%Qpos by (unfold e';QposRing). + apply ball_triangle with (Cmap plX (approximate f e') y). + apply ball_triangle with (Cmap plX (approximate f e') x). + rewrite Cap_fun_correct. + simpl (Cmap plX (approximate f e') x). + rewrite Cmap_fun_correct. + apply Cap_slow_help. + apply (uc_prf). + apply H. + apply ball_sym. + rewrite Cap_fun_correct. + simpl (Cmap plX (approximate f e') y). + rewrite Cmap_fun_correct. + apply Cap_slow_help. Qed. Definition Cap_weak X Y plX (f:Complete (X --> Y)) : Complete X --> Complete Y := @@ -475,15 +464,15 @@ Build_UniformlyContinuousFunction (Cap_weak_prf plX f). Lemma Cap_weak_correct : forall X Y plX (f:Complete (X --> Y)), st_eq (Cap_weak plX f) (Cap_weak_slow f). Proof. -apply: Cap_fun_correct. + apply: Cap_fun_correct. Qed. Lemma Cap_prf X Y plX : is_UniformlyContinuousFunction (@Cap_weak X Y plX) Qpos2QposInf. Proof. -intros X Y plX e a b Hab. -do 2 rewrite Cap_weak_correct. -apply Cap_slow_prf. -auto. + intros X Y plX e a b Hab. + do 2 rewrite Cap_weak_correct. + apply Cap_slow_prf. + auto. Qed. Definition Cap X Y plX : Complete (X --> Y) --> Complete X --> Complete Y := @@ -491,32 +480,34 @@ Build_UniformlyContinuousFunction (Cap_prf plX). Lemma Cap_correct : forall X Y plX, st_eq (Cap Y plX) (Cap_slow X Y). Proof. -apply: Cap_fun_correct. + apply: Cap_fun_correct. Qed. (* begin hide *) Add Parametric Morphism X Y plX : (@Cmap_fun X Y plX) with signature (@st_eq _) ==> (@st_eq _) ==> (@st_eq _) as Cmap_wd. Proof. -intros x1 x2 Hx y1 y2 Hy. -change (st_eq (Cmap_fun plX x1 y1) (Cmap_fun plX x2 y2)). -rewrite Cmap_fun_correct. -set (a:=(Cmap_slow_fun x1 y1)). -rewrite Cmap_fun_correct. -apply Cmap_slow_wd; auto. + intros x1 x2 Hx y1 y2 Hy. + change (st_eq (Cmap_fun plX x1 y1) (Cmap_fun plX x2 y2)). + rewrite Cmap_fun_correct. + set (a:=(Cmap_slow_fun x1 y1)). + rewrite Cmap_fun_correct. + apply Cmap_slow_wd; auto. Qed. Add Parametric Morphism X Y H : (@Cap_weak X Y H) with signature (@st_eq _) ==> (@st_eq _) as Cap_weak_wd. -intros x1 x2 Hx. -apply: (@uc_wd _ _ (Cap Y H));assumption. +Proof. + intros x1 x2 Hx. + apply: (@uc_wd _ _ (Cap Y H));assumption. Qed. Add Parametric Morphism X Y H : (@Cap_fun X Y H) with signature (@st_eq _) ==> (@st_eq _) ==> (@st_eq _) as Cap_wd. -intros x1 x2 Hx y1 y2 Hy. -change (st_eq (Cap_fun H x1 y1) (Cap_fun H x2 y2)). -transitivity (Cap_fun H x1 y2). -apply (@uc_wd _ _ (Cap_weak H x1) _ _ Hy). -generalize y2. -apply: (@uc_wd _ _ (Cap Y H));assumption. +Proof. + intros x1 x2 Hx y1 y2 Hy. + change (st_eq (Cap_fun H x1 y1) (Cap_fun H x2 y2)). + transitivity (Cap_fun H x1 y2). + apply (@uc_wd _ _ (Cap_weak H x1) _ _ Hy). + generalize y2. + apply: (@uc_wd _ _ (Cap Y H));assumption. Qed. (* end hide *) @@ -528,67 +519,67 @@ In fact the completion of a prelenght space is a length space, but we have not formalized the notion of a length space yet. *) Lemma CompletePL : forall X, PrelengthSpace X -> PrelengthSpace (Complete X). Proof. -intros X Xpl x y e d1 d2 He Hxy. -setoid_replace (d1+d2) with ((d1+d2)%Qpos:Q) in He by QposRing. -destruct (Qpos_lt_plus He). -pose (gA := ((1#5)*x0)%Qpos). -pose (g := Qpos_min (Qpos_min ((1#2)*d1) ((1#2)*d2)) gA). -unfold PrelengthSpace in Xpl. -assert (Hd1:g < d1). -unfold g. -eapply Qle_lt_trans. -apply Qpos_min_lb_l. -eapply Qle_lt_trans. -apply Qpos_min_lb_l. -apply (half_3 _ (d1:Q)). -apply Qpos_prf. -assert (Hd2:g < d2). -unfold g. -eapply Qle_lt_trans. -apply Qpos_min_lb_l. -eapply Qle_lt_trans. -apply Qpos_min_lb_r. -apply (half_3 _ (d2:Q)). -apply Qpos_prf. -destruct (Qpos_lt_plus Hd1) as [d1' Hd1']. -destruct (Qpos_lt_plus Hd2) as [d2' Hd2']. -assert (He':(g + e + g)%Qpos < d1' + d2'). -apply: plus_cancel_less;simpl. -instantiate (1:= (g+g)). -replace RHS with ((g+d1')%Qpos+(g+d2')%Qpos) by QposRing. -unfold QposEq in *. -rewrite <- Hd1'. -rewrite <- Hd2'. -clear d1' Hd1' d2' Hd2'. -apply Qle_lt_trans with (e + 4*gA). -replace LHS with (e+4*g) by (unfold inject_Z;QposRing). -apply: plus_resp_leEq_lft. -apply: mult_resp_leEq_lft. -apply Qpos_min_lb_r. -compute; discriminate. -replace RHS with ((d1+d2)%Qpos:Q) by QposRing. -rewrite q. -replace RHS with (e+1*x0) by QposRing. -apply: plus_resp_less_lft;simpl. -replace LHS with ((4#5)*x0) by (unfold inject_Z, gA;QposRing). -apply: mult_resp_less. -constructor. -apply Qpos_prf. -destruct (Xpl _ _ _ _ _ He' (Hxy g g)) as [c Hc1 Hc2]. -exists (Cunit c). -rewrite <- Q_Qpos_plus in Hd1'. -change (QposEq d1 (g + d1')) in Hd1'. -rewrite Hd1'. -eapply ball_triangle. -apply ball_approx_r. -rewrite ball_Cunit. -assumption. -rewrite <- Q_Qpos_plus in Hd2'. -change (QposEq d2 (g + d2')) in Hd2'. -rewrite Hd2'. -setoid_replace (g + d2')%Qpos with (d2' + g)%Qpos by QposRing. -eapply ball_triangle with (Cunit (approximate y g)). -rewrite ball_Cunit. -assumption. -apply ball_approx_l. + intros X Xpl x y e d1 d2 He Hxy. + setoid_replace (d1+d2) with ((d1+d2)%Qpos:Q) in He by QposRing. + destruct (Qpos_lt_plus He). + pose (gA := ((1#5)*x0)%Qpos). + pose (g := Qpos_min (Qpos_min ((1#2)*d1) ((1#2)*d2)) gA). + unfold PrelengthSpace in Xpl. + assert (Hd1:g < d1). + unfold g. + eapply Qle_lt_trans. + apply Qpos_min_lb_l. + eapply Qle_lt_trans. + apply Qpos_min_lb_l. + apply (half_3 _ (d1:Q)). + apply Qpos_prf. + assert (Hd2:g < d2). + unfold g. + eapply Qle_lt_trans. + apply Qpos_min_lb_l. + eapply Qle_lt_trans. + apply Qpos_min_lb_r. + apply (half_3 _ (d2:Q)). + apply Qpos_prf. + destruct (Qpos_lt_plus Hd1) as [d1' Hd1']. + destruct (Qpos_lt_plus Hd2) as [d2' Hd2']. + assert (He':(g + e + g)%Qpos < d1' + d2'). + apply: plus_cancel_less;simpl. + instantiate (1:= (g+g)). + replace RHS with ((g+d1')%Qpos+(g+d2')%Qpos) by QposRing. + unfold QposEq in *. + rewrite <- Hd1'. + rewrite <- Hd2'. + clear d1' Hd1' d2' Hd2'. + apply Qle_lt_trans with (e + 4*gA). + replace LHS with (e+4*g) by (unfold inject_Z;QposRing). + apply: plus_resp_leEq_lft. + apply: mult_resp_leEq_lft. + apply Qpos_min_lb_r. + compute; discriminate. + replace RHS with ((d1+d2)%Qpos:Q) by QposRing. + rewrite q. + replace RHS with (e+1*x0) by QposRing. + apply: plus_resp_less_lft;simpl. + replace LHS with ((4#5)*x0) by (unfold inject_Z, gA;QposRing). + apply: mult_resp_less. + constructor. + apply Qpos_prf. + destruct (Xpl _ _ _ _ _ He' (Hxy g g)) as [c Hc1 Hc2]. + exists (Cunit c). + rewrite <- Q_Qpos_plus in Hd1'. + change (QposEq d1 (g + d1')) in Hd1'. + rewrite Hd1'. + eapply ball_triangle. + apply ball_approx_r. + rewrite ball_Cunit. + assumption. + rewrite <- Q_Qpos_plus in Hd2'. + change (QposEq d2 (g + d2')) in Hd2'. + rewrite Hd2'. + setoid_replace (g + d2')%Qpos with (d2' + g)%Qpos by QposRing. + eapply ball_triangle with (Cunit (approximate y g)). + rewrite ball_Cunit. + assumption. + apply ball_approx_l. Qed. diff --git a/metric2/ProductMetric.v b/metric2/ProductMetric.v index ab2558502..3725f36e3 100644 --- a/metric2/ProductMetric.v +++ b/metric2/ProductMetric.v @@ -38,12 +38,12 @@ st_eq (fst a) (fst b) /\ st_eq (snd a) (snd b). Lemma prodST : Setoid_Theory _ prod_st_eq. Proof. -split; unfold prod_st_eq. - intros; split; reflexivity. - intros x y [H1 H2]; split; symmetry; assumption. -intros x y z [H1 H2] [H3 H4]; split. - transitivity (fst y); assumption. -transitivity (snd y); assumption. + split; unfold prod_st_eq. + intros; split; reflexivity. + intros x y [H1 H2]; split; symmetry; assumption. + intros x y z [H1 H2] [H3 H4]; split. + transitivity (fst y); assumption. + transitivity (snd y); assumption. Qed. Definition prodS : Setoid := Build_Setoid prodST. @@ -57,55 +57,52 @@ ball e (fst a) (fst b) /\ ball e (snd a) (snd b). Lemma prod_ball_refl : forall e a, prod_ball e a a. Proof. -intros e a. -split; auto with *. + intros e a. + split; auto with *. Qed. Lemma prod_ball_sym : forall e a b, prod_ball e a b -> prod_ball e b a. Proof. -intros e a b [H1 H2]. -split; auto with *. + intros e a b [H1 H2]. + split; auto with *. Qed. Lemma prod_ball_triangle : forall e1 e2 a b c, prod_ball e1 a b -> prod_ball e2 b c -> prod_ball (e1 + e2) a c. Proof. -intros e1 e2 a b c [H1 H2] [H3 H4]. -split; eauto with metric. + intros e1 e2 a b c [H1 H2] [H3 H4]. + split; eauto with metric. Qed. Lemma prod_ball_closed : forall e a b, (forall d, prod_ball (e + d) a b) -> prod_ball e a b. Proof. -intros e a b H. -unfold prod_ball in *. -split; apply ball_closed; firstorder. + intros e a b H. + unfold prod_ball in *. + split; apply ball_closed; firstorder. Qed. Lemma prod_ball_eq : forall a b, (forall e, prod_ball e a b) -> prod_st_eq _ _ a b. Proof. -intros a b H. -unfold prod_ball in *. -split; apply ball_eq; firstorder. + intros a b H. + unfold prod_ball in *. + split; apply ball_eq; firstorder. Qed. Lemma prod_is_MetricSpace : is_MetricSpace (prodS X Y) prod_ball. Proof. -split. - apply: prod_ball_refl. - apply: prod_ball_sym. - apply: prod_ball_triangle. - apply: prod_ball_closed. -apply: prod_ball_eq. + split. + apply: prod_ball_refl. + apply: prod_ball_sym. + apply: prod_ball_triangle. + apply: prod_ball_closed. + apply: prod_ball_eq. Qed. Definition ProductMS : MetricSpace. -exists (prodS X Y) prod_ball. - abstract ( - intros e1 e2 He a1 a2 [Ha0 Ha1] b1 b2 [Hb0 Hb1]; - unfold prod_ball; - change (QposEq e1 e2) in He; - rewrite He Ha0 Ha1 Hb0 Hb1; - reflexivity) using prod_ball_wd. -apply prod_is_MetricSpace. +Proof. + exists (prodS X Y) prod_ball. + abstract ( intros e1 e2 He a1 a2 [Ha0 Ha1] b1 b2 [Hb0 Hb1]; unfold prod_ball; + change (QposEq e1 e2) in He; rewrite He Ha0 Ha1 Hb0 Hb1; reflexivity) using prod_ball_wd. + apply prod_is_MetricSpace. Defined. (** Product metrics preserve properties of metric spaces such as @@ -113,82 +110,81 @@ being a prelenght space, being stable, being located, and being deciable *) Lemma ProductMS_prelength : PrelengthSpace X -> PrelengthSpace Y -> PrelengthSpace ProductMS. Proof. -intros HX HY a b e d1 d2 Hed Hab. -destruct (HX (fst a) (fst b) e d1 d2 Hed (proj1 Hab)) as [c1 Hc1]. -destruct (HY (snd a) (snd b) e d1 d2 Hed (proj2 Hab)) as [c2 Hc2]. -exists (c1,c2); split; assumption. + intros HX HY a b e d1 d2 Hed Hab. + destruct (HX (fst a) (fst b) e d1 d2 Hed (proj1 Hab)) as [c1 Hc1]. + destruct (HY (snd a) (snd b) e d1 d2 Hed (proj2 Hab)) as [c2 Hc2]. + exists (c1,c2); split; assumption. Defined. Lemma ProductMS_stable : stableMetric X -> stableMetric Y -> stableMetric ProductMS. Proof. -unfold stableMetric. -intros H0 H1 e [xl xr] [yl yr] H. -simpl in H. -unfold prod_ball in H. -split. - apply H0; tauto. -apply H1; tauto. + unfold stableMetric. + intros H0 H1 e [xl xr] [yl yr] H. + simpl in H. + unfold prod_ball in H. + split. + apply H0; tauto. + apply H1; tauto. Qed. (** Furthermore, if a product space is stable, then the components are stable (assuming the components are non-zero). *) Lemma ProductMS_stableX : Y -> stableMetric ProductMS -> stableMetric X. Proof. -unfold stableMetric. -intros a H0 e x y H. -assert (Z:~ ~ ball (m:=ProductMS) e (x,a) (y,a)). - revert H. - cut (ball (m:=X) e x y -> - ball (m:=ProductMS) e (x, a) (y, a)). - tauto. - intros H. - split; auto. - apply ball_refl. -destruct (H0 _ _ _ Z). -assumption. + unfold stableMetric. + intros a H0 e x y H. + assert (Z:~ ~ ball (m:=ProductMS) e (x,a) (y,a)). + revert H. + cut (ball (m:=X) e x y -> ball (m:=ProductMS) e (x, a) (y, a)). + tauto. + intros H. + split; auto. + apply ball_refl. + destruct (H0 _ _ _ Z). + assumption. Qed. Lemma ProductMS_stableY : X -> stableMetric ProductMS -> stableMetric Y. Proof. -unfold stableMetric. -intros a H0 e x y H. -assert (Z:~ ~ ball (m:=ProductMS) e (a,x) (a,y)). - revert H. - cut (ball (m:=Y) e x y -> - ball (m:=ProductMS) e (a,x) (a, y)). - tauto. - intros H. - split; auto. - apply ball_refl. -destruct (H0 _ _ _ Z). -assumption. + unfold stableMetric. + intros a H0 e x y H. + assert (Z:~ ~ ball (m:=ProductMS) e (a,x) (a,y)). + revert H. + cut (ball (m:=Y) e x y -> ball (m:=ProductMS) e (a,x) (a, y)). + tauto. + intros H. + split; auto. + apply ball_refl. + destruct (H0 _ _ _ Z). + assumption. Qed. Lemma ProductMS_located : locatedMetric X -> locatedMetric Y -> locatedMetric ProductMS. Proof. -unfold locatedMetric. -intros H0 H1 e d x y Hed. -destruct (H0 _ _ (fst x) (fst y) Hed) as [A | A]. - destruct (H1 _ _ (snd x) (snd y) Hed) as [B | B]. - left. - split; assumption. - right; intros [_ H]. - apply B; assumption. -right; intros [H _]. -apply A; assumption. + unfold locatedMetric. + intros H0 H1 e d x y Hed. + destruct (H0 _ _ (fst x) (fst y) Hed) as [A | A]. + destruct (H1 _ _ (snd x) (snd y) Hed) as [B | B]. + left. + split; assumption. + right; intros [_ H]. + apply B; assumption. + right; intros [H _]. + apply A; assumption. Defined. Lemma ProductMS_decidable : decidableMetric X -> decidableMetric Y -> decidableMetric ProductMS. -unfold decidableMetric. -intros H0 H1 e x y. -destruct (H0 e (fst x) (fst y)) as [A | A]. - destruct (H1 e (snd x) (snd y)) as [B | B]. - left. - split; assumption. - right; intros [_ H]. - apply B; assumption. -right; intros [H _]. -apply A; assumption. +Proof. + unfold decidableMetric. + intros H0 H1 e x y. + destruct (H0 e (fst x) (fst y)) as [A | A]. + destruct (H1 e (snd x) (snd y)) as [B | B]. + left. + split; assumption. + right; intros [_ H]. + apply B; assumption. + right; intros [H _]. + apply A; assumption. Defined. (** This defines a pairing function with types of a metric space *) @@ -200,26 +196,25 @@ Implicit Arguments PairMS [X Y]. Add Parametric Morphism X Y : (@PairMS X Y) with signature (@st_eq _) ==> (@st_eq _) ==> (@st_eq _) as PairMS_wd. Proof. -intros. -split; assumption. + intros. + split; assumption. Qed. (* end hide *) Open Local Scope uc_scope. (** [together] forms the tensor of two functions operating between metric spaces *) -Lemma together_uc : forall A B C D (f:A --> C) (g:B --> D), +Lemma together_uc : forall A B C D (f:A --> C) (g:B --> D), is_UniformlyContinuousFunction (fun (p:ProductMS A B) => (f (fst p), g (snd p)):ProductMS C D) (fun x => QposInf_min (mu f x) (mu g x)). Proof. -intros A B C D f g e a b H. -split; simpl; apply uc_prf; - apply ball_ex_weak_le with (QposInf_min (mu f e) (mu g e)). - apply QposInf_min_lb_l. - destruct (QposInf_min (mu f e) (mu g e)) as [q|]; auto. - destruct H; auto. - apply QposInf_min_lb_r. -destruct (QposInf_min (mu f e) (mu g e)) as [q|]; auto. -destruct H; auto. + intros A B C D f g e a b H. + split; simpl; apply uc_prf; apply ball_ex_weak_le with (QposInf_min (mu f e) (mu g e)). + apply QposInf_min_lb_l. + destruct (QposInf_min (mu f e) (mu g e)) as [q|]; auto. + destruct H; auto. + apply QposInf_min_lb_r. + destruct (QposInf_min (mu f e) (mu g e)) as [q|]; auto. + destruct H; auto. Qed. Definition together A B C D (f:A --> C) (g:B --> D) : (ProductMS A B --> ProductMS C D) := diff --git a/metric2/StepFunction.v b/metric2/StepFunction.v index 255c9d1d4..87b2aaaf4 100644 --- a/metric2/StepFunction.v +++ b/metric2/StepFunction.v @@ -67,17 +67,17 @@ StepFfold constStepF (fun a l r => glue (OpenUnitDual a) r l). (** [Split] decomposes (and scales) a step function at a point o. It is essentially an inverse operation of glue *) Definition Split : StepF -> OpenUnit -> StepF*StepF. -fix 1. -intros s a. -destruct s as [x | b t1 t2]. - exact (constStepF x , constStepF x). - -destruct (Q_dec a b) as [[H|H]|H]. +Proof. + fix 1. + intros s a. + destruct s as [x | b t1 t2]. + exact (constStepF x , constStepF x). + destruct (Q_dec a b) as [[H|H]|H]. destruct (Split t1 (OpenUnitDiv a b H)) as [L R]. - exact (L, (glue (OpenUnitDualDiv b a H) R t2)). + exact (L, (glue (OpenUnitDualDiv b a H) R t2)). destruct (Split t2 (OpenUnitDualDiv a b H)) as [L R]. refine ((glue (OpenUnitDiv b a H) t1 L), R). - exact (t1,t2). + exact (t1,t2). Defined. Definition SplitL (s:StepF) (o:OpenUnit) : StepF := @@ -91,10 +91,10 @@ and [SplitL] *) Lemma Split_ind : forall s a (P:StepF*StepF -> Prop), (P (SplitL s a,SplitR s a)) -> P (Split s a). Proof. -intros s a P. -unfold SplitL, SplitR. -destruct (Split s a). -auto with *. + intros s a P. + unfold SplitL, SplitR. + destruct (Split s a). + auto with *. Qed. Lemma SplitLR_glue_ind : forall s1 s2 (a b:OpenUnit) (P:StepF -> StepF -> Prop), @@ -103,11 +103,10 @@ Lemma SplitLR_glue_ind : forall s1 s2 (a b:OpenUnit) (P:StepF -> StepF -> Prop), (a == b -> P s1 s2) -> P (SplitL (glue b s1 s2) a) (SplitR (glue b s1 s2) a). Proof. -intros s1 s2 a b P Hl Hr Heq. -unfold SplitL, SplitR. -simpl. -destruct (Q_dec a b) as [[Hab|Hab]|Hab]; - try apply Split_ind; simpl; auto with *. + intros s1 s2 a b P Hl Hr Heq. + unfold SplitL, SplitR. + simpl. + destruct (Q_dec a b) as [[Hab|Hab]|Hab]; try apply Split_ind; simpl; auto with *. Qed. Lemma SplitL_glue_ind : forall s1 s2 (a b:OpenUnit) (P:StepF -> Prop), @@ -116,9 +115,8 @@ Lemma SplitL_glue_ind : forall s1 s2 (a b:OpenUnit) (P:StepF -> Prop), (a == b -> P (s1)) -> P (SplitL (glue b s1 s2) a). Proof. -intros. -apply (SplitLR_glue_ind s1 s2 a b (fun a b => P a)); -assumption. + intros. + apply (SplitLR_glue_ind s1 s2 a b (fun a b => P a)); assumption. Qed. Lemma SplitR_glue_ind : forall s1 s2 (a b:OpenUnit) (P:StepF -> Prop), @@ -127,31 +125,33 @@ Lemma SplitR_glue_ind : forall s1 s2 (a b:OpenUnit) (P:StepF -> Prop), (a == b -> P (s2)) -> P (SplitR (glue b s1 s2) a). Proof. -intros. -apply (SplitLR_glue_ind s1 s2 a b (fun a b => P b)); -assumption. + intros. + apply (SplitLR_glue_ind s1 s2 a b (fun a b => P b)); assumption. Qed. Lemma SplitGlue : forall x y:StepF, forall o, (Split (glue o x y) o)=(x, y). -intros. simpl. +Proof. + intros. simpl. destruct (Q_dec o o) as [[H1|H1]|H1]; try (elim (Qlt_not_le _ _ H1); auto with *); simpl; auto with *. Qed. Lemma SplitLGlue : forall x y:StepF, forall o, (SplitL (glue o x y) o)=x. -unfold SplitL. -intros. -rewrite SplitGlue. -reflexivity. +Proof. + unfold SplitL. + intros. + rewrite SplitGlue. + reflexivity. Qed. Lemma SplitRGlue : forall x y:StepF, forall o, (SplitR (glue o x y) o)=y. -unfold SplitR. -intros. -rewrite SplitGlue. -reflexivity. +Proof. + unfold SplitR. + intros. + rewrite SplitGlue. + reflexivity. Qed. (** As stepping point to a proper setoid equality on step functions, @@ -166,22 +166,22 @@ end. Lemma StepF_Qeq_refl : forall (s: StepF), StepF_Qeq s s. Proof. -induction s; simpl; auto with *. + induction s; simpl; auto with *. Qed. Lemma StepF_Qeq_sym : forall (s t: StepF), StepF_Qeq s t -> StepF_Qeq t s. Proof. -induction s; induction t; try contradiction; simpl; auto with *. -intros [H0 [H1 H2]]. -repeat split; eauto with *. + induction s; induction t; try contradiction; simpl; auto with *. + intros [H0 [H1 H2]]. + repeat split; eauto with *. Qed. Lemma StepF_Qeq_trans : forall (s t u: StepF), StepF_Qeq s t -> StepF_Qeq t u -> StepF_Qeq s u. Proof. -induction s; induction t; induction u; try contradiction; simpl; auto with *. - intros; transitivity x0; assumption. -intros [H0 [H1 H2]] [H3 [H4 H5]]. -repeat split; eauto with *. + induction s; induction t; induction u; try contradiction; simpl; auto with *. + intros; transitivity x0; assumption. + intros [H0 [H1 H2]] [H3 [H4 H5]]. + repeat split; eauto with *. Qed. (* begin hide *) Hint Resolve StepF_Qeq_refl StepF_Qeq_sym StepF_Qeq_trans. @@ -189,385 +189,378 @@ Hint Resolve StepF_Qeq_refl StepF_Qeq_sym StepF_Qeq_trans. (** [Mirror] behaves well with respect to this equality *) Lemma Mirror_resp_Qeq : forall (s t:StepF), StepF_Qeq s t -> StepF_Qeq (Mirror s) (Mirror t). Proof. -induction s; induction t; intros Hst; simpl in *; try assumption; try contradiction. -destruct Hst as [Ho [Hst1 Hst2]]. -repeat split. - rewrite Ho; reflexivity. - apply IHs2; assumption. -apply IHs1; assumption. + induction s; induction t; intros Hst; simpl in *; try assumption; try contradiction. + destruct Hst as [Ho [Hst1 Hst2]]. + repeat split. + rewrite Ho; reflexivity. + apply IHs2; assumption. + apply IHs1; assumption. Qed. (* begin hide *) Hint Resolve Mirror_resp_Qeq. (* end hide *) Lemma MirrorMirror : forall (s:StepF), (StepF_Qeq (Mirror (Mirror s)) s). Proof. -induction s. - simpl; reflexivity. -repeat split; auto with *. -simpl; ring. -Qed. + induction s. + simpl; reflexivity. + repeat split; auto with *. + simpl; ring. +Qed. (* begin hide *) Hint Resolve MirrorMirror. (* end hide *) (** Splits interacts with Mirror in the way you expect *) Lemma SplitR_resp_Qeq : forall (s t:StepF) (a b:OpenUnit), a == b -> StepF_Qeq s t -> StepF_Qeq (SplitR s a) (SplitR t b). Proof. -induction s; induction t; intros a b Hab Hst; simpl in *; try assumption; try contradiction. -destruct Hst as [Ho [Hst1 Hst2]]. -apply SplitR_glue_ind; intros Hao; apply SplitR_glue_ind; intros Hbo; repeat split; auto with *; - try solve [elim (Qlt_not_le _ _ Hao); rewrite Hab; rewrite Ho; try rewrite Hbo; auto with * - |elim (Qlt_not_le _ _ Hbo); rewrite <- Hab; rewrite <- Ho; try rewrite Hao; auto with *]; - try apply IHs1; try apply IHs2; auto with *; simpl; try (rewrite Hab; rewrite Ho; reflexivity). + induction s; induction t; intros a b Hab Hst; simpl in *; try assumption; try contradiction. + destruct Hst as [Ho [Hst1 Hst2]]. + apply SplitR_glue_ind; intros Hao; apply SplitR_glue_ind; intros Hbo; repeat split; auto with *; + try solve [elim (Qlt_not_le _ _ Hao); rewrite Hab; rewrite Ho; try rewrite Hbo; auto with * + |elim (Qlt_not_le _ _ Hbo); rewrite <- Hab; rewrite <- Ho; try rewrite Hao; auto with *]; + try apply IHs1; try apply IHs2; auto with *; simpl; try (rewrite Hab; rewrite Ho; reflexivity). Qed. (* begin hide *) Hint Resolve SplitR_resp_Qeq. (* end hide *) Lemma MirrorSplitL_Qeq : forall (s:StepF) (a b:OpenUnit), b == (OpenUnitDual a) -> (StepF_Qeq (Mirror (SplitL s a)) (SplitR (Mirror s) b)). Proof. -induction s. - auto with *. -intros a b Hab; simpl in Hab. -simpl. -apply SplitL_glue_ind; intros Hao; apply: SplitR_glue_ind; intros Hoa; simpl in Hoa; - try (repeat split; auto with *; try apply IHs1; try apply IHs2; simpl; rewrite Hab; field; auto with *). + induction s. + auto with *. + intros a b Hab; simpl in Hab. + simpl. + apply SplitL_glue_ind; intros Hao; apply: SplitR_glue_ind; intros Hoa; simpl in Hoa; + try (repeat split; auto with *; try apply IHs1; try apply IHs2; simpl; rewrite Hab; field; auto with *). + elim (Qlt_not_le _ _ Hao). + rewrite -> Qlt_minus_iff in Hoa. + rewrite Qle_minus_iff. + replace RHS with (1 - o + - (1 - a)) by ring. + rewrite <- Hab. + auto with *. elim (Qlt_not_le _ _ Hao). - rewrite -> Qlt_minus_iff in Hoa. rewrite Qle_minus_iff. replace RHS with (1 - o + - (1 - a)) by ring. rewrite <- Hab. + rewrite <- Hoa. + ring_simplify. auto with *. - elim (Qlt_not_le _ _ Hao). - rewrite Qle_minus_iff. - replace RHS with (1 - o + - (1 - a)) by ring. - rewrite <- Hab. - rewrite <- Hoa. - ring_simplify. - auto with *. - intros H; ring_simplify in H. - revert H; change (~(a==0)); auto with *. + intros H; ring_simplify in H. + revert H; change (~(a==0)); auto with *. + elim (Qlt_not_le _ _ Hao). + rewrite Qle_minus_iff. + rewrite -> Qlt_minus_iff in Hoa. + replace RHS with (1 - a + - (1 - o)) by ring. + rewrite <- Hab. + auto with *. elim (Qlt_not_le _ _ Hao). rewrite Qle_minus_iff. - rewrite -> Qlt_minus_iff in Hoa. replace RHS with (1 - a + - (1 - o)) by ring. rewrite <- Hab. + rewrite <- Hoa. + ring_simplify. auto with *. - elim (Qlt_not_le _ _ Hao). - rewrite Qle_minus_iff. - replace RHS with (1 - a + - (1 - o)) by ring. - rewrite <- Hab. - rewrite <- Hoa. - ring_simplify. + elim (Qlt_not_le _ _ Hoa). + rewrite Hab. + rewrite Hao. auto with *. elim (Qlt_not_le _ _ Hoa). rewrite Hab. rewrite Hao. auto with *. -elim (Qlt_not_le _ _ Hoa). -rewrite Hab. -rewrite Hao. -auto with *. Qed. Lemma MirrorSplitR_Qeq: forall (s:StepF) (a b:OpenUnit), b == (OpenUnitDual a) -> (StepF_Qeq (Mirror (SplitR s a)) (SplitL (Mirror s) b)). Proof. -intros s a b H. -apply StepF_Qeq_trans with (Mirror (SplitR (Mirror (Mirror s)) a)); - auto with *. -apply StepF_Qeq_trans with (Mirror (Mirror (SplitL (Mirror s) b))); - auto with *. -apply Mirror_resp_Qeq. -apply StepF_Qeq_sym. -apply MirrorSplitL_Qeq. -simpl in *. -rewrite H. -ring. + intros s a b H. + apply StepF_Qeq_trans with (Mirror (SplitR (Mirror (Mirror s)) a)); auto with *. + apply StepF_Qeq_trans with (Mirror (Mirror (SplitL (Mirror s) b))); auto with *. + apply Mirror_resp_Qeq. + apply StepF_Qeq_sym. + apply MirrorSplitL_Qeq. + simpl in *. + rewrite H. + ring. Qed. Lemma SplitL_resp_Qeq : forall (s t:StepF) (a b:OpenUnit), a == b -> StepF_Qeq s t -> StepF_Qeq (SplitL s a) (SplitL t b). Proof. -intros s t a b H H0. -apply StepF_Qeq_trans with (Mirror (Mirror (SplitL s a))); - auto with *. -apply StepF_Qeq_trans with (Mirror (SplitR (Mirror s) (OpenUnitDual a))). + intros s t a b H H0. + apply StepF_Qeq_trans with (Mirror (Mirror (SplitL s a))); auto with *. + apply StepF_Qeq_trans with (Mirror (SplitR (Mirror s) (OpenUnitDual a))). + apply Mirror_resp_Qeq. + apply MirrorSplitL_Qeq; auto with *. + apply StepF_Qeq_trans with (Mirror (SplitR (Mirror t) (OpenUnitDual b))). + apply Mirror_resp_Qeq. + apply SplitR_resp_Qeq; auto with *. + simpl; rewrite H; reflexivity. + apply StepF_Qeq_trans with (Mirror (Mirror (SplitL t b))); auto with *. apply Mirror_resp_Qeq. + apply StepF_Qeq_sym. apply MirrorSplitL_Qeq; auto with *. -apply StepF_Qeq_trans with (Mirror (SplitR (Mirror t) (OpenUnitDual b))). - apply Mirror_resp_Qeq. - apply SplitR_resp_Qeq; auto with *. - simpl; rewrite H; reflexivity. -apply StepF_Qeq_trans with (Mirror (Mirror (SplitL t b))); - auto with *. -apply Mirror_resp_Qeq. -apply StepF_Qeq_sym. -apply MirrorSplitL_Qeq; auto with *. Qed. (* begin hide *) Hint Resolve SplitL_resp_Qeq. (* end hide *) (** The following three lemmas are the key lemmas about Splits. They characterise how Splits distribute across each other. *) -Lemma SplitLSplitL : forall (s:StepF) (a b c:OpenUnit), (a*b==c) -> +Lemma SplitLSplitL : forall (s:StepF) (a b c:OpenUnit), (a*b==c) -> (StepF_Qeq (SplitL (SplitL s a) b) (SplitL s c)). Proof. -induction s. - intros a b c _. - apply StepF_Qeq_refl. -intros a b c H. -apply SplitL_glue_ind; intros Hao. - apply SplitL_glue_ind; intros Hco. - apply IHs1. - simpl. - rewrite <- H; field. - auto with *. + induction s. + intros a b c _. + apply StepF_Qeq_refl. + intros a b c H. + apply SplitL_glue_ind; intros Hao. + apply SplitL_glue_ind; intros Hco. + apply IHs1. + simpl. + rewrite <- H; field. + auto with *. + elim (Qlt_not_le a c). + apply Qlt_trans with o; assumption. + rewrite <- H. + replace RHS with (1*a) by ring. + replace LHS with (b*a) by ring. + apply Qmult_le_compat_r; auto with *. elim (Qlt_not_le a c). - apply Qlt_trans with o; assumption. + rewrite Hco. + apply Qlt_le_trans with o; auto with *. rewrite <- H. replace RHS with (1*a) by ring. replace LHS with (b*a) by ring. apply Qmult_le_compat_r; auto with *. - elim (Qlt_not_le a c). - rewrite Hco. - apply Qlt_le_trans with o; auto with *. - rewrite <- H. - replace RHS with (1*a) by ring. - replace LHS with (b*a) by ring. - apply Qmult_le_compat_r; auto with *. - apply SplitL_glue_ind; intros Hbd. - apply SplitL_glue_ind; intros Hco. - apply SplitL_resp_Qeq; auto with *. + apply SplitL_glue_ind; intros Hbd. + apply SplitL_glue_ind; intros Hco. + apply SplitL_resp_Qeq; auto with *. + simpl. + rewrite <- H. + field; auto with *. + elim (Qlt_not_le _ _ Hbd). simpl. - rewrite <- H. - field; auto with *. + apply Qle_shift_div_r; auto with *. + rewrite Qmult_comm; rewrite H; auto with *. elim (Qlt_not_le _ _ Hbd). simpl. apply Qle_shift_div_r; auto with *. - rewrite Qmult_comm; rewrite H; auto with *. - elim (Qlt_not_le _ _ Hbd). - simpl. - apply Qle_shift_div_r; auto with *. - rewrite Qmult_comm; rewrite H; rewrite Hco; auto with *. - apply SplitL_glue_ind; intros Hco. - elim (Qlt_not_le _ _ Hbd). - simpl. - apply Qle_shift_div_l; auto with *. - rewrite Qmult_comm; rewrite H; auto with *. - repeat split; auto with *. + rewrite Qmult_comm; rewrite H; rewrite Hco; auto with *. + apply SplitL_glue_ind; intros Hco. + elim (Qlt_not_le _ _ Hbd). + simpl. + apply Qle_shift_div_l; auto with *. + rewrite Qmult_comm; rewrite H; auto with *. + repeat split; auto with *. + simpl. + rewrite <- H. + field; auto with *. + apply IHs2. simpl. rewrite <- H. - field; auto with *. - apply IHs2. + field; repeat split; auto with *. + clear - Hao; rewrite -> Qlt_minus_iff in Hao. + auto with *. + elim (Qlt_not_le _ _ Hbd). simpl. + apply Qle_shift_div_l; auto with *. + rewrite Qmult_comm; rewrite H; auto with *. + assert (Y:o==c). rewrite <- H. - field; repeat split; auto with *. - clear - Hao; rewrite -> Qlt_minus_iff in Hao. + rewrite Hbd. + simpl. + field. auto with *. - elim (Qlt_not_le _ _ Hbd). - simpl. - apply Qle_shift_div_l; auto with *. - rewrite Qmult_comm; rewrite H; auto with *. - assert (Y:o==c). - rewrite <- H. - rewrite Hbd. - simpl. - field. + apply SplitL_glue_ind; intros Hco; try (elim (Qlt_not_le _ _ Hco); rewrite Y; auto with *). auto with *. - apply SplitL_glue_ind; intros Hco; - try (elim (Qlt_not_le _ _ Hco); rewrite Y; auto with *). - auto with *. -apply SplitL_glue_ind; intros Hco. - apply SplitL_resp_Qeq; auto with *. - simpl. + apply SplitL_glue_ind; intros Hco. + apply SplitL_resp_Qeq; auto with *. + simpl. + rewrite <- H. + rewrite Hao. + field; auto with *. + elim (Qlt_not_le _ _ Hco). rewrite <- H. - rewrite Hao. - field; auto with *. - elim (Qlt_not_le _ _ Hco). - rewrite <- H. - rewrite <- Hao. - replace RHS with (1*a) by ring. - replace LHS with (b*a) by ring. - apply Qmult_le_compat_r; auto with *. -elim (Qlt_not_le b 1). - auto with *. -rewrite <- Hao in Hco. -rewrite -> Hco in H. -apply Qmult_lt_0_le_reg_r with a. + rewrite <- Hao. + replace RHS with (1*a) by ring. + replace LHS with (b*a) by ring. + apply Qmult_le_compat_r; auto with *. + elim (Qlt_not_le b 1). + auto with *. + rewrite <- Hao in Hco. + rewrite -> Hco in H. + apply Qmult_lt_0_le_reg_r with a. + auto with *. + ring_simplify. + rewrite H. auto with *. -ring_simplify. -rewrite H. -auto with *. Qed. -Lemma SplitRSplitR : forall (s:StepF) (a b c:OpenUnit), (a+b-a*b==c) -> +Lemma SplitRSplitR : forall (s:StepF) (a b c:OpenUnit), (a+b-a*b==c) -> (StepF_Qeq (SplitR (SplitR s a) b) (SplitR s c)). Proof. -intros s a b c H. -apply StepF_Qeq_trans with (Mirror (Mirror (SplitR (SplitR s a) b))); - auto with *. -apply StepF_Qeq_trans with (Mirror (Mirror (SplitR s c))); - auto with *. -apply Mirror_resp_Qeq. -apply StepF_Qeq_trans with (SplitL (SplitL (Mirror s) (OpenUnitDual a)) (OpenUnitDual b)). - apply StepF_Qeq_trans with (SplitL (Mirror (SplitR s a)) (OpenUnitDual b)). + intros s a b c H. + apply StepF_Qeq_trans with (Mirror (Mirror (SplitR (SplitR s a) b))); auto with *. + apply StepF_Qeq_trans with (Mirror (Mirror (SplitR s c))); auto with *. + apply Mirror_resp_Qeq. + apply StepF_Qeq_trans with (SplitL (SplitL (Mirror s) (OpenUnitDual a)) (OpenUnitDual b)). + apply StepF_Qeq_trans with (SplitL (Mirror (SplitR s a)) (OpenUnitDual b)). + apply MirrorSplitR_Qeq; auto with *. + apply SplitL_resp_Qeq; auto with *. apply MirrorSplitR_Qeq; auto with *. - apply SplitL_resp_Qeq; auto with *. + apply StepF_Qeq_trans with (SplitL (Mirror s) (OpenUnitDual c)). + apply SplitLSplitL. + simpl. + rewrite <- H. + ring. + apply StepF_Qeq_sym. apply MirrorSplitR_Qeq; auto with *. -apply StepF_Qeq_trans with (SplitL (Mirror s) (OpenUnitDual c)). - apply SplitLSplitL. - simpl. - rewrite <- H. - ring. -apply StepF_Qeq_sym. -apply MirrorSplitR_Qeq; auto with *. Qed. -Lemma SplitLSplitR : forall (s:StepF) (a b c d:OpenUnit), (a+b-a*b==c) -> (d*c==a) -> +Lemma SplitLSplitR : forall (s:StepF) (a b c d:OpenUnit), (a+b-a*b==c) -> (d*c==a) -> (StepF_Qeq (SplitL (SplitR s a) b) (SplitR (SplitL s c) d)). Proof. -induction s. - intros a b c d _ _. - apply StepF_Qeq_refl. -intros a b c d H0 H1. -apply SplitR_glue_ind; intros Hao. - assert (Hao':~ o - a == 0). - intros H. - elim (Qlt_not_le _ _ Hao). - rewrite Qle_minus_iff. - replace RHS with (- (o- a)) by ring. - rewrite H. - auto with *. - apply SplitL_glue_ind; intros Hbz; simpl in Hbz. - apply SplitL_glue_ind; intros Hco. - apply IHs1; simpl; [rewrite <- H0|rewrite <- H1]; field; auto with *. + induction s. + intros a b c d _ _. + apply StepF_Qeq_refl. + intros a b c d H0 H1. + apply SplitR_glue_ind; intros Hao. + assert (Hao':~ o - a == 0). + intros H. + elim (Qlt_not_le _ _ Hao). + rewrite Qle_minus_iff. + replace RHS with (- (o- a)) by ring. + rewrite H. + auto with *. + apply SplitL_glue_ind; intros Hbz; simpl in Hbz. + apply SplitL_glue_ind; intros Hco. + apply IHs1; simpl; [rewrite <- H0|rewrite <- H1]; field; auto with *. + elim (Qlt_not_le _ _ Hbz). + rewrite -> Qlt_minus_iff in Hco. + rewrite Qle_minus_iff. + replace RHS with ((a + b - a*b + -o)/(1 -a)) by (field; auto with *). + rewrite H0. + apply Qle_shift_div_l; auto with *. + replace LHS with 0 by ring. + auto with *. elim (Qlt_not_le _ _ Hbz). - rewrite -> Qlt_minus_iff in Hco. rewrite Qle_minus_iff. replace RHS with ((a + b - a*b + -o)/(1 -a)) by (field; auto with *). rewrite H0. - apply Qle_shift_div_l; auto with *. - replace LHS with 0 by ring. + rewrite Hco. + replace RHS with 0 by (field; auto with *). + auto with *. + apply SplitL_glue_ind; intros Hco. + elim (Qlt_not_le _ _ Hbz). + rewrite -> Qlt_minus_iff in Hco. + rewrite Qle_minus_iff. + replace RHS with ((o + -(a + b - a*b))/(1 -a)) by (field; auto with *). + rewrite H0. + apply Qle_shift_div_l; auto with *. + replace LHS with 0 by ring. + auto with *. + apply SplitR_glue_ind; intros Hdz; simpl in Hdz. + repeat split; simpl. + field_simplify; auto with *. + apply Qmult_simpl. + rewrite <- H1; ring. + apply Qinv_comp. + replace LHS with (a + b - a*b - a) by ring. + rewrite H0. + replace RHS with (c - (d*c)) by ring. + rewrite H1. + reflexivity. + apply SplitR_resp_Qeq; auto with *; simpl. + rewrite <- H1; field; auto with *. + apply SplitL_resp_Qeq; auto with *; simpl. + rewrite <- H0; field; auto with *. + elim (Qlt_not_le _ _ Hdz). + apply Qle_shift_div_l; auto with *. + rewrite H1; auto with *. + elim (Qlt_not_le _ _ Hao). + rewrite <- H1. + rewrite Hdz. + replace RHS with (o:Q) by (field; auto with *). auto with *. elim (Qlt_not_le _ _ Hbz). - rewrite Qle_minus_iff. - replace RHS with ((a + b - a*b + -o)/(1 -a)) by (field; auto with *). - rewrite H0. - rewrite Hco. - replace RHS with 0 by (field; auto with *). + rewrite <- Hco. + rewrite <- H0. + replace RHS with (b:Q) by (field; auto with *). auto with *. apply SplitL_glue_ind; intros Hco. - elim (Qlt_not_le _ _ Hbz). - rewrite -> Qlt_minus_iff in Hco. - rewrite Qle_minus_iff. - replace RHS with ((o + -(a + b - a*b))/(1 -a)) by (field; auto with *). - rewrite H0. - apply Qle_shift_div_l; auto with *. - replace LHS with 0 by ring. + elim (Qlt_not_le _ _ Hco). + rewrite <- H0. + rewrite Hbz. + replace RHS with (o:Q) by (field; auto with *). auto with *. - apply SplitR_glue_ind; intros Hdz; simpl in Hdz. - repeat split; simpl. - field_simplify; auto with *. - apply Qmult_simpl. - rewrite <- H1; ring. - apply Qinv_comp. - replace LHS with (a + b - a*b - a) by ring. - rewrite H0. - replace RHS with (c - (d*c)) by ring. - rewrite H1. - reflexivity. - apply SplitR_resp_Qeq; auto with *; simpl. - rewrite <- H1; field; auto with *. - apply SplitL_resp_Qeq; auto with *; simpl. - rewrite <- H0; field; auto with *. - elim (Qlt_not_le _ _ Hdz). - apply Qle_shift_div_l; auto with *. - rewrite H1; auto with *. - elim (Qlt_not_le _ _ Hao). - rewrite <- H1. - rewrite Hdz. - replace RHS with (o:Q) by (field; auto with *). - auto with *. - elim (Qlt_not_le _ _ Hbz). - rewrite <- Hco. - rewrite <- H0. - replace RHS with (b:Q) by (field; auto with *). - auto with *. - apply SplitL_glue_ind; intros Hco. elim (Qlt_not_le _ _ Hco). rewrite <- H0. rewrite Hbz. - replace RHS with (o:Q) by (field; auto with *). + replace LHS with (o:Q) by (field; auto with *). auto with *. - elim (Qlt_not_le _ _ Hco). - rewrite <- H0. - rewrite Hbz. + apply SplitR_resp_Qeq; simpl; auto with *. + rewrite <- H1. + rewrite Hco. + field; auto with *. + apply SplitL_glue_ind; intros Hco. + elim (Qlt_not_le _ _ Hco). + rewrite <- H0. + apply Qlt_le_weak. + rewrite -> Qlt_minus_iff in *. + replace RHS with (a + - o + b*(1-a)) by ring. + assert (Z:0 < (1-a)) by auto with *. + Qauto_pos. + assert (Hco':~ c - o == 0). + intros H. + elim (Qlt_not_le _ _ Hco). + rewrite -> Qle_minus_iff. + replace RHS with (c-o). rewrite H. auto with *. + replace LHS with (-(c-o)) by ring. rewrite H. ring. + apply SplitR_glue_ind; intros Hdz; simpl in Hdz. + elim (Qlt_not_le _ _ Hdz). + apply Qle_shift_div_r; auto with *. + rewrite H1; auto with *. + apply IHs2; simpl; [rewrite <- H0|rewrite <- H1]; field; auto with *. + elim (Qlt_not_le _ _ Hao). + rewrite <- H1. + rewrite Hdz. replace LHS with (o:Q) by (field; auto with *). auto with *. - apply SplitR_resp_Qeq; simpl; auto with *. + elim (Qlt_not_le _ _ Hao). rewrite <- H1. - rewrite Hco. - field; auto with *. + rewrite <- Hco. + rewrite Qle_minus_iff. + replace RHS with (c * (1-d)) by ring. + apply Qlt_le_weak. + assert (Z:0 < (1-d)) by auto with *. + Qauto_pos. apply SplitL_glue_ind; intros Hco. elim (Qlt_not_le _ _ Hco). - rewrite <- H0. + rewrite <- Hao. + rewrite <- H1. + rewrite Qle_minus_iff. + replace RHS with (c * (1-d)) by ring. apply Qlt_le_weak. - rewrite -> Qlt_minus_iff in *. - replace RHS with (a + - o + b*(1-a)) by ring. - assert (Z:0 < (1-a)) by auto with *. + assert (Z:0 < (1-d)) by auto with *. Qauto_pos. - assert (Hco':~ c - o == 0). - intros H. - elim (Qlt_not_le _ _ Hco). - rewrite -> Qle_minus_iff. - replace RHS with (c-o). rewrite H. auto with *. - replace LHS with (-(c-o)) by ring. rewrite H. ring. - apply SplitR_glue_ind; intros Hdz; simpl in Hdz. + apply SplitR_glue_ind; intros Hdz; simpl in Hdz. elim (Qlt_not_le _ _ Hdz). apply Qle_shift_div_r; auto with *. + rewrite <- Hao. rewrite H1; auto with *. - apply IHs2; simpl; [rewrite <- H0|rewrite <- H1]; field; auto with *. - elim (Qlt_not_le _ _ Hao). - rewrite <- H1. -rewrite Hdz. - replace LHS with (o:Q) by (field; auto with *). - auto with *. - elim (Qlt_not_le _ _ Hao). - rewrite <- H1. - rewrite <- Hco. - rewrite Qle_minus_iff. - replace RHS with (c * (1-d)) by ring. - apply Qlt_le_weak. - assert (Z:0 < (1-d)) by auto with *. - Qauto_pos. -apply SplitL_glue_ind; intros Hco. - elim (Qlt_not_le _ _ Hco). - rewrite <- Hao. - rewrite <- H1. - rewrite Qle_minus_iff. - replace RHS with (c * (1-d)) by ring. - apply Qlt_le_weak. - assert (Z:0 < (1-d)) by auto with *. - Qauto_pos. - apply SplitR_glue_ind; intros Hdz; simpl in Hdz. elim (Qlt_not_le _ _ Hdz). - apply Qle_shift_div_r; auto with *. + apply Qle_shift_div_l; auto with *. rewrite <- Hao. rewrite H1; auto with *. - elim (Qlt_not_le _ _ Hdz). - apply Qle_shift_div_l; auto with *. + apply SplitL_resp_Qeq; simpl; auto with *. + rewrite <- H0. rewrite <- Hao. - rewrite H1; auto with *. - apply SplitL_resp_Qeq; simpl; auto with *. - rewrite <- H0. - rewrite <- Hao. - field; auto with *. -elim (Qlt_not_le (d*c) a). - rewrite Hao. - rewrite Hco. - rewrite Qlt_minus_iff. - replace RHS with (o * (1-d)) by ring. - assert (Z:0 < (1-d)) by auto with *. - Qauto_pos. -rewrite H1. -auto with *. + field; auto with *. + elim (Qlt_not_le (d*c) a). + rewrite Hao. + rewrite Hco. + rewrite Qlt_minus_iff. + replace RHS with (o * (1-d)) by ring. + assert (Z:0 < (1-d)) by auto with *. + Qauto_pos. + rewrite H1. + auto with *. Qed. End StepFunction. @@ -580,9 +573,10 @@ Add Parametric Relation X : (StepF X) (@StepF_Qeq X) (* end hide *) (** Step functions are a functor *) Definition Map(X Y:Type):(X->Y)->(StepF X)->(StepF Y). -fix 4. intros X Y f [x| a t1 t2]. +Proof. + fix 4. intros X Y f [x| a t1 t2]. exact (constStepF (f x)). -exact (glue a (Map _ _ f t1) (Map _ _ f t2)). + exact (glue a (Map _ _ f t1) (Map _ _ f t2)). Defined. Notation "f ^@> x" := (Map f x) (at level 15, left associativity) : sfscope. @@ -601,45 +595,45 @@ Definition Map2 (X Y Z:Type) (f:(X->Y->Z)) a b := f ^@> a <@> b. Add Parametric Morphism X Y f : (@Map X Y f) with signature (@StepF_Qeq X) ==> (@StepF_Qeq Y) as Map_resp_Qeq. -Proof. -induction x; induction y; try contradiction; intros Hs. - simpl in *. - rewrite Hs. - reflexivity. -destruct Hs as [Ho [Hl Hr]]. -repeat split; auto with *. +Proof. + induction x; induction y; try contradiction; intros Hs. + simpl in *. + rewrite Hs. + reflexivity. + destruct Hs as [Ho [Hl Hr]]. + repeat split; auto with *. Qed. (** These lemmas show how ap distributes over glue *) Lemma ApGlue : forall X Y (fl fr:StepF (X -> Y)) o b, (glue o fl fr) <@> b = glue o (fl <@> (SplitL b o)) (fr <@> (SplitR b o)). Proof. -intros. -simpl. -apply Split_ind. -reflexivity. + intros. + simpl. + apply Split_ind. + reflexivity. Qed. Lemma ApGlueGlue : forall X Y (fl fr:StepF (X -> Y)) o l r, (glue o fl fr) <@> (glue o l r) = glue o (fl <@> l) (fr <@> r). Proof. -intros. -rewrite ApGlue SplitLGlue SplitRGlue. -reflexivity. + intros. + rewrite ApGlue SplitLGlue SplitRGlue. + reflexivity. Qed. (* begn hide *) Add Parametric Morphism X Y : (@Ap X Y) with signature (@StepF_Qeq (X->Y)) ==> (@StepF_Qeq X) ==> (@StepF_Qeq Y) as Ap_resp_Qeq. Proof. -induction x; induction y; try contradiction; intros Hf s1 s2 Hs. - simpl in *. - rewrite Hf. - apply Map_resp_Qeq. - assumption. -destruct Hf as [Ho [Hl Hr]]. -do 2 rewrite ApGlue. -repeat split; auto. - apply IHx1; auto with *. - apply SplitL_resp_Qeq; auto with *. -apply IHx2; auto with *. -apply SplitR_resp_Qeq; auto with *. + induction x; induction y; try contradiction; intros Hf s1 s2 Hs. + simpl in *. + rewrite Hf. + apply Map_resp_Qeq. + assumption. + destruct Hf as [Ho [Hl Hr]]. + do 2 rewrite ApGlue. + repeat split; auto. + apply IHx1; auto with *. + apply SplitL_resp_Qeq; auto with *. + apply IHx2; auto with *. + apply SplitR_resp_Qeq; auto with *. Qed. (* end hide *) Section Ap. @@ -647,25 +641,28 @@ Section Ap. Hint Resolve StepF_Qeq_refl SplitL_resp_Qeq SplitR_resp_Qeq. (* end hide *) (** Splits commute with maps *) -Lemma SplitMap (X Y:Type):forall x:(StepF X), forall a, forall f:X->Y, +Lemma SplitMap (X Y:Type):forall x:(StepF X), forall a, forall f:X->Y, (Split (Map f x) a) = let (l,r) := Split x a in (Map f l,Map f r). -intros X Y s a f. revert a. induction s. simpl; auto. -intros a. -simpl. -destruct (Q_dec a o) as [[H0|H0]|H0]. -rewrite IHs1. destruct (Split s1 (OpenUnitDiv a o H0)). auto with *. -rewrite IHs2. destruct (Split s2 (OpenUnitDualDiv a o H0)). auto with *. -auto. +Proof. + intros X Y s a f. revert a. induction s. simpl; auto. + intros a. + simpl. + destruct (Q_dec a o) as [[H0|H0]|H0]. + rewrite IHs1. destruct (Split s1 (OpenUnitDiv a o H0)). auto with *. + rewrite IHs2. destruct (Split s2 (OpenUnitDualDiv a o H0)). auto with *. + auto. Qed. -Lemma SplitLMap (X Y:Type): forall x:(StepF X), forall a, forall f:X->Y, +Lemma SplitLMap (X Y:Type): forall x:(StepF X), forall a, forall f:X->Y, SplitL (Map f x) a = Map f (SplitL x a). -intros. unfold SplitL. rewrite SplitMap. destruct (Split x a). simpl. auto. +Proof. + intros. unfold SplitL. rewrite SplitMap. destruct (Split x a). simpl. auto. Qed. -Lemma SplitRMap(X Y:Type): forall x:(StepF X), forall a, forall f:X->Y, +Lemma SplitRMap(X Y:Type): forall x:(StepF X), forall a, forall f:X->Y, SplitR (Map f x) a = Map f (SplitR x a). -intros. unfold SplitR. rewrite SplitMap. destruct (Split x a). simpl. auto. +Proof. + intros. unfold SplitR. rewrite SplitMap. destruct (Split x a). simpl. auto. Qed. (** These lemmas show how ap distributes over split and uses mirror @@ -673,99 +670,98 @@ properties to get the symetric cases *) Lemma SplitLAp_Qeq (X Y:Type) : forall (f: StepF (X -> Y)) s o, StepF_Qeq (SplitL (f <@> s) o) ((SplitL f o) <@> (SplitL s o)). Proof. -induction f; intros. + induction f; intros. + simpl. + rewrite SplitLMap; auto with *. + rewrite ApGlue. + unfold SplitL at 1 3. simpl. - rewrite SplitLMap; auto with *. -rewrite ApGlue. -unfold SplitL at 1 3. -simpl. -destruct (Q_dec o0 o) as [[Ho|Ho]|Ho]. + destruct (Q_dec o0 o) as [[Ho|Ho]|Ho]. + do 2 apply Split_ind. + simpl. + eapply StepF_Qeq_trans; try assumption. + apply IHf1. + apply Ap_resp_Qeq; auto with *. + apply SplitLSplitL. + simpl. + field; auto with *. do 2 apply Split_ind. simpl. + apply Split_ind. + repeat split; auto with *. + apply Ap_resp_Qeq; auto with *. + apply StepF_Qeq_sym. + apply SplitLSplitL. + simpl. + field; auto with *. eapply StepF_Qeq_trans; try assumption. - apply IHf1. + apply IHf2. apply Ap_resp_Qeq; auto with *. - apply SplitLSplitL. - simpl. - field; auto with *. - do 2 apply Split_ind. + apply SplitLSplitR; simpl; field; auto with *. simpl. - apply Split_ind. - repeat split; auto with *. - apply Ap_resp_Qeq; auto with *. - apply StepF_Qeq_sym. - apply SplitLSplitL. - simpl. - field; auto with *. - eapply StepF_Qeq_trans; try assumption. - apply IHf2. apply Ap_resp_Qeq; auto with *. - apply SplitLSplitR; simpl; field; auto with *. -simpl. -apply Ap_resp_Qeq; auto with *. Qed. Lemma MirrorMap (X Y:Type) : forall (f: X -> Y) s, (Mirror (Map f s)) = (Map f (Mirror s)). Proof. -intros X Y f. -induction s. + intros X Y f. + induction s. + reflexivity. + change (Mirror (glue o (Map f s1) (Map f s2)) = + glue (OpenUnitDual o) (Map f (Mirror s2)) (Map f (Mirror s1))). + rewrite <- IHs1. + rewrite <- IHs2. reflexivity. -change (Mirror (glue o (Map f s1) (Map f s2)) = -glue (OpenUnitDual o) (Map f (Mirror s2)) (Map f (Mirror s1))). -rewrite <- IHs1. -rewrite <- IHs2. -reflexivity. Qed. Lemma MirrorAp_Qeq (X Y: Type) : forall (f: StepF (X -> Y)) s, StepF_Qeq (Mirror (f <@> s)) ((Mirror f) <@> (Mirror s)). Proof. -intros X Y. -induction f; intros s. - simpl. - rewrite MirrorMap. - auto with *. -rewrite ApGlue. -change (StepF_Qeq - (glue (OpenUnitDual o) (Mirror (f2 <@> (SplitR s o))) (Mirror (f1 <@> (SplitL s o)))) - ((glue (OpenUnitDual o) (Mirror f2) (Mirror f1)) <@> (Mirror s))). -rewrite ApGlue. -repeat split; auto with *. + intros X Y. + induction f; intros s. + simpl. + rewrite MirrorMap. + auto with *. + rewrite ApGlue. + change (StepF_Qeq + (glue (OpenUnitDual o) (Mirror (f2 <@> (SplitR s o))) (Mirror (f1 <@> (SplitL s o)))) + ((glue (OpenUnitDual o) (Mirror f2) (Mirror f1)) <@> (Mirror s))). + rewrite ApGlue. + repeat split; auto with *. + eapply StepF_Qeq_trans. + apply IHf2. + apply Ap_resp_Qeq; auto with *. + apply MirrorSplitR_Qeq. + reflexivity. eapply StepF_Qeq_trans. - apply IHf2. + apply IHf1. apply Ap_resp_Qeq; auto with *. - apply MirrorSplitR_Qeq. + apply MirrorSplitL_Qeq. reflexivity. -eapply StepF_Qeq_trans. - apply IHf1. -apply Ap_resp_Qeq; auto with *. -apply MirrorSplitL_Qeq. -reflexivity. -Qed. +Qed. Lemma SplitRAp_Qeq (X Y:Type) : forall (f: StepF (X -> Y)) s o, StepF_Qeq (SplitR (f <@> s) o) ((SplitR f o) <@> (SplitR s o)). Proof. -intros X Y f s o. -eapply StepF_Qeq_trans. - apply StepF_Qeq_sym. - apply MirrorMirror. -eapply StepF_Qeq_trans;[|apply MirrorMirror]. -apply Mirror_resp_Qeq. -eapply StepF_Qeq_trans;[|apply StepF_Qeq_sym; apply MirrorAp_Qeq]. -eapply StepF_Qeq_trans. - apply MirrorSplitR_Qeq. - reflexivity. -eapply StepF_Qeq_trans. - apply SplitL_resp_Qeq. + intros X Y f s o. + eapply StepF_Qeq_trans. + apply StepF_Qeq_sym. + apply MirrorMirror. + eapply StepF_Qeq_trans;[|apply MirrorMirror]. + apply Mirror_resp_Qeq. + eapply StepF_Qeq_trans;[|apply StepF_Qeq_sym; apply MirrorAp_Qeq]. + eapply StepF_Qeq_trans. + apply MirrorSplitR_Qeq. reflexivity. - apply MirrorAp_Qeq. -eapply StepF_Qeq_trans. - apply SplitLAp_Qeq. -apply StepF_Qeq_sym. -apply Ap_resp_Qeq; - apply MirrorSplitR_Qeq; reflexivity. + eapply StepF_Qeq_trans. + apply SplitL_resp_Qeq. + reflexivity. + apply MirrorAp_Qeq. + eapply StepF_Qeq_trans. + apply SplitLAp_Qeq. + apply StepF_Qeq_sym. + apply Ap_resp_Qeq; apply MirrorSplitR_Qeq; reflexivity. Qed. End Ap. @@ -775,17 +771,17 @@ Section ApplicativeFunctor. (** These are the laws of an applicative functor *) Lemma Ap_identity : forall X (a:StepF X), constStepF (fun x => x) <@> a = a. Proof. -induction a. + induction a. + reflexivity. + simpl in *. + rewrite IHa1. + rewrite IHa2. reflexivity. -simpl in *. -rewrite IHa1. -rewrite IHa2. -reflexivity. Qed. Lemma Map_identity : forall X (a:StepF X), (fun x => x) ^@> a = a. Proof. -exact Ap_identity. + exact Ap_identity. Qed. (* begin hide *) Hint Resolve Ap_resp_Qeq. @@ -798,70 +794,70 @@ Let compose X Y Z (x : Y ->Z) (y:X -> Y) z := x (y z). Lemma Ap_composition_Qeq : forall X Y Z (a:StepF (Y->Z)) (b:StepF (X->Y)) (c:StepF X), StepF_Qeq (constStepF (@compose X Y Z) <@> a <@> b <@> c) (a <@> (b <@> c)). Proof. -induction a. - simpl. - induction b. + induction a. simpl. - induction c. - auto. + induction b. + simpl. + induction c. + auto. + repeat split; auto. + intros c. + simpl in *. + destruct (Split c o). repeat split; auto. - intros c. + intros b c. simpl in *. - destruct (Split c o). - repeat split; auto. -intros b c. -simpl in *. -do 2 apply Split_ind. -simpl. -apply Split_ind. -repeat split; eauto. + do 2 apply Split_ind. + simpl. + apply Split_ind. + repeat split; eauto. Qed. Lemma Map_composition_Qeq : forall X Y Z (a:StepF (Y->Z)) (b:StepF (X->Y)) (c:StepF X), StepF_Qeq ((fun x y z => x (y z)) ^@> a <@> b <@> c) (a <@> (b <@> c)). Proof. -exact Ap_composition_Qeq. + exact Ap_composition_Qeq. Qed. Lemma Ap_homomorphism : forall X Y (f:X->Y) (a:X), (constStepF f <@> constStepF a) = (constStepF (f a)). Proof. -reflexivity. + reflexivity. Qed. Lemma Map_homomorphism : forall X Y (f:X->Y) (a:X), (f ^@> constStepF a) = (constStepF (f a)). Proof. -exact Ap_homomorphism. + exact Ap_homomorphism. Qed. Lemma Ap_interchange : forall X Y (f:StepF (X->Y)) (a:X), (f <@> constStepF a) = (constStepF (fun g => g a)) <@> f. Proof. -induction f. + induction f. + reflexivity. + intros a. + simpl. + rewrite IHf1. + rewrite IHf2. reflexivity. -intros a. -simpl. -rewrite IHf1. -rewrite IHf2. -reflexivity. Qed. Lemma Map_interchange : forall X Y (f:StepF (X->Y)) (a:X), (f <@> constStepF a) = (fun g => g a) ^@> f. Proof. -exact Ap_interchange. + exact Ap_interchange. Qed. Lemma Map_compose_Map : forall X Y Z (f:Y->Z) (g:X -> Y) a, StepF_Qeq ((fun a => f (g a)) ^@> a) (f ^@> (g ^@> a)). Proof. -intros X Y Z f g a. -change (StepF_Qeq (constStepF (compose f g) <@> a) (constStepF f <@> (constStepF g <@> a))). -rewrite <- (Map_homomorphism (compose f) g). -change (compose f ^@> constStepF g) with (constStepF (compose f) <@> constStepF g). -rewrite <- (Map_homomorphism (@compose X Y Z) f). -apply Map_composition_Qeq. + intros X Y Z f g a. + change (StepF_Qeq (constStepF (compose f g) <@> a) (constStepF f <@> (constStepF g <@> a))). + rewrite <- (Map_homomorphism (compose f) g). + change (compose f ^@> constStepF g) with (constStepF (compose f) <@> constStepF g). + rewrite <- (Map_homomorphism (@compose X Y Z) f). + apply Map_composition_Qeq. Qed. -End ApplicativeFunctor. \ No newline at end of file +End ApplicativeFunctor. diff --git a/metric2/StepFunctionMonad.v b/metric2/StepFunctionMonad.v index 3e0580181..fd3f5a8ca 100644 --- a/metric2/StepFunctionMonad.v +++ b/metric2/StepFunctionMonad.v @@ -1,5 +1,5 @@ (* -Copyright © 2007-2008 +Copyright © 2007-2008 Russell O’Connor Bas Spitters @@ -34,8 +34,9 @@ Set Implicit Arguments. (** This version of [StepF] has type [Setoid] that carries its equivalence relation with it. *) Definition StepFS (X:Setoid):Setoid. -intro X. exists (StepF X) (@StepF_eq X). -apply StepF_Sth. +Proof. + intro X. exists (StepF X) (@StepF_eq X). + apply StepF_Sth. Defined. Open Local Scope setoid_scope. @@ -44,181 +45,192 @@ Open Local Scope sfstscope. (** We redefine several functions to return a setoid type. *) Definition StFReturn (X:Setoid) : X-->(StepFS X). -intros. -exists (@constStepF X). -abstract (auto with *). +Proof. + intros. + exists (@constStepF X). + abstract (auto with *). Defined. Definition SplitLS0(X:Setoid):OpenUnit->(StepFS X)->(StepFS X):= (fun o x => SplitL x o). Definition SplitLS(X:Setoid):OpenUnit->(StepFS X)-->(StepFS X). -intros X o. -exists (fun x => (SplitLS0 o x)). -abstract (intros; apply: SplitL_wd;auto with *). +Proof. + intros X o. + exists (fun x => (SplitLS0 o x)). + abstract (intros; apply: SplitL_wd;auto with *). Defined. Definition SplitRS0(X:Setoid):OpenUnit->(StepFS X)->(StepFS X):= (fun o x => SplitR x o). Definition SplitRS(X:Setoid):OpenUnit->(StepFS X)-->(StepFS X). -intros X o. -exists (fun x => (SplitRS0 o x)). -abstract (intros; apply: SplitR_wd;auto with *). +Proof. + intros X o. + exists (fun x => (SplitRS0 o x)). + abstract (intros; apply: SplitR_wd;auto with *). Defined. Definition MirrorS(X:Setoid):(StepFS X)-->(StepFS X). -intro X. -exists (@Mirror X). -abstract (intros; change (Mirror x1 == Mirror x2); rewrite Mirror_eq_Mirror; assumption). +Proof. + intro X. + exists (@Mirror X). + abstract (intros; change (Mirror x1 == Mirror x2); rewrite Mirror_eq_Mirror; assumption). Defined. (** Definition of bind. *) -Definition StFBind00(X Y:Setoid) : +Definition StFBind00(X Y:Setoid) : (StepFS X) -> (X --> (StepFS Y)) -> (StepFS Y). -intros X Y . -fix 1. intro m. case m. +Proof. + intros X Y . + fix 1. intro m. case m. intros x f. - exact (f x). -intros o m1 m2 f. -exact (glue o (StFBind00 m1 (compose (SplitLS Y o) f)) - (StFBind00 m2 (compose (SplitRS Y o) f))). + exact (f x). + intros o m1 m2 f. + exact (glue o (StFBind00 m1 (compose (SplitLS Y o) f)) (StFBind00 m2 (compose (SplitRS Y o) f))). Defined. Lemma StFBind_wd1(X Y:Setoid):forall m, forall x1 x2 : X --> StepFS Y, st_eq x1 x2 -> st_eq (StFBind00 m x1) (StFBind00 m x2). -induction m. - intros x1 x2 H. - simpl; auto with *. apply H. -intros x1 x2 H. simpl. apply glue_resp_StepF_eq. - apply IHm1. intro. simpl. unfold compose0. - apply SplitL_wd; auto with *. apply H. -apply IHm2. intro. simpl. unfold compose0. -apply SplitR_wd; auto with *. apply H. +Proof. + induction m. + intros x1 x2 H. + simpl; auto with *. apply H. + intros x1 x2 H. simpl. apply glue_resp_StepF_eq. + apply IHm1. intro. simpl. unfold compose0. + apply SplitL_wd; auto with *. apply H. + apply IHm2. intro. simpl. unfold compose0. + apply SplitR_wd; auto with *. apply H. Qed. -Definition StFBind1(X Y:Setoid) : +Definition StFBind1(X Y:Setoid) : (StepFS X) -> (X --> (StepFS Y)) --> (StepFS Y). -intros X Y m. -exists (fun f=> (@StFBind00 X Y m f)). -apply StFBind_wd1. +Proof. + intros X Y m. + exists (fun f=> (@StFBind00 X Y m f)). + apply StFBind_wd1. Defined. -Lemma MirrorBind(X Y:Setoid):forall (x:StepF X) (f:X --> (StepFS Y)), +Lemma MirrorBind(X Y:Setoid):forall (x:StepF X) (f:X --> (StepFS Y)), Mirror (StFBind00 x f)==(StFBind00 (Mirror x) (compose (MirrorS Y) f)). -induction x using StepF_ind. - reflexivity. -intros. simpl. rewrite MirrorGlue. apply glue_wd; auto with *. - rewrite IHx2. simpl. change - (StFBind00 (Mirror x2) (compose1 (MirrorS Y) (compose1 (SplitRS Y o) f)) == - StFBind00 (Mirror x2) (compose1 (SplitLS Y (OpenUnitDual o)) (compose1 (MirrorS Y) f))). +Proof. + induction x using StepF_ind. + reflexivity. + intros. simpl. rewrite MirrorGlue. apply glue_wd; auto with *. + rewrite IHx2. simpl. change + (StFBind00 (Mirror x2) (compose1 (MirrorS Y) (compose1 (SplitRS Y o) f)) == + StFBind00 (Mirror x2) (compose1 (SplitLS Y (OpenUnitDual o)) (compose1 (MirrorS Y) f))). + apply StFBind_wd1. intro. simpl. unfold compose0. unfold SplitRS0, SplitLS0. + apply MirrorSplitR; auto with *. + rewrite IHx1. simpl. change (StFBind00 (Mirror x1) (compose1 (MirrorS Y) (compose1 (SplitLS Y o) f)) == + StFBind00 (Mirror x1) (compose1 (SplitRS Y (OpenUnitDual o)) (compose1 (MirrorS Y) f))). apply StFBind_wd1. intro. simpl. unfold compose0. unfold SplitRS0, SplitLS0. - apply MirrorSplitR; auto with *. -rewrite IHx1. simpl. change (StFBind00 (Mirror x1) (compose1 (MirrorS Y) (compose1 (SplitLS Y o) f)) == -StFBind00 (Mirror x1) (compose1 (SplitRS Y (OpenUnitDual o)) (compose1 (MirrorS Y) f))). -apply StFBind_wd1. intro. simpl. unfold compose0. unfold SplitRS0, SplitLS0. -apply MirrorSplitL; auto with *. + apply MirrorSplitL; auto with *. Qed. Lemma SplitLBind (X Y:Setoid) : forall (y:(StepF X)) (o:OpenUnit) (f: (X-->(StepFS Y))), SplitL (StFBind00 y f) o == StFBind00 (SplitL y o) (compose1 (SplitLS Y o) f). -induction y using StepF_ind. reflexivity. -intros p f. simpl. apply SplitL_glue_ind; apply SplitL_glue_ind; intros H H0; - try solve [ elim (Qlt_not_le o p); auto with * - | elim (Qlt_not_le _ _ H0) || elim (Qlt_not_le _ _ H); rewrite H || rewrite H0; auto with *]. - setoid_replace (OpenUnitDiv p o H0) with (OpenUnitDiv p o H) by (unfold ou_eq; reflexivity). - rewrite IHy1. - apply StFBind_wd1. - intros x. simpl. unfold compose0. apply StepF_Qeq_eq. - apply (SplitLSplitL (f x) o (OpenUnitDiv p o H) p). simpl. field. auto with *. - (* o(StepFS Y))), SplitR (StFBind00 y f) o == StFBind00 (SplitR y o) (compose1 (SplitRS Y o) f). Proof. -induction y using StepF_ind. reflexivity. -intros p f. simpl. apply SplitR_glue_ind; apply SplitR_glue_ind; intros H H0; - try solve [ elim (Qlt_not_le o p); auto with * - | elim (Qlt_not_le _ _ H0) || elim (Qlt_not_le _ _ H); rewrite H || rewrite H0; auto with *]. - simpl. apply glue_wd. - unfold ou_eq; reflexivity. - setoid_replace (OpenUnitDiv _ _ H0) with (OpenUnitDiv _ _ H) by (unfold ou_eq; reflexivity). - rewrite IHy1. - apply StFBind_wd1. intro. simpl. unfold compose0, SplitLS0, SplitRS0. - symmetry. apply StepF_Qeq_eq. apply ((SplitLSplitR (f x) p) (OpenUnitDualDiv _ _ H)); - simpl; field; auto with *. + induction y using StepF_ind. reflexivity. + intros p f. simpl. apply SplitR_glue_ind; apply SplitR_glue_ind; intros H H0; + try solve [ elim (Qlt_not_le o p); auto with * + | elim (Qlt_not_le _ _ H0) || elim (Qlt_not_le _ _ H); rewrite H || rewrite H0; auto with *]. + simpl. apply glue_wd. + unfold ou_eq; reflexivity. + setoid_replace (OpenUnitDiv _ _ H0) with (OpenUnitDiv _ _ H) by (unfold ou_eq; reflexivity). + rewrite IHy1. + apply StFBind_wd1. intro. simpl. unfold compose0, SplitLS0, SplitRS0. + symmetry. apply StepF_Qeq_eq. apply ((SplitLSplitR (f x) p) (OpenUnitDualDiv _ _ H)); + simpl; field; auto with *. + apply StFBind_wd1. + intro x. simpl. unfold compose0, SplitLS0. symmetry. apply: StepF_Qeq_eq. apply (SplitRSplitR (f x)). + simpl. field. auto with *. + (* o st_eq (StFBind1 Y x1) (StFBind1 Y x2). -intros X Y. -induction x1 using StepF_ind. intro y. - induction y using StepF_ind. simpl. intro H. - intro f. apply f. auto with *. - simpl. intro H. destruct H as [Hl Hr] using (eq_glue_ind y1). - intro f. - rewrite <- (IHy1 Hl (compose1 (SplitLS Y o) f)). simpl. unfold compose0. clear IHy1. - rewrite <- (IHy2 Hr (compose1 (SplitRS Y o) f)). simpl. unfold compose0. - unfold SplitLS0, SplitRS0. symmetry. apply: glueSplit. -intros y H f. -simpl in H. -destruct H as [Hl Hr] using (glue_eq_ind x1_1). -simpl. -rewrite -> (IHx1_1 _ Hl (compose1 (SplitLS Y o) f)). -rewrite -> (IHx1_2 _ Hr (compose1 (SplitRS Y o) f)). -clear IHx1_1 IHx1_2. -change ((StFBind1 _ (glue o (SplitL y o) (SplitR y o)) f) == StFBind00 y f). -clear Hl Hr x1_1 x1_2. -simpl. -rewrite <- (glueSplit (StFBind00 y f) o). -rewrite SplitLBind. -rewrite SplitRBind. -reflexivity. +Proof. + intros X Y. + induction x1 using StepF_ind. intro y. + induction y using StepF_ind. simpl. intro H. + intro f. apply f. auto with *. + simpl. intro H. destruct H as [Hl Hr] using (eq_glue_ind y1). + intro f. + rewrite <- (IHy1 Hl (compose1 (SplitLS Y o) f)). simpl. unfold compose0. clear IHy1. + rewrite <- (IHy2 Hr (compose1 (SplitRS Y o) f)). simpl. unfold compose0. + unfold SplitLS0, SplitRS0. symmetry. apply: glueSplit. + intros y H f. + simpl in H. + destruct H as [Hl Hr] using (glue_eq_ind x1_1). + simpl. + rewrite -> (IHx1_1 _ Hl (compose1 (SplitLS Y o) f)). + rewrite -> (IHx1_2 _ Hr (compose1 (SplitRS Y o) f)). + clear IHx1_1 IHx1_2. + change ((StFBind1 _ (glue o (SplitL y o) (SplitR y o)) f) == StFBind00 y f). + clear Hl Hr x1_1 x1_2. + simpl. + rewrite <- (glueSplit (StFBind00 y f) o). + rewrite SplitLBind. + rewrite SplitRBind. + reflexivity. Qed. -Definition StFBind(X Y:Setoid) : +Definition StFBind(X Y:Setoid) : (StepFS X) --> (X --> (StepFS Y)) --> (StepFS Y). -intros X Y. -exists (fun m => (@StFBind1 X Y m)). -exact (@StFBind_wd X Y). +Proof. + intros X Y. + exists (fun m => (@StFBind1 X Y m)). + exact (@StFBind_wd X Y). Defined. Add Parametric Morphism X Y : (@StFBind00 X Y) with signature (@StepF_eq X ==> (@st_eq _) ==> @StepF_eq Y) as StFBind00_wd. -intros x y Hxy f g Hfg. -transitivity (StFBind00 x g). - apply StFBind_wd1; assumption. -apply: StFBind_wd; assumption. +Proof. + intros x y Hxy f g Hfg. + transitivity (StFBind00 x g). + apply StFBind_wd1; assumption. + apply: StFBind_wd; assumption. Qed. (** Join is defined in terms of bind. *) @@ -226,16 +238,17 @@ Qed. Definition StFJoin (X:Setoid):(StepFS (StepFS X))-->(StepFS X):= (flip (@StFBind (StepFS X) X) (@id (StepFS X))). -Lemma JoinGlue(X:Setoid): forall o a b, +Lemma JoinGlue(X:Setoid): forall o a b, (StFJoin X (glue o a b))==(glue o (StFBind (StepFS X) _ a (SplitLS X o)) (StFBind (StepFS X) _ b (SplitRS X o))). -intros. simpl. -transitivity (glue o (StFBind00 (SplitL (glue o a b) o) (compose1 (SplitLS X o) id)) - (StFBind00 (SplitR (glue o a b) o) (compose1 (SplitRS X o) id))). -apply glue_wd; auto with *. apply StFBind00_wd; try reflexivity. rewrite SplitLGlue. reflexivity. - apply StFBind00_wd; try reflexivity. rewrite SplitRGlue. reflexivity. - apply glue_wd; auto with *. - rewrite <- SplitLBind. simpl. rewrite SplitLGlue. apply StFBind_wd1. intro x. reflexivity. - rewrite <- SplitRBind. simpl. rewrite SplitRGlue. apply StFBind_wd1. intro x. reflexivity. +Proof. + intros. simpl. + transitivity (glue o (StFBind00 (SplitL (glue o a b) o) (compose1 (SplitLS X o) id)) + (StFBind00 (SplitR (glue o a b) o) (compose1 (SplitRS X o) id))). + apply glue_wd; auto with *. apply StFBind00_wd; try reflexivity. rewrite SplitLGlue. reflexivity. + apply StFBind00_wd; try reflexivity. rewrite SplitRGlue. reflexivity. + apply glue_wd; auto with *. + rewrite <- SplitLBind. simpl. rewrite SplitLGlue. apply StFBind_wd1. intro x. reflexivity. + rewrite <- SplitRBind. simpl. rewrite SplitRGlue. apply StFBind_wd1. intro x. reflexivity. Qed. Section Monad_Laws. @@ -243,7 +256,8 @@ Section Monad_Laws. Variable X Y:Setoid. Lemma ReturnBind(x:X)(f:X-->StepFS Y): (StFBind X Y (StFReturn X x) f)==(f x). -simpl; auto with *. +Proof. + simpl; auto with *. Qed. Let Bind_compose(Z:Setoid)(f:X-->StepFS Y)(g:Y-->StepFS Z):= @@ -251,49 +265,46 @@ Let Bind_compose(Z:Setoid)(f:X-->StepFS Y)(g:Y-->StepFS Z):= Lemma BindBind(Z:Setoid)(m:StepF X)(f:X-->StepFS Y)(g:Y-->StepFS Z): (StFBind Y Z (StFBind X Y m f) g) == (StFBind X Z m (Bind_compose f g)). -intros Z m. -induction m. simpl. unfold compose0. simpl; auto with *. -simpl. -intros. apply glue_resp_StepF_eq. +Proof. + intros Z m. + induction m. simpl. unfold compose0. simpl; auto with *. + simpl. + intros. apply glue_resp_StepF_eq. clear IHm2 m2. simpl in IHm1. - rewrite (IHm1 (compose1 (SplitLS Y o) f) (compose1 (SplitLS Z o) g)). - clear IHm1. + rewrite (IHm1 (compose1 (SplitLS Y o) f) (compose1 (SplitLS Z o) g)). + clear IHm1. + apply StFBind_wd1. + intro. simpl. unfold compose0. + symmetry. apply: SplitLBind. + clear IHm1 m1. simpl in IHm2. + rewrite (IHm2 (compose1 (SplitRS Y o) f) (compose1 (SplitRS Z o) g)). + clear IHm2. apply StFBind_wd1. intro. simpl. unfold compose0. - symmetry. apply: SplitLBind. -clear IHm1 m1. simpl in IHm2. -rewrite (IHm2 (compose1 (SplitRS Y o) f) (compose1 (SplitRS Z o) g)). -clear IHm2. -apply StFBind_wd1. -intro. simpl. unfold compose0. -symmetry. apply: SplitRBind. + symmetry. apply: SplitRBind. Qed. Lemma BindReturn(m:StepF X): (StFBind X X m (StFReturn X)) == m. -intro m. -unfold StFBind. -induction m using StepF_ind. - simpl. auto with *. -simpl. -unfold StFBind00. -simpl. apply glue_resp_StepF_eq. - clear IHm2 m2. simpl in IHm1. - assert (extEq (StepFS X) (StFReturn X) - (compose1 (SplitLS X o) (StFReturn X))). - intro. simpl. auto with *. - pose (s:=Morphism_prf (StFBind1 X m1) (StFReturn X) - (compose1 (SplitLS X o) (StFReturn X)) H). - rewrite -> s in IHm1. clear s H. +Proof. + intro m. + unfold StFBind. + induction m using StepF_ind. + simpl. auto with *. + simpl. + unfold StFBind00. + simpl. apply glue_resp_StepF_eq. + clear IHm2 m2. simpl in IHm1. + assert (extEq (StepFS X) (StFReturn X) (compose1 (SplitLS X o) (StFReturn X))). + intro. simpl. auto with *. + pose (s:=Morphism_prf (StFBind1 X m1) (StFReturn X) (compose1 (SplitLS X o) (StFReturn X)) H). + rewrite -> s in IHm1. clear s H. + assumption. + clear IHm1 m1. simpl in IHm2. + assert (extEq (StepFS X) (StFReturn X) (compose1 (SplitRS X o) (StFReturn X))). + intro; simpl; auto with *. + pose (s:=Morphism_prf (StFBind1 X m2) (StFReturn X) (compose1 (SplitRS X o) (StFReturn X)) H). + rewrite -> s in IHm2. clear s H. assumption. - -clear IHm1 m1. simpl in IHm2. -assert (extEq (StepFS X) (StFReturn X) -(compose1 (SplitRS X o) (StFReturn X))). -intro; simpl; auto with *. -pose (s:=Morphism_prf (StFBind1 X m2) (StFReturn X) -(compose1 (SplitRS X o) (StFReturn X)) H). -rewrite -> s in IHm2. clear s H. -assumption. Qed. End Monad_Laws. @@ -304,7 +315,7 @@ x: S X a: X g: X--> Y \a -> return (g a) :X --> S Y = (compose return g) -x >>= \a -> return (g a) : SY +x >>= \a -> return (g a) : SY x >>= : (X --> S Y) --> SY = (bind x) \g -> ,... : (X-->Y) -> SY @@ -320,32 +331,31 @@ x >>= : (X --> S Y) --> SY = (bind x) Lemma ApBind(X Y:Setoid): forall (x:(StepFS X)) (f:StepFS (X-->Y)) , (f<@>x== -(@StFBind _ _ f (compose (StFBind _ _ x) +(@StFBind _ _ f (compose (StFBind _ _ x) (compose (StFReturn _))))). Proof. -intros X Y. -apply: StepF_ind2. - intros s s0 t t0 Hs Ht H. - rewrite <- Hs, <- Ht at 1. - rewrite H. - unfold StFBind. - simpl. - transitivity (StFBind00 t0 (compose1 (StFBind1 Y s) (compose2 X (StFReturn Y)))). + intros X Y. + apply: StepF_ind2. + intros s s0 t t0 Hs Ht H. + rewrite <- Hs, <- Ht at 1. + rewrite H. + unfold StFBind. + simpl. + transitivity (StFBind00 t0 (compose1 (StFBind1 Y s) (compose2 X (StFReturn Y)))). + apply: StFBind_wd; auto. + apply StFBind_wd1. + intros a. apply: StFBind_wd; auto. + reflexivity. + intros o s s0 t t0 IHf1 IHf2. + rewrite ApGlueGlue. + rewrite IHf1 IHf2. + simpl. apply glue_wd; try reflexivity; apply StFBind_wd1; intro x; + unfold StFBind1, compose1, compose0; simpl. + unfold SplitLS0. rewrite SplitLGlue. apply StFBind_wd1. - intros a. - apply: StFBind_wd; auto. - reflexivity. -intros o s s0 t t0 IHf1 IHf2. -rewrite ApGlueGlue. -rewrite IHf1 IHf2. -simpl. apply glue_wd; try reflexivity; - apply StFBind_wd1; intro x; - unfold StFBind1, compose1, compose0; simpl. - unfold SplitLS0. rewrite SplitLGlue. + intro y. reflexivity. + unfold SplitRS0. rewrite SplitRGlue. apply StFBind_wd1. intro y. reflexivity. -unfold SplitRS0. rewrite SplitRGlue. -apply StFBind_wd1. -intro y. reflexivity. -Qed. \ No newline at end of file +Qed. diff --git a/metric2/StepFunctionSetoid.v b/metric2/StepFunctionSetoid.v index 9a46145d7..9569359f7 100644 --- a/metric2/StepFunctionSetoid.v +++ b/metric2/StepFunctionSetoid.v @@ -54,10 +54,10 @@ Lemma StepF_ind : forall (P : StepF -> Prop), P s -> forall s0 : StepF, P s0 -> P (glue o s s0)) -> forall s : StepF, P s. Proof. -intros P H0 H1 s. -induction s. - apply H0. -apply H1; auto. + intros P H0 H1 s. + induction s. + apply H0. + apply H1; auto. Qed. Definition StepFfold : forall Y, (X -> Y) -> (OpenUnit -> Y -> Y -> Y) -> StepF -> Y := (@StepFfold X). @@ -84,50 +84,50 @@ Open Local Scope sfstscope. Lemma MirrorGlue : forall (X : Setoid) (o : OpenUnit) (al ar : StepF X), Mirror (glue o al ar) = glue (OpenUnitDual o) (Mirror ar) (Mirror al). Proof. -reflexivity. + reflexivity. Qed. Lemma MapGlue : forall (X Y : Setoid) (f : (X --> Y)) (o : OpenUnit) (al ar : StepF X), f ^@> (glue o al ar) = glue o (f ^@> al) (f ^@> ar). Proof. -reflexivity. + reflexivity. Qed. Lemma ApGlue : forall (X Y : Setoid) (fl fr : StepF (X --> Y)) (o : OpenUnit) (b : StepF X), (glue o fl fr) <@> b = glue o (fl <@> (SplitL b o)) (fr <@> (SplitR b o)). Proof. -intros X Y fl fr o b. -unfold Ap. -simpl (StepFunction.Map (@evalMorphism X Y) (glue o fl fr)). -rewrite ApGlue. -reflexivity. + intros X Y fl fr o b. + unfold Ap. + simpl (StepFunction.Map (@evalMorphism X Y) (glue o fl fr)). + rewrite ApGlue. + reflexivity. Qed. Lemma ApGlueGlue : forall (X Y : Setoid) (fl fr : StepF (X --> Y)) (o : OpenUnit) (l r : StepF X), (glue o fl fr) <@> (glue o l r) = glue o (fl <@> l) (fr <@> r). Proof. -intros X Y fl fr o l r. -unfold Ap. -simpl (StepFunction.Map (@evalMorphism X Y) (glue o fl fr)). -unfold glue. -rewrite ApGlueGlue. -reflexivity. + intros X Y fl fr o l r. + unfold Ap. + simpl (StepFunction.Map (@evalMorphism X Y) (glue o fl fr)). + unfold glue. + rewrite ApGlueGlue. + reflexivity. Qed. Lemma SplitLGlue : forall (X : Setoid) (x y : StepF X) (o : OpenUnit), SplitL (glue o x y) o = x. Proof. -intros X. -exact (@SplitLGlue X). + intros X. + exact (@SplitLGlue X). Qed. Lemma SplitRGlue : forall (X : Setoid) (x y : StepF X) (o : OpenUnit), SplitR (glue o x y) o = y. Proof. -intros X. -exact (@SplitRGlue X). + intros X. + exact (@SplitRGlue X). Qed. Lemma SplitLR_glue_ind : forall (X : Setoid) (s1 s2 : StepF X) (a b : OpenUnit) @@ -138,18 +138,18 @@ Lemma SplitLR_glue_ind : forall (X : Setoid) (s1 s2 : StepF X) (a b : OpenUnit) P (glue (OpenUnitDiv b a H) s1 (SplitL s2 (OpenUnitDualDiv a b H))) (SplitR s2 (OpenUnitDualDiv a b H))) -> (a == b -> P s1 s2) -> P (SplitL (glue b s1 s2) a) (SplitR (glue b s1 s2) a). Proof. -intros X. -exact (@SplitLR_glue_ind X). + intros X. + exact (@SplitLR_glue_ind X). Qed. Lemma SplitL_glue_ind : forall (X : Setoid) (s1 s2 : StepF X) (a b : OpenUnit) (P : StepF X -> Prop), (forall H : a < b, P (SplitL s1 (OpenUnitDiv a b H))) -> - (forall H : b < a, P (glue (OpenUnitDiv b a H) s1 (SplitL s2 (OpenUnitDualDiv a b H)))) -> + (forall H : b < a, P (glue (OpenUnitDiv b a H) s1 (SplitL s2 (OpenUnitDualDiv a b H)))) -> (a == b -> P s1) -> P (SplitL (glue b s1 s2) a). Proof. -intros X. -exact (@SplitL_glue_ind X). + intros X. + exact (@SplitL_glue_ind X). Qed. Lemma SplitR_glue_ind : forall (X : Setoid) (s1 s2 : StepF X) (a b : OpenUnit) @@ -158,28 +158,28 @@ Lemma SplitR_glue_ind : forall (X : Setoid) (s1 s2 : StepF X) (a b : OpenUnit) (forall H : b < a, P (SplitR s2 (OpenUnitDualDiv a b H))) -> (a == b -> P s2) -> P (SplitR (glue b s1 s2) a). Proof. -intros X. -exact (@SplitR_glue_ind X). + intros X. + exact (@SplitR_glue_ind X). Qed. Lemma SplitLMap : forall (X Y : Setoid) (x : StepF X) (a : OpenUnit) (f : X --> Y), SplitL (f ^@> x) a = f ^@> (SplitL x a). Proof. -intros X Y x a f. -unfold Ap, SplitL. -simpl. -rewrite SplitLMap. -reflexivity. + intros X Y x a f. + unfold Ap, SplitL. + simpl. + rewrite SplitLMap. + reflexivity. Qed. Lemma SplitRMap : forall (X Y : Setoid) (x : StepF X) (a : OpenUnit) (f : X --> Y), SplitR (f ^@> x) a = f ^@> (SplitR x a). Proof. -intros X Y x a f. -unfold Ap, SplitR. -simpl. -rewrite SplitRMap. -reflexivity. + intros X Y x a f. + unfold Ap, SplitR. + simpl. + rewrite SplitRMap. + reflexivity. Qed. Section EquivalenceA. @@ -190,22 +190,16 @@ function *) Definition StepFfoldProp : StepF iffSetoid -> Prop := (StepFfold (X:=iffSetoid) (fun x => x ) (fun _ a b => a /\ b )). Definition st_eqS0 : X -> X --> iffSetoid. -intros x. -exists (st_eq x). -abstract ( -intros x1 x2 Hx; -simpl; -rewrite Hx; -reflexivity). +Proof. + intros x. + exists (st_eq x). + abstract ( intros x1 x2 Hx; simpl; rewrite Hx; reflexivity). Defined. Definition st_eqS : X --> X --> iffSetoid. -exists (st_eqS0). -abstract ( -intros x1 x2 Hx y; -simpl; -rewrite Hx; -reflexivity). +Proof. + exists (st_eqS0). + abstract ( intros x1 x2 Hx y; simpl; rewrite Hx; reflexivity). Defined. (** ** Equivalence @@ -223,30 +217,32 @@ Notation "x === y" := (StepF_eq x y) (at level 70). (** With equality defined we can complete the proof that split is the opposite of glue *) Lemma glue_StepF_eq:forall (s:StepF X) (s1 s2:StepF X), forall a, s1 === (SplitL s a) -> s2 === (SplitR s a) -> (glue a s1 s2) === s. -intros s s1 s2 a H0 H1. -unfold StepF_eq. -rewrite MapGlue. -rewrite ApGlue. -split; assumption. +Proof. + intros s s1 s2 a H0 H1. + unfold StepF_eq. + rewrite MapGlue. + rewrite ApGlue. + split; assumption. Qed. Lemma glue_eq_ind : forall (s1 s2 s:StepF X) a (P:Prop), (s1 === SplitL s a -> s2 === SplitR s a -> P) -> (glue a s1 s2 === s) -> P. Proof. -intros s1 s2 s a P H H0. -unfold StepF_eq in *. -rewrite -> MapGlue in *. -rewrite ApGlue in H0. -destruct H0. -auto. + intros s1 s2 s a P H H0. + unfold StepF_eq in *. + rewrite -> MapGlue in *. + rewrite ApGlue in H0. + destruct H0. + auto. Qed. (** The equivalence relation is reflexive *) Lemma StepF_eq_refl:forall x : StepF X, x === x. -induction x using StepF_ind. - change (st_eq x x). - reflexivity. -apply glue_StepF_eq. -simpl; rewrite SplitLGlue; assumption. -simpl; rewrite SplitRGlue; assumption. +Proof. + induction x using StepF_ind. + change (st_eq x x). + reflexivity. + apply glue_StepF_eq. + simpl; rewrite SplitLGlue; assumption. + simpl; rewrite SplitRGlue; assumption. Qed. (* begin hide *) Hint Resolve StepF_eq_refl. @@ -254,25 +250,22 @@ Hint Resolve StepF_eq_refl. (** StepF_Qeq is a refinement of any setoid equality *) Lemma StepF_Qeq_eq : forall (s t:StepF X), (StepF_Qeq s t) -> s === t. Proof. -induction s using StepF_ind; - induction t using StepF_ind; - try contradiction; simpl. - intros H. - rewrite H. - auto with *. -intros [H [H0 H1]]. -apply glue_StepF_eq. - apply IHs1. - apply SplitL_glue_ind; intros H2; - try (elim (Qlt_not_le _ _ H2); rewrite H); auto with *. -apply IHs2. -apply SplitR_glue_ind; intros H2; - try (elim (Qlt_not_le _ _ H2); rewrite H); auto with *. + induction s using StepF_ind; induction t using StepF_ind; try contradiction; simpl. + intros H. + rewrite H. + auto with *. + intros [H [H0 H1]]. + apply glue_StepF_eq. + apply IHs1. + apply SplitL_glue_ind; intros H2; try (elim (Qlt_not_le _ _ H2); rewrite H); auto with *. + apply IHs2. + apply SplitR_glue_ind; intros H2; try (elim (Qlt_not_le _ _ H2); rewrite H); auto with *. Qed. Lemma glueSplit:forall (s : StepF X), forall a, (glue a (SplitL s a) (SplitR s a)) === s. -intros s a. -apply glue_StepF_eq; auto with *. +Proof. + intros s a. + apply glue_StepF_eq; auto with *. Qed. End EquivalenceA. @@ -287,76 +280,79 @@ Variable X Y:Setoid. Lemma Map_resp_StepF_eq: forall f:X-->Y, (forall x y, (st_eq x y)-> (st_eq (f x) (f y))) -> forall s t:(StepF X), s == t -> (f ^@> s) == (f ^@> t). -intros f H. -induction s using StepF_ind. induction t using StepF_ind. +Proof. + intros f H. + induction s using StepF_ind. induction t using StepF_ind. unfold StepF_eq, Map2, StepFfoldProp ;simpl;auto with *. - unfold StepF_eq, Map2, StepFfoldProp. simpl; intuition. -intros t H0. -unfold StepF_eq, Map2 in H0. -rewrite MapGlue in H0. -rewrite ApGlue in H0. -unfold StepF_eq, Map2. -repeat rewrite MapGlue. -rewrite ApGlue. -rewrite SplitLMap. -rewrite SplitRMap. -destruct H0 as [H0l H0R]. -split. - apply IHs1; auto. -apply IHs2; auto. + unfold StepF_eq, Map2, StepFfoldProp. simpl; intuition. + intros t H0. + unfold StepF_eq, Map2 in H0. + rewrite MapGlue in H0. + rewrite ApGlue in H0. + unfold StepF_eq, Map2. + repeat rewrite MapGlue. + rewrite ApGlue. + rewrite SplitLMap. + rewrite SplitRMap. + destruct H0 as [H0l H0R]. + split. + apply IHs1; auto. + apply IHs2; auto. Qed. End EquivalenceB. Lemma StepFfoldPropglue:forall (y:StepF iffSetoid) o, StepFfoldProp (glue o (SplitL y o) (SplitR y o)) <-> StepFfoldProp y. -induction y using StepF_ind. +Proof. + induction y using StepF_ind. unfold StepF_eq, StepFfoldProp. simpl; tauto. -simpl. -intro o0. -apply SplitLR_glue_ind; intros H. - generalize (IHy1 (OpenUnitDiv o0 o H)). + simpl. + intro o0. + apply SplitLR_glue_ind; intros H. + generalize (IHy1 (OpenUnitDiv o0 o H)). + unfold StepFfoldProp; simpl; tauto. + generalize (IHy2 (OpenUnitDualDiv o0 o H)). unfold StepFfoldProp; simpl; tauto. - generalize (IHy2 (OpenUnitDualDiv o0 o H)). - unfold StepFfoldProp; simpl; tauto. -simpl. -reflexivity. + simpl. + reflexivity. Qed. Lemma StepFfoldProp_morphism:forall x y:(StepF iffSetoid), (StepF_eq x y) -> ((StepFfoldProp x)<->(StepFfoldProp y)). -induction x using StepF_ind. induction y using StepF_ind. - auto with *. +Proof. + induction x using StepF_ind. induction y using StepF_ind. + auto with *. unfold StepF_eq. simpl. unfold StepFfoldProp;simpl;intuition. -intros y H0. -unfold StepF_eq, Map2 in H0. -rewrite MapGlue in H0. -rewrite ApGlue in H0. -destruct H0 as [H0l H0r]. -change ((StepFfoldProp x1 /\ StepFfoldProp x2) <-> StepFfoldProp y). -rewrite (IHx1 (SplitL y o)); auto with *. -rewrite (IHx2 (SplitR y o)); auto with *. -apply: StepFfoldPropglue. + intros y H0. + unfold StepF_eq, Map2 in H0. + rewrite MapGlue in H0. + rewrite ApGlue in H0. + destruct H0 as [H0l H0r]. + change ((StepFfoldProp x1 /\ StepFfoldProp x2) <-> StepFfoldProp y). + rewrite (IHx1 (SplitL y o)); auto with *. + rewrite (IHx2 (SplitR y o)); auto with *. + apply: StepFfoldPropglue. Qed. Lemma StepFfoldPropSplitR : forall (s : StepF iffSetoid) (a : OpenUnit), StepFfoldProp s -> StepFfoldProp (SplitR s a). Proof. -intros s a H. -rewrite <- (StepFfoldPropglue s a) in H. -destruct H; auto. + intros s a H. + rewrite <- (StepFfoldPropglue s a) in H. + destruct H; auto. Qed. Lemma StepFfoldPropSplitL : forall (s : StepF iffSetoid) (a : OpenUnit), StepFfoldProp s -> StepFfoldProp (SplitL s a). Proof. -intros s a H. -rewrite <- (StepFfoldPropglue s a) in H. -destruct H; auto. + intros s a H. + rewrite <- (StepFfoldPropglue s a) in H. + destruct H; auto. Qed. Section EquivalenceC. @@ -367,152 +363,155 @@ Hint Resolve StepF_Qeq_eq StepF_Qeq_refl SplitL_resp_Qeq SplitR_resp_Qeq. (* end hide *) Lemma StepF_eq_resp_Qeq : forall (s t : StepF X) u v, (StepF_Qeq s t) -> (StepF_Qeq u v) -> s == u -> t == v. Proof. -induction s using StepF_ind; induction t using StepF_ind; try contradiction. - intros u v Hst Huv Hsu. - simpl in Hst. - unfold StepF_eq in *. - rewrite <- Hst. - rewrite <- (StepFfoldProp_morphism ((st_eqS X) ^@> constStepF x <@> u)); auto. - apply: (Map_resp_StepF_eq); auto with *. - intros a b Hab. - simpl. - rewrite Hab. - reflexivity. -intros u v [H [Hst0 Hst1]] Huv Hsu. -destruct Hsu as [Hsu1 Hsu2] using (glue_eq_ind s1). -apply glue_StepF_eq. - eapply IHs1. + induction s using StepF_ind; induction t using StepF_ind; try contradiction. + intros u v Hst Huv Hsu. + simpl in Hst. + unfold StepF_eq in *. + rewrite <- Hst. + rewrite <- (StepFfoldProp_morphism ((st_eqS X) ^@> constStepF x <@> u)); auto. + apply: (Map_resp_StepF_eq); auto with *. + intros a b Hab. + simpl. + rewrite Hab. + reflexivity. + intros u v [H [Hst0 Hst1]] Huv Hsu. + destruct Hsu as [Hsu1 Hsu2] using (glue_eq_ind s1). + apply glue_StepF_eq. + eapply IHs1. + assumption. + unfold SplitL; apply SplitL_resp_Qeq. + apply H. + apply Huv. + assumption. + eapply IHs2. assumption. - unfold SplitL; apply SplitL_resp_Qeq. + unfold SplitR; apply SplitR_resp_Qeq. apply H. apply Huv. assumption. -eapply IHs2. - assumption. - unfold SplitR; apply SplitR_resp_Qeq. - apply H. - apply Huv. -assumption. Qed. Lemma Mirror_eq_Mirror : forall (s t : StepF X), Mirror s == Mirror t <-> s == t. Proof. -induction s using StepF_ind. - induction t using StepF_ind; simpl. - reflexivity. - change (constStepF x == (Mirror t2) /\ constStepF x == (Mirror t1) <-> constStepF x == t1 /\ constStepF x == t2). - tauto. -intros t. -rewrite MirrorGlue. -split; apply (@glue_eq_ind X); intros H0 H1. - apply glue_StepF_eq. - rewrite <- IHs1. - eapply StepF_eq_resp_Qeq;[| |apply H1]; auto with *. + induction s using StepF_ind. + induction t using StepF_ind; simpl. + reflexivity. + change (constStepF x == (Mirror t2) /\ constStepF x == (Mirror t1) <-> constStepF x == t1 /\ constStepF x == t2). + tauto. + intros t. + rewrite MirrorGlue. + split; apply (@glue_eq_ind X); intros H0 H1. + apply glue_StepF_eq. + rewrite <- IHs1. + eapply StepF_eq_resp_Qeq;[| |apply H1]; auto with *. + apply StepF_Qeq_sym. + apply MirrorSplitL_Qeq; auto with *. + rewrite <- IHs2. + eapply StepF_eq_resp_Qeq;[| |apply H0]; auto with *. apply StepF_Qeq_sym. - apply MirrorSplitL_Qeq; auto with *. - rewrite <- IHs2. - eapply StepF_eq_resp_Qeq;[| |apply H0]; auto with *. - apply StepF_Qeq_sym. - apply MirrorSplitR_Qeq; auto with *. -apply glue_StepF_eq. - apply StepF_eq_resp_Qeq with (Mirror s2) (Mirror (SplitR t o)); auto. - apply MirrorSplitR_Qeq; apply Qeq_refl. - rewrite IHs2. + apply MirrorSplitR_Qeq; auto with *. + apply glue_StepF_eq. + apply StepF_eq_resp_Qeq with (Mirror s2) (Mirror (SplitR t o)); auto. + apply MirrorSplitR_Qeq; apply Qeq_refl. + rewrite IHs2. + assumption. + apply StepF_eq_resp_Qeq with (Mirror s1) (Mirror (SplitL t o)); auto. + apply MirrorSplitL_Qeq; apply Qeq_refl. + rewrite IHs1. assumption. -apply StepF_eq_resp_Qeq with (Mirror s1) (Mirror (SplitL t o)); auto. - apply MirrorSplitL_Qeq; apply Qeq_refl. -rewrite IHs1. -assumption. Qed. Lemma SplitL_resp_Xeq : forall (s1 s2 : StepF X) a, s1 == s2 -> SplitL s1 a == SplitL s2 a. Proof. -induction s1 using StepF_ind. + induction s1 using StepF_ind. + intros s2 a H. + unfold StepF_eq in *. + change (StepFfoldProp ((st_eqS X x:X-->iffSetoid) ^@> SplitL s2 a)). + rewrite <- SplitLMap. + apply StepFfoldPropSplitL. + assumption. intros s2 a H. - unfold StepF_eq in *. - change (StepFfoldProp ((st_eqS X x:X-->iffSetoid) ^@> SplitL s2 a)). - rewrite <- SplitLMap. - apply StepFfoldPropSplitL. + destruct H using (glue_eq_ind s1_1). + apply SplitL_glue_ind; intros Hao. + apply StepF_eq_resp_Qeq with (SplitL s1_1 (OpenUnitDiv a o Hao)) (SplitL (SplitL s2 o) (OpenUnitDiv a o Hao)); auto. + apply SplitLSplitL. + simpl; field; auto with *. + apply glue_StepF_eq. + apply StepF_eq_resp_Qeq with s1_1 (SplitL s2 o); auto. + apply StepF_Qeq_sym. + apply SplitLSplitL. + simpl; field; auto with *. + apply StepF_eq_resp_Qeq with (SplitL s1_2 (OpenUnitDualDiv a o Hao)) (SplitL (SplitR s2 o) (OpenUnitDualDiv a o Hao)); auto. + apply SplitLSplitR; simpl; field; auto with *. + apply StepF_eq_resp_Qeq with s1_1 (SplitL s2 o); auto with *. + apply SplitL_resp_Qeq; auto. + symmetry. assumption. -intros s2 a H. -destruct H using (glue_eq_ind s1_1). -apply SplitL_glue_ind; intros Hao. - apply StepF_eq_resp_Qeq with (SplitL s1_1 (OpenUnitDiv a o Hao)) (SplitL (SplitL s2 o) (OpenUnitDiv a o Hao)); auto. - apply SplitLSplitL. - simpl; field; auto with *. - apply glue_StepF_eq. - apply StepF_eq_resp_Qeq with s1_1 (SplitL s2 o); auto. - apply StepF_Qeq_sym. - apply SplitLSplitL. - simpl; field; auto with *. - apply StepF_eq_resp_Qeq with (SplitL s1_2 (OpenUnitDualDiv a o Hao)) (SplitL (SplitR s2 o) (OpenUnitDualDiv a o Hao)); auto. - apply SplitLSplitR; simpl; field; auto with *. -apply StepF_eq_resp_Qeq with s1_1 (SplitL s2 o); auto with *. -apply SplitL_resp_Qeq; auto. -symmetry. -assumption. Qed. Lemma SplitR_resp_Xeq : forall (s1 s2:StepF X) a, s1 == s2 -> SplitR s1 a == SplitR s2 a. Proof. -intros s1 s2 a H. -pose (b:=OpenUnitDual a). -apply StepF_eq_resp_Qeq with (Mirror (SplitL (Mirror s1) b)) (Mirror (SplitL (Mirror s2) b)); - try (unfold Mirror, SplitR, SplitL, b;eapply StepF_Qeq_trans;[apply Mirror_resp_Qeq; apply StepF_Qeq_sym; apply MirrorSplitR_Qeq; reflexivity|apply MirrorMirror]). -rewrite Mirror_eq_Mirror. -apply SplitL_resp_Xeq. -rewrite Mirror_eq_Mirror. -assumption. + intros s1 s2 a H. + pose (b:=OpenUnitDual a). + apply StepF_eq_resp_Qeq with (Mirror (SplitL (Mirror s1) b)) (Mirror (SplitL (Mirror s2) b)); + try (unfold Mirror, SplitR, SplitL, b;eapply StepF_Qeq_trans;[apply Mirror_resp_Qeq; apply StepF_Qeq_sym; apply MirrorSplitR_Qeq; reflexivity|apply MirrorMirror]). + rewrite Mirror_eq_Mirror. + apply SplitL_resp_Xeq. + rewrite Mirror_eq_Mirror. + assumption. Qed. (** equalitiy is transitive *) Lemma StepF_eq_trans:forall x y z : StepF X, x == y -> y == z -> x == z. -induction x using StepF_ind. intros. - unfold StepF_eq in *. - set (A:=((st_eqS X:X-->X-->iffSetoid) ^@> constStepF x)) in *. - rewrite <- (StepFfoldProp_morphism (A <@> y)); auto with *. - apply: (Map_resp_StepF_eq); auto with *. - intros a b Hab. - simpl. - rewrite Hab. - reflexivity. -intros. -destruct H using (glue_eq_ind x1). -apply glue_StepF_eq. - eapply IHx1. - apply H. - apply SplitL_resp_Xeq. +Proof. + induction x using StepF_ind. intros. + unfold StepF_eq in *. + set (A:=((st_eqS X:X-->X-->iffSetoid) ^@> constStepF x)) in *. + rewrite <- (StepFfoldProp_morphism (A <@> y)); auto with *. + apply: (Map_resp_StepF_eq); auto with *. + intros a b Hab. + simpl. + rewrite Hab. + reflexivity. + intros. + destruct H using (glue_eq_ind x1). + apply glue_StepF_eq. + eapply IHx1. + apply H. + apply SplitL_resp_Xeq. + assumption. + eapply IHx2. + apply H1. + apply SplitR_resp_Xeq. assumption. -eapply IHx2. - apply H1. -apply SplitR_resp_Xeq. -assumption. Qed. Lemma glue_resp_StepF_eq:forall (x x' y y':StepF X) o, (x==x')->(y==y')-> (glue o x y)==(glue o x' y'). -intros. -unfold StepF_eq. -rewrite MapGlue. -rewrite ApGlueGlue. -split; assumption. +Proof. + intros. + unfold StepF_eq. + rewrite MapGlue. + rewrite ApGlueGlue. + split; assumption. Qed. (** equality is symmetric *) Lemma StepF_eq_sym :forall x y: StepF X, x == y -> y == x. -intros x y. -revert x. -induction y using StepF_ind. - unfold StepF_eq. simpl. intro x0. induction x0. +Proof. + intros x y. + revert x. + induction y using StepF_ind. + unfold StepF_eq. simpl. intro x0. induction x0. unfold StepFfoldProp. simpl. intros. symmetry; assumption. - simpl. unfold StepFfoldProp; simpl; intuition; auto with *. -intros x H. -assert (H0:=(SplitL_resp_Xeq _ _ o H)). -rewrite SplitLGlue in H0. -assert (H1:=(SplitR_resp_Xeq _ _ o H)). -rewrite SplitRGlue in H1. -apply glue_StepF_eq;auto with *. + simpl. unfold StepFfoldProp; simpl; intuition; auto with *. + intros x H. + assert (H0:=(SplitL_resp_Xeq _ _ o H)). + rewrite SplitLGlue in H0. + assert (H1:=(SplitR_resp_Xeq _ _ o H)). + rewrite SplitRGlue in H1. + apply glue_StepF_eq;auto with *. Qed. End EquivalenceC. @@ -528,13 +527,12 @@ Hint Resolve StepF_eq_sym StepF_eq_trans. Add Morphism (StepFfoldProp) with signature (@StepF_eq iffSetoid) ==> iff as StepFfoldProp_mor. -exact StepFfoldProp_morphism. +Proof. + exact StepFfoldProp_morphism. Qed. (* end hide *) Lemma StepF_Sth (X:Setoid) : (Setoid_Theory (StepF X) (@StepF_eq X)). -split; - unfold Reflexive, Symmetric, Transitive; - eauto with sfarith. + split; unfold Reflexive, Symmetric, Transitive; eauto with sfarith. Qed. (** ** Common subdivision view @@ -549,34 +547,36 @@ Lemma StepF_ind2 : forall (X Y : Setoid) (P : StepF X -> StepF Y -> Prop), P s t -> P s0 t0 -> P (glue o s s0) (glue o t t0)) -> forall (s:StepF X) (t:StepF Y), P s t. Proof. -intros X Y P wd c0 c1. -induction s using StepF_ind. - induction t using StepF_ind. - apply c0. - apply wd with (s:=(glue o (constStepF x) (constStepF x))) (t:=glue o t1 t2); try reflexivity. - apply (glueSplit (constStepF x) o). - apply c1; assumption. -intros t. -eapply wd. - reflexivity. - apply glueSplit with (a:=o). -apply c1; auto. + intros X Y P wd c0 c1. + induction s using StepF_ind. + induction t using StepF_ind. + apply c0. + apply wd with (s:=(glue o (constStepF x) (constStepF x))) (t:=glue o t1 t2); try reflexivity. + apply (glueSplit (constStepF x) o). + apply c1; assumption. + intros t. + eapply wd. + reflexivity. + apply glueSplit with (a:=o). + apply c1; auto. Qed. Lemma glue_injl X :forall o (x y x1 y1:StepF X), (glue o x y)==(glue o x1 y1) -> (x==x1). -intros. -destruct H as [H _] using (glue_eq_ind x). -rewrite SplitLGlue in H. -assumption. +Proof. + intros. + destruct H as [H _] using (glue_eq_ind x). + rewrite SplitLGlue in H. + assumption. Qed. Lemma glue_injr X :forall o (x y x1 y1:StepF X), (glue o x y)==(glue o x1 y1) -> (y==y1). -intros. -destruct H as [_ H] using (glue_eq_ind x). -rewrite SplitRGlue in H. -assumption. +Proof. + intros. + destruct H as [_ H] using (glue_eq_ind x). + rewrite SplitRGlue in H. + assumption. Qed. (** Decompose an equality over glue into two parts *) @@ -584,29 +584,29 @@ Lemma eq_glue_ind X : forall (s1 s2 s : StepF X) (a : OpenUnit) (P : Prop), ((SplitL s a) == s1 -> (SplitR s a) == s2 -> P) -> s == (glue a s1 s2) -> P. Proof. -intros X s1 s2 s a P H H0. -symmetry in H0. -destruct H0 as [H0l H0r] using (glue_eq_ind s1). -symmetry in H0l, H0r. -auto. + intros X s1 s2 s a P H H0. + symmetry in H0. + destruct H0 as [H0l H0r] using (glue_eq_ind s1). + symmetry in H0l, H0r. + auto. Qed. Lemma MirrorSplitR X : forall (s : StepF X) (a b : OpenUnit), (b == OpenUnitDual a)%Q -> (Mirror (SplitR s a)) == (SplitL (Mirror s) b). Proof. -intros. -apply StepF_Qeq_eq; auto with *. -apply MirrorSplitR_Qeq; auto with *. + intros. + apply StepF_Qeq_eq; auto with *. + apply MirrorSplitR_Qeq; auto with *. Qed. Lemma MirrorSplitL X : forall (s : StepF X) (a b : OpenUnit), (b == OpenUnitDual a)%Q -> (Mirror (SplitL s a)) == (SplitR (Mirror s) b). Proof. -intros. -apply StepF_Qeq_eq; auto with *. -apply MirrorSplitL_Qeq; auto with *. + intros. + apply StepF_Qeq_eq; auto with *. + apply MirrorSplitL_Qeq; auto with *. Qed. (** Lift the distribution lemmas between ap and split to work over step @@ -614,115 +614,117 @@ functions *) Lemma SplitRAp :forall (X Y:Setoid) (f : StepF (Y --> X)) (s : StepF Y) (o : OpenUnit), (SplitR (f <@> s) o) == (SplitR f o <@> SplitR s o). Proof. -intros X Y f s o. -apply StepF_Qeq_eq; auto with *. -unfold Ap, SplitR. -rewrite <- StepFunction.SplitRMap. -apply SplitRAp_Qeq. + intros X Y f s o. + apply StepF_Qeq_eq; auto with *. + unfold Ap, SplitR. + rewrite <- StepFunction.SplitRMap. + apply SplitRAp_Qeq. Qed. Lemma SplitLAp :forall (X Y:Setoid) (f : StepF (Y --> X)) (s : StepF Y) (o : OpenUnit), (SplitL (f <@> s) o) == (SplitL f o <@> SplitL s o). Proof. -intros X Y f s o. -apply StepF_Qeq_eq; auto with *. -unfold Ap, SplitL. -rewrite <- StepFunction.SplitLMap. -apply SplitLAp_Qeq. + intros X Y f s o. + apply StepF_Qeq_eq; auto with *. + unfold Ap, SplitL. + rewrite <- StepFunction.SplitLMap. + apply SplitLAp_Qeq. Qed. (* begin hide *) Add Parametric Morphism s : (@constStepF s) with signature (@st_eq s) ==> (@StepF_eq s) as constStepF_wd. -auto. +Proof. + auto. Qed. Add Parametric Morphism s : (@glue s) with signature ou_eq ==> (@StepF_eq s) ==> (@StepF_eq s) ==> (@StepF_eq s) as glue_wd. -intros o1 o2 Ho x1 x2 Hx y1 y2 Hy. -transitivity (glue o1 x2 y2). -apply glue_resp_StepF_eq; auto. -apply StepF_Qeq_eq. -repeat split; auto; reflexivity. +Proof. + intros o1 o2 Ho x1 x2 Hx y1 y2 Hy. + transitivity (glue o1 x2 y2). + apply glue_resp_StepF_eq; auto. + apply StepF_Qeq_eq. + repeat split; auto; reflexivity. Qed. Add Parametric Morphism X : (@SplitL X) with signature (@StepF_eq X) ==> ou_eq ==> (@StepF_eq X) as SplitL_wd. Proof. -intros x1 x2 Hx o1 o2 Ho. -transitivity (SplitL x2 o1). - apply SplitL_resp_Xeq; auto. -apply StepF_Qeq_eq. -apply SplitL_resp_Qeq; auto; reflexivity. + intros x1 x2 Hx o1 o2 Ho. + transitivity (SplitL x2 o1). + apply SplitL_resp_Xeq; auto. + apply StepF_Qeq_eq. + apply SplitL_resp_Qeq; auto; reflexivity. Qed. Add Parametric Morphism X : (@SplitR X) with signature (@StepF_eq X) ==> ou_eq ==> (@StepF_eq X) as SplitR_wd. Proof. -intros x1 x2 Hx o1 o2 Ho. -transitivity (SplitR x2 o1). - apply SplitR_resp_Xeq; auto. -apply StepF_Qeq_eq. -apply SplitR_resp_Qeq; auto; reflexivity. + intros x1 x2 Hx o1 o2 Ho. + transitivity (SplitR x2 o1). + apply SplitR_resp_Xeq; auto. + apply StepF_Qeq_eq. + apply SplitR_resp_Qeq; auto; reflexivity. Qed. Add Parametric Morphism X Y : (@Ap X Y) with signature (@StepF_eq (extSetoid X Y)) ==> (@StepF_eq X) ==> (@StepF_eq Y) as Ap_wd. Proof. -intros f. -induction f using StepF_ind; intros g Hfg. - induction g using StepF_ind; intros x1. - simpl. - induction x1 using StepF_ind; intros x2. - induction x2 using StepF_ind. + intros f. + induction f using StepF_ind; intros g Hfg. + induction g using StepF_ind; intros x1. + simpl. + induction x1 using StepF_ind; intros x2. + induction x2 using StepF_ind. + intros H. + transitivity (x ^@> (constStepF x2)). + destruct x as [x Hx]. + clear Hfg. apply: Hx ; assumption. + apply: Hfg. intros H. - transitivity (x ^@> (constStepF x2)). - destruct x as [x Hx]. - clear Hfg. apply: Hx ; assumption. - apply: Hfg. + rewrite MapGlue. + symmetry. + symmetry in H. + destruct H as [Hl Hr] using (glue_eq_ind x2_1). + apply glue_StepF_eq. + symmetry. + symmetry in Hl. + apply IHx2_1. + assumption. + symmetry. + symmetry in Hr. + apply IHx2_2. + assumption. intros H. rewrite MapGlue. - symmetry. - symmetry in H. - destruct H as [Hl Hr] using (glue_eq_ind x2_1). + destruct H as [Hl Hr] using (glue_eq_ind x1_1). apply glue_StepF_eq. - symmetry. - symmetry in Hl. - apply IHx2_1. - assumption. - symmetry. - symmetry in Hr. - apply IHx2_2. - assumption. - intros H. - rewrite MapGlue. - destruct H as [Hl Hr] using (glue_eq_ind x1_1). - apply glue_StepF_eq. + rewrite SplitLMap. + apply IHx1_1; auto. + rewrite SplitRMap. + apply IHx1_2; auto. + symmetry. + rewrite ApGlue. + destruct Hfg as [Hfg0 Hfg1] using (eq_glue_ind g1). + apply glue_StepF_eq; symmetry. rewrite SplitLMap. - apply IHx1_1; auto. + apply IHg1; try rewrite H0; auto with *. rewrite SplitRMap. - apply IHx1_2; auto. - symmetry. + apply IHg2; try rewrite H0; auto with *. + intros s s' Hs. + destruct Hfg as [Hfg0 Hfg1] using (glue_eq_ind f1). rewrite ApGlue. - destruct Hfg as [Hfg0 Hfg1] using (eq_glue_ind g1). - apply glue_StepF_eq; symmetry. - rewrite SplitLMap. - apply IHg1; try rewrite H0; auto with *. - rewrite SplitRMap. - apply IHg2; try rewrite H0; auto with *. -intros s s' Hs. -destruct Hfg as [Hfg0 Hfg1] using (glue_eq_ind f1). -rewrite ApGlue. -apply glue_StepF_eq; auto with *. - rewrite SplitLAp. - apply IHf1; try rewrite Hs; auto with *. -rewrite SplitRAp. -apply IHf2; try rewrite Hs; auto with *. + apply glue_StepF_eq; auto with *. + rewrite SplitLAp. + apply IHf1; try rewrite Hs; auto with *. + rewrite SplitRAp. + apply IHf2; try rewrite Hs; auto with *. Qed. (* end hide *) Lemma GlueAp : forall (X Y : Setoid) (f : StepF (X --> Y)) (o : OpenUnit) (l r : StepF X), f <@> (glue o l r) == glue o ((SplitL f o) <@> l) ((SplitR f o) <@> r). Proof. -intros X Y f o l r. -set (A:= ((SplitL f o)<@>l)). -set (B:= ((SplitR f o)<@>r)). -rewrite <- (glueSplit f o). -rewrite ApGlueGlue. -reflexivity. + intros X Y f o l r. + set (A:= ((SplitL f o)<@>l)). + set (B:= ((SplitR f o)<@>r)). + rewrite <- (glueSplit f o). + rewrite ApGlueGlue. + reflexivity. Qed. (** ** Applicative Functor @@ -731,100 +733,100 @@ Here we prove the axioms of an applicative functor. Lemma Map_homomorphism (X Y:Setoid) : forall (f:X-->Y) (a:X), (f ^@> constStepF a) == (constStepF (f a)). Proof. -reflexivity. + reflexivity. Qed. Lemma Map_identity X : forall (a:StepF X), (@id X) ^@> a == a. Proof. -intros X a. -rewrite <- Map_identity. -reflexivity. + intros X a. + rewrite <- Map_identity. + reflexivity. Qed. Lemma Map_composition X Y Z: forall (a:StepF (Y-->Z)) (b:StepF (X-->Y)) (c:StepF X), ((@compose X Y Z) ^@> a <@> b <@> c) == (a <@> (b <@> c)). Proof. -induction a using StepF_ind. - simpl. - apply StepF_ind2; auto with *. - intros s s0 t t0 Hs Ht. - rewrite Hs Ht. - auto. - intros o s s0 t t0 H H0. - rewrite Map_homomorphism. - rewrite ApGlueGlue. - do 2 rewrite MapGlue. - rewrite ApGlueGlue. - rewrite <- H. - rewrite <- H0. - reflexivity. -intros b c. -rewrite MapGlue. -repeat rewrite ApGlue. -apply glue_resp_StepF_eq. - rewrite IHa1. - rewrite SplitLAp. + induction a using StepF_ind. + simpl. + apply StepF_ind2; auto with *. + intros s s0 t t0 Hs Ht. + rewrite Hs Ht. + auto. + intros o s s0 t t0 H H0. + rewrite Map_homomorphism. + rewrite ApGlueGlue. + do 2 rewrite MapGlue. + rewrite ApGlueGlue. + rewrite <- H. + rewrite <- H0. + reflexivity. + intros b c. + rewrite MapGlue. + repeat rewrite ApGlue. + apply glue_resp_StepF_eq. + rewrite IHa1. + rewrite SplitLAp. + reflexivity. + rewrite IHa2. + rewrite SplitRAp. reflexivity. -rewrite IHa2. -rewrite SplitRAp. -reflexivity. Qed. -(** Here we show that the rest of the BCKW combinators lift to +(** Here we show that the rest of the BCKW combinators lift to step functions. Hence all of the lambda calculus lifts to operate over step functions. Step functions form about a nice of an applicative functor as is possible. *) Lemma Map_discardable X Y : forall (a:StepF X) (b:StepF Y), ((@const _ _) ^@> a <@> b == a). Proof. -intros X Y. -apply StepF_ind2; auto with *. - intros s s0 t t0 Hs Ht. - rewrite Hs Ht; auto. -intros o s s0 t t0 H0 H1. -rewrite MapGlue. -rewrite ApGlueGlue. -rewrite H0 H1;reflexivity. + intros X Y. + apply StepF_ind2; auto with *. + intros s s0 t t0 Hs Ht. + rewrite Hs Ht; auto. + intros o s s0 t t0 H0 H1. + rewrite MapGlue. + rewrite ApGlueGlue. + rewrite H0 H1;reflexivity. Qed. Lemma Map_commutative W X Y : forall (f:StepF (W --> X --> Y)) (x:StepF X) (w:StepF W), ((@flip _ _ _) ^@> f <@> x <@> w) == (f <@> w <@> x). Proof. -induction f using StepF_ind. - simpl. - apply StepF_ind2; auto with *. - intros s s0 t t0 Hs Ht. - rewrite Hs Ht;auto. - intros o s s0 t t0 H0 H1. - rewrite Map_homomorphism. - do 2 rewrite MapGlue. - do 2 rewrite ApGlueGlue. - rewrite H0 H1; reflexivity. -intros x w. -rewrite MapGlue. -do 4 rewrite ApGlue. -apply glue_resp_StepF_eq; auto. + induction f using StepF_ind. + simpl. + apply StepF_ind2; auto with *. + intros s s0 t t0 Hs Ht. + rewrite Hs Ht;auto. + intros o s s0 t t0 H0 H1. + rewrite Map_homomorphism. + do 2 rewrite MapGlue. + do 2 rewrite ApGlueGlue. + rewrite H0 H1; reflexivity. + intros x w. + rewrite MapGlue. + do 4 rewrite ApGlue. + apply glue_resp_StepF_eq; auto. Qed. Lemma Map_copyable X Y : forall (f:StepF (X --> X --> Y)) (x:StepF X), ((@join _ _) ^@> f <@> x) == (f <@> x <@> x). Proof. -intros X Y. -apply StepF_ind2; auto with *. - intros s s0 t t0 Hs Ht. - rewrite Hs Ht; auto. -intros o s s0 t t0 H0 H1. -rewrite MapGlue. -do 3 rewrite ApGlueGlue. -rewrite H0 H1;reflexivity. + intros X Y. + apply StepF_ind2; auto with *. + intros s s0 t t0 Hs Ht. + rewrite Hs Ht; auto. + intros o s s0 t t0 H0 H1. + rewrite MapGlue. + do 3 rewrite ApGlueGlue. + rewrite H0 H1;reflexivity. Qed. (* begin hide *) -Hint Rewrite +Hint Rewrite ApGlueGlue ApGlue GlueAp SplitRAp SplitLAp SplitLGlue SplitRGlue Map_homomorphism : StepF_rew. -Hint Rewrite +Hint Rewrite Map_composition Map_discardable Map_commutative @@ -833,117 +835,120 @@ Hint Rewrite (* end hide *) (** This tactic is usefully for symbolically evaluating functions written in (BCKWI) combinator form that are ap'ed to step functions *) -Ltac evalStepF := progress +Ltac evalStepF := progress (repeat rewrite <- Map_homomorphism; autorewrite with StepF_eval). Lemma Ap_interchange (X Y:Setoid) : forall (f:StepF (X-->Y)) (a:X), (f <@^ a) == (flip id a) ^@> f. Proof. -intros X Y f a. -evalStepF. -reflexivity. + intros X Y f a. + evalStepF. + reflexivity. Qed. (** Map'ing the S combinator (which is also called ap) *) Lemma Map_ap X Y Z : forall (f:StepF (X --> Y --> Z)) (x:StepF (X --> Y)) (a:StepF X), ((@ap _ _ _) ^@> f <@> x <@> a) == (f <@> a <@> (x <@> a)). Proof. -intros X Y Z f x a. -unfold ap. -evalStepF. -reflexivity. + intros X Y Z f x a. + unfold ap. + evalStepF. + reflexivity. Qed. (* begin hide *) Hint Rewrite Map_ap : StepF_eval. (* end hide *) Ltac rewriteStepF := autorewrite with StepF_rew. -Lemma StepFfoldPropForall_Ap : +Lemma StepFfoldPropForall_Ap : forall X (f:StepF (X --> iffSetoid)) (x:StepF X), (forall y, StepFfoldProp (f <@> constStepF y)) -> StepFfoldProp (f <@> x). Proof. -intros X f x H. -revert f H. -induction x using StepF_ind. + intros X f x H. + revert f H. + induction x using StepF_ind. + intros f H. + apply H. intros f H. - apply H. -intros f H. -rewrite <- (glueSplit f o). -rewrite ApGlueGlue. -split. - apply IHx1. + rewrite <- (glueSplit f o). + rewrite ApGlueGlue. + split. + apply IHx1. + intros y. + assert (H0:=H y). + rewrite <- (glueSplit f o) in H0. + rewrite ApGlue in H0. + destruct H0 as [H0 _]. + assumption. + apply IHx2. intros y. assert (H0:=H y). rewrite <- (glueSplit f o) in H0. rewrite ApGlue in H0. - destruct H0 as [H0 _]. + destruct H0 as [_ H0]. assumption. -apply IHx2. -intros y. -assert (H0:=H y). -rewrite <- (glueSplit f o) in H0. -rewrite ApGlue in H0. -destruct H0 as [_ H0]. -assumption. Qed. (** A common case that we will encounter is that a predicate holds for all step functions when it is define via map (or map2 or map3) and the underlying function holds for all X. *) -Lemma StepFfoldPropForall_Map : +Lemma StepFfoldPropForall_Map : forall X (f:X --> iffSetoid) (x:StepF X), (forall a, f a) -> StepFfoldProp (f ^@> x). Proof. -intros X f x H. -apply StepFfoldPropForall_Ap. -assumption. + intros X f x H. + apply StepFfoldPropForall_Ap. + assumption. Qed. -Lemma StepFfoldPropForall_Map2 : +Lemma StepFfoldPropForall_Map2 : forall X Y (f:X --> Y --> iffSetoid) x y, (forall a b, f a b) -> StepFfoldProp (f ^@> x <@> y). Proof. -intros X Y f x y H. -apply StepFfoldPropForall_Ap. -intros b. -rewrite <- (Map_commutative (constStepF f) (constStepF b)). -rewriteStepF. -apply StepFfoldPropForall_Map. -intros a. -apply: H. + intros X Y f x y H. + apply StepFfoldPropForall_Ap. + intros b. + rewrite <- (Map_commutative (constStepF f) (constStepF b)). + rewriteStepF. + apply StepFfoldPropForall_Map. + intros a. + apply: H. Qed. -Lemma StepFfoldPropForall_Map3 : +Lemma StepFfoldPropForall_Map3 : forall X Y Z (f:X --> Y --> Z --> iffSetoid) x y z, (forall a b c, f a b c) -> StepFfoldProp (f ^@> x <@> y <@> z). Proof. -intros X Y Z f x y z H. -apply StepFfoldPropForall_Ap. -intros c. -rewrite <- (Map_commutative ((constStepF f) <@> x) (constStepF c)). -rewrite <- Map_composition. -rewriteStepF. -rewrite <- (Map_commutative (constStepF (compose flip f)) (constStepF c)). -rewriteStepF. -apply StepFfoldPropForall_Map2. -intros a b. -apply: H. + intros X Y Z f x y z H. + apply StepFfoldPropForall_Ap. + intros c. + rewrite <- (Map_commutative ((constStepF f) <@> x) (constStepF c)). + rewrite <- Map_composition. + rewriteStepF. + rewrite <- (Map_commutative (constStepF (compose flip f)) (constStepF c)). + rewriteStepF. + apply StepFfoldPropForall_Map2. + intros a b. + apply: H. Qed. (** The implication operation can be lifted to work on characteristic functions *) Definition imp0:Prop->iffSetoid-->iffSetoid. -intro A. -exists (fun B:Prop=>(A->B)). -abstract (simpl; intuition). +Proof. + intro A. + exists (fun B:Prop=>(A->B)). + abstract (simpl; intuition). Defined. Definition imp:iffSetoid-->iffSetoid-->iffSetoid. -exists imp0. -abstract (simpl; unfold extEq; simpl; intuition). +Proof. + exists imp0. + abstract (simpl; unfold extEq; simpl; intuition). Defined. Definition StepF_imp (f g:StepF iffSetoid):Prop:= (StepFfoldProp (imp ^@> f <@> g)). Lemma StepFfoldPropglue_rew:(forall o x y, (StepFfoldProp (glue o x y))<->((StepFfoldProp x)/\StepFfoldProp y)). -auto with *. +Proof. + auto with *. Qed. (* begin hide *) Hint Rewrite StepFfoldPropglue_rew:StepF_rew. @@ -951,14 +956,15 @@ Hint Rewrite StepFfoldPropglue_rew:StepF_rew. Lemma StepF_imp_imp:forall x y:(StepF iffSetoid), (StepF_imp x y) -> ((StepFfoldProp x)->(StepFfoldProp y)). -induction x using StepF_ind. induction y using StepF_ind. - auto with *. +Proof. + induction x using StepF_ind. induction y using StepF_ind. + auto with *. unfold StepF_imp. unfold StepFfoldProp;simpl;intuition. -intros y. -unfold StepF_imp, Map2. -rewriteStepF. -intros. -rewrite <- (StepFfoldPropglue y o). -rewriteStepF. -intuition. + intros y. + unfold StepF_imp, Map2. + rewriteStepF. + intros. + rewrite <- (StepFfoldPropglue y o). + rewriteStepF. + intuition. Qed. diff --git a/metric2/UniformContinuity.v b/metric2/UniformContinuity.v index 131ea7b92..3b1e8c590 100644 --- a/metric2/UniformContinuity.v +++ b/metric2/UniformContinuity.v @@ -40,24 +40,23 @@ Implicit Arguments ball_ex [X]. (* end hide *) Lemma ball_ex_weak_le : forall (X:MetricSpace) (e d:QposInf) (a b:X), QposInf_le e d -> ball_ex e a b -> ball_ex d a b. Proof. -intros X e d a b Hed Hab. -destruct d as [d|]; -destruct e as [e|]. -apply: (ball_weak_le X). -apply Hed. -assumption. -elim Hed. -constructor. -assumption. + intros X e d a b Hed Hab. + destruct d as [d|]; destruct e as [e|]. + apply: (ball_weak_le X). + apply Hed. + assumption. + elim Hed. + constructor. + assumption. Qed. Lemma ball_ex_dec : forall (X:MetricSpace), (forall e (a b:X), {ball e a b}+{~ball e a b}) -> forall e (a b:X), {ball_ex e a b}+{~ball_ex e a b}. Proof. -intros X ball_dec e a b. -destruct e as [e|]. -apply (ball_dec e a b). -simpl. -auto. + intros X ball_dec e a b. + destruct e as [e|]. + apply (ball_dec e a b). + simpl. + auto. Defined. Section UniformlyContinuousFunction. @@ -71,7 +70,7 @@ Variable X Y : MetricSpace. (** This is the traditional definitition of uniform continuity with an explicitly given modulus of continuity *) -Definition is_UniformlyContinuousFunction +Definition is_UniformlyContinuousFunction (f: X -> Y) (mu: Qpos -> QposInf) := forall e a b, ball_ex (mu e) a b -> ball e (f a) (f b). @@ -82,12 +81,12 @@ Lemma is_UniformlyContinuousFunction_wd : forall (f1 f2:X -> Y) (mu1 mu2: Qpos - (is_UniformlyContinuousFunction f1 mu1) -> (is_UniformlyContinuousFunction f2 mu2). Proof. -intros f1 f2 mu1 mu2 Hf Hmu H e a b Hab. -do 2 rewrite <- Hf. -apply H. -eapply ball_ex_weak_le. -apply Hmu. -assumption. + intros f1 f2 mu1 mu2 Hf Hmu H e a b Hab. + do 2 rewrite <- Hf. + apply H. + eapply ball_ex_weak_le. + apply Hmu. + assumption. Qed. (** A uniformly continuous function consists of a function, a modulus @@ -105,11 +104,11 @@ Lemma uc_prf_smaller : forall (f:UniformlyContinuousFunction) (mu2 : Qpos -> Qpo (forall e, QposInf_le (mu2 e) (mu f e)) -> is_UniformlyContinuousFunction (ucFun f) mu2. Proof. -intros f my2 H. -eapply is_UniformlyContinuousFunction_wd. -intros; reflexivity. -apply H. -apply uc_prf. + intros f my2 H. + eapply is_UniformlyContinuousFunction_wd. + intros; reflexivity. + apply H. + apply uc_prf. Qed. (** *** The metric space of uniformly continuous functions @@ -119,16 +118,16 @@ Definition ucEq (f g : UniformlyContinuousFunction) := Lemma uc_setoid : Setoid_Theory UniformlyContinuousFunction ucEq. Proof. -constructor. -intros x a. -reflexivity. -intros x y H a. -symmetry. -apply H. -intros x y z H1 H2 a. -transitivity (y a). -apply H1. -apply H2. + constructor. + intros x a. + reflexivity. + intros x y H a. + symmetry. + apply H. + intros x y z H1 H2 a. + transitivity (y a). + apply H1. + apply H2. Qed. Definition uc_Setoid : Setoid := (Build_Setoid uc_setoid). @@ -137,40 +136,40 @@ Definition ucBall e (f g : UniformlyContinuousFunction) := forall a, ball e (f a Lemma uc_is_MetricSpace : is_MetricSpace uc_Setoid ucBall. Proof. -constructor. -firstorder using ball_refl. -firstorder using ball_sym. -intros e1 e2 f g h H1 H2 a. -apply ball_triangle with (g a); auto. -intros e f g H a. -apply ball_closed. -firstorder. -intros f g H a. -apply ball_eq. -firstorder. + constructor. + firstorder using ball_refl. + firstorder using ball_sym. + intros e1 e2 f g h H1 H2 a. + apply ball_triangle with (g a); auto. + intros e f g H a. + apply ball_closed. + firstorder. + intros f g H a. + apply ball_eq. + firstorder. Qed. -Lemma ucBall_wd : forall (e1 e2:Qpos), (QposEq e1 e2) -> - forall (x1 x2 : uc_Setoid), (st_eq x1 x2) -> - forall (y1 y2 : uc_Setoid), (st_eq y1 y2) -> +Lemma ucBall_wd : forall (e1 e2:Qpos), (QposEq e1 e2) -> + forall (x1 x2 : uc_Setoid), (st_eq x1 x2) -> + forall (y1 y2 : uc_Setoid), (st_eq y1 y2) -> (ucBall e1 x1 y1 <-> ucBall e2 x2 y2). Proof. -intros. -unfold ucEq in *. -unfold ucBall in *. -simpl in H0, H1. -unfold ucEq in H0, H1. -split. -intros. -rewrite <- H. -rewrite <- H0. -rewrite <- H1. -auto. -intros. -rewrite H. -rewrite H0. -rewrite H1. -auto. + intros. + unfold ucEq in *. + unfold ucBall in *. + simpl in H0, H1. + unfold ucEq in H0, H1. + split. + intros. + rewrite <- H. + rewrite <- H0. + rewrite <- H1. + auto. + intros. + rewrite H. + rewrite H0. + rewrite H1. + auto. Qed. End UniformlyContinuousFunction. @@ -191,27 +190,28 @@ Notation "x --> y" := (UniformlyContinuousSpace x y) (at level 55, right associa Open Local Scope uc_scope. (* begin hide *) Add Parametric Morphism (X Y:MetricSpace) f : (@ucFun X Y f) with signature (@st_eq X) ==> (@st_eq Y) as uc_wd. -intros x0 x1 Hx. -apply ball_eq. -intros e. -apply uc_prf. -destruct (mu f e);[|constructor]. -simpl. -rewrite Hx. -apply ball_refl. +Proof. + intros x0 x1 Hx. + apply ball_eq. + intros e. + apply uc_prf. + destruct (mu f e);[|constructor]. + simpl. + rewrite Hx. + apply ball_refl. Qed. Definition ucFun2 (X Y Z:MetricSpace) (f: X --> Y --> Z) (x:X) (y:Y) := f x y. Add Parametric Morphism (X Y Z:MetricSpace) f : (@ucFun2 X Y Z f) with signature (@st_eq X) ==> (@st_eq Y) ==> (@st_eq Z) as ucFun2_wd. Proof. -intros x y Hxy x0 y0 Hxy0. -unfold ucFun2. -rewrite Hxy0. -generalize y0. -change (st_eq (f x) (f y)). -rewrite Hxy. -reflexivity. + intros x y Hxy x0 y0 Hxy0. + unfold ucFun2. + rewrite Hxy0. + generalize y0. + change (st_eq (f x) (f y)). + rewrite Hxy. + reflexivity. Qed. (* end hide *) (** @@ -222,8 +222,8 @@ The identity function is uniformly continuous. *) Lemma uc_id_prf (X:MetricSpace) : is_UniformlyContinuousFunction (fun (x:X) => x) Qpos2QposInf. Proof. -intros X e a b Hab. -assumption. + intros X e a b Hab. + assumption. Qed. Definition uc_id (X:MetricSpace) : UniformlyContinuousFunction X X := @@ -234,12 +234,12 @@ continuous *) Lemma uc_compose_prf (X Y Z:MetricSpace) (g: Y --> Z) (f:X --> Y) : is_UniformlyContinuousFunction (fun x => g (f x)) (fun e => QposInf_bind (mu f) (mu g e)). Proof. -intros X Y Z [g mu_g Hg] [f mu_f Hf] e a b Hab. -unfold is_UniformlyContinuousFunction in *. -simpl in *. -apply Hg. -clear Hg. -destruct (mu_g e) as [mge|]; firstorder. + intros X Y Z [g mu_g Hg] [f mu_f Hf] e a b Hab. + unfold is_UniformlyContinuousFunction in *. + simpl in *. + apply Hg. + clear Hg. + destruct (mu_g e) as [mge|]; firstorder. Qed. Definition uc_compose (X Y Z:MetricSpace) (g: Y --> Z) (f:X --> Y) : X --> Z := @@ -248,39 +248,39 @@ Build_UniformlyContinuousFunction (uc_compose_prf g f). (* begin hide *) Add Parametric Morphism X Y Z : (@uc_compose X Y Z) with signature (@st_eq _) ==> (@st_eq _) ==> (@st_eq _) as uc_compose_wd. Proof. -intros x1 x2 Hx y1 y2 Hy. -intros x. -simpl. -rewrite (Hx (y1 x)). -apply uc_wd. -rewrite (Hy x). -reflexivity. + intros x1 x2 Hx y1 y2 Hy. + intros x. + simpl. + rewrite (Hx (y1 x)). + apply uc_wd. + rewrite (Hy x). + reflexivity. Qed. (* end hide *) Notation "f ∘ g" := (uc_compose f g) (at level 40, left associativity) : uc_scope. -Lemma is_uc_uc_compose0 : forall X Y Z (f:Y-->Z), +Lemma is_uc_uc_compose0 : forall X Y Z (f:Y-->Z), is_UniformlyContinuousFunction (@uc_compose X Y Z f) (mu f). Proof. -intros X Y Z f e x y Hxy z. -simpl. -simpl in Hxy. -apply uc_prf. -destruct (mu f e); auto. -apply Hxy. + intros X Y Z f e x y Hxy z. + simpl. + simpl in Hxy. + apply uc_prf. + destruct (mu f e); auto. + apply Hxy. Qed. -Definition uc_compose_uc0 X Y Z (f:Y-->Z) : (X-->Y) --> X --> Z := +Definition uc_compose_uc0 X Y Z (f:Y-->Z) : (X-->Y) --> X --> Z := Build_UniformlyContinuousFunction (is_uc_uc_compose0 f). Lemma is_uc_uc_compose : forall X Y Z, is_UniformlyContinuousFunction (@uc_compose_uc0 X Y Z) Qpos2QposInf. Proof. -intros X Y Z e x y Hxy z z0. -simpl. -apply Hxy. + intros X Y Z e x y Hxy z z0. + simpl. + apply Hxy. Qed. -Definition uc_compose_uc X Y Z : (Y-->Z)-->(X-->Y)-->X-->Z := +Definition uc_compose_uc X Y Z : (Y-->Z)-->(X-->Y)-->X-->Z := Build_UniformlyContinuousFunction (@is_uc_uc_compose X Y Z). diff --git a/metrics/CMetricSpaces.v b/metrics/CMetricSpaces.v index 241f87e25..5dc034dbe 100644 --- a/metrics/CMetricSpaces.v +++ b/metrics/CMetricSpaces.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Prod_Sub. Require Export Equiv. @@ -43,7 +43,7 @@ Section Definition_MS. *) -Record CMetricSpace : Type := +Record CMetricSpace : Type := {scms_crr :> CPsMetricSpace; ax_d_apdiag_imp_grzero : apdiag_imp_grzero scms_crr (cms_d (c:=scms_crr))}. @@ -58,36 +58,36 @@ Section MS_basics. Lemma d_CMetricSpace_apdiag_imp_grzero : forall X : CMetricSpace, apdiag_imp_grzero (cms_crr X) (cms_d (c:=X)). -intro X. -apply ax_d_apdiag_imp_grzero. +Proof. + intro X. + apply ax_d_apdiag_imp_grzero. Qed. Lemma d_zero_imp_eq : forall (X : CMetricSpace) (a b : X), a[-d]b[=]Zero -> a[=]b. -intros X a b. -intro H. -apply not_ap_imp_eq. -red in |- *. -intro H1. -generalize H. -apply ap_imp_neq. -apply Greater_imp_ap. -apply ax_d_apdiag_imp_grzero. -exact H1. +Proof. + intros X a b. + intro H. + apply not_ap_imp_eq. + red in |- *. + intro H1. + generalize H. + apply ap_imp_neq. + apply Greater_imp_ap. + apply ax_d_apdiag_imp_grzero. + exact H1. Qed. Lemma is_CMetricSpace_diag_zero : - forall (X : CSetoid) (d : CSetoid_bin_fun X X IR) + forall (X : CSetoid) (d : CSetoid_bin_fun X X IR) (H : com d) (H1 : tri_ineq d) (H2 : nneg d) (H3 : diag_zero X d) (H4 : apdiag_imp_grzero X d), CMetricSpace. -intros X d H H1 H2 H3 H4. -set - (H5 := - Build_is_CPsMetricSpace X d H H2 (diag_zero_imp_pos_imp_ap X d H3) H1) - in *. -set (H6 := Build_CPsMetricSpace X d H5) in *. -set (H7 := Build_CMetricSpace H6 H4) in *. -exact H7. +Proof. + intros X d H H1 H2 H3 H4. + set (H5 := Build_is_CPsMetricSpace X d H H2 (diag_zero_imp_pos_imp_ap X d H3) H1) in *. + set (H6 := Build_CPsMetricSpace X d H5) in *. + set (H7 := Build_CMetricSpace H6 H4) in *. + exact H7. Qed. End MS_basics. @@ -102,29 +102,30 @@ The product of two metric spaces is again a metric space. Lemma Prod0CMetricSpaces_apdiag_grzero : forall X Y : CMetricSpace, apdiag_imp_grzero (Prod0CPsMetricSpace X Y) - (cms_d (c:=Prod0CPsMetricSpace X Y)). -intros X Y. -unfold apdiag_imp_grzero in |- *. -intros x y. -case x. -case y. -intros c c0 c1 c2. -simpl in |- *. -intro H. -elim H. -intro H1. -apply plus_resp_pos_nonneg. -apply ax_d_apdiag_imp_grzero. -exact H1. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. -intro H1. -astepr ((c2[-d]c0)[+](c1[-d]c)). -apply plus_resp_pos_nonneg. -apply ax_d_apdiag_imp_grzero. -exact H1. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. + (cms_d (c:=Prod0CPsMetricSpace X Y)). +Proof. + intros X Y. + unfold apdiag_imp_grzero in |- *. + intros x y. + case x. + case y. + intros c c0 c1 c2. + simpl in |- *. + intro H. + elim H. + intro H1. + apply plus_resp_pos_nonneg. + apply ax_d_apdiag_imp_grzero. + exact H1. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + intro H1. + astepr ((c2[-d]c0)[+](c1[-d]c)). + apply plus_resp_pos_nonneg. + apply ax_d_apdiag_imp_grzero. + exact H1. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Definition Prod0CMetricSpace (X Y : CMetricSpace) := @@ -139,16 +140,17 @@ Implicit Arguments SubPsMetricSpace [X]. Lemma SubMetricSpace_apdiag_grzero : forall (X : CMetricSpace) (P : X -> CProp), apdiag_imp_grzero (SubPsMetricSpace P) (cms_d (c:=SubPsMetricSpace P)). -intros X P. -unfold apdiag_imp_grzero in |- *. -intros x y. -simpl in |- *. -case x. -case y. -simpl in |- *. -intros. -apply ax_d_apdiag_imp_grzero. -auto. +Proof. + intros X P. + unfold apdiag_imp_grzero in |- *. + intros x y. + simpl in |- *. + case x. + case y. + simpl in |- *. + intros. + apply ax_d_apdiag_imp_grzero. + auto. Qed. Definition SubMetricSpace (X : CMetricSpace) (P : X -> CProp) := @@ -171,26 +173,27 @@ Lemma zf_nis_CMetricSpace : Not (apdiag_imp_grzero (zf_as_CPsMetricSpace X) (cms_d (c:=zf_as_CPsMetricSpace X))). -intros X Z. -red in |- *. -intro H. -set (H1 := Build_CMetricSpace (zf_as_CPsMetricSpace X) H) in *. -set (H2 := d_CMetricSpace_apdiag_imp_grzero H1) in *. -generalize H2. -unfold H1 in |- *. -simpl in |- *. -unfold apdiag_imp_grzero in |- *. -unfold Zero_fun in |- *. -simpl in |- *. -unfold zero_fun in |- *. -elim Z. -intros x Z1. -elim Z1. -intros y Z2. -intros H3. -set (H4 := H3 x y Z2) in *. -set (H5 := less_irreflexive_unfolded IR Zero H4) in *. -exact H5. +Proof. + intros X Z. + red in |- *. + intro H. + set (H1 := Build_CMetricSpace (zf_as_CPsMetricSpace X) H) in *. + set (H2 := d_CMetricSpace_apdiag_imp_grzero H1) in *. + generalize H2. + unfold H1 in |- *. + simpl in |- *. + unfold apdiag_imp_grzero in |- *. + unfold Zero_fun in |- *. + simpl in |- *. + unfold zero_fun in |- *. + elim Z. + intros x Z1. + elim Z1. + intros y Z2. + intros H3. + set (H4 := H3 x y Z2) in *. + set (H5 := less_irreflexive_unfolded IR Zero H4) in *. + exact H5. Qed. (** @@ -203,87 +206,88 @@ Definition metric_eq (X : CPsMetricSpace) (x y : X) : Prop := x[-d]y[=]Zero. Lemma metric_ap_irreflexive : forall X : CPsMetricSpace, irreflexive (metric_ap X). -intro X. -unfold irreflexive in |- *. -intro x. -red in |- *. -unfold metric_ap in |- *. -set - (H0 := - pos_imp_ap_imp_diag_zero X (cms_d (c:=X)) - (ax_d_pos_imp_ap X (cms_d (c:=X)) (CPsMetricSpace_is_CPsMetricSpace X)) - (ax_d_nneg X (cms_d (c:=X)) (CPsMetricSpace_is_CPsMetricSpace X))) - in *. -generalize H0. -unfold diag_zero in |- *. -intros H1 H2. -set (H3 := less_wdr IR Zero (x[-d]x) Zero H2 (H1 x)) in *. -set (H4 := less_irreflexive_unfolded IR Zero H3) in *. -exact H4. +Proof. + intro X. + unfold irreflexive in |- *. + intro x. + red in |- *. + unfold metric_ap in |- *. + set (H0 := pos_imp_ap_imp_diag_zero X (cms_d (c:=X)) + (ax_d_pos_imp_ap X (cms_d (c:=X)) (CPsMetricSpace_is_CPsMetricSpace X)) + (ax_d_nneg X (cms_d (c:=X)) (CPsMetricSpace_is_CPsMetricSpace X))) in *. + generalize H0. + unfold diag_zero in |- *. + intros H1 H2. + set (H3 := less_wdr IR Zero (x[-d]x) Zero H2 (H1 x)) in *. + set (H4 := less_irreflexive_unfolded IR Zero H3) in *. + exact H4. Qed. Lemma metric_ap_symmetric : - forall X : CPsMetricSpace, Csymmetric (metric_ap X). -intro X. -unfold Csymmetric in |- *. -intros x y. -unfold metric_ap in |- *. -intro H. -astepr (x[-d]y). -exact H. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. + forall X : CPsMetricSpace, Csymmetric (metric_ap X). +Proof. + intro X. + unfold Csymmetric in |- *. + intros x y. + unfold metric_ap in |- *. + intro H. + astepr (x[-d]y). + exact H. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Lemma metric_ap_cotransitive : forall X : CPsMetricSpace, cotransitive (metric_ap X). -intro X. -unfold cotransitive in |- *. -unfold metric_ap in |- *. -intros x y H z. -cut (ZeroR[<](x[-d]z)[+](z[-d]y)). -intro H0. -apply positive_Sum_two. -exact H0. -apply less_leEq_trans with (x[-d]y). -exact H. -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intro X. + unfold cotransitive in |- *. + unfold metric_ap in |- *. + intros x y H z. + cut (ZeroR[<](x[-d]z)[+](z[-d]y)). + intro H0. + apply positive_Sum_two. + exact H0. + apply less_leEq_trans with (x[-d]y). + exact H. + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Lemma metric_ap_tight : forall X : CPsMetricSpace, tight_apart (metric_eq X) (metric_ap X). -intro X. -unfold tight_apart in |- *. -unfold metric_ap in |- *. -unfold metric_eq in |- *. -intros x y. -split. -intro H. -cut (ZeroR[<=]x[-d]y). -rewrite leEq_def in |- *. -intro H1. -cut (Not (x[-d]y[#]Zero)). -intro H2. -apply not_ap_imp_eq. -exact H2. -red in |- *. -intro H2. -set (H3 := less_conf_ap IR (x[-d]y) Zero) in *. -elim H3. -intros H4 H5. -set (H6 := H4 H2) in *. -elim H6. -intuition. -intuition. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. -intro H. -red in |- *. -intro H0. -set (H1 := less_wdr IR Zero (x[-d]y) Zero H0 H) in *. -set (H2 := less_irreflexive_unfolded IR Zero H1) in *. -exact H2. +Proof. + intro X. + unfold tight_apart in |- *. + unfold metric_ap in |- *. + unfold metric_eq in |- *. + intros x y. + split. + intro H. + cut (ZeroR[<=]x[-d]y). + rewrite leEq_def in |- *. + intro H1. + cut (Not (x[-d]y[#]Zero)). + intro H2. + apply not_ap_imp_eq. + exact H2. + red in |- *. + intro H2. + set (H3 := less_conf_ap IR (x[-d]y) Zero) in *. + elim H3. + intros H4 H5. + set (H6 := H4 H2) in *. + elim H6. + intuition. + intuition. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + intro H. + red in |- *. + intro H0. + set (H1 := less_wdr IR Zero (x[-d]y) Zero H0 H) in *. + set (H2 := less_irreflexive_unfolded IR Zero H1) in *. + exact H2. Qed. Definition Metric_CSet_is_CSetoid (X : CPsMetricSpace) := @@ -299,69 +303,69 @@ Definition metric_d (X : CPsMetricSpace) (x y : Metric_CSetoid X) := x[-d]y. Lemma metric_d_strext : forall X : CPsMetricSpace, bin_fun_strext (Metric_CSetoid X) (Metric_CSetoid X) IR (metric_d X). -intro X. -unfold bin_fun_strext in |- *. -intros x1 x2 y1 y2. -simpl in |- *. -unfold metric_d in |- *. -unfold metric_ap in |- *. -intro H. -apply positive_Sum_two. -set (H0 := less_conf_ap IR (x1[-d]y1) (x2[-d]y2)) in *. -elim H0. -intros H1 H2. -set (H4 := H1 H) in *. -elim H4. -intro H5. -astepr ((x1[-d]x2)[+](y1[-d]y2)[+]Zero). -astepr ((x1[-d]x2)[+](y1[-d]y2)[+]((x1[-d]y1)[-](x1[-d]y1))). -astepr ((x1[-d]x2)[+](y1[-d]y2)[+](x1[-d]y1)[-](x1[-d]y1)). -apply shift_less_minus. -astepl (x1[-d]y1). -apply less_leEq_trans with (x2[-d]y2). -exact H5. -apply leEq_transitive with ((x2[-d]x1)[+](x1[-d]y2)). -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. -astepr ((x2[-d]x1)[+](y1[-d]y2)[+](x1[-d]y1)). -astepr ((x2[-d]x1)[+]((y1[-d]y2)[+](x1[-d]y1))). -apply plus_resp_leEq_lft. -astepr ((x1[-d]y1)[+](y1[-d]y2)). -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. -astepl ((y1[-d]y2)[+](x2[-d]x1)[+](x1[-d]y1)). -astepr ((y1[-d]y2)[+](x1[-d]x2)[+](x1[-d]y1)). -astepl ((y1[-d]y2)[+]((x2[-d]x1)[+](x1[-d]y1))). -astepr ((y1[-d]y2)[+]((x1[-d]x2)[+](x1[-d]y1))). -astepl ((y1[-d]y2)[+]((x1[-d]y1)[+](x2[-d]x1))). -astepr ((y1[-d]y2)[+]((x1[-d]y1)[+](x1[-d]x2))). -astepl ((y1[-d]y2)[+](x1[-d]y1)[+](x2[-d]x1)). -astepr ((y1[-d]y2)[+](x1[-d]y1)[+](x1[-d]x2)). -apply plus_resp_eq. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. - -intro H5. -astepr ((x1[-d]x2)[+](y1[-d]y2)[+]Zero). -astepr ((x1[-d]x2)[+](y1[-d]y2)[+]((x2[-d]y2)[-](x2[-d]y2))). -astepr ((x1[-d]x2)[+](y1[-d]y2)[+](x2[-d]y2)[-](x2[-d]y2)). -apply shift_less_minus. -astepl (x2[-d]y2). -apply less_leEq_trans with (x1[-d]y1). -exact H5. -apply leEq_transitive with ((x1[-d]x2)[+](x2[-d]y1)). -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. -astepr ((x1[-d]x2)[+](y1[-d]y2)[+](x2[-d]y2)). -astepr ((x1[-d]x2)[+]((y1[-d]y2)[+](x2[-d]y2))). -apply plus_resp_leEq_lft. -astepr ((x2[-d]y2)[+](y1[-d]y2)). -astepr ((x2[-d]y2)[+](y2[-d]y1)). -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. -apply plus_resp_eq. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intro X. + unfold bin_fun_strext in |- *. + intros x1 x2 y1 y2. + simpl in |- *. + unfold metric_d in |- *. + unfold metric_ap in |- *. + intro H. + apply positive_Sum_two. + set (H0 := less_conf_ap IR (x1[-d]y1) (x2[-d]y2)) in *. + elim H0. + intros H1 H2. + set (H4 := H1 H) in *. + elim H4. + intro H5. + astepr ((x1[-d]x2)[+](y1[-d]y2)[+]Zero). + astepr ((x1[-d]x2)[+](y1[-d]y2)[+]((x1[-d]y1)[-](x1[-d]y1))). + astepr ((x1[-d]x2)[+](y1[-d]y2)[+](x1[-d]y1)[-](x1[-d]y1)). + apply shift_less_minus. + astepl (x1[-d]y1). + apply less_leEq_trans with (x2[-d]y2). + exact H5. + apply leEq_transitive with ((x2[-d]x1)[+](x1[-d]y2)). + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + astepr ((x2[-d]x1)[+](y1[-d]y2)[+](x1[-d]y1)). + astepr ((x2[-d]x1)[+]((y1[-d]y2)[+](x1[-d]y1))). + apply plus_resp_leEq_lft. + astepr ((x1[-d]y1)[+](y1[-d]y2)). + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + astepl ((y1[-d]y2)[+](x2[-d]x1)[+](x1[-d]y1)). + astepr ((y1[-d]y2)[+](x1[-d]x2)[+](x1[-d]y1)). + astepl ((y1[-d]y2)[+]((x2[-d]x1)[+](x1[-d]y1))). + astepr ((y1[-d]y2)[+]((x1[-d]x2)[+](x1[-d]y1))). + astepl ((y1[-d]y2)[+]((x1[-d]y1)[+](x2[-d]x1))). + astepr ((y1[-d]y2)[+]((x1[-d]y1)[+](x1[-d]x2))). + astepl ((y1[-d]y2)[+](x1[-d]y1)[+](x2[-d]x1)). + astepr ((y1[-d]y2)[+](x1[-d]y1)[+](x1[-d]x2)). + apply plus_resp_eq. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + intro H5. + astepr ((x1[-d]x2)[+](y1[-d]y2)[+]Zero). + astepr ((x1[-d]x2)[+](y1[-d]y2)[+]((x2[-d]y2)[-](x2[-d]y2))). + astepr ((x1[-d]x2)[+](y1[-d]y2)[+](x2[-d]y2)[-](x2[-d]y2)). + apply shift_less_minus. + astepl (x2[-d]y2). + apply less_leEq_trans with (x1[-d]y1). + exact H5. + apply leEq_transitive with ((x1[-d]x2)[+](x2[-d]y1)). + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + astepr ((x1[-d]x2)[+](y1[-d]y2)[+](x2[-d]y2)). + astepr ((x1[-d]x2)[+]((y1[-d]y2)[+](x2[-d]y2))). + apply plus_resp_leEq_lft. + astepr ((x2[-d]y2)[+](y1[-d]y2)). + astepr ((x2[-d]y2)[+](y2[-d]y1)). + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + apply plus_resp_eq. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. @@ -370,48 +374,52 @@ Definition Metric_d (X : CPsMetricSpace) := metric_d X) (metric_d_strext X). Lemma Metric_d_com : forall X : CPsMetricSpace, com (Metric_d X). -intro X. -unfold com in |- *. -intros x y. -unfold Metric_d in |- *. -simpl in |- *. -unfold metric_d in |- *. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intro X. + unfold com in |- *. + intros x y. + unfold Metric_d in |- *. + simpl in |- *. + unfold metric_d in |- *. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Lemma Metric_d_nneg : forall X : CPsMetricSpace, nneg (Metric_d X). -intro X. -unfold nneg in |- *. -intros x y. -unfold Metric_d in |- *. -simpl in |- *. -unfold metric_d in |- *. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intro X. + unfold nneg in |- *. + intros x y. + unfold Metric_d in |- *. + simpl in |- *. + unfold metric_d in |- *. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Lemma Metric_d_pos_imp_ap : forall X : CPsMetricSpace, pos_imp_ap (Metric_d X). -intro X. -unfold pos_imp_ap in |- *. -intros x y. -unfold Metric_d in |- *. -simpl in |- *. -unfold metric_d in |- *. -unfold metric_ap in |- *. -intuition. +Proof. + intro X. + unfold pos_imp_ap in |- *. + intros x y. + unfold Metric_d in |- *. + simpl in |- *. + unfold metric_d in |- *. + unfold metric_ap in |- *. + intuition. Qed. Lemma Metric_d_tri_ineq : forall X : CPsMetricSpace, tri_ineq (Metric_d X). -intro X. -unfold tri_ineq in |- *. -intros x y z. -unfold Metric_d in |- *. -simpl in |- *. -unfold metric_d in |- *. -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intro X. + unfold tri_ineq in |- *. + intros x y z. + unfold Metric_d in |- *. + simpl in |- *. + unfold metric_d in |- *. + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Definition QuotientCSetoid_is_CPsMetricSpace (X : CPsMetricSpace) := @@ -427,13 +435,14 @@ Lemma Metric_d_apdiag_grzero : forall X : CPsMetricSpace, apdiag_imp_grzero (QuotientCPsMetricSpace X) (cms_d (c:=QuotientCPsMetricSpace X)). -intro X. -unfold apdiag_imp_grzero in |- *. -intros x y. -simpl in |- *. -unfold metric_ap in |- *. -unfold metric_d in |- *. -intuition. +Proof. + intro X. + unfold apdiag_imp_grzero in |- *. + intros x y. + simpl in |- *. + unfold metric_ap in |- *. + unfold metric_d in |- *. + intuition. Qed. Definition QuotientCMetricSpace (X : CPsMetricSpace) := @@ -445,18 +454,19 @@ Some pseudo metric spaces already are a metric space: Lemma dIR_apdiag_grzero : apdiag_imp_grzero IR_as_CPsMetricSpace (cms_d (c:=IR_as_CPsMetricSpace)). -unfold apdiag_imp_grzero in |- *. -intros x y. -simpl in |- *. -unfold dIR in |- *. -intro H. -set (H0 := AbsIR_pos) in *. -generalize H0. -simpl in |- *. -intro H1. -apply H1. -apply minus_ap_zero. -exact H. +Proof. + unfold apdiag_imp_grzero in |- *. + intros x y. + simpl in |- *. + unfold dIR in |- *. + intro H. + set (H0 := AbsIR_pos) in *. + generalize H0. + simpl in |- *. + intro H1. + apply H1. + apply minus_ap_zero. + exact H. Qed. Definition IR_as_CMetricSpace := @@ -467,93 +477,88 @@ In that case the induced metric space is equivalent to the original one: *) Definition emb (X : CPsMetricSpace) : X -> QuotientCMetricSpace X. -intros X x. -unfold QuotientCMetricSpace in |- *. -simpl in |- *. -exact x. +Proof. + intros X x. + unfold QuotientCMetricSpace in |- *. + simpl in |- *. + exact x. Defined. Lemma emb_strext : forall X : CPsMetricSpace, fun_strext (emb X). -intro X. -unfold fun_strext in |- *. -unfold emb in |- *. -simpl in |- *. -unfold metric_ap in |- *. -apply ax_d_pos_imp_ap. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intro X. + unfold fun_strext in |- *. + unfold emb in |- *. + simpl in |- *. + unfold metric_ap in |- *. + apply ax_d_pos_imp_ap. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Definition Emb (X : CPsMetricSpace) := Build_CSetoid_fun X (QuotientCMetricSpace X) (emb X) (emb_strext X). Lemma Quotient_pres_CMetricSpace : - forall X : CMetricSpace, isopsmetry X (QuotientCPsMetricSpace X) (Emb X). -intro X. -unfold isopsmetry in |- *. -unfold Emb in |- *. -simpl in |- *. -unfold emb in |- *. -split. -unfold bijective in |- *. -split. -unfold injective in |- *. -simpl in |- *. -intros a0 a1. -unfold metric_ap in |- *. -apply ax_d_apdiag_imp_grzero. - -unfold surjective in |- *. -intro b. -simpl in |- *. -exists b. -unfold metric_eq in |- *. -apply pos_imp_ap_imp_diag_zero. -apply d_pos_imp_ap. -apply d_nneg. - -unfold equivalent_psmetric in |- *. -simpl in |- *. -split. -split. -apply CPsMetricSpace_is_CPsMetricSpace. - -apply Build_is_CPsMetricSpace. -unfold com in |- *. -simpl in |- *. -unfold metric_d in |- *. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. - -unfold nneg in |- *. -simpl in |- *. -unfold metric_d in |- *. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. - -unfold pos_imp_ap in |- *. -simpl in |- *. -unfold metric_d in |- *. -apply ax_d_pos_imp_ap. -apply CPsMetricSpace_is_CPsMetricSpace. - -unfold tri_ineq in |- *. -simpl in |- *. -unfold metric_d in |- *. -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. - -split. -exists 0. -unfold metric_d in |- *. -intros x y. -apply eq_imp_leEq. -rational. - -exists 0. -unfold metric_d in |- *. -intros x y. -apply eq_imp_leEq. -rational. + forall X : CMetricSpace, isopsmetry X (QuotientCPsMetricSpace X) (Emb X). +Proof. + intro X. + unfold isopsmetry in |- *. + unfold Emb in |- *. + simpl in |- *. + unfold emb in |- *. + split. + unfold bijective in |- *. + split. + unfold injective in |- *. + simpl in |- *. + intros a0 a1. + unfold metric_ap in |- *. + apply ax_d_apdiag_imp_grzero. + unfold surjective in |- *. + intro b. + simpl in |- *. + exists b. + unfold metric_eq in |- *. + apply pos_imp_ap_imp_diag_zero. + apply d_pos_imp_ap. + apply d_nneg. + unfold equivalent_psmetric in |- *. + simpl in |- *. + split. + split. + apply CPsMetricSpace_is_CPsMetricSpace. + apply Build_is_CPsMetricSpace. + unfold com in |- *. + simpl in |- *. + unfold metric_d in |- *. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold nneg in |- *. + simpl in |- *. + unfold metric_d in |- *. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold pos_imp_ap in |- *. + simpl in |- *. + unfold metric_d in |- *. + apply ax_d_pos_imp_ap. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold tri_ineq in |- *. + simpl in |- *. + unfold metric_d in |- *. + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + split. + exists 0. + unfold metric_d in |- *. + intros x y. + apply eq_imp_leEq. + rational. + exists 0. + unfold metric_d in |- *. + intros x y. + apply eq_imp_leEq. + rational. Qed. @@ -570,249 +575,185 @@ Implicit Arguments MSseqLimit [X]. (* begin hide *) Lemma nz : forall n m : nat, n <= max n m. -intro n. -intro m. -intuition. +Proof. + intro n. + intro m. + intuition. Qed. (* end hide *) (* begin hide *) Lemma d_wd : forall (X : CPsMetricSpace) (a b c : X), a[=]b -> a[-d]c[=]b[-d]c. -intros X a b c. -intros H. -apply not_ap_imp_eq. -red in |- *. -intro H1. -cut (a[#]b or c[#]c). -intro H2. -elim H2. -apply eq_imp_not_ap. -exact H. - -apply ap_irreflexive_unfolded. -cut (a[-d]c[#]b[-d]c -> a[#]b or c[#]c). -intro H2. -apply H2. -exact H1. - -apply csbf_strext. +Proof. + intros X a b c. + intros H. + apply not_ap_imp_eq. + red in |- *. + intro H1. + cut (a[#]b or c[#]c). + intro H2. + elim H2. + apply eq_imp_not_ap. + exact H. + apply ap_irreflexive_unfolded. + cut (a[-d]c[#]b[-d]c -> a[#]b or c[#]c). + intro H2. + apply H2. + exact H1. + apply csbf_strext. Qed. (* end hide *) Lemma unique_MSseqLim : forall (X : CMetricSpace) (seq : nat -> X) (a b : X), MSseqLimit seq a and MSseqLimit seq b -> a[=]b. -intros X seq a b. -unfold MSseqLimit in |- *. -simpl in |- *. -intros H. -apply d_zero_imp_eq. -apply not_ap_imp_eq. -red in |- *. -intro H1. -set (H2 := recip_ap_zero IR (a[-d]b) H1) in *. -set (H3 := Archimedes' (OneR[/] a[-d]b[//]H1)) in *. -elim H3. -intros n H4. -set - (H6 := - less_transitive_unfolded IR (One[/] a[-d]b[//]H1) ( - nring n) (nring n[+]One) H4 (nring_less_succ IR n)) - in *. -elim H. -intros H5 H7. -elim - (H5 (S (S n)) - (ap_symmetric_unfolded IR Zero (Zero[+]One[+]One) - (less_imp_ap IR Zero (Zero[+]One[+]One) - (less_transitive_unfolded IR Zero (Zero[+]One) ( - Zero[+]One[+]One) (less_plusOne IR Zero) - (less_plusOne IR (ZeroR[+]One)))))). -intros x H8. -elim - (H7 (S (S n)) - (ap_symmetric_unfolded IR Zero (Zero[+]One[+]One) - (less_imp_ap IR Zero (Zero[+]One[+]One) - (less_transitive_unfolded IR Zero (Zero[+]One) ( - Zero[+]One[+]One) (less_plusOne IR Zero) - (less_plusOne IR (Zero[+]One:IR)))))). -intros y H9. -set (H10 := H9 (max y x)) in *. -set (H11 := H8 (max x y)) in *. - - -simpl in |- *. -set (H12 := H11 (nz x y)) in *. -set (H13 := H10 (nz y x)) in *. -set - (H14 := - ap_symmetric_unfolded IR Zero (Zero[+]One[+]One) - (less_imp_ap IR Zero (Zero[+]One[+]One) - (less_transitive_unfolded IR Zero (Zero[+]One) ( - Zero[+]One[+]One) (less_plusOne IR Zero) - (less_plusOne IR (Zero[+]One))))) in *. -cut - ((seq (max x y)[-d]a)[+](seq (max y x)[-d]b)[<] - nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[+] - nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)). -intro H15. - -cut - (nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[+] - nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[<=] - (seq (max x y)[-d]a)[+](seq (max y x)[-d]b)). -rewrite leEq_def in |- *. -intro H16. -auto. - -cut - (nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[+] - nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[<=] - a[-d]b). -intro H16. -apply leEq_transitive with (a[-d]b). -exact H16. - -astepr ((seq (max x y)[-d]a)[+](seq (max x y)[-d]b)). -astepr ((a[-d]seq (max x y))[+](seq (max x y)[-d]b)). -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. -astepl ((seq (max x y)[-d]b)[+](a[-d]seq (max x y))). -astepr ((seq (max x y)[-d]b)[+](seq (max x y)[-d]a)). -apply plus_resp_eq. - - - -simpl in |- *. -apply d_com. - -apply plus_resp_eq. -apply d_wd. -cut (max x y = max y x -> seq (max x y)[=]seq (max y x)). -intro H17. -apply H17. -apply max_comm. - -intro H17. -rewrite H17. -apply eq_reflexive. - -astepl ((Two:IR)[*]nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)). -astepl (nexp IR (S n) (One[/] Zero[+]One[+]One[//]H14)). -astepl ((One[/] Zero[+]One[+]One[//]H14)[^]S n). -astepl (One[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H14). -apply - leEq_transitive - with - (One[/] nring (S n)[//] - ap_symmetric_unfolded IR Zero (nring (S n)) - (less_imp_ap IR Zero (nring (S n)) (pos_Snring IR n))). -apply - leEq_transitive - with (One[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H14). -2: apply less_leEq. -2: set (Hn := bin_less_un) in *. -2: generalize Hn. -2: simpl in |- *. -2: intro Hn'. -2: apply Hn'. -apply recip_resp_leEq. -apply nexp_resp_pos. -astepr (Two:IR). -apply pos_two. -apply eq_imp_leEq. -apply eq_reflexive_unfolded. - -apply shift_div_leEq. -apply (pos_Snring IR n). - -apply shift_leEq_mult' with H1. -2: apply less_leEq. -2: apply H6. - -cut (Zero[<]a[-d]b or a[-d]b[<]Zero). -intro H16. -elim H16. -intro H17. -exact H17. - -intro H17. -set (H18 := ax_d_nneg X (cms_d (c:=X))) in *. -generalize H18. -unfold nneg in |- *. -intro H19. -set (H20 := H19 (CPsMetricSpace_is_CPsMetricSpace X) a b) in *. -rewrite -> leEq_def in H20. -set (H21 := H20 H17) in *. -intuition. - -apply ap_imp_less. -apply ap_symmetric_unfolded. -exact H1. - -astepl ((OneR[/] Zero[+]One[+]One[//]H14)[^]S n). -astepl - (OneR[^]S n[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H14). -astepl (OneR[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H14). -astepl - ((OneR[+]One)[*] - (One[/] (Zero[+]One[+]One)[^]S (S n)[//]nexp_resp_ap_zero (S (S n)) H14)). -apply mult_cancel_lft with (OneR[/] Zero[+]One[+]One[//]H14). -apply div_resp_ap_zero_rev. -apply ap_symmetric_unfolded. -apply less_imp_ap. -apply pos_one. - -astepr - ((One[/] Zero[+]One[+]One[//]H14)[*](Zero[+]One[+]One)[*] - (One[/] (Zero[+]One[+]One)[^]S (S n)[//]nexp_resp_ap_zero (S (S n)) H14)). -astepr - (OneR[*] - (One[/] (Zero[+]One[+]One)[^]S (S n)[//]nexp_resp_ap_zero (S (S n)) H14)). -astepr - (OneR[/] (Zero[+]One[+]One)[^]S (S n)[//]nexp_resp_ap_zero (S (S n)) H14). -astepr - (OneR[*]One[/] (Zero[+]One[+]One)[*](Zero[+]One[+]One)[^]S n[//] - mult_resp_ap_zero IR (Zero[+]One[+]One) ((Zero[+]One[+]One)[^]S n) H14 - (nexp_resp_ap_zero (S n) H14)). -astepr - (One[*]One[/] (Zero[+]One[+]One)[^]S (S n)[//] - nexp_resp_ap_zero (S (S n)) H14). -rational. - -astepr - ((One[/] Zero[+]One[+]One[//]H14)[*]Two[*] - nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)). -astepr - ((One[/] Zero[+]One[+]One[//]H14)[*](Zero[+]One[+]One)[*] - nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)). -apply mult_wdr. - -3: apply plus_resp_less_both. -3: exact H12. - -3: exact H13. -astepr ((One[/] Zero[+]One[+]One[//]H14)[^]S (S n)). -apply eq_symmetric_unfolded. -apply nexp_distr_recip. - -astepl - (One[+]One[/] (Zero[+]One[+]One)[^]S (S n)[//] - nexp_resp_ap_zero (S (S n)) H14). -2: rational. -astepl - (Zero[+]One[+]One[/] (Zero[+]One[+]One)[^]S (S n)[//] - nexp_resp_ap_zero (S (S n)) H14). -rstepr - (Zero[+]One[+]One[/] (Zero[+]One[+]One)[*](Zero[+]One[+]One)[^]S n[//] - mult_resp_ap_zero IR (Zero[+]One[+]One) ((Zero[+]One[+]One)[^]S n) H14 - (nexp_resp_ap_zero (S n) H14)). -astepl - (Zero[+]One[+]One[/] (Zero[+]One[+]One)[*](Zero[+]One[+]One)[^]S n[//] - mult_resp_ap_zero IR (Zero[+]One[+]One) ((Zero[+]One[+]One)[^]S n) H14 - (nexp_resp_ap_zero (S n) H14)). -apply eq_reflexive_unfolded. +Proof. + intros X seq a b. + unfold MSseqLimit in |- *. + simpl in |- *. + intros H. + apply d_zero_imp_eq. + apply not_ap_imp_eq. + red in |- *. + intro H1. + set (H2 := recip_ap_zero IR (a[-d]b) H1) in *. + set (H3 := Archimedes' (OneR[/] a[-d]b[//]H1)) in *. + elim H3. + intros n H4. + set (H6 := less_transitive_unfolded IR (One[/] a[-d]b[//]H1) ( + nring n) (nring n[+]One) H4 (nring_less_succ IR n)) in *. + elim H. + intros H5 H7. + elim (H5 (S (S n)) (ap_symmetric_unfolded IR Zero (Zero[+]One[+]One) + (less_imp_ap IR Zero (Zero[+]One[+]One) (less_transitive_unfolded IR Zero (Zero[+]One) ( + Zero[+]One[+]One) (less_plusOne IR Zero) (less_plusOne IR (ZeroR[+]One)))))). + intros x H8. + elim (H7 (S (S n)) (ap_symmetric_unfolded IR Zero (Zero[+]One[+]One) + (less_imp_ap IR Zero (Zero[+]One[+]One) (less_transitive_unfolded IR Zero (Zero[+]One) ( + Zero[+]One[+]One) (less_plusOne IR Zero) (less_plusOne IR (Zero[+]One:IR)))))). + intros y H9. + set (H10 := H9 (max y x)) in *. + set (H11 := H8 (max x y)) in *. + simpl in |- *. + set (H12 := H11 (nz x y)) in *. + set (H13 := H10 (nz y x)) in *. + set (H14 := ap_symmetric_unfolded IR Zero (Zero[+]One[+]One) (less_imp_ap IR Zero (Zero[+]One[+]One) + (less_transitive_unfolded IR Zero (Zero[+]One) ( Zero[+]One[+]One) (less_plusOne IR Zero) + (less_plusOne IR (Zero[+]One))))) in *. + cut ((seq (max x y)[-d]a)[+](seq (max y x)[-d]b)[<] + nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[+] + nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)). + intro H15. + cut (nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[+] + nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[<=] + (seq (max x y)[-d]a)[+](seq (max y x)[-d]b)). + rewrite leEq_def in |- *. + intro H16. + auto. + cut (nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[+] + nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)[<=] a[-d]b). + intro H16. + apply leEq_transitive with (a[-d]b). + exact H16. + astepr ((seq (max x y)[-d]a)[+](seq (max x y)[-d]b)). + astepr ((a[-d]seq (max x y))[+](seq (max x y)[-d]b)). + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + astepl ((seq (max x y)[-d]b)[+](a[-d]seq (max x y))). + astepr ((seq (max x y)[-d]b)[+](seq (max x y)[-d]a)). + apply plus_resp_eq. + simpl in |- *. + apply d_com. + apply plus_resp_eq. + apply d_wd. + cut (max x y = max y x -> seq (max x y)[=]seq (max y x)). + intro H17. + apply H17. + apply max_comm. + intro H17. + rewrite H17. + apply eq_reflexive. + astepl ((Two:IR)[*]nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)). + astepl (nexp IR (S n) (One[/] Zero[+]One[+]One[//]H14)). + astepl ((One[/] Zero[+]One[+]One[//]H14)[^]S n). + astepl (One[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H14). + apply leEq_transitive with (One[/] nring (S n)[//] ap_symmetric_unfolded IR Zero (nring (S n)) + (less_imp_ap IR Zero (nring (S n)) (pos_Snring IR n))). + apply leEq_transitive with (One[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H14). + 2: apply less_leEq. + 2: set (Hn := bin_less_un) in *. + 2: generalize Hn. + 2: simpl in |- *. + 2: intro Hn'. + 2: apply Hn'. + apply recip_resp_leEq. + apply nexp_resp_pos. + astepr (Two:IR). + apply pos_two. + apply eq_imp_leEq. + apply eq_reflexive_unfolded. + apply shift_div_leEq. + apply (pos_Snring IR n). + apply shift_leEq_mult' with H1. + 2: apply less_leEq. + 2: apply H6. + cut (Zero[<]a[-d]b or a[-d]b[<]Zero). + intro H16. + elim H16. + intro H17. + exact H17. + intro H17. + set (H18 := ax_d_nneg X (cms_d (c:=X))) in *. + generalize H18. + unfold nneg in |- *. + intro H19. + set (H20 := H19 (CPsMetricSpace_is_CPsMetricSpace X) a b) in *. + rewrite -> leEq_def in H20. + set (H21 := H20 H17) in *. + intuition. + apply ap_imp_less. + apply ap_symmetric_unfolded. + exact H1. + astepl ((OneR[/] Zero[+]One[+]One[//]H14)[^]S n). + astepl (OneR[^]S n[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H14). + astepl (OneR[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H14). + astepl ((OneR[+]One)[*] (One[/] (Zero[+]One[+]One)[^]S (S n)[//]nexp_resp_ap_zero (S (S n)) H14)). + apply mult_cancel_lft with (OneR[/] Zero[+]One[+]One[//]H14). + apply div_resp_ap_zero_rev. + apply ap_symmetric_unfolded. + apply less_imp_ap. + apply pos_one. + astepr ((One[/] Zero[+]One[+]One[//]H14)[*](Zero[+]One[+]One)[*] + (One[/] (Zero[+]One[+]One)[^]S (S n)[//]nexp_resp_ap_zero (S (S n)) H14)). + astepr (OneR[*] (One[/] (Zero[+]One[+]One)[^]S (S n)[//]nexp_resp_ap_zero (S (S n)) H14)). + astepr (OneR[/] (Zero[+]One[+]One)[^]S (S n)[//]nexp_resp_ap_zero (S (S n)) H14). + astepr (OneR[*]One[/] (Zero[+]One[+]One)[*](Zero[+]One[+]One)[^]S n[//] + mult_resp_ap_zero IR (Zero[+]One[+]One) ((Zero[+]One[+]One)[^]S n) H14 + (nexp_resp_ap_zero (S n) H14)). + astepr (One[*]One[/] (Zero[+]One[+]One)[^]S (S n)[//] nexp_resp_ap_zero (S (S n)) H14). + rational. + astepr ((One[/] Zero[+]One[+]One[//]H14)[*]Two[*] + nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)). + astepr ((One[/] Zero[+]One[+]One[//]H14)[*](Zero[+]One[+]One)[*] + nexp IR (S (S n)) (One[/] Zero[+]One[+]One[//]H14)). + apply mult_wdr. + 3: apply plus_resp_less_both. + 3: exact H12. + 3: exact H13. + astepr ((One[/] Zero[+]One[+]One[//]H14)[^]S (S n)). + apply eq_symmetric_unfolded. + apply nexp_distr_recip. + astepl (One[+]One[/] (Zero[+]One[+]One)[^]S (S n)[//] nexp_resp_ap_zero (S (S n)) H14). + 2: rational. + astepl (Zero[+]One[+]One[/] (Zero[+]One[+]One)[^]S (S n)[//] nexp_resp_ap_zero (S (S n)) H14). + rstepr (Zero[+]One[+]One[/] (Zero[+]One[+]One)[*](Zero[+]One[+]One)[^]S n[//] + mult_resp_ap_zero IR (Zero[+]One[+]One) ((Zero[+]One[+]One)[^]S n) H14 + (nexp_resp_ap_zero (S n) H14)). + astepl (Zero[+]One[+]One[/] (Zero[+]One[+]One)[*](Zero[+]One[+]One)[^]S n[//] + mult_resp_ap_zero IR (Zero[+]One[+]One) ((Zero[+]One[+]One)[^]S n) H14 + (nexp_resp_ap_zero (S n) H14)). + apply eq_reflexive_unfolded. Qed. End Limitt. diff --git a/metrics/CPMSTheory.v b/metrics/CPMSTheory.v index fea4f0e04..8bd2aa972 100644 --- a/metrics/CPMSTheory.v +++ b/metrics/CPMSTheory.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Prod_Sub. @@ -42,8 +42,8 @@ Section lists. *) (** - List and membership of lists are used in the definition of -%''totally bounded''% #"totally bounded"#. Note that we use the Leibniz equality in the definition + List and membership of lists are used in the definition of +%''totally bounded''% #"totally bounded"#. Note that we use the Leibniz equality in the definition of [MSmember], and not the setoid equality. So we are really talking about finite sets of representants, instead of finite subsetoids. This seems to make the proofs a bit easier. @@ -58,57 +58,59 @@ Fixpoint MSmember (X : CSetoid) (x : X) (l : list X) {struct l} : CProp := Implicit Arguments MSmember [X]. Definition to_IR (P : IR -> CProp) : subcsetoid_crr IR P -> IR. -intro P. -intro a. -case a. -intros b C. -exact b. +Proof. + intro P. + intro a. + case a. + intros b C. + exact b. Defined. Definition from_IR (P : IR -> CProp) (x : IR) (H : P x) : subcsetoid_crr IR P. -intros P x H. -set (H0 := Build_subcsetoid_crr IR P) in *. -set (H1 := H0 x H) in *. -exact H1. +Proof. + intros P x H. + set (H0 := Build_subcsetoid_crr IR P) in *. + set (H1 := H0 x H) in *. + exact H1. Defined. Definition list_IR (P : IR -> CProp) : - list (SubPsMetricSpace IR_as_CPsMetricSpace P) -> list IR. -intro P. -intro l. -induction l as [| a l Hrecl]. -apply (@nil IR). -apply (cons (to_IR P a) Hrecl). + list (SubPsMetricSpace IR_as_CPsMetricSpace P) -> list IR. +Proof. + intro P. + intro l. + induction l as [| a l Hrecl]. + apply (@nil IR). + apply (cons (to_IR P a) Hrecl). Defined. Lemma is_P : forall (P : IR -> CProp) - (l : list (SubPsMetricSpace IR_as_CPsMetricSpace P)) + (l : list (SubPsMetricSpace IR_as_CPsMetricSpace P)) (x : IR), pred_wd IR P -> member x (list_IR P l) -> P x. -intros P l x Q. -induction l as [| a l Hrecl]. -simpl in |- *. -intuition. - -case a. -simpl in |- *. -intros b C D. -elim D. -intro E. -apply Hrecl. -exact E. -unfold pred_wd in Q. -intro H. -apply Q with b. -exact C. - -apply eq_symmetric_unfolded. -exact H. +Proof. + intros P l x Q. + induction l as [| a l Hrecl]. + simpl in |- *. + intuition. + case a. + simpl in |- *. + intros b C D. + elim D. + intro E. + apply Hrecl. + exact E. + unfold pred_wd in Q. + intro H. + apply Q with b. + exact C. + apply eq_symmetric_unfolded. + exact H. Qed. (** If a real number is element of a list in the above defined sense, -it is an element of the list in the sense of [member], +it is an element of the list in the sense of [member], that uses the setoid equality. *) @@ -117,51 +119,49 @@ Lemma member1 : (l : list (SubPsMetricSpace IR_as_CPsMetricSpace P)), MSmember (X:=SubPsMetricSpace IR_as_CPsMetricSpace P) x0 l -> member (to_IR P x0) (list_IR P l). -intros P x0 l. -induction l as [| a l Hrecl]. -simpl in |- *. -intuition. - -simpl in |- *. -intros H. -elim H. -intro H1. -apply Cinleft. -apply Hrecl. -exact H1. - -simpl in |- *. -intros. -apply Cinright. -rewrite b. -intuition. +Proof. + intros P x0 l. + induction l as [| a l Hrecl]. + simpl in |- *. + intuition. + simpl in |- *. + intros H. + elim H. + intro H1. + apply Cinleft. + apply Hrecl. + exact H1. + simpl in |- *. + intros. + apply Cinright. + rewrite b. + intuition. Qed. (** -The image under a certain mapping of an element of a list $l$ #l# is member +The image under a certain mapping of an element of a list $l$ #l# is member of the list of images of elements of $l$ #l#. *) Lemma map_member : forall (X Z : CPsMetricSpace) (f : X -> Z) (l : list X) (m : X), MSmember m l -> MSmember (f m) (map f l). -intros X Z f l m. -induction l as [| a l Hrecl]. -simpl in |- *. -auto. - -simpl in |- *. -intro H. -elim H. -intro H1. -apply Cinleft. -apply Hrecl. -exact H1. - -intro H1. -apply Cinright. -rewrite H1. -intuition. +Proof. + intros X Z f l m. + induction l as [| a l Hrecl]. + simpl in |- *. + auto. + simpl in |- *. + intro H. + elim H. + intro H1. + apply Cinleft. + apply Hrecl. + exact H1. + intro H1. + apply Cinright. + rewrite H1. + intuition. Qed. End lists. @@ -173,20 +173,22 @@ Section loc_and_bound. Definition Re_co_do (X Z : CSetoid) (f : CSetoid_fun X Z) : X -> Build_SubCSetoid Z (fun y : Z => {x : X | f x[=]y}). -intros X Z f x. -exists (f x). -exists x. -apply eq_reflexive. +Proof. + intros X Z f x. + exists (f x). + exists x. + apply eq_reflexive. Defined. Lemma Re_co_do_strext : forall (X Z : CSetoid) (f : CSetoid_fun X Z), fun_strext (Re_co_do X Z f). -intros X Z f. -unfold fun_strext in |- *. -intros x y. -simpl in |- *. -apply (csf_strext X Z f). +Proof. + intros X Z f. + unfold fun_strext in |- *. + intros x y. + simpl in |- *. + apply (csf_strext X Z f). Qed. Definition re_co_do (X Z : CSetoid) (f : CSetoid_fun X Z) : @@ -197,15 +199,16 @@ Definition re_co_do (X Z : CSetoid) (f : CSetoid_fun X Z) : Lemma re_co_do_well_def : forall (X Z : CSetoid) (f : CSetoid_fun X Z), pred_wd Z (fun y : Z => {x : X | f x[=]y}). -intros X Z f. -unfold pred_wd in |- *. -intros x y. -intros H0 H1. -elim H0. -intros x0 H3. -exists x0. -astepr x. -exact H3. +Proof. + intros X Z f. + unfold pred_wd in |- *. + intros x y. + intros H0 H1. + elim H0. + intros x0 H3. + exists x0. + astepr x. + exact H3. Qed. Implicit Arguments MSmember [X]. @@ -219,23 +222,22 @@ Lemma map_member' : MSmember m l -> MSmember (X:=Build_SubCSetoid Z (fun y : Z => {x0 : X | f x0[=]y})) (re_co_do X Z f m) (map (re_co_do X Z f) l). -intros X Z f l m. -induction l as [| a l Hrecl]. -simpl in |- *. -auto. - -simpl in |- *. -intro H. -elim H. -intro H1. -apply Cinleft. -apply Hrecl. -exact H1. - -intro H1. -apply Cinright. -rewrite H1. -intuition. +Proof. + intros X Z f l m. + induction l as [| a l Hrecl]. + simpl in |- *. + auto. + simpl in |- *. + intro H. + elim H. + intro H1. + apply Cinleft. + apply Hrecl. + exact H1. + intro H1. + apply Cinright. + rewrite H1. + intuition. Qed. Definition bounded (X : CPsMetricSpace) : CProp := @@ -256,34 +258,33 @@ Lemma unicon_resp_totallybounded : forall (X Z : CPsMetricSpace) (f : CSetoid_fun X Z) (H : uni_continuous'' f), MStotally_bounded X -> MStotally_bounded (SubPsMetricSpace (fun y : Z => {x : X | f x[=]y})). -intros X Z f. -unfold uni_continuous'' in |- *. -intro H. -unfold MStotally_bounded in |- *. -intro H1. -intro n. -elim H. -intros mod_ H3. -elim (H1 (mod_ n)). -intros l H2. -simpl in |- *. -exists (map (re_co_do X Z f) l). -intros x. -elim x. -intros r H5. -elim H5. -intros k H6. -elim (H2 k). -intros m H7 H8. -exists (re_co_do X Z f m). - -2: simpl in |- *. -2: astepl (f k[-d]f m). -2: apply H3. -2: exact H8. - -apply map_member'. -exact H7. +Proof. + intros X Z f. + unfold uni_continuous'' in |- *. + intro H. + unfold MStotally_bounded in |- *. + intro H1. + intro n. + elim H. + intros mod_ H3. + elim (H1 (mod_ n)). + intros l H2. + simpl in |- *. + exists (map (re_co_do X Z f) l). + intros x. + elim x. + intros r H5. + elim H5. + intros k H6. + elim (H2 k). + intros m H7 H8. + exists (re_co_do X Z f m). + 2: simpl in |- *. + 2: astepl (f k[-d]f m). + 2: apply H3. + 2: exact H8. + apply map_member'. + exact H7. Qed. Lemma MStotallybounded_totallybounded : @@ -291,138 +292,117 @@ Lemma MStotallybounded_totallybounded : pred_wd IR P -> MStotally_bounded (SubPsMetricSpace (X:=IR_as_CPsMetricSpace) P) -> totally_bounded P. -intros P H0 Q. -unfold MStotally_bounded in |- *. -intro H. -unfold totally_bounded in |- *. -constructor. -exact H0. - -intros e H1. -set - (H2 := - OneR[/] e[//]ap_symmetric_unfolded IR Zero e (less_imp_ap IR Zero e H1)) - in *. -unfold AbsSmall in |- *. -set (H3 := Archimedes H2) in *. -elim H3. -intros m H4. -elim H with m. -intros l H5. -exists (list_IR P l). -intro x. -apply is_P. -exact Q. - -intros x H6. -generalize H5. -simpl in |- *. -intro H7. -elim (H7 (from_IR P x H6)). -intros x0 H8 H9. -exists (to_IR P x0). -apply member1. -exact H8. -split. -generalize H9. -unfold dIR_as_CSetoid_fun in |- *. -unfold dIR in |- *. -case x0. -intros. -simpl in |- *. -apply leEq_transitive with ([--](one_div_succ (R:=IR) m)). -apply inv_resp_leEq. -unfold one_div_succ in |- *. -apply shift_div_leEq. -unfold Snring in |- *. -apply less_transitive_unfolded with (nring (R:=IR) m). -apply less_leEq_trans with H2. -unfold H2 in |- *. -apply recip_resp_pos. -exact H1. - -exact H4. - -simpl in |- *. -astepl (nring (R:=IR) m[+]Zero). -apply plus_resp_less_lft. -apply pos_one. - -apply - shift_leEq_mult' - with (ap_symmetric_unfolded IR Zero e (less_imp_ap IR Zero e H1)). -exact H1. - -apply leEq_transitive with (nring (R:=IR) m). -exact H4. - -unfold Snring in |- *. -simpl in |- *. -apply less_leEq. -astepl (nring (R:=IR) m[+]Zero). -apply plus_resp_less_lft. -apply pos_one. - -apply inv_cancel_leEq. -astepr (one_div_succ (R:=IR) m). -apply leEq_transitive with (AbsIR (x[-]scs_elem)). -apply inv_leEq_AbsIR. -unfold AbsIR in |- *. -simpl in |- *. -generalize H10. -simpl in |- *. -intuition. - -generalize H9. -case x0. -intros x1 Q0 H10. -simpl in |- *. -apply leEq_transitive with (one_div_succ (R:=IR) m). -generalize H10. -unfold dIR_as_CSetoid_fun in |- *. -unfold dIR in |- *. -simpl in |- *. -intro H11. -apply leEq_transitive with (AbsIR (x[-]x1)). -apply leEq_AbsIR. -unfold AbsIR in |- *. -simpl in |- *. -exact H11. - -unfold one_div_succ in |- *. -apply shift_div_leEq. -unfold Snring in |- *. -apply less_transitive_unfolded with (nring (R:=IR) m). -apply less_leEq_trans with H2. -unfold H2 in |- *. -apply recip_resp_pos. -exact H1. - -exact H4. - -simpl in |- *. -astepl (nring (R:=IR) m[+]Zero). -apply plus_resp_less_lft. -apply pos_one. - -apply - shift_leEq_mult' - with (ap_symmetric_unfolded IR Zero e (less_imp_ap IR Zero e H1)). -exact H1. - -apply leEq_transitive with (nring (R:=IR) m). -exact H4. - -unfold Snring in |- *. -simpl in |- *. -apply less_leEq. -astepl (nring (R:=IR) m[+]Zero). -apply plus_resp_less_lft. -apply pos_one. +Proof. + intros P H0 Q. + unfold MStotally_bounded in |- *. + intro H. + unfold totally_bounded in |- *. + constructor. + exact H0. + intros e H1. + set (H2 := OneR[/] e[//]ap_symmetric_unfolded IR Zero e (less_imp_ap IR Zero e H1)) in *. + unfold AbsSmall in |- *. + set (H3 := Archimedes H2) in *. + elim H3. + intros m H4. + elim H with m. + intros l H5. + exists (list_IR P l). + intro x. + apply is_P. + exact Q. + intros x H6. + generalize H5. + simpl in |- *. + intro H7. + elim (H7 (from_IR P x H6)). + intros x0 H8 H9. + exists (to_IR P x0). + apply member1. + exact H8. + split. + generalize H9. + unfold dIR_as_CSetoid_fun in |- *. + unfold dIR in |- *. + case x0. + intros. + simpl in |- *. + apply leEq_transitive with ([--](one_div_succ (R:=IR) m)). + apply inv_resp_leEq. + unfold one_div_succ in |- *. + apply shift_div_leEq. + unfold Snring in |- *. + apply less_transitive_unfolded with (nring (R:=IR) m). + apply less_leEq_trans with H2. + unfold H2 in |- *. + apply recip_resp_pos. + exact H1. + exact H4. + simpl in |- *. + astepl (nring (R:=IR) m[+]Zero). + apply plus_resp_less_lft. + apply pos_one. + apply shift_leEq_mult' with (ap_symmetric_unfolded IR Zero e (less_imp_ap IR Zero e H1)). + exact H1. + apply leEq_transitive with (nring (R:=IR) m). + exact H4. + unfold Snring in |- *. + simpl in |- *. + apply less_leEq. + astepl (nring (R:=IR) m[+]Zero). + apply plus_resp_less_lft. + apply pos_one. + apply inv_cancel_leEq. + astepr (one_div_succ (R:=IR) m). + apply leEq_transitive with (AbsIR (x[-]scs_elem)). + apply inv_leEq_AbsIR. + unfold AbsIR in |- *. + simpl in |- *. + generalize H10. + simpl in |- *. + intuition. + generalize H9. + case x0. + intros x1 Q0 H10. + simpl in |- *. + apply leEq_transitive with (one_div_succ (R:=IR) m). + generalize H10. + unfold dIR_as_CSetoid_fun in |- *. + unfold dIR in |- *. + simpl in |- *. + intro H11. + apply leEq_transitive with (AbsIR (x[-]x1)). + apply leEq_AbsIR. + unfold AbsIR in |- *. + simpl in |- *. + exact H11. + unfold one_div_succ in |- *. + apply shift_div_leEq. + unfold Snring in |- *. + apply less_transitive_unfolded with (nring (R:=IR) m). + apply less_leEq_trans with H2. + unfold H2 in |- *. + apply recip_resp_pos. + exact H1. + exact H4. + simpl in |- *. + astepl (nring (R:=IR) m[+]Zero). + apply plus_resp_less_lft. + apply pos_one. + apply shift_leEq_mult' with (ap_symmetric_unfolded IR Zero e (less_imp_ap IR Zero e H1)). + exact H1. + apply leEq_transitive with (nring (R:=IR) m). + exact H4. + unfold Snring in |- *. + simpl in |- *. + apply less_leEq. + astepl (nring (R:=IR) m[+]Zero). + apply plus_resp_less_lft. + apply pos_one. Qed. (** -Every image under an uniformly continuous function of an totally bounded +Every image under an uniformly continuous function of an totally bounded pseudo metric space has an infimum and a supremum. *) @@ -432,23 +412,19 @@ Lemma infimum_exists : MStotally_bounded X -> forall x : X, {z : IR | set_glb_IR (fun y : IR_as_CPsMetricSpace => {x : X | f x[=]y}) z}. -intros X f H0 H1 x. -apply totally_bounded_has_glb. -apply MStotallybounded_totallybounded. - - -3: apply unicon_resp_totallybounded. -3: exact H0. - -3: exact H1. - -2: unfold IR_as_CPsMetricSpace in |- *. -2: simpl in |- *. -2: apply re_co_do_well_def. - -exists (f x). -exists x. -apply eq_reflexive. +Proof. + intros X f H0 H1 x. + apply totally_bounded_has_glb. + apply MStotallybounded_totallybounded. + 3: apply unicon_resp_totallybounded. + 3: exact H0. + 3: exact H1. + 2: unfold IR_as_CPsMetricSpace in |- *. + 2: simpl in |- *. + 2: apply re_co_do_well_def. + exists (f x). + exists x. + apply eq_reflexive. Qed. Lemma supremum_exists : @@ -457,27 +433,24 @@ Lemma supremum_exists : MStotally_bounded X -> forall x : X, {z : IR | set_lub_IR (fun y : IR_as_CPsMetricSpace => {x : X | f x[=]y}) z}. -intros X f H0 H1 x. -apply totally_bounded_has_lub. -apply MStotallybounded_totallybounded. - -3: apply unicon_resp_totallybounded. -3: exact H0. - -3: exact H1. - -2: unfold IR_as_CPsMetricSpace in |- *. -2: simpl in |- *. -2: apply re_co_do_well_def. - -exists (f x). -exists x. -apply eq_reflexive. +Proof. + intros X f H0 H1 x. + apply totally_bounded_has_lub. + apply MStotallybounded_totallybounded. + 3: apply unicon_resp_totallybounded. + 3: exact H0. + 3: exact H1. + 2: unfold IR_as_CPsMetricSpace in |- *. + 2: simpl in |- *. + 2: apply re_co_do_well_def. + exists (f x). + exists x. + apply eq_reflexive. Qed. (** -A subspace $P$#P# of a pseudo metric space $X$#X# is said to be located if for all -elements $x$#x# of $X$#X# there exists an infimum for the distance +A subspace $P$#P# of a pseudo metric space $X$#X# is said to be located if for all +elements $x$#x# of $X$#X# there exists an infimum for the distance between $x$#x# and the elements of $P$#P#. *) @@ -502,51 +475,49 @@ Implicit Arguments located' [X]. Lemma located_imp_located' : forall (X : CPsMetricSpace) (P : X -> CProp), located P -> located' P. -intros X P. -unfold located in |- *. -unfold located' in |- *. -intros H x y. -set (H0 := H x y) in *. -elim H0. -intros x0 H1. -exists x0. -unfold dsub' in H1. -generalize H1. -unfold dsub'_as_cs_fun in |- *. -unfold dsub' in |- *. -simpl in |- *. -unfold set_glb_IR in |- *. -intros. -split. -intro x1. -elim H2. -intros a b H3. -apply a. -elim H3. -intros. -exists x2. -astepl (x[-d]from_SubPsMetricSpace X P x2). -exact p. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. - - -intros e H3. -elim H2. -intros. -set (H8 := b e H3) in *. -elim H8. -intros. -exists x1. -elim p. -intros. -exists x2. -astepl (from_SubPsMetricSpace X P x2[-d]x). -exact p0. - -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. -exact q. +Proof. + intros X P. + unfold located in |- *. + unfold located' in |- *. + intros H x y. + set (H0 := H x y) in *. + elim H0. + intros x0 H1. + exists x0. + unfold dsub' in H1. + generalize H1. + unfold dsub'_as_cs_fun in |- *. + unfold dsub' in |- *. + simpl in |- *. + unfold set_glb_IR in |- *. + intros. + split. + intro x1. + elim H2. + intros a b H3. + apply a. + elim H3. + intros. + exists x2. + astepl (x[-d]from_SubPsMetricSpace X P x2). + exact p. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + intros e H3. + elim H2. + intros. + set (H8 := b e H3) in *. + elim H8. + intros. + exists x1. + elim p. + intros. + exists x2. + astepl (from_SubPsMetricSpace X P x2[-d]x). + exact p0. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + exact q. Qed. (** @@ -556,33 +527,33 @@ Every totally bounded pseudo metric space is located. Lemma MStotally_bounded_imp_located : forall (X : CPsMetricSpace) (P : X -> CProp), MStotally_bounded (SubPsMetricSpace P) -> located P. -intros X P H. -unfold located in |- *. -intros x y. -set (H0 := infimum_exists (SubPsMetricSpace P) (dsub'_as_cs_fun P x)) in *. -set (H1 := H0 (dsub'_uni_continuous'' X P x) H y) in *. -elim H1. -intros x0 H2. -elim H2. -intros. -simpl in |- *. -exists x0. -unfold set_glb_IR in |- *. -split. -intro x1. -intro H6. -apply a. -generalize b. -intros. -elim H6. -intros. -exists x2. -simpl in |- *. -exact p. - -intros e H3. -set (H7 := b e H3) in *. -apply H7. +Proof. + intros X P H. + unfold located in |- *. + intros x y. + set (H0 := infimum_exists (SubPsMetricSpace P) (dsub'_as_cs_fun P x)) in *. + set (H1 := H0 (dsub'_uni_continuous'' X P x) H y) in *. + elim H1. + intros x0 H2. + elim H2. + intros. + simpl in |- *. + exists x0. + unfold set_glb_IR in |- *. + split. + intro x1. + intro H6. + apply a. + generalize b. + intros. + elim H6. + intros. + exists x2. + simpl in |- *. + exact p. + intros e H3. + set (H7 := b e H3) in *. + apply H7. Qed. (** @@ -590,12 +561,12 @@ For all $x$#x# in a pseudo metric space $X$#X#, for all located su [Floc] chooses for a given natural number $n$#n# an $y$#y# in $P$#P# such that: $d(x,y)\leq \mbox{inf}\{d(x,p)|p \in P\}+(n+1)^{-1}$ #d(x,y) ≤ inf{d(x,p)| pϵP} + (n+1)-1#. -[Flocfun] does (almost) the same, but has a different type. This enables +[Flocfun] does (almost) the same, but has a different type. This enables one to use the latter as an argument of [map]. *) -Definition Floc (X : CPsMetricSpace) (P : X -> CProp) - (H0 : located' P) (H2 : SubPsMetricSpace P) (n : nat) +Definition Floc (X : CPsMetricSpace) (P : X -> CProp) + (H0 : located' P) (H2 : SubPsMetricSpace P) (n : nat) (x : X) : {y : SubPsMetricSpace P | {z : IR | @@ -603,65 +574,43 @@ Definition Floc (X : CPsMetricSpace) (P : X -> CProp) (fun v : IR => {y : SubPsMetricSpace P | x[-d]from_SubPsMetricSpace X P y[=]v}) z | x[-d]from_SubPsMetricSpace X P y[<=]z[+]one_div_succ n}}. -intros X P H0 y n x. -unfold located' in H0. -set (H1 := H0 x y) in *. -elim H1. -intros x0 H3. -unfold set_glb_IR in H3. -elim H3. -intros H4 H5. -elim (H5 (one_div_succ n)). -intros x1 H6 H7. -elim H6. -intros x2 H8. - - -eapply - existT - with - (P := - fun y0 : SubPsMetricSpace P => - {z : IR | - set_glb_IR - (fun v : IR => - {y1 : SubPsMetricSpace P | - x[-d]from_SubPsMetricSpace X P y1[=]v}) z | - x[-d]from_SubPsMetricSpace X P y0[<=]z[+]one_div_succ n}) - (x := x2). - -eapply - exist2T - with - (P := - fun z : IR => - set_glb_IR - (fun v : IR => - {y1 : SubPsMetricSpace P | - x[-d]from_SubPsMetricSpace X P y1[=]v}) z) - (Q := - fun z : IR => - x[-d]from_SubPsMetricSpace X P x2[<=]z[+]one_div_succ n) - (x := x0). -unfold set_glb_IR in |- *. -apply H3. - -apply shift_leEq_plus'. -astepl (x1[-]x0). -apply less_leEq. -apply H7. - -apply one_div_succ_pos. +Proof. + intros X P H0 y n x. + unfold located' in H0. + set (H1 := H0 x y) in *. + elim H1. + intros x0 H3. + unfold set_glb_IR in H3. + elim H3. + intros H4 H5. + elim (H5 (one_div_succ n)). + intros x1 H6 H7. + elim H6. + intros x2 H8. + eapply existT with (P := fun y0 : SubPsMetricSpace P => {z : IR | set_glb_IR (fun v : IR => + {y1 : SubPsMetricSpace P | x[-d]from_SubPsMetricSpace X P y1[=]v}) z | + x[-d]from_SubPsMetricSpace X P y0[<=]z[+]one_div_succ n}) (x := x2). + eapply exist2T with (P := fun z : IR => set_glb_IR (fun v : IR => {y1 : SubPsMetricSpace P | + x[-d]from_SubPsMetricSpace X P y1[=]v}) z) (Q := fun z : IR => + x[-d]from_SubPsMetricSpace X P x2[<=]z[+]one_div_succ n) (x := x0). + unfold set_glb_IR in |- *. + apply H3. + apply shift_leEq_plus'. + astepl (x1[-]x0). + apply less_leEq. + apply H7. + apply one_div_succ_pos. Defined. -Definition Flocfun (X : CPsMetricSpace) (P : X -> CProp) +Definition Flocfun (X : CPsMetricSpace) (P : X -> CProp) (H0 : located' P) (H2 : SubPsMetricSpace P) (n : nat) : X -> SubPsMetricSpace P. -intros. -set (H1 := Floc X P H0 H2 n X0) in *. -elim H1. -intros. -exact x. +Proof. + intros. + set (H1 := Floc X P H0 H2 n X0) in *. + elim H1. + intros. + exact x. Defined. (** @@ -674,115 +623,99 @@ Lemma locatedsub_totallybounded_imp_totallyboundedsub : forall (X : CPsMetricSpace) (P : X -> CProp), SubPsMetricSpace P -> located' P -> MStotally_bounded X -> MStotally_bounded (SubPsMetricSpace P). -intros X P y H0. -unfold MStotally_bounded in |- *. -intros H1 n. -elim (H1 (3 * n + 2)). -intros l H2. -unfold located' in H0. -simpl in |- *. -exists (map (Flocfun X P H0 y (3 * n + 2)) l). -simpl in |- *. -intro x. -elim (H2 (from_SubPsMetricSpace X P x)). -intros xj xjl H3. -exists (Flocfun X P H0 y (n + (n + (n + 0)) + 2) xj). -apply map_member with (f := Flocfun X P H0 y (n + (n + (n + 0)) + 2)). -exact xjl. -unfold Flocfun in |- *. -unfold sigT_rec in |- *. -unfold sigT_rect in |- *. -case Floc. -intros. -elim s. -intros x2 p0 q. -generalize H3. -case x. -intros xn Pn H4. -apply - leEq_transitive with ((xn[-d]xj)[+](xj[-d]from_SubPsMetricSpace X P x0)). -case x0. -intros. -simpl in |- *. -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. -astepr - (one_div_succ (R:=IR) (n + (n + (n + 0)) + 2)[+] - (one_div_succ (n + (n + (n + 0)) + 2)[+] +Proof. + intros X P y H0. + unfold MStotally_bounded in |- *. + intros H1 n. + elim (H1 (3 * n + 2)). + intros l H2. + unfold located' in H0. + simpl in |- *. + exists (map (Flocfun X P H0 y (3 * n + 2)) l). + simpl in |- *. + intro x. + elim (H2 (from_SubPsMetricSpace X P x)). + intros xj xjl H3. + exists (Flocfun X P H0 y (n + (n + (n + 0)) + 2) xj). + apply map_member with (f := Flocfun X P H0 y (n + (n + (n + 0)) + 2)). + exact xjl. + unfold Flocfun in |- *. + unfold sigT_rec in |- *. + unfold sigT_rect in |- *. + case Floc. + intros. + elim s. + intros x2 p0 q. + generalize H3. + case x. + intros xn Pn H4. + apply leEq_transitive with ((xn[-d]xj)[+](xj[-d]from_SubPsMetricSpace X P x0)). + case x0. + intros. + simpl in |- *. + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + astepr (one_div_succ (R:=IR) (n + (n + (n + 0)) + 2)[+] (one_div_succ (n + (n + (n + 0)) + 2)[+] one_div_succ (n + (n + (n + 0)) + 2))). -apply plus_resp_leEq_both. -apply H4. -apply leEq_transitive with (x2[+]one_div_succ (n + (n + (n + 0)) + 2)). -apply leEq_transitive with (xj[-d]from_SubPsMetricSpace X P x0). -apply eq_imp_leEq. -apply csbf_wd_unfolded. -intuition. - -intuition. - -exact q. -apply plus_resp_leEq. -apply leEq_transitive with (from_SubPsMetricSpace X P x[-d]xj). -unfold set_glb_IR in p0. -elim p0. -intros. -apply a. -unfold SubPsMetricSpace in |- *. -simpl in |- *. -exists x. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. - -apply H3. - -astepr (One[*]one_div_succ (R:=IR) n). -astepr (((Three:IR)[/] Three:IR[//]three_ap_zero IR)[*]one_div_succ n). -astepl - (one_div_succ (n + (n + (n + 0)) + 2)[+] - (Two:IR)[*]one_div_succ (n + (n + (n + 0)) + 2)). -astepl - (OneR[*]one_div_succ (n + (n + (n + 0)) + 2)[+] - (Two:IR)[*]one_div_succ (n + (n + (n + 0)) + 2)). -astepl ((OneR[+]Two)[*]one_div_succ (n + (n + (n + 0)) + 2)). -astepl ((Three:IR)[*]one_div_succ (n + (n + (n + 0)) + 2)). -2: apply mult_wdl. -2: rational. -astepr ((Three:IR)[*](One[/] Three[//]three_ap_zero IR)[*]one_div_succ n). -astepr ((Three:IR)[*]((One[/] Three[//]three_ap_zero IR)[*]one_div_succ n)). -apply mult_wdr. -unfold one_div_succ in |- *. -unfold Snring in |- *. -simpl in |- *. -astepr - (OneR[/] (Three:IR)[*](nring n[+]One)[//] - mult_resp_ap_zero IR Three (nring n[+]One) (three_ap_zero IR) - (nringS_ap_zero IR n)). -apply eq_div. -apply mult_wdr. -astepl (Three[*]nring (R:=IR) n[+]Three[*]One). -simpl in |- *. -astepr (nring (R:=IR) (n + (n + (n + 0)))[+]Two[+]One). - - -astepr (nring (R:=IR) n[+]nring (n + (n + 0))[+]Two[+]One). -astepr (nring (R:=IR) n[+](nring n[+]nring (n + 0))[+]Two[+]One). - -3: apply mult_wdl. -3: rational. - -2: simpl in |- *. -2: rational. - -astepr (nring (R:=IR) n[+](nring n[+]nring (n + 0))[+]Two[+]One). -astepr (nring (R:=IR) n[+](nring n[+]nring (n + 0))[+](Two[+]One)). -astepl ((ZeroR[+]One[+]One[+]One)[*]nring n[+](Zero[+]One[+]One[+]One)). -simpl in |- *. -astepl (ZeroR[+]One[+]One[+]One[+](Zero[+]One[+]One[+]One)[*]nring n). -astepr (ZeroR[+]One[+]One[+]One[+](nring n[+](nring n[+]nring (n + 0)))). -apply plus_resp_eq. -astepr (nring (R:=IR) n[+](nring n[+](nring n[+]nring 0))). -simpl in |- *. -rational. + apply plus_resp_leEq_both. + apply H4. + apply leEq_transitive with (x2[+]one_div_succ (n + (n + (n + 0)) + 2)). + apply leEq_transitive with (xj[-d]from_SubPsMetricSpace X P x0). + apply eq_imp_leEq. + apply csbf_wd_unfolded. + intuition. + intuition. + exact q. + apply plus_resp_leEq. + apply leEq_transitive with (from_SubPsMetricSpace X P x[-d]xj). + unfold set_glb_IR in p0. + elim p0. + intros. + apply a. + unfold SubPsMetricSpace in |- *. + simpl in |- *. + exists x. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + apply H3. + astepr (One[*]one_div_succ (R:=IR) n). + astepr (((Three:IR)[/] Three:IR[//]three_ap_zero IR)[*]one_div_succ n). + astepl (one_div_succ (n + (n + (n + 0)) + 2)[+] (Two:IR)[*]one_div_succ (n + (n + (n + 0)) + 2)). + astepl (OneR[*]one_div_succ (n + (n + (n + 0)) + 2)[+] + (Two:IR)[*]one_div_succ (n + (n + (n + 0)) + 2)). + astepl ((OneR[+]Two)[*]one_div_succ (n + (n + (n + 0)) + 2)). + astepl ((Three:IR)[*]one_div_succ (n + (n + (n + 0)) + 2)). + 2: apply mult_wdl. + 2: rational. + astepr ((Three:IR)[*](One[/] Three[//]three_ap_zero IR)[*]one_div_succ n). + astepr ((Three:IR)[*]((One[/] Three[//]three_ap_zero IR)[*]one_div_succ n)). + apply mult_wdr. + unfold one_div_succ in |- *. + unfold Snring in |- *. + simpl in |- *. + astepr (OneR[/] (Three:IR)[*](nring n[+]One)[//] + mult_resp_ap_zero IR Three (nring n[+]One) (three_ap_zero IR) (nringS_ap_zero IR n)). + apply eq_div. + apply mult_wdr. + astepl (Three[*]nring (R:=IR) n[+]Three[*]One). + simpl in |- *. + astepr (nring (R:=IR) (n + (n + (n + 0)))[+]Two[+]One). + astepr (nring (R:=IR) n[+]nring (n + (n + 0))[+]Two[+]One). + astepr (nring (R:=IR) n[+](nring n[+]nring (n + 0))[+]Two[+]One). + 3: apply mult_wdl. + 3: rational. + 2: simpl in |- *. + 2: rational. + astepr (nring (R:=IR) n[+](nring n[+]nring (n + 0))[+]Two[+]One). + astepr (nring (R:=IR) n[+](nring n[+]nring (n + 0))[+](Two[+]One)). + astepl ((ZeroR[+]One[+]One[+]One)[*]nring n[+](Zero[+]One[+]One[+]One)). + simpl in |- *. + astepl (ZeroR[+]One[+]One[+]One[+](Zero[+]One[+]One[+]One)[*]nring n). + astepr (ZeroR[+]One[+]One[+]One[+](nring n[+](nring n[+]nring (n + 0)))). + apply plus_resp_eq. + astepr (nring (R:=IR) n[+](nring n[+](nring n[+]nring 0))). + simpl in |- *. + rational. Qed. (** @@ -801,7 +734,7 @@ Definition MSComplete (X : CPsMetricSpace) : CProp := MSCauchy_seq X seq -> {lim : X | MSseqLimit' seq lim}. (** -A compact pseudo metric space is a pseudo metric space which is complete and +A compact pseudo metric space is a pseudo metric space which is complete and totally bounded. *) @@ -809,7 +742,7 @@ Definition MSCompact (X : CPsMetricSpace) : CProp := MSComplete X and MStotally_bounded X. (** -A subset $P$#P# is %\emph{open}%#open# if for all $x$#x# in $P$#P# there exists an open sphere +A subset $P$#P# is %\emph{open}%#open# if for all $x$#x# in $P$#P# there exists an open sphere with centre $x$#x# that is contained in $P$#P#. *) @@ -820,24 +753,25 @@ Definition open (X : CPsMetricSpace) (P : X -> CProp) := Implicit Arguments open [X]. (** -The operator [infima] gives the infimum for the distance between an -element $x$#x# of a located pseudo metric space $X$#X# and the elements of a +The operator [infima] gives the infimum for the distance between an +element $x$#x# of a located pseudo metric space $X$#X# and the elements of a subspace $P$#P# of $X$#X#. -*) +*) -Definition infima (X : CPsMetricSpace) (P : X -> CProp) +Definition infima (X : CPsMetricSpace) (P : X -> CProp) (H : located' P) (a : SubPsMetricSpace P) : X -> IR. -intros X P H a H0. -unfold located' in H. -elim (H H0 a). -intros. -exact x. +Proof. + intros X P H a H0. + unfold located' in H. + elim (H H0 a). + intros. + exact x. Defined. Implicit Arguments infima [X]. (** -A non-empty totally bounded sub-pseudo-metric-space $P$#P# is said to be -%\emph{well contained}% #well contained# in an open sub-pseudo-metric-space $Q$#Q# if $Q$#Q# contains +A non-empty totally bounded sub-pseudo-metric-space $P$#P# is said to be +%\emph{well contained}% #well contained# in an open sub-pseudo-metric-space $Q$#Q# if $Q$#Q# contains all points that are in some sense close to $P$#P#. *) diff --git a/metrics/CPseudoMSpaces.v b/metrics/CPseudoMSpaces.v index 50cdde2b7..df1b4dfd4 100644 --- a/metrics/CPseudoMSpaces.v +++ b/metrics/CPseudoMSpaces.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Intervals. @@ -80,16 +80,16 @@ Section Definition_PsMS0. (** A pseudo metric space consists of a setoid and a %''pseudo metric''% #"pseudo metric"#, also called %''distance''% #"distance"#, a binairy function that fulfils certain properties. -*) +*) Record is_CPsMetricSpace (A : CSetoid) (d : CSetoid_bin_fun A A IR) : - Type := + Type := {ax_d_com : com d; ax_d_nneg : nneg d; ax_d_pos_imp_ap : pos_imp_ap d; ax_d_tri_ineq : tri_ineq d}. - -Record CPsMetricSpace : Type := + +Record CPsMetricSpace : Type := {cms_crr :> CSetoid; cms_d : CSetoid_bin_fun cms_crr cms_crr IR; cms_proof : is_CPsMetricSpace cms_crr cms_d}. @@ -113,23 +113,27 @@ Lemma CPsMetricSpace_is_CPsMetricSpace : is_CPsMetricSpace A cms_d. Proof cms_proof A. Lemma d_com : com (cms_d (c:=A)). -elim CPsMetricSpace_is_CPsMetricSpace. -auto. +Proof. + elim CPsMetricSpace_is_CPsMetricSpace. + auto. Qed. Lemma d_nneg : nneg (cms_d (c:=A)). -elim CPsMetricSpace_is_CPsMetricSpace. -auto. +Proof. + elim CPsMetricSpace_is_CPsMetricSpace. + auto. Qed. Lemma d_pos_imp_ap : pos_imp_ap (cms_d (c:=A)). -elim CPsMetricSpace_is_CPsMetricSpace. -auto. +Proof. + elim CPsMetricSpace_is_CPsMetricSpace. + auto. Qed. Lemma d_tri_ineq : tri_ineq (cms_d (c:=A)). -elim CPsMetricSpace_is_CPsMetricSpace. -auto. +Proof. + elim CPsMetricSpace_is_CPsMetricSpace. + auto. Qed. End PsMS_axioms. @@ -145,117 +149,110 @@ Let [Y] be a pseudo metric space. Variable Y : CPsMetricSpace. Lemma rev_tri_ineq : - forall a b c : cms_crr Y, AbsSmall (b[-d]c) ((a[-d]b)[-](a[-d]c)). -intros. -unfold AbsSmall in |- *. -split. -apply shift_leEq_minus. -apply shift_plus_leEq'. -unfold cg_minus in |- *. -cut ([--][--](b[-d]c)[=]b[-d]c). -intros. -apply leEq_wdr with ((a[-d]b)[+](b[-d]c)). -apply ax_d_tri_ineq. - -apply CPsMetricSpace_is_CPsMetricSpace. - -apply eq_symmetric_unfolded. -apply bin_op_wd_unfolded. -apply eq_reflexive_unfolded. - -exact H. - -apply cg_inv_inv. - -astepr (c[-d]b). -apply shift_minus_leEq. -apply shift_leEq_plus'. -apply shift_minus_leEq. -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. - -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. -Qed. + forall a b c : cms_crr Y, AbsSmall (b[-d]c) ((a[-d]b)[-](a[-d]c)). +Proof. + intros. + unfold AbsSmall in |- *. + split. + apply shift_leEq_minus. + apply shift_plus_leEq'. + unfold cg_minus in |- *. + cut ([--][--](b[-d]c)[=]b[-d]c). + intros. + apply leEq_wdr with ((a[-d]b)[+](b[-d]c)). + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + apply eq_symmetric_unfolded. + apply bin_op_wd_unfolded. + apply eq_reflexive_unfolded. + exact H. + apply cg_inv_inv. + astepr (c[-d]b). + apply shift_minus_leEq. + apply shift_leEq_plus'. + apply shift_minus_leEq. + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. +Qed. (** -Instead of taking [pos_imp_ap] as axiom, -we could as well have taken [diag_zero]. +Instead of taking [pos_imp_ap] as axiom, +we could as well have taken [diag_zero]. *) Lemma diag_zero_imp_pos_imp_ap : forall (X : CSetoid) (d : CSetoid_bin_fun X X IR), diag_zero X d -> pos_imp_ap d. -intros X d. -unfold diag_zero in |- *. -unfold pos_imp_ap in |- *. -intros H. -intros x y H0. -cut (x[#]x or x[#]y). -intro H1. -elim H1. -cut (Not (x[#]x)). -intros H3 H4. -set (H5 := H3 H4) in *. -intuition. - -apply ap_irreflexive_unfolded. - -intro H2. -exact H2. - -apply (csbf_strext X X IR d). -astepl ZeroR. -apply less_imp_ap. -exact H0. +Proof. + intros X d. + unfold diag_zero in |- *. + unfold pos_imp_ap in |- *. + intros H. + intros x y H0. + cut (x[#]x or x[#]y). + intro H1. + elim H1. + cut (Not (x[#]x)). + intros H3 H4. + set (H5 := H3 H4) in *. + intuition. + apply ap_irreflexive_unfolded. + intro H2. + exact H2. + apply (csbf_strext X X IR d). + astepl ZeroR. + apply less_imp_ap. + exact H0. Qed. Lemma pos_imp_ap_imp_diag_zero : forall (X : CSetoid) (d : CSetoid_bin_fun X X IR), pos_imp_ap d -> nneg d -> diag_zero X d. -intros X d. -unfold pos_imp_ap in |- *. -unfold nneg in |- *. -intros H H6. -unfold diag_zero in |- *. -intro x. -apply not_ap_imp_eq. -red in |- *. -intro H0. -set (H1 := less_conf_ap IR (d x x) Zero) in *. -generalize H1. -unfold Iff in |- *. -intro H2. -elim H2. -intros H3 H4. -set (H5 := H3 H0) in *. -elim H5. -generalize H6. -intros H7 H8. -set (H9 := H7 x x) in *. -rewrite -> leEq_def in H9. -set (H10 := H9 H8) in *. -exact H10. - -intro H7. -set (H8 := H x x) in *. -set (H9 := H8 H7) in *. -set (H10 := ap_irreflexive_unfolded X x H9) in *. -exact H10. +Proof. + intros X d. + unfold pos_imp_ap in |- *. + unfold nneg in |- *. + intros H H6. + unfold diag_zero in |- *. + intro x. + apply not_ap_imp_eq. + red in |- *. + intro H0. + set (H1 := less_conf_ap IR (d x x) Zero) in *. + generalize H1. + unfold Iff in |- *. + intro H2. + elim H2. + intros H3 H4. + set (H5 := H3 H0) in *. + elim H5. + generalize H6. + intros H7 H8. + set (H9 := H7 x x) in *. + rewrite -> leEq_def in H9. + set (H10 := H9 H8) in *. + exact H10. + intro H7. + set (H8 := H x x) in *. + set (H9 := H8 H7) in *. + set (H10 := ap_irreflexive_unfolded X x H9) in *. + exact H10. Qed. Lemma is_CPsMetricSpace_diag_zero : forall (X : CSetoid) (d : CSetoid_bin_fun X X IR), com d /\ tri_ineq d /\ nneg d /\ diag_zero X d -> is_CPsMetricSpace X d. -intros X d H. -elim H. -intros H1 H2. -elim H2. -intros H3 H4. -elim H4. -intros H5 H6. -apply - (Build_is_CPsMetricSpace X d H1 H5 (diag_zero_imp_pos_imp_ap X d H6) H3). +Proof. + intros X d H. + elim H. + intros H1 H2. + elim H2. + intros H3 H4. + elim H4. + intros H5 H6. + apply (Build_is_CPsMetricSpace X d H1 H5 (diag_zero_imp_pos_imp_ap X d H6) H3). Qed. End PsMS_basics. @@ -265,67 +262,72 @@ Section Zerof. ** Zero function *) (** -Every setoid forms with the binary function that always returns zero, -a pseudo metric space. +Every setoid forms with the binary function that always returns zero, +a pseudo metric space. *) Definition zero_fun (X : CSetoid) (x y : X) : IR := ZeroR. Lemma zero_fun_strext : forall X : CSetoid, bin_fun_strext X X IR (zero_fun X). -intro X. -unfold bin_fun_strext in |- *. -unfold zero_fun in |- *. -intros x1 x2 y1 y2 Z. -set (H := ap_irreflexive_unfolded IR Zero Z) in *. -intuition. +Proof. + intro X. + unfold bin_fun_strext in |- *. + unfold zero_fun in |- *. + intros x1 x2 y1 y2 Z. + set (H := ap_irreflexive_unfolded IR Zero Z) in *. + intuition. Qed. Definition Zero_fun (X : CSetoid) := Build_CSetoid_bin_fun X X IR (zero_fun X) (zero_fun_strext X). Lemma zero_fun_com : forall X : CSetoid, com (Zero_fun X). -intro X. -unfold com in |- *. -intros x y. -unfold Zero_fun in |- *. -simpl in |- *. -unfold zero_fun in |- *. -intuition. +Proof. + intro X. + unfold com in |- *. + intros x y. + unfold Zero_fun in |- *. + simpl in |- *. + unfold zero_fun in |- *. + intuition. Qed. Lemma zero_fun_nneg : forall X : CSetoid, nneg (Zero_fun X). -intro X. -unfold nneg in |- *. -intros x y. -unfold Zero_fun in |- *. -simpl in |- *. -unfold zero_fun in |- *. -apply eq_imp_leEq. -intuition. +Proof. + intro X. + unfold nneg in |- *. + intros x y. + unfold Zero_fun in |- *. + simpl in |- *. + unfold zero_fun in |- *. + apply eq_imp_leEq. + intuition. Qed. Lemma zero_fun_pos_imp_ap : forall X : CSetoid, pos_imp_ap (Zero_fun X). -intro X. -unfold pos_imp_ap in |- *. -intros x y. -unfold Zero_fun in |- *. -simpl in |- *. -unfold zero_fun in |- *. -intro Z. -set (H := less_irreflexive IR Zero Z) in *. -intuition. +Proof. + intro X. + unfold pos_imp_ap in |- *. + intros x y. + unfold Zero_fun in |- *. + simpl in |- *. + unfold zero_fun in |- *. + intro Z. + set (H := less_irreflexive IR Zero Z) in *. + intuition. Qed. Lemma zero_fun_tri_ineq : forall X : CSetoid, tri_ineq (Zero_fun X). -intro X. -unfold tri_ineq in |- *. -intros x y z. -unfold Zero_fun in |- *. -simpl in |- *. -unfold zero_fun in |- *. -apply eq_imp_leEq. -rational. +Proof. + intro X. + unfold tri_ineq in |- *. + intros x y z. + unfold Zero_fun in |- *. + simpl in |- *. + unfold zero_fun in |- *. + apply eq_imp_leEq. + rational. Qed. Definition zf_is_CPsMetricSpace (X : CSetoid) := diff --git a/metrics/ContFunctions.v b/metrics/ContFunctions.v index 5feb2d6d0..9da5176ee 100644 --- a/metrics/ContFunctions.v +++ b/metrics/ContFunctions.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CPseudoMSpaces. @@ -101,330 +101,309 @@ Section Lemmas. (* begin hide *) Lemma nexp_power : forall p : nat, nexp IR p Two[=]nring (power p 2). -simple induction p. -simpl in |- *. -algebra. - -intros n H. -astepr (nring (R:=IR) (power n 2 * 2)). -astepr (nring (R:=IR) (power n 2)[*]Two). -astepl (nexp IR n Two[*]Two). -apply mult_wdl. -exact H. - -Qed. +Proof. + simple induction p. + simpl in |- *. + algebra. + intros n H. + astepr (nring (R:=IR) (power n 2 * 2)). + astepr (nring (R:=IR) (power n 2)[*]Two). + astepl (nexp IR n Two[*]Two). + apply mult_wdl. + exact H. + +Qed. (* end hide *) Lemma continuous_imp_continuous' : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B), continuous f -> continuous' f. -intros A B f. -unfold continuous in |- *. -intro H. -unfold continuous' in |- *. -intros x n. -set (H1 := two_ap_zero IR) in *. -elim H with x (S n) H1. -intros p H2. -exists (power p 2). -intro y. -intro H3. -apply leEq_transitive with ((OneR[/] Two:IR[//]H1)[^]S n). -apply less_leEq. -apply H2. -apply leEq_less_trans with (one_div_succ (R:=IR) (power p 2)). -exact H3. - -unfold one_div_succ in |- *. -astepr (OneR[^]p[/] (Two:IR)[^]p[//]nexp_resp_ap_zero p H1). -astepr (OneR[/] (Two:IR)[^]p[//]nexp_resp_ap_zero p H1). -apply recip_resp_less. -apply nexp_resp_pos. -apply pos_two. - -unfold Snring in |- *. -apply less_wdr with (nexp IR p Two[+]One). -apply shift_less_plus. -apply minusOne_less. - -astepl (OneR[+]nexp IR p Two). -astepr (OneR[+]nring (power p 2)). -apply plus_resp_eq. - - - -apply nexp_power. -simpl in |- *. -algebra. -apply less_leEq. -astepl (OneR[^]S n[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1). -astepl (OneR[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1). -unfold one_div_succ in |- *. -unfold Snring in |- *. -apply bin_less_un. +Proof. + intros A B f. + unfold continuous in |- *. + intro H. + unfold continuous' in |- *. + intros x n. + set (H1 := two_ap_zero IR) in *. + elim H with x (S n) H1. + intros p H2. + exists (power p 2). + intro y. + intro H3. + apply leEq_transitive with ((OneR[/] Two:IR[//]H1)[^]S n). + apply less_leEq. + apply H2. + apply leEq_less_trans with (one_div_succ (R:=IR) (power p 2)). + exact H3. + unfold one_div_succ in |- *. + astepr (OneR[^]p[/] (Two:IR)[^]p[//]nexp_resp_ap_zero p H1). + astepr (OneR[/] (Two:IR)[^]p[//]nexp_resp_ap_zero p H1). + apply recip_resp_less. + apply nexp_resp_pos. + apply pos_two. + unfold Snring in |- *. + apply less_wdr with (nexp IR p Two[+]One). + apply shift_less_plus. + apply minusOne_less. + astepl (OneR[+]nexp IR p Two). + astepr (OneR[+]nring (power p 2)). + apply plus_resp_eq. + apply nexp_power. + simpl in |- *. + algebra. + apply less_leEq. + astepl (OneR[^]S n[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1). + astepl (OneR[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1). + unfold one_div_succ in |- *. + unfold Snring in |- *. + apply bin_less_un. Qed. Lemma continuous'_imp_continuous : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B), continuous' f -> continuous f. -intros A B f. -unfold continuous' in |- *. -intro H. -unfold continuous in |- *. -intros x n H0. -elim H with x (power n 2). -intros p H1. -exists (S p). -intros y H2. -apply leEq_less_trans with (one_div_succ (R:=IR) (power n 2)). -apply H1. -apply less_leEq. -apply less_transitive_unfolded with ((One[/] Two:IR[//]H0)[^]S p). -exact H2. - -unfold one_div_succ in |- *. -astepl (OneR[^]S p[/] (Two:IR)[^]S p[//]nexp_resp_ap_zero (S p) H0). -astepl (OneR[/] (Two:IR)[^]S p[//]nexp_resp_ap_zero (S p) H0). -apply recip_resp_less. -unfold Snring in |- *. -apply nring_pos. -intuition. - -apply nat_less_bin_nexp. -unfold one_div_succ in |- *. -unfold Snring in |- *. -astepr (OneR[^]n[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). -astepr (OneR[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). -apply recip_resp_less. -apply nexp_resp_pos. -apply pos_two. -astepr (nring (R:=IR) (power n 2)[+]One). -astepl (nexp IR n Two[+]Zero). -apply plus_resp_leEq_less. -apply eq_imp_leEq. -apply nexp_power. - -apply pos_one. +Proof. + intros A B f. + unfold continuous' in |- *. + intro H. + unfold continuous in |- *. + intros x n H0. + elim H with x (power n 2). + intros p H1. + exists (S p). + intros y H2. + apply leEq_less_trans with (one_div_succ (R:=IR) (power n 2)). + apply H1. + apply less_leEq. + apply less_transitive_unfolded with ((One[/] Two:IR[//]H0)[^]S p). + exact H2. + unfold one_div_succ in |- *. + astepl (OneR[^]S p[/] (Two:IR)[^]S p[//]nexp_resp_ap_zero (S p) H0). + astepl (OneR[/] (Two:IR)[^]S p[//]nexp_resp_ap_zero (S p) H0). + apply recip_resp_less. + unfold Snring in |- *. + apply nring_pos. + intuition. + apply nat_less_bin_nexp. + unfold one_div_succ in |- *. + unfold Snring in |- *. + astepr (OneR[^]n[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). + astepr (OneR[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). + apply recip_resp_less. + apply nexp_resp_pos. + apply pos_two. + astepr (nring (R:=IR) (power n 2)[+]One). + astepl (nexp IR n Two[+]Zero). + apply plus_resp_leEq_less. + apply eq_imp_leEq. + apply nexp_power. + apply pos_one. Qed. Lemma uni_continuous_imp_uni_continuous' : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B), uni_continuous f -> uni_continuous' f. -intros A B f. -unfold uni_continuous in |- *. -intro H. -unfold uni_continuous' in |- *. -intro n. -set (H0 := two_ap_zero IR) in *. -elim H with (S n) H0. -intros p H1. -exists (power p 2). -intros x y H2. -apply less_leEq. -apply less_transitive_unfolded with ((OneR[/] Two:IR[//]H0)[^]S n). -apply H1. -apply leEq_less_trans with (one_div_succ (R:=IR) (power p 2)). -exact H2. - -unfold one_div_succ in |- *. -unfold Snring in |- *. -astepr (OneR[^]p[/] (Two:IR)[^]p[//]nexp_resp_ap_zero p H0). -astepr (OneR[/] (Two:IR)[^]p[//]nexp_resp_ap_zero p H0). -apply recip_resp_less. -apply nexp_resp_pos. -apply pos_two. -astepr (nring (R:=IR) (power p 2)[+]One). -astepl (nexp IR p Two[+]Zero). -apply plus_resp_leEq_less. -apply eq_imp_leEq. -apply nexp_power. - -apply pos_one. - -unfold one_div_succ in |- *. -unfold Snring in |- *. -astepl (OneR[^]S n[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H0). -astepl (OneR[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H0). -apply bin_less_un. +Proof. + intros A B f. + unfold uni_continuous in |- *. + intro H. + unfold uni_continuous' in |- *. + intro n. + set (H0 := two_ap_zero IR) in *. + elim H with (S n) H0. + intros p H1. + exists (power p 2). + intros x y H2. + apply less_leEq. + apply less_transitive_unfolded with ((OneR[/] Two:IR[//]H0)[^]S n). + apply H1. + apply leEq_less_trans with (one_div_succ (R:=IR) (power p 2)). + exact H2. + unfold one_div_succ in |- *. + unfold Snring in |- *. + astepr (OneR[^]p[/] (Two:IR)[^]p[//]nexp_resp_ap_zero p H0). + astepr (OneR[/] (Two:IR)[^]p[//]nexp_resp_ap_zero p H0). + apply recip_resp_less. + apply nexp_resp_pos. + apply pos_two. + astepr (nring (R:=IR) (power p 2)[+]One). + astepl (nexp IR p Two[+]Zero). + apply plus_resp_leEq_less. + apply eq_imp_leEq. + apply nexp_power. + apply pos_one. + unfold one_div_succ in |- *. + unfold Snring in |- *. + astepl (OneR[^]S n[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H0). + astepl (OneR[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H0). + apply bin_less_un. Qed. Lemma uni_continuous'_imp_uni_continuous : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B), uni_continuous' f -> uni_continuous f. -intros A B f. -unfold uni_continuous' in |- *. -intro H. -unfold uni_continuous in |- *. -intros n H0. -elim H with (power n 2). -intros p H1. -exists (S p). -intros x y H2. -apply leEq_less_trans with (one_div_succ (R:=IR) (power n 2)). -apply H1. -apply less_leEq. -apply less_transitive_unfolded with ((OneR[/] Two:IR[//]H0)[^]S p). -exact H2. - -unfold one_div_succ in |- *. -unfold Snring in |- *. -astepl (OneR[^]S p[/] (Two:IR)[^]S p[//]nexp_resp_ap_zero (S p) H0). -astepl (OneR[/] (Two:IR)[^]S p[//]nexp_resp_ap_zero (S p) H0). -apply bin_less_un. - -unfold one_div_succ in |- *. -astepr (OneR[^]n[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). -astepr (OneR[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). -apply recip_resp_less. -apply nexp_resp_pos. -apply pos_two. - -unfold Snring in |- *. -astepr (nring (R:=IR) (power n 2)[+]One). -astepl (nexp IR n Two[+]Zero). -apply plus_resp_leEq_less. -apply eq_imp_leEq. -apply nexp_power. - -apply pos_one. +Proof. + intros A B f. + unfold uni_continuous' in |- *. + intro H. + unfold uni_continuous in |- *. + intros n H0. + elim H with (power n 2). + intros p H1. + exists (S p). + intros x y H2. + apply leEq_less_trans with (one_div_succ (R:=IR) (power n 2)). + apply H1. + apply less_leEq. + apply less_transitive_unfolded with ((OneR[/] Two:IR[//]H0)[^]S p). + exact H2. + unfold one_div_succ in |- *. + unfold Snring in |- *. + astepl (OneR[^]S p[/] (Two:IR)[^]S p[//]nexp_resp_ap_zero (S p) H0). + astepl (OneR[/] (Two:IR)[^]S p[//]nexp_resp_ap_zero (S p) H0). + apply bin_less_un. + unfold one_div_succ in |- *. + astepr (OneR[^]n[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). + astepr (OneR[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). + apply recip_resp_less. + apply nexp_resp_pos. + apply pos_two. + unfold Snring in |- *. + astepr (nring (R:=IR) (power n 2)[+]One). + astepl (nexp IR n Two[+]Zero). + apply plus_resp_leEq_less. + apply eq_imp_leEq. + apply nexp_power. + apply pos_one. Qed. Lemma uni_continuous'_imp_uni_continuous'' : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B), uni_continuous' f -> uni_continuous'' f. -intros A B f. -unfold uni_continuous' in |- *. -unfold uni_continuous'' in |- *. -apply - choice - with - (P := fun n m : nat => - forall x y : A, - x[-d]y[<=]one_div_succ m -> f x[-d]f y[<=]one_div_succ n). +Proof. + intros A B f. + unfold uni_continuous' in |- *. + unfold uni_continuous'' in |- *. + apply choice with (P := fun n m : nat => forall x y : A, + x[-d]y[<=]one_div_succ m -> f x[-d]f y[<=]one_div_succ n). Qed. Lemma lipschitz_imp_lipschitz' : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B), lipschitz f -> lipschitz' f. -intros A B f. -unfold lipschitz in |- *. -intro H. -unfold lipschitz' in |- *. -elim H. -intros n H0. -elim Archimedes with ((Two:IR)[^]n). -intros m H1. -exists m. -intros x y. -apply leEq_transitive with ((Two:IR)[^]n[*](x[-d]y)). -apply H0. - -apply mult_resp_leEq_rht. -exact H1. - -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intros A B f. + unfold lipschitz in |- *. + intro H. + unfold lipschitz' in |- *. + elim H. + intros n H0. + elim Archimedes with ((Two:IR)[^]n). + intros m H1. + exists m. + intros x y. + apply leEq_transitive with ((Two:IR)[^]n[*](x[-d]y)). + apply H0. + apply mult_resp_leEq_rht. + exact H1. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Lemma lipschitz'_imp_lipschitz : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B), lipschitz' f -> lipschitz f. -intros A B f. -unfold lipschitz' in |- *. -intro H. -unfold lipschitz in |- *. -elim H. -intros m H1. -exists m. -intros x y. -apply leEq_transitive with (nring m[*](x[-d]y)). -apply H1. - -apply mult_resp_leEq_rht. -case m. -simpl in |- *. -apply less_leEq. -apply pos_one. - -intro n. -astepl (Snring IR n). -apply less_leEq. -apply nat_less_bin_nexp. - -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intros A B f. + unfold lipschitz' in |- *. + intro H. + unfold lipschitz in |- *. + elim H. + intros m H1. + exists m. + intros x y. + apply leEq_transitive with (nring m[*](x[-d]y)). + apply H1. + apply mult_resp_leEq_rht. + case m. + simpl in |- *. + apply less_leEq. + apply pos_one. + intro n. + astepl (Snring IR n). + apply less_leEq. + apply nat_less_bin_nexp. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. -Lemma lip_c_imp_lip : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B) (C : IR), +Lemma lip_c_imp_lip : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B) (C : IR), lipschitz_c f C -> lipschitz' f. -unfold lipschitz_c. -unfold lipschitz'. -intros. -assert ({n : nat| C [<=] nring n}). -apply Archimedes. -destruct X as [n H1]. -exists n. -intros. -assert (f x[-d]f y [<=] C[*](x[-d]y)). -apply H. -apply leEq_transitive with (C[*](x[-d]y)); auto. -apply mult_resp_leEq_rht; auto. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + unfold lipschitz_c. + unfold lipschitz'. + intros. + assert ({n : nat| C [<=] nring n}). + apply Archimedes. + destruct X as [n H1]. + exists n. + intros. + assert (f x[-d]f y [<=] C[*](x[-d]y)). + apply H. + apply leEq_transitive with (C[*](x[-d]y)); auto. + apply mult_resp_leEq_rht; auto. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. (** -Every uniformly continuous function is continuous and +Every uniformly continuous function is continuous and every Lipschitz function is uniformly continuous. *) Lemma uni_continuous_imp_continuous : forall (C D : CPsMetricSpace) (f : CSetoid_fun C D), uni_continuous f -> continuous f. -intros C D F. -red in |- *. -unfold uni_continuous in |- *. -intros H0 n u H3. -elim H0 with u H3. -intros. -exists x. -intro y. -apply p. +Proof. + intros C D F. + red in |- *. + unfold uni_continuous in |- *. + intros H0 n u H3. + elim H0 with u H3. + intros. + exists x. + intro y. + apply p. Qed. Lemma lipschitz_imp_uni_continuous : forall (C D : CPsMetricSpace) (f : CSetoid_fun C D), lipschitz f -> uni_continuous f. -red in |- *. -unfold lipschitz in |- *. -intros C D f H n H0. -elim H. -intros. -exists (n + x). -intros x0 y H1. -apply leEq_less_trans with (Two[^]x[*](x0[-d]y)). -apply p. - -apply mult_cancel_less with ((One[/] Two:IR[//]H0)[^]x). -apply nexp_resp_pos. -apply div_resp_pos. -apply pos_two. - -apply pos_one. - -apply less_wdr with ((One[/] Two:IR[//]H0)[^](n + x)). -apply less_wdl with (x0[-d]y). -exact H1. - -astepr (Two[^]x[*](x0[-d]y)[*](One[^]x[/] Two[^]x[//]nexp_resp_ap_zero x H0)). -astepr (Two[^]x[*](x0[-d]y)[*](One[/] Two[^]x[//]nexp_resp_ap_zero x H0)). - -rational. - -apply eq_symmetric_unfolded. -astepr ((One[/] Two:IR[//]H0)[^](n + x)). -apply nexp_plus. +Proof. + red in |- *. + unfold lipschitz in |- *. + intros C D f H n H0. + elim H. + intros. + exists (n + x). + intros x0 y H1. + apply leEq_less_trans with (Two[^]x[*](x0[-d]y)). + apply p. + apply mult_cancel_less with ((One[/] Two:IR[//]H0)[^]x). + apply nexp_resp_pos. + apply div_resp_pos. + apply pos_two. + apply pos_one. + apply less_wdr with ((One[/] Two:IR[//]H0)[^](n + x)). + apply less_wdl with (x0[-d]y). + exact H1. + astepr (Two[^]x[*](x0[-d]y)[*](One[^]x[/] Two[^]x[//]nexp_resp_ap_zero x H0)). + astepr (Two[^]x[*](x0[-d]y)[*](One[/] Two[^]x[//]nexp_resp_ap_zero x H0)). + rational. + apply eq_symmetric_unfolded. + astepr ((One[/] Two:IR[//]H0)[^](n + x)). + apply nexp_plus. Qed. @@ -432,35 +411,38 @@ End Lemmas. Section Identity. (** -** Identity +** Identity *) (** -The identity function is Lipschitz. +The identity function is Lipschitz. Hence it is uniformly continuous and continuous. *) Lemma id_is_lipschitz : forall X : CPsMetricSpace, lipschitz (id_un_op X). -intro X. -red in |- *. -simpl in |- *. -exists 0. -intros x y. -astepr (OneR[*](x[-d]y)). -astepr (x[-d]y). -apply leEq_reflexive. +Proof. + intro X. + red in |- *. + simpl in |- *. + exists 0. + intros x y. + astepr (OneR[*](x[-d]y)). + astepr (x[-d]y). + apply leEq_reflexive. Qed. Lemma id_is_uni_continuous : forall X : CPsMetricSpace, uni_continuous (id_un_op X). -intro X. -apply lipschitz_imp_uni_continuous. -apply id_is_lipschitz. +Proof. + intro X. + apply lipschitz_imp_uni_continuous. + apply id_is_lipschitz. Qed. Lemma id_is_continuous : forall X : CPsMetricSpace, continuous (id_un_op X). -intro X. -apply uni_continuous_imp_continuous. -apply id_is_uni_continuous. +Proof. + intro X. + apply uni_continuous_imp_continuous. + apply id_is_uni_continuous. Qed. End Identity. @@ -473,7 +455,7 @@ Let [B] and [X] be pseudo metric spaces. %\end{convention}% *) (** -Any constant function is Lipschitz. +Any constant function is Lipschitz. Hence it is uniformly continuous and continuous. *) Variable B : CPsMetricSpace. @@ -481,43 +463,44 @@ Variable X : CPsMetricSpace. Lemma const_fun_is_lipschitz : forall b : B, lipschitz (Const_CSetoid_fun X B b). -intro b. -red in |- *. -exists 1. -intros. -astepr (Two[^]1[*](x[-d]y)). -astepr (Two[*](x[-d]y)). -unfold Const_CSetoid_fun in |- *. -rewrite leEq_def in |- *. -red in |- *. -simpl in |- *. -intros H. -apply (ap_irreflexive_unfolded B b). -apply (ax_d_pos_imp_ap B (cms_d (c:=B)) (CPsMetricSpace_is_CPsMetricSpace B)). -apply leEq_less_trans with ((Zero[+]One[+]One)[*](x[-d]y)). -astepr ((Two:IR)[*](x[-d]y)). -apply shift_leEq_mult' with (two_ap_zero IR). -apply pos_two. - -astepl ZeroR. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. - -exact H. +Proof. + intro b. + red in |- *. + exists 1. + intros. + astepr (Two[^]1[*](x[-d]y)). + astepr (Two[*](x[-d]y)). + unfold Const_CSetoid_fun in |- *. + rewrite leEq_def in |- *. + red in |- *. + simpl in |- *. + intros H. + apply (ap_irreflexive_unfolded B b). + apply (ax_d_pos_imp_ap B (cms_d (c:=B)) (CPsMetricSpace_is_CPsMetricSpace B)). + apply leEq_less_trans with ((Zero[+]One[+]One)[*](x[-d]y)). + astepr ((Two:IR)[*](x[-d]y)). + apply shift_leEq_mult' with (two_ap_zero IR). + apply pos_two. + astepl ZeroR. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + exact H. Qed. Lemma const_fun_is_uni_continuous : forall b : B, uni_continuous (Const_CSetoid_fun X B b). -intro b. -apply lipschitz_imp_uni_continuous. -apply const_fun_is_lipschitz. +Proof. + intro b. + apply lipschitz_imp_uni_continuous. + apply const_fun_is_lipschitz. Qed. Lemma const_fun_is_continuous : forall b : B, continuous (Const_CSetoid_fun X B b). -intro b. -apply uni_continuous_imp_continuous. -apply const_fun_is_uni_continuous. +Proof. + intro b. + apply uni_continuous_imp_continuous. + apply const_fun_is_uni_continuous. Qed. End Constant. @@ -532,7 +515,7 @@ Let [f : (CSetoid_fun X B)] and %\end{convention}% *) (** -The composition of two Lipschitz/uniformly continous/continuous functions is +The composition of two Lipschitz/uniformly continous/continuous functions is again Lipschitz/uniformly continuous/continuous. *) Variable X : CPsMetricSpace. @@ -543,29 +526,27 @@ Variable g : CSetoid_fun B C. Lemma comp_resp_lipschitz : lipschitz f -> lipschitz g -> lipschitz (compose_CSetoid_fun X B C f g). -unfold lipschitz in |- *. -intros H H0. -elim H. -intros x H1. -elim H0. -intros x0 H2. -exists (x + x0). -simpl in |- *. -intros x1 y. -apply leEq_transitive with ((Two:IR)[^]x0[*](f x1[-d]f y)). -apply H2. - -astepr (Two[^](x + x0)[*](x1[-d]y)). - -astepr (Two[^]x[*]Two[^]x0[*](x1[-d]y)). -astepr (Two[^]x0[*]Two[^]x[*](x1[-d]y)). -rstepr (Two[^]x0[*](Two[^]x[*](x1[-d]y))). -apply mult_resp_leEq_lft. -apply H1. - -apply nexp_resp_nonneg. -apply less_leEq. -apply pos_two. +Proof. + unfold lipschitz in |- *. + intros H H0. + elim H. + intros x H1. + elim H0. + intros x0 H2. + exists (x + x0). + simpl in |- *. + intros x1 y. + apply leEq_transitive with ((Two:IR)[^]x0[*](f x1[-d]f y)). + apply H2. + astepr (Two[^](x + x0)[*](x1[-d]y)). + astepr (Two[^]x[*]Two[^]x0[*](x1[-d]y)). + astepr (Two[^]x0[*]Two[^]x[*](x1[-d]y)). + rstepr (Two[^]x0[*](Two[^]x[*](x1[-d]y))). + apply mult_resp_leEq_lft. + apply H1. + apply nexp_resp_nonneg. + apply less_leEq. + apply pos_two. Qed. @@ -573,37 +554,39 @@ Qed. Lemma comp_resp_uni_continuous : uni_continuous f -> uni_continuous g -> uni_continuous (compose_CSetoid_fun X B C f g). -unfold uni_continuous in |- *. -intros H H0. -simpl in |- *. -intros n H1. -elim H0 with n H1. -intro x. -intro H3. -elim H with x H1. -intro x0. -intro H4. -exists x0. -intros x1 y H5. -apply H3. -apply H4. -exact H5. +Proof. + unfold uni_continuous in |- *. + intros H H0. + simpl in |- *. + intros n H1. + elim H0 with n H1. + intro x. + intro H3. + elim H with x H1. + intro x0. + intro H4. + exists x0. + intros x1 y H5. + apply H3. + apply H4. + exact H5. Qed. Lemma comp_resp_continuous : continuous f -> continuous g -> continuous (compose_CSetoid_fun X B C f g). -unfold continuous in |- *. -intros H H0 x n H1. -simpl in |- *. -elim H0 with (f x) n H1. -intros. -elim H with x x0 H1. -intros. -exists x1. -intros y H2. -apply p. -apply p0. -exact H2. +Proof. + unfold continuous in |- *. + intros H H0 x n H1. + simpl in |- *. + elim H0 with (f x) n H1. + intros. + elim H with x x0 H1. + intros. + exists x1. + intros y H2. + apply p. + apply p0. + exact H2. Qed. @@ -614,7 +597,7 @@ Section Limit. ** Limit *) -Definition MSseqLimit (X : CPsMetricSpace) (seq : nat -> X) +Definition MSseqLimit (X : CPsMetricSpace) (seq : nat -> X) (lim : X) : CProp := forall (n : nat) (H : Two[#]Zero), {N : nat | @@ -622,7 +605,7 @@ Definition MSseqLimit (X : CPsMetricSpace) (seq : nat -> X) Implicit Arguments MSseqLimit [X]. -Definition MSseqLimit' (X : CPsMetricSpace) (seq : nat -> X) +Definition MSseqLimit' (X : CPsMetricSpace) (seq : nat -> X) (lim : X) : CProp := forall n : nat, {N : nat | forall m : nat, N <= m -> seq m[-d]lim[<=]one_div_succ n}. @@ -632,63 +615,60 @@ Implicit Arguments MSseqLimit' [X]. Lemma MSseqLimit_imp_MSseqLimit' : forall (X : CPsMetricSpace) (seq : nat -> X) (lim : X), MSseqLimit seq lim -> MSseqLimit' seq lim. -intros X seq lim. -unfold MSseqLimit in |- *. -intro H. -unfold MSseqLimit' in |- *. -intro n. -set (H2 := two_ap_zero IR) in *. -elim H with (S n) H2. -intros p H3. -exists p. -intros m H4. -apply less_leEq. -apply less_transitive_unfolded with ((OneR[/] Two:IR[//]H2)[^]S n). -apply H3. -exact H4. - -unfold one_div_succ in |- *. -unfold Snring in |- *. -astepl (OneR[^]S n[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H2). -astepl (OneR[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H2). -apply bin_less_un. +Proof. + intros X seq lim. + unfold MSseqLimit in |- *. + intro H. + unfold MSseqLimit' in |- *. + intro n. + set (H2 := two_ap_zero IR) in *. + elim H with (S n) H2. + intros p H3. + exists p. + intros m H4. + apply less_leEq. + apply less_transitive_unfolded with ((OneR[/] Two:IR[//]H2)[^]S n). + apply H3. + exact H4. + unfold one_div_succ in |- *. + unfold Snring in |- *. + astepl (OneR[^]S n[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H2). + astepl (OneR[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H2). + apply bin_less_un. Qed. Lemma MSseqLimit'_imp_MSseqLimit : forall (X : CPsMetricSpace) (seq : nat -> X) (lim : X), MSseqLimit' seq lim -> MSseqLimit seq lim. -intros X seq lim. -unfold MSseqLimit' in |- *. -intro H. -unfold MSseqLimit in |- *. -intros n H0. -elim H with (power n 2). -intros p H1. -exists p. -intros m H2. -apply leEq_less_trans with (one_div_succ (R:=IR) (power n 2)). -apply H1. -exact H2. - -unfold one_div_succ in |- *. -astepr (OneR[^]n[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). -astepr (OneR[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). -apply recip_resp_less. -apply nexp_resp_pos. -apply pos_two. - - -unfold Snring in |- *. -simpl in |- *. -apply less_wdr with (nexp IR n Two[+]One). -apply shift_less_plus. -astepl (nexp IR n Two[-]One). -apply minusOne_less. - -astepl (OneR[+]nexp IR n Two). -astepr (OneR[+]nring (power n 2)). -apply plus_resp_eq. -apply nexp_power. +Proof. + intros X seq lim. + unfold MSseqLimit' in |- *. + intro H. + unfold MSseqLimit in |- *. + intros n H0. + elim H with (power n 2). + intros p H1. + exists p. + intros m H2. + apply leEq_less_trans with (one_div_succ (R:=IR) (power n 2)). + apply H1. + exact H2. + unfold one_div_succ in |- *. + astepr (OneR[^]n[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). + astepr (OneR[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H0). + apply recip_resp_less. + apply nexp_resp_pos. + apply pos_two. + unfold Snring in |- *. + simpl in |- *. + apply less_wdr with (nexp IR n Two[+]One). + apply shift_less_plus. + astepl (nexp IR n Two[-]One). + apply minusOne_less. + astepl (OneR[+]nexp IR n Two). + astepr (OneR[+]nring (power n 2)). + apply plus_resp_eq. + apply nexp_power. Qed. @@ -702,32 +682,31 @@ Implicit Arguments seqcontinuous' [A B]. Lemma continuous'_imp_seqcontinuous' : forall (A B : CPsMetricSpace) (f : CSetoid_fun A B), continuous' f -> seqcontinuous' f. -intros A B f. -unfold continuous' in |- *. -intro H. -unfold seqcontinuous' in |- *. -intros seq lim. -unfold MSseqLimit' in |- *. -intro H0. -intro n. -elim H with lim n. -intros p H1. -elim H0 with p. -intros q H2. -exists q. -intro m. -intro H3. -astepl (f lim[-d]f (seq m)). -apply H1. -astepl (seq m[-d]lim). -apply H2. -exact H3. - -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. - -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intros A B f. + unfold continuous' in |- *. + intro H. + unfold seqcontinuous' in |- *. + intros seq lim. + unfold MSseqLimit' in |- *. + intro H0. + intro n. + elim H with lim n. + intros p H1. + elim H0 with p. + intros q H2. + exists q. + intro m. + intro H3. + astepl (f lim[-d]f (seq m)). + apply H1. + astepl (seq m[-d]lim). + apply H2. + exact H3. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. End Limit. diff --git a/metrics/Equiv.v b/metrics/Equiv.v index 9a81cf611..d92d2ac63 100644 --- a/metrics/Equiv.v +++ b/metrics/Equiv.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export IR_CPMSpace. @@ -41,7 +41,7 @@ Section equivalent. ** Equivalent Pseudo Metric Spaces *) (** -We say that two pseudo metric spaces are equivalent, when there exists a +We say that two pseudo metric spaces are equivalent, when there exists a bijective, structure-preserving function between them. *) @@ -61,572 +61,436 @@ Implicit Arguments isopsmetry [X Y]. Lemma isopsmetry_imp_bij : forall (X Y : CPsMetricSpace) (f : CSetoid_fun X Y), isopsmetry f -> bijective f. -intros X Y f H. -unfold isopsmetry in H. -elim H. -intuition. +Proof. + intros X Y f H. + unfold isopsmetry in H. + elim H. + intuition. Qed. Lemma isopsmetry_imp_lipschitz : forall (X Y : CPsMetricSpace) (f : CSetoid_fun X Y), isopsmetry f -> lipschitz' f. -intros X Y f. -unfold isopsmetry in |- *. -unfold equivalent_psmetric in |- *. -intro H. -elim H. clear H. -intros H0 H1. -elim H1. clear H1. -intros H10 H11. -elim H11. clear H11. -intros H110 H111. -unfold lipschitz' in |- *. -elim H111. clear H111. -simpl in |- *. -intros n H111'. -exists (S n). -simpl in |- *. -exact H111'. +Proof. + intros X Y f. + unfold isopsmetry in |- *. + unfold equivalent_psmetric in |- *. + intro H. + elim H. clear H. + intros H0 H1. + elim H1. clear H1. + intros H10 H11. + elim H11. clear H11. + intros H110 H111. + unfold lipschitz' in |- *. + elim H111. clear H111. + simpl in |- *. + intros n H111'. + exists (S n). + simpl in |- *. + exact H111'. Qed. Lemma id_is_isopsmetry : forall X : CPsMetricSpace, isopsmetry (id_un_op X). -intro X. -unfold isopsmetry in |- *. -split. -apply id_is_bij. -unfold equivalent_psmetric in |- *. -simpl in |- *. -unfold id_un_op in |- *. -split. -split. -apply CPsMetricSpace_is_CPsMetricSpace. -apply Build_is_CPsMetricSpace. -unfold com in |- *. -intros x y. -simpl in |- *. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. -unfold nneg in |- *. -simpl in |- *. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. -unfold pos_imp_ap in |- *. -simpl in |- *. -apply ax_d_pos_imp_ap. -apply CPsMetricSpace_is_CPsMetricSpace. -unfold tri_ineq in |- *. -simpl in |- *. -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. -split. -exists 0. -intros x y. -simpl in |- *. -astepr (OneR[*](x[-d]y)). -astepr (x[-d]y). -apply leEq_reflexive. -exists 0. -intros x y. -simpl in |- *. -astepr (OneR[*](x[-d]y)). -astepr (x[-d]y). -apply leEq_reflexive. +Proof. + intro X. + unfold isopsmetry in |- *. + split. + apply id_is_bij. + unfold equivalent_psmetric in |- *. + simpl in |- *. + unfold id_un_op in |- *. + split. + split. + apply CPsMetricSpace_is_CPsMetricSpace. + apply Build_is_CPsMetricSpace. + unfold com in |- *. + intros x y. + simpl in |- *. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold nneg in |- *. + simpl in |- *. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold pos_imp_ap in |- *. + simpl in |- *. + apply ax_d_pos_imp_ap. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold tri_ineq in |- *. + simpl in |- *. + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + split. + exists 0. + intros x y. + simpl in |- *. + astepr (OneR[*](x[-d]y)). + astepr (x[-d]y). + apply leEq_reflexive. + exists 0. + intros x y. + simpl in |- *. + astepr (OneR[*](x[-d]y)). + astepr (x[-d]y). + apply leEq_reflexive. Qed. Lemma comp_resp_isopsmetry : forall (X Y Z : CPsMetricSpace) (f : CSetoid_fun X Y) (g : CSetoid_fun Y Z), isopsmetry f -> isopsmetry g -> isopsmetry (compose_CSetoid_fun X Y Z f g). -intros X Y Z f g. -unfold isopsmetry in |- *. -intros H0 H1. -elim H0. -intros H00 H01. -elim H1. -intros H10 H11. -split. -apply comp_resp_bij. -exact H00. -exact H10. -unfold equivalent_psmetric in |- *. -split. -split. -apply CPsMetricSpace_is_CPsMetricSpace. -unfold equivalent_psmetric in H01. -elim H01. -intros H010 H011. -elim H010. -intros H0100 H0101. -elim H11. -intros H110 H111. -elim H110. -intros H1100 H1101. -apply Build_is_CPsMetricSpace. -unfold com in |- *. -simpl in |- *. -intros x y. -elim H1101. -intros. -generalize ax_d_com. -unfold com in |- *. -simpl in |- *. -intro H2. -apply H2. -unfold nneg in |- *. -intros x y. -simpl in |- *. -elim H1101. -intros. -generalize ax_d_nneg. -unfold nneg in |- *. -simpl in |- *. -intro H2. -apply H2. - -elim H1101. -intros. -generalize ax_d_pos_imp_ap. -unfold pos_imp_ap in |- *. -simpl in |- *. -intros H2 x y H3. -set (H5 := csf_strext X Y f) in *. -generalize H5. -unfold fun_strext in |- *. -intro H6. -apply H6. -auto. - -unfold tri_ineq in |- *. -simpl in |- *. -intros x y z. -elim H1101. -intros. -generalize ax_d_tri_ineq. -unfold tri_ineq in |- *. -simpl in |- *. -intro H2. -apply H2. - -split. -unfold equivalent_psmetric in H01. -elim H01. -intros H010 H011. -elim H011. -intros H0110 H0111. -unfold equivalent_psmetric in H11. -elim H11. -intros H110 H111. -elim H111. -intros H1110 H1111. -elim H0110. -simpl in |- *. -intros n H0110'. -elim H1110. -simpl in |- *. -intros m H1110'. -exists (S m * S n). -intros x y. -apply leEq_transitive with ((nring n[+]One)[*](f x[-d]f y)). -apply H0110'. -apply - leEq_transitive - with ((nring n[+]One)[*](nring m[+]One)[*](g (f x)[-d]g (f y))). -astepr ((nring n[+]One)[*]((nring m[+]One)[*](g (f x)[-d]g (f y)))). -apply mult_resp_leEq_lft. -apply H1110'. -apply less_leEq. -astepr (nring (R:=IR) (S n)). -apply pos_nring_S. -apply mult_resp_leEq_rht. -apply leEq_transitive with (nring (R:=IR) (S m * S n)). -apply eq_imp_leEq. -astepl (nring (R:=IR) (S n)[*](nring m[+]One)). -astepl (nring (R:=IR) (S n)[*]nring (S m)). -astepl (nring (R:=IR) (S m)[*]nring (S n)). -astepl (nring (R:=IR) (S m * S n)). -apply eq_reflexive. -astepr (nring (R:=IR) (S (S m * S n))). -apply less_leEq. -apply nring_less_succ. - -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. - - -unfold equivalent_psmetric in H01. -elim H01. -intros H010 H011. -elim H011. -intros H0110 H0111. -unfold equivalent_psmetric in H11. -elim H11. -intros H110 H111. -elim H111. -intros H1110 H1111. -elim H0111. -simpl in |- *. -intros n H0111'. -elim H1111. -simpl in |- *. -intros m H1111'. -exists (S m * S n). -intros x y. -apply leEq_transitive with (nring (R:=IR) (S m)[*](f x[-d]f y)). -apply H1111'. -apply leEq_transitive with (nring (S m)[*]nring (S n)[*](x[-d]y)). -astepr (nring (S m)[*](nring (S n)[*](x[-d]y))). -apply mult_resp_leEq_lft. -apply H0111'. -apply less_leEq. -apply pos_nring_S. -apply mult_resp_leEq_rht. -apply leEq_transitive with (nring (R:=IR) (S m * S n)). -apply eq_imp_leEq. -astepl (nring (R:=IR) (S m * S n)). -apply eq_reflexive. -astepr (nring (R:=IR) (S (S m * S n))). -apply less_leEq. -apply nring_less_succ. - -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intros X Y Z f g. + unfold isopsmetry in |- *. + intros H0 H1. + elim H0. + intros H00 H01. + elim H1. + intros H10 H11. + split. + apply comp_resp_bij. + exact H00. + exact H10. + unfold equivalent_psmetric in |- *. + split. + split. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold equivalent_psmetric in H01. + elim H01. + intros H010 H011. + elim H010. + intros H0100 H0101. + elim H11. + intros H110 H111. + elim H110. + intros H1100 H1101. + apply Build_is_CPsMetricSpace. + unfold com in |- *. + simpl in |- *. + intros x y. + elim H1101. + intros. + generalize ax_d_com. + unfold com in |- *. + simpl in |- *. + intro H2. + apply H2. + unfold nneg in |- *. + intros x y. + simpl in |- *. + elim H1101. + intros. + generalize ax_d_nneg. + unfold nneg in |- *. + simpl in |- *. + intro H2. + apply H2. + elim H1101. + intros. + generalize ax_d_pos_imp_ap. + unfold pos_imp_ap in |- *. + simpl in |- *. + intros H2 x y H3. + set (H5 := csf_strext X Y f) in *. + generalize H5. + unfold fun_strext in |- *. + intro H6. + apply H6. + auto. + unfold tri_ineq in |- *. + simpl in |- *. + intros x y z. + elim H1101. + intros. + generalize ax_d_tri_ineq. + unfold tri_ineq in |- *. + simpl in |- *. + intro H2. + apply H2. + split. + unfold equivalent_psmetric in H01. + elim H01. + intros H010 H011. + elim H011. + intros H0110 H0111. + unfold equivalent_psmetric in H11. + elim H11. + intros H110 H111. + elim H111. + intros H1110 H1111. + elim H0110. + simpl in |- *. + intros n H0110'. + elim H1110. + simpl in |- *. + intros m H1110'. + exists (S m * S n). + intros x y. + apply leEq_transitive with ((nring n[+]One)[*](f x[-d]f y)). + apply H0110'. + apply leEq_transitive with ((nring n[+]One)[*](nring m[+]One)[*](g (f x)[-d]g (f y))). + astepr ((nring n[+]One)[*]((nring m[+]One)[*](g (f x)[-d]g (f y)))). + apply mult_resp_leEq_lft. + apply H1110'. + apply less_leEq. + astepr (nring (R:=IR) (S n)). + apply pos_nring_S. + apply mult_resp_leEq_rht. + apply leEq_transitive with (nring (R:=IR) (S m * S n)). + apply eq_imp_leEq. + astepl (nring (R:=IR) (S n)[*](nring m[+]One)). + astepl (nring (R:=IR) (S n)[*]nring (S m)). + astepl (nring (R:=IR) (S m)[*]nring (S n)). + astepl (nring (R:=IR) (S m * S n)). + apply eq_reflexive. + astepr (nring (R:=IR) (S (S m * S n))). + apply less_leEq. + apply nring_less_succ. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold equivalent_psmetric in H01. + elim H01. + intros H010 H011. + elim H011. + intros H0110 H0111. + unfold equivalent_psmetric in H11. + elim H11. + intros H110 H111. + elim H111. + intros H1110 H1111. + elim H0111. + simpl in |- *. + intros n H0111'. + elim H1111. + simpl in |- *. + intros m H1111'. + exists (S m * S n). + intros x y. + apply leEq_transitive with (nring (R:=IR) (S m)[*](f x[-d]f y)). + apply H1111'. + apply leEq_transitive with (nring (S m)[*]nring (S n)[*](x[-d]y)). + astepr (nring (S m)[*](nring (S n)[*](x[-d]y))). + apply mult_resp_leEq_lft. + apply H0111'. + apply less_leEq. + apply pos_nring_S. + apply mult_resp_leEq_rht. + apply leEq_transitive with (nring (R:=IR) (S m * S n)). + apply eq_imp_leEq. + astepl (nring (R:=IR) (S m * S n)). + apply eq_reflexive. + astepr (nring (R:=IR) (S (S m * S n))). + apply less_leEq. + apply nring_less_succ. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Lemma inv_isopsmetry : forall (X Y : CPsMetricSpace) (f : CSetoid_fun X Y) (H : isopsmetry f), isopsmetry (Inv f (isopsmetry_imp_bij X Y f H)). -intros X Y f H. -unfold isopsmetry in |- *. -split. -apply Inv_bij. -unfold isopsmetry in H. -unfold equivalent_psmetric in H. -elim H. -intros. -elim b. -intros. -elim a0. -intros. -elim b0. -intros. -unfold equivalent_psmetric in |- *. -split. -split. -apply CPsMetricSpace_is_CPsMetricSpace. -apply Build_is_CPsMetricSpace. -unfold com in |- *. -intros x y. -unfold Inv in |- *. -simpl in |- *. -apply ax_d_com. -exact a1. - -unfold nneg in |- *. -intros x y. -unfold Inv in |- *. -simpl in |- *. -apply ax_d_nneg. -exact a1. - -unfold pos_imp_ap in |- *. -intros x y. -unfold Inv in |- *. -simpl in |- *. -intro H7. -set (H6 := inv_strext) in *. -set - (H5 := - H6 X Y f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ a - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 b2))))) - in *. -generalize H5. -unfold fun_strext in |- *. -intros H4. -apply H4. -set (H8 := ax_d_pos_imp_ap) in *. -set (H9 := H8 X (cms_d (c:=X)) a1) in *. -generalize H9. -unfold pos_imp_ap in |- *. -intro H10. -apply H10. -apply H7. - -unfold tri_ineq in |- *. -unfold Inv in |- *. -simpl in |- *. -set (H3 := ax_d_tri_ineq) in *. -set (H4 := H3 X (cms_d (c:=X)) a1) in *. -generalize H4. -unfold tri_ineq in |- *. -intro H5. -intros x y z. -apply H5. - -split. -elim b2. -simpl in |- *. -intros m P. -exists m. -intros y0 y1. -elim a. -intros. -unfold surjective in b3. -elim (b3 y0). -intros x0 b4. -elim (b3 y1). -intros x1 b5. -astepl (f x0[-d]y1). -astepl (f x0[-d]f x1). -apply leEq_transitive with (nring (S m)[*](x0[-d]x1)). -simpl in |- *. -apply P. -simpl in |- *. -apply eq_imp_leEq. -apply mult_wdr. -set (H4 := csbf_wd) in *. -set (H5 := H4 X X IR (cms_d (c:=X))) in *. -generalize H5. -unfold bin_fun_wd in |- *. -intro H6. -apply H6. -cut - (invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ a2 - (existT - (fun n : nat => - forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) - m P))))) (f x0)[=] - invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ a2 - (existT - (fun n : nat => - forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) - m P))))) y0). -intros. -astepr - (invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ a2 - (existT - (fun n : nat => - forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) - m P))))) (f x0)). -apply eq_symmetric. -apply inv2. -set (H10 := csf_wd) in *. -set - (H7 := - H10 Y X - (Inv f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ a2 - (existT - (fun n : nat => - forall x y : X, - f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))))) - in *. -generalize H7. -unfold fun_wd in |- *. -unfold Inv in |- *. -simpl in |- *. -intro H8. -apply H8. -exact b4. - -cut - (invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ a2 - (existT - (fun n : nat => - forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) - m P))))) (f x1)[=] - invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ a2 - (existT - (fun n : nat => - forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) - m P))))) y1). -intros. -astepr - (invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ a2 - (existT - (fun n : nat => - forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) - m P))))) (f x1)). -apply eq_symmetric. -apply inv2. -set (H10 := csf_wd) in *. -set - (H7 := - H10 Y X - (Inv f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ a2 - (existT - (fun n : nat => - forall x y : X, - f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))))) - in *. -generalize H7. -unfold fun_wd in |- *. -unfold Inv in |- *. -simpl in |- *. -intro H8. -apply H8. -exact b5. - -elim a2. -simpl in |- *. -intros m P. -exists m. -intros y0 y1. -elim a. -intros. -unfold surjective in b3. -elim (b3 y0). -intros x0 b4. -elim (b3 y1). -intros x1 b5. -astepr ((nring m[+]One)[*](f x0[-d]f x1)). -apply leEq_transitive with (x0[-d]x1). -2: apply P. -apply eq_imp_leEq. -set (H4 := csbf_wd) in *. -set (H5 := H4 X X IR (cms_d (c:=X))) in *. -generalize H5. -unfold bin_fun_wd in |- *. -intro H6. -apply H6. -cut - (invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ - (existT - (fun n : nat => - forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) - m P) b2)))) y0[=] - invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ - (existT - (fun n : nat => - forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) - m P) b2)))) (f x0)). -intros. -astepl - (invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ - (existT - (fun n : nat => - forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) - m P) b2)))) (f x0)). -apply inv2. -set (H10 := csf_wd) in *. -set - (H7 := - H10 Y X - (Inv f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ - (existT - (fun n : nat => - forall x y : X, - x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))))) - in *. -generalize H7. -unfold fun_wd in |- *. -unfold Inv in |- *. -simpl in |- *. -intro H8. -apply H8. -apply eq_symmetric. -exact b4. - -cut - (invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ - (existT - (fun n : nat => - forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) - m P) b2)))) y1[=] - invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ - (existT - (fun n : nat => - forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) - m P) b2)))) (f x1)). -intros. -astepl - (invfun f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ - (existT - (fun n : nat => - forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) - m P) b2)))) (f x1)). -apply inv2. -set (H10 := csf_wd) in *. -set - (H7 := - H10 Y X - (Inv f - (isopsmetry_imp_bij X Y f - (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) - (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) - (CAnd_intro _ _ - (existT - (fun n : nat => - forall x y : X, - x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))))) - in *. -generalize H7. -unfold fun_wd in |- *. -unfold Inv in |- *. -simpl in |- *. -intro H8. -apply H8. -apply eq_symmetric. -exact b5. +Proof. + intros X Y f H. + unfold isopsmetry in |- *. + split. + apply Inv_bij. + unfold isopsmetry in H. + unfold equivalent_psmetric in H. + elim H. + intros. + elim b. + intros. + elim a0. + intros. + elim b0. + intros. + unfold equivalent_psmetric in |- *. + split. + split. + apply CPsMetricSpace_is_CPsMetricSpace. + apply Build_is_CPsMetricSpace. + unfold com in |- *. + intros x y. + unfold Inv in |- *. + simpl in |- *. + apply ax_d_com. + exact a1. + unfold nneg in |- *. + intros x y. + unfold Inv in |- *. + simpl in |- *. + apply ax_d_nneg. + exact a1. + unfold pos_imp_ap in |- *. + intros x y. + unfold Inv in |- *. + simpl in |- *. + intro H7. + set (H6 := inv_strext) in *. + set (H5 := H6 X Y f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ a + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 b2))))) in *. + generalize H5. + unfold fun_strext in |- *. + intros H4. + apply H4. + set (H8 := ax_d_pos_imp_ap) in *. + set (H9 := H8 X (cms_d (c:=X)) a1) in *. + generalize H9. + unfold pos_imp_ap in |- *. + intro H10. + apply H10. + apply H7. + unfold tri_ineq in |- *. + unfold Inv in |- *. + simpl in |- *. + set (H3 := ax_d_tri_ineq) in *. + set (H4 := H3 X (cms_d (c:=X)) a1) in *. + generalize H4. + unfold tri_ineq in |- *. + intro H5. + intros x y z. + apply H5. + split. + elim b2. + simpl in |- *. + intros m P. + exists m. + intros y0 y1. + elim a. + intros. + unfold surjective in b3. + elim (b3 y0). + intros x0 b4. + elim (b3 y1). + intros x1 b5. + astepl (f x0[-d]y1). + astepl (f x0[-d]f x1). + apply leEq_transitive with (nring (S m)[*](x0[-d]x1)). + simpl in |- *. + apply P. + simpl in |- *. + apply eq_imp_leEq. + apply mult_wdr. + set (H4 := csbf_wd) in *. + set (H5 := H4 X X IR (cms_d (c:=X))) in *. + generalize H5. + unfold bin_fun_wd in |- *. + intro H6. + apply H6. + cut (invfun f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 (existT (fun n : nat => + forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))) (f x0)[=] invfun f + (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 (existT (fun n : nat => + forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))) y0). + intros. + astepr (invfun f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 (existT (fun n : nat => + forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))) (f x0)). + apply eq_symmetric. + apply inv2. + set (H10 := csf_wd) in *. + set (H7 := H10 Y X (Inv f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 (existT (fun n : nat => forall x y : X, + f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))))) in *. + generalize H7. + unfold fun_wd in |- *. + unfold Inv in |- *. + simpl in |- *. + intro H8. + apply H8. + exact b4. + cut (invfun f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 (existT (fun n : nat => + forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))) (f x1)[=] invfun f + (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 (existT (fun n : nat => + forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))) y1). + intros. + astepr (invfun f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 (existT (fun n : nat => + forall x y : X, f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))) (f x1)). + apply eq_symmetric. + apply inv2. + set (H10 := csf_wd) in *. + set (H7 := H10 Y X (Inv f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ a2 (existT (fun n : nat => forall x y : X, + f x[-d]f y[<=](nring n[+]One)[*](x[-d]y)) m P))))))) in *. + generalize H7. + unfold fun_wd in |- *. + unfold Inv in |- *. + simpl in |- *. + intro H8. + apply H8. + exact b5. + elim a2. + simpl in |- *. + intros m P. + exists m. + intros y0 y1. + elim a. + intros. + unfold surjective in b3. + elim (b3 y0). + intros x0 b4. + elim (b3 y1). + intros x1 b5. + astepr ((nring m[+]One)[*](f x0[-d]f x1)). + apply leEq_transitive with (x0[-d]x1). + 2: apply P. + apply eq_imp_leEq. + set (H4 := csbf_wd) in *. + set (H5 := H4 X X IR (cms_d (c:=X))) in *. + generalize H5. + unfold bin_fun_wd in |- *. + intro H6. + apply H6. + cut (invfun f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ (existT (fun n : nat => + forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))) y0[=] invfun f + (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ (existT (fun n : nat => + forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))) (f x0)). + intros. + astepl (invfun f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ (existT (fun n : nat => + forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))) (f x0)). + apply inv2. + set (H10 := csf_wd) in *. + set (H7 := H10 Y X (Inv f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ (existT (fun n : nat => forall x y : X, + x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))))) in *. + generalize H7. + unfold fun_wd in |- *. + unfold Inv in |- *. + simpl in |- *. + intro H8. + apply H8. + apply eq_symmetric. + exact b4. + cut (invfun f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ (existT (fun n : nat => + forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))) y1[=] invfun f + (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ (existT (fun n : nat => + forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))) (f x1)). + intros. + astepl (invfun f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ (existT (fun n : nat => + forall x y : X, x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))) (f x1)). + apply inv2. + set (H10 := csf_wd) in *. + set (H7 := H10 Y X (Inv f (isopsmetry_imp_bij X Y f (CAnd_intro _ _ (CAnd_intro _ _ a3 b3) + (CAnd_intro _ _ (CAnd_intro _ _ a1 b1) (CAnd_intro _ _ (existT (fun n : nat => forall x y : X, + x[-d]y[<=](nring n[+]One)[*](f x[-d]f y)) m P) b2)))))) in *. + generalize H7. + unfold fun_wd in |- *. + unfold Inv in |- *. + simpl in |- *. + intro H8. + apply H8. + apply eq_symmetric. + exact b5. Qed. Definition MSequivalent (X Y : CPsMetricSpace) := @@ -638,47 +502,45 @@ Not all pseudo metric spaces are equivalent: Lemma MSequivalent_discr : Not (MSequivalent IR_as_CPsMetricSpace (zf_as_CPsMetricSpace IR)). -red in |- *. -unfold MSequivalent in |- *. -unfold isopsmetry in |- *. -unfold equivalent_psmetric in |- *. -intros H0. -elim H0. -intros f H0'. -elim H0'. -intros H1 H2. -elim H2. -intros H3 H4. -elim H4. -intros H5 H6. -elim H5. -intros n. -simpl in |- *. -unfold zero_fun in |- *. -unfold dIR in |- *. -intro H7. -cut (OneR[<=]Zero). -rewrite leEq_def in |- *. -intro H8. -set (H9 := H8 (pos_one IR)) in *. -exact H9. - -astepr ((nring (R:=IR) n[+]One)[*]Zero). -astepl (ABSIR (One[-]Zero)). -apply H7. - -unfold ABSIR in |- *. -astepl (Max [--](One[-]Zero) (One[-]Zero)). -astepl (Max [--](One[-]Zero) One). -apply leEq_imp_Max_is_rht. -astepl ([--]OneR). -astepl (ZeroR[-]One). -apply shift_minus_leEq. -astepr (Two:IR). -apply less_leEq. -apply pos_two. - -apply Max_comm. +Proof. + red in |- *. + unfold MSequivalent in |- *. + unfold isopsmetry in |- *. + unfold equivalent_psmetric in |- *. + intros H0. + elim H0. + intros f H0'. + elim H0'. + intros H1 H2. + elim H2. + intros H3 H4. + elim H4. + intros H5 H6. + elim H5. + intros n. + simpl in |- *. + unfold zero_fun in |- *. + unfold dIR in |- *. + intro H7. + cut (OneR[<=]Zero). + rewrite leEq_def in |- *. + intro H8. + set (H9 := H8 (pos_one IR)) in *. + exact H9. + astepr ((nring (R:=IR) n[+]One)[*]Zero). + astepl (ABSIR (One[-]Zero)). + apply H7. + unfold ABSIR in |- *. + astepl (Max [--](One[-]Zero) (One[-]Zero)). + astepl (Max [--](One[-]Zero) One). + apply leEq_imp_Max_is_rht. + astepl ([--]OneR). + astepl (ZeroR[-]One). + apply shift_minus_leEq. + astepr (Two:IR). + apply less_leEq. + apply pos_two. + apply Max_comm. Qed. diff --git a/metrics/IR_CPMSpace.v b/metrics/IR_CPMSpace.v index 6196b2b5b..eadc83401 100644 --- a/metrics/IR_CPMSpace.v +++ b/metrics/IR_CPMSpace.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export ContFunctions. @@ -40,146 +40,135 @@ Section Reals. (** ** Real numbers *) -(** +(** %\begin{convention}% Let [X] be a pseudo metric space. %\end{convention}% *) (** -The real numbers with the usual distance form a pseudo metric space. +The real numbers with the usual distance form a pseudo metric space. *) Definition dIR (x y : IR) : IR := ABSIR (x[-]y). Lemma bin_fun_strext_dIR : bin_fun_strext IR IR IR dIR. -unfold bin_fun_strext in |- *. -unfold dIR in |- *. -intros. -apply cg_minus_strext. -apply un_op_strext_unfolded with AbsIR. -auto. +Proof. + unfold bin_fun_strext in |- *. + unfold dIR in |- *. + intros. + apply cg_minus_strext. + apply un_op_strext_unfolded with AbsIR. + auto. Qed. Definition dIR_as_CSetoid_fun := Build_CSetoid_bin_fun IR IR IR dIR bin_fun_strext_dIR. Lemma dIR_nneg : forall x y : IR, Zero[<=]dIR_as_CSetoid_fun x y. -unfold dIR_as_CSetoid_fun in |- *. -unfold dIR in |- *. -simpl in |- *. -intros. -apply AbsIR_nonneg. +Proof. + unfold dIR_as_CSetoid_fun in |- *. + unfold dIR in |- *. + simpl in |- *. + intros. + apply AbsIR_nonneg. Qed. Lemma dIR_com : forall x y : IR, dIR_as_CSetoid_fun x y[=]dIR_as_CSetoid_fun y x. -unfold dIR_as_CSetoid_fun in |- *. -unfold dIR in |- *. -simpl in |- *. -exact AbsIR_minus. +Proof. + unfold dIR_as_CSetoid_fun in |- *. + unfold dIR in |- *. + simpl in |- *. + exact AbsIR_minus. Qed. Lemma dIR_pos_imp_ap : forall x y : IR, Zero[<]dIR_as_CSetoid_fun x y -> x[#]y. -unfold dIR_as_CSetoid_fun in |- *. -simpl in |- *. -intros x y H. -cut (x[#]x or y[#]x). -intro H0. -apply ap_symmetric_unfolded. -elim H0. -intro H1. -cut False. -intuition. - -cut (Not (x[#]x)). -intro H2. -exact (H2 H1). - -apply ap_irreflexive_unfolded. - -intro H1. -exact H1. - -apply bin_fun_strext_dIR. -astepr ZeroR. -apply ap_symmetric_unfolded. -apply less_imp_ap. -exact H. - -unfold dIR in |- *. -astepr (ABSIR ZeroR). -apply eq_symmetric_unfolded. -apply AbsIRz_isz. - -apply AbsIR_wd. -apply eq_symmetric_unfolded. -apply cg_minus_correct. +Proof. + unfold dIR_as_CSetoid_fun in |- *. + simpl in |- *. + intros x y H. + cut (x[#]x or y[#]x). + intro H0. + apply ap_symmetric_unfolded. + elim H0. + intro H1. + cut False. + intuition. + cut (Not (x[#]x)). + intro H2. + exact (H2 H1). + apply ap_irreflexive_unfolded. + intro H1. + exact H1. + apply bin_fun_strext_dIR. + astepr ZeroR. + apply ap_symmetric_unfolded. + apply less_imp_ap. + exact H. + unfold dIR in |- *. + astepr (ABSIR ZeroR). + apply eq_symmetric_unfolded. + apply AbsIRz_isz. + apply AbsIR_wd. + apply eq_symmetric_unfolded. + apply cg_minus_correct. Qed. (* begin hide *) Lemma IR_tri_ineq : forall a b : IR, AbsIR (a[+]b)[<=]AbsIR a[+]AbsIR b. -intros a b. -astepr (AbsIR (AbsIR a[+]AbsIR b)). -apply AbsSmall_imp_AbsIR. -unfold AbsSmall in |- *. -split. -apply inv_cancel_leEq. -astepr (AbsIR (AbsIR a[+]AbsIR b)). -astepl ([--]a[+][--]b). -astepr (AbsIR a[+]AbsIR b). -apply plus_resp_leEq_both. -apply inv_leEq_AbsIR. - -apply inv_leEq_AbsIR. - -apply eq_symmetric_unfolded. -apply AbsIR_eq_x. -astepl (ZeroR[+]ZeroR). -apply plus_resp_leEq_both. -apply AbsIR_nonneg. - -apply AbsIR_nonneg. - -astepr (AbsIR a[+]AbsIR b). -apply plus_resp_leEq_both. -apply leEq_AbsIR. - -apply leEq_AbsIR. - -apply eq_symmetric_unfolded. -apply AbsIR_eq_x. -astepl (ZeroR[+]ZeroR). -apply plus_resp_leEq_both. -apply AbsIR_nonneg. - -apply AbsIR_nonneg. - -apply AbsIR_eq_x. -astepl (ZeroR[+]ZeroR). -apply plus_resp_leEq_both. -apply AbsIR_nonneg. - -apply AbsIR_nonneg. +Proof. + intros a b. + astepr (AbsIR (AbsIR a[+]AbsIR b)). + apply AbsSmall_imp_AbsIR. + unfold AbsSmall in |- *. + split. + apply inv_cancel_leEq. + astepr (AbsIR (AbsIR a[+]AbsIR b)). + astepl ([--]a[+][--]b). + astepr (AbsIR a[+]AbsIR b). + apply plus_resp_leEq_both. + apply inv_leEq_AbsIR. + apply inv_leEq_AbsIR. + apply eq_symmetric_unfolded. + apply AbsIR_eq_x. + astepl (ZeroR[+]ZeroR). + apply plus_resp_leEq_both. + apply AbsIR_nonneg. + apply AbsIR_nonneg. + astepr (AbsIR a[+]AbsIR b). + apply plus_resp_leEq_both. + apply leEq_AbsIR. + apply leEq_AbsIR. + apply eq_symmetric_unfolded. + apply AbsIR_eq_x. + astepl (ZeroR[+]ZeroR). + apply plus_resp_leEq_both. + apply AbsIR_nonneg. + apply AbsIR_nonneg. + apply AbsIR_eq_x. + astepl (ZeroR[+]ZeroR). + apply plus_resp_leEq_both. + apply AbsIR_nonneg. + apply AbsIR_nonneg. Qed. (* end hide *) Lemma dIR_tri_ineq : tri_ineq dIR_as_CSetoid_fun. -unfold tri_ineq in |- *. -intros x y z. -unfold dIR_as_CSetoid_fun in |- *. -unfold dIR in |- *. -simpl in |- *. -astepl (ABSIR (x[+]([--]y[+]y)[-]z)). -astepl (ABSIR (x[+][--]y[+](y[-]z))). -astepl (ABSIR (x[-]y[+](y[-]z))). -apply IR_tri_ineq. - -apply AbsIR_wd. -rational. - -apply AbsIR_wd. -rational. +Proof. + unfold tri_ineq in |- *. + intros x y z. + unfold dIR_as_CSetoid_fun in |- *. + unfold dIR in |- *. + simpl in |- *. + astepl (ABSIR (x[+]([--]y[+]y)[-]z)). + astepl (ABSIR (x[+][--]y[+](y[-]z))). + astepl (ABSIR (x[-]y[+](y[-]z))). + apply IR_tri_ineq. + apply AbsIR_wd. + rational. + apply AbsIR_wd. + rational. Qed. Definition IR_dIR_is_CPsMetricSpace := @@ -195,11 +184,12 @@ Variable X : CPsMetricSpace. Lemma rev_tri_ineq' : forall a b c : X, cms_d (c:=IR_as_CPsMetricSpace) (a[-d]b) (a[-d]c)[<=]b[-d]c. -simpl in |- *. -unfold dIR in |- *. -intros a b c. -apply AbsSmall_imp_AbsIR. -apply rev_tri_ineq. +Proof. + simpl in |- *. + unfold dIR in |- *. + intros a b c. + apply AbsSmall_imp_AbsIR. + apply rev_tri_ineq. Qed. (** @@ -209,30 +199,33 @@ A pseudo metric is Lipschitz. Hence it is uniformly continuous and continuous. Lemma d_is_lipschitz : forall a : X, lipschitz (projected_bin_fun X X IR_as_CPsMetricSpace (cms_d (c:=X)) a). -intro a. -red in |- *. -simpl in |- *. -exists 0. -intros x y. -astepr (OneR[*](x[-d]y)). -astepr (x[-d]y). -apply rev_tri_ineq'. +Proof. + intro a. + red in |- *. + simpl in |- *. + exists 0. + intros x y. + astepr (OneR[*](x[-d]y)). + astepr (x[-d]y). + apply rev_tri_ineq'. Qed. Lemma d_is_uni_continuous : forall a : X, uni_continuous (projected_bin_fun X X IR_as_CPsMetricSpace (cms_d (c:=X)) a). -intro a. -apply lipschitz_imp_uni_continuous. -apply d_is_lipschitz. +Proof. + intro a. + apply lipschitz_imp_uni_continuous. + apply d_is_lipschitz. Qed. Lemma d_is_continuous : forall a : X, continuous (projected_bin_fun X X IR_as_CPsMetricSpace (cms_d (c:=X)) a). -intro a. -apply uni_continuous_imp_continuous. -apply d_is_uni_continuous. +Proof. + intro a. + apply uni_continuous_imp_continuous. + apply d_is_uni_continuous. Qed. End Reals. @@ -243,83 +236,68 @@ Section Addition. *) (** -The sum of two Lipschitz/uniformly continous/continuous functions is again +The sum of two Lipschitz/uniformly continous/continuous functions is again Lipschitz/uniformly continuous/continuous. *) - + Lemma plus_resp_lipschitz : forall (X : CPsMetricSpace) (f g : CSetoid_fun X IR_as_CPsMetricSpace) (H : lipschitz f) (H1 : lipschitz g), lipschitz (compose_CSetoid_bin_fun X IR_as_CPsMetricSpace IR_as_CPsMetricSpace f g (csg_op (c:=IR))). -red in |- *. -unfold lipschitz in |- *. -intros X f g H H1. -elim H. -intros x H2. -elim H1. -intros x0 H3. -exists (max x x0 + 1). -intros x1 y. -astepl (dIR (f x1[+]g x1) (f y[+]g y)). -unfold dIR in |- *. -unfold dIR in |- *. -astepl (ABSIR (g x1[-]g y[+](f x1[-]f y))). -apply leEq_transitive with (ABSIR (g x1[-]g y)[+]ABSIR (f x1[-]f y)). -apply IR_tri_ineq. -apply leEq_transitive with ((Two:IR)[^]x0[*](x1[-d]y)[+]ABSIR (f x1[-]f y)). -apply plus_resp_leEq. -astepl (g x1[-d]g y). -apply H3. -apply leEq_transitive with (Two[^]x0[*](x1[-d]y)[+]Two[^]x[*](x1[-d]y)). -apply plus_resp_leEq_lft. -astepl (f x1[-d]f y). -apply H2. -astepr ((Two:IR)[*]Two[^]max x x0[*](x1[-d]y)). -apply - leEq_transitive - with (Two[^]max x x0[*](x1[-d]y)[+]Two[^]max x x0[*](x1[-d]y)). -apply plus_resp_leEq_both. -apply mult_resp_leEq_rht. -apply great_nexp_resp_le. -apply less_leEq. -apply one_less_two. - -intuition. - -apply ax_d_nneg. - -apply CPsMetricSpace_is_CPsMetricSpace. - -apply mult_resp_leEq_rht. - -apply great_nexp_resp_le. -apply less_leEq. -apply one_less_two. - -intuition. - -apply ax_d_nneg. - -apply CPsMetricSpace_is_CPsMetricSpace. - -apply eq_imp_leEq. -rational. - -astepl (Two[^]1[*]Two[^]max x x0[*](x1[-d]y)). - -2: apply AbsIR_wd. - -apply mult_wdl. -astepl ((Two:IR)[^](max x x0 + 1)). -2: astepl ((Two:IR)[^]max x x0[*]Two[^]1). -2: apply mult_commutes. - -astepr ((Two:IR)[^](max x x0 + 1)). -rational. - -rational. +Proof. + red in |- *. + unfold lipschitz in |- *. + intros X f g H H1. + elim H. + intros x H2. + elim H1. + intros x0 H3. + exists (max x x0 + 1). + intros x1 y. + astepl (dIR (f x1[+]g x1) (f y[+]g y)). + unfold dIR in |- *. + unfold dIR in |- *. + astepl (ABSIR (g x1[-]g y[+](f x1[-]f y))). + apply leEq_transitive with (ABSIR (g x1[-]g y)[+]ABSIR (f x1[-]f y)). + apply IR_tri_ineq. + apply leEq_transitive with ((Two:IR)[^]x0[*](x1[-d]y)[+]ABSIR (f x1[-]f y)). + apply plus_resp_leEq. + astepl (g x1[-d]g y). + apply H3. + apply leEq_transitive with (Two[^]x0[*](x1[-d]y)[+]Two[^]x[*](x1[-d]y)). + apply plus_resp_leEq_lft. + astepl (f x1[-d]f y). + apply H2. + astepr ((Two:IR)[*]Two[^]max x x0[*](x1[-d]y)). + apply leEq_transitive with (Two[^]max x x0[*](x1[-d]y)[+]Two[^]max x x0[*](x1[-d]y)). + apply plus_resp_leEq_both. + apply mult_resp_leEq_rht. + apply great_nexp_resp_le. + apply less_leEq. + apply one_less_two. + intuition. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + apply mult_resp_leEq_rht. + apply great_nexp_resp_le. + apply less_leEq. + apply one_less_two. + intuition. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + apply eq_imp_leEq. + rational. + astepl (Two[^]1[*]Two[^]max x x0[*](x1[-d]y)). + 2: apply AbsIR_wd. + apply mult_wdl. + astepl ((Two:IR)[^](max x x0 + 1)). + 2: astepl ((Two:IR)[^]max x x0[*]Two[^]1). + 2: apply mult_commutes. + astepr ((Two:IR)[^](max x x0 + 1)). + rational. + rational. Qed. @@ -330,119 +308,93 @@ Lemma plus_resp_uni_continuous : uni_continuous (compose_CSetoid_bin_fun X IR_as_CPsMetricSpace IR_as_CPsMetricSpace f g (csg_op (c:=IR))). -unfold uni_continuous in |- *. -unfold IR_as_CPsMetricSpace in |- *. -unfold dIR_as_CSetoid_fun in |- *. -unfold dIR in |- *. -intros X f g H H0. -intros n H1. -elim (H (S n) H1). -intros x H2. -elim (H0 (S n) H1). -intros x0 H3. -exists (max x x0). -intros x1 y H6. -astepl (ABSIR (f x1[-]f y[+](g x1[-]g y))). -apply leEq_less_trans with (ABSIR (f x1[-]f y)[+]ABSIR (g x1[-]g y)). -apply IR_tri_ineq. - -apply - less_leEq_trans with ((OneR[/] Two:IR[//]H1)[^]S n[+]ABSIR (g x1[-]g y)). -apply plus_resp_less_rht. -generalize H2. -simpl in |- *. -intro H7. -apply H7. -generalize H6. -intro H8. -apply - less_leEq_trans with (nexp IR (max x x0) (One[/] Zero[+]One[+]One[//]H1)). -apply H8. - -3: simpl in |- *. -astepl (nexp IR (max x x0) (One[/] Two:IR[//]H1)). -astepr (nexp IR x (One[/] Two:IR[//]H1)). -astepl ((OneR[/] Two:IR[//]H1)[^]max x x0). -astepr ((OneR[/] Two:IR[//]H1)[^]x). -apply small_nexp_resp_le. -apply shift_leEq_div. -apply pos_two. - -astepl ZeroR. -apply less_leEq. -apply pos_one. - -apply shift_div_leEq. -apply pos_two. - -astepr (Two:IR). -apply less_leEq. -apply one_less_two. - -intuition. - -apply - leEq_transitive - with ((OneR[/] Two:IR[//]H1)[^]S n[+](One[/] Two:IR[//]H1)[^]S n). -apply plus_resp_leEq_lft. -apply less_leEq. -generalize H3. -simpl in |- *. -intro H7. -apply H7. -apply less_leEq_trans with (nexp IR (max x x0) (One[/] Two:IR[//]H1)). -exact H6. - -astepr (nexp IR x0 (One[/] Two:IR[//]H1)). -astepl ((OneR[/] Two:IR[//]H1)[^]max x x0). -astepr ((OneR[/] Two:IR[//]H1)[^]x0). -apply small_nexp_resp_le. -apply shift_leEq_div. -apply pos_two. - -astepl ZeroR. -apply less_leEq. -apply pos_one. - -apply shift_div_leEq. -apply pos_two. - -astepr (Two:IR). -apply less_leEq. -apply one_less_two. - -intuition. -apply eq_imp_leEq. -astepl ((Two:IR)[*](One[/] Two:IR[//]H1)[^]S n). -astepl - ((Two:IR)[*](One[^]S n[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1)). -astepl ((Two:IR)[*](One[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1)). -astepl - ((Two:IR)[*] - ((One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*](One[/] Two:IR[//]H1))). -2: apply mult_wdr. -2: astepl ((One[/] Two:IR[//]H1)[^]S n). -3: astepl ((One[/] Two:IR[//]H1)[^]n[*](One[/] Two:IR[//]H1)). - -rstepl - ((One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*]Two[*] - (One[/] Two:IR[//]H1)). -astepl - ((One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*] - (Two[*](One[/] Two:IR[//]H1))). -rstepl ((One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*]One). -rstepl (One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1). -astepl ((OneR[/] Two:IR[//]H1)[^]n). -apply eq_reflexive. - -3: apply AbsIR_wd. -3: rational. - -astepr ((OneR[/] Two:IR[//]H1)[^]S n). -apply eq_reflexive. - -astepr ((One[/] Two:IR[//]H1)[^]n[*](One[/] Two:IR[//]H1)). -apply eq_reflexive. +Proof. + unfold uni_continuous in |- *. + unfold IR_as_CPsMetricSpace in |- *. + unfold dIR_as_CSetoid_fun in |- *. + unfold dIR in |- *. + intros X f g H H0. + intros n H1. + elim (H (S n) H1). + intros x H2. + elim (H0 (S n) H1). + intros x0 H3. + exists (max x x0). + intros x1 y H6. + astepl (ABSIR (f x1[-]f y[+](g x1[-]g y))). + apply leEq_less_trans with (ABSIR (f x1[-]f y)[+]ABSIR (g x1[-]g y)). + apply IR_tri_ineq. + apply less_leEq_trans with ((OneR[/] Two:IR[//]H1)[^]S n[+]ABSIR (g x1[-]g y)). + apply plus_resp_less_rht. + generalize H2. + simpl in |- *. + intro H7. + apply H7. + generalize H6. + intro H8. + apply less_leEq_trans with (nexp IR (max x x0) (One[/] Zero[+]One[+]One[//]H1)). + apply H8. + 3: simpl in |- *. + astepl (nexp IR (max x x0) (One[/] Two:IR[//]H1)). + astepr (nexp IR x (One[/] Two:IR[//]H1)). + astepl ((OneR[/] Two:IR[//]H1)[^]max x x0). + astepr ((OneR[/] Two:IR[//]H1)[^]x). + apply small_nexp_resp_le. + apply shift_leEq_div. + apply pos_two. + astepl ZeroR. + apply less_leEq. + apply pos_one. + apply shift_div_leEq. + apply pos_two. + astepr (Two:IR). + apply less_leEq. + apply one_less_two. + intuition. + apply leEq_transitive with ((OneR[/] Two:IR[//]H1)[^]S n[+](One[/] Two:IR[//]H1)[^]S n). + apply plus_resp_leEq_lft. + apply less_leEq. + generalize H3. + simpl in |- *. + intro H7. + apply H7. + apply less_leEq_trans with (nexp IR (max x x0) (One[/] Two:IR[//]H1)). + exact H6. + astepr (nexp IR x0 (One[/] Two:IR[//]H1)). + astepl ((OneR[/] Two:IR[//]H1)[^]max x x0). + astepr ((OneR[/] Two:IR[//]H1)[^]x0). + apply small_nexp_resp_le. + apply shift_leEq_div. + apply pos_two. + astepl ZeroR. + apply less_leEq. + apply pos_one. + apply shift_div_leEq. + apply pos_two. + astepr (Two:IR). + apply less_leEq. + apply one_less_two. + intuition. + apply eq_imp_leEq. + astepl ((Two:IR)[*](One[/] Two:IR[//]H1)[^]S n). + astepl ((Two:IR)[*](One[^]S n[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1)). + astepl ((Two:IR)[*](One[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1)). + astepl ((Two:IR)[*] ((One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*](One[/] Two:IR[//]H1))). + 2: apply mult_wdr. + 2: astepl ((One[/] Two:IR[//]H1)[^]S n). + 3: astepl ((One[/] Two:IR[//]H1)[^]n[*](One[/] Two:IR[//]H1)). + rstepl ((One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*]Two[*] (One[/] Two:IR[//]H1)). + astepl ((One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*] (Two[*](One[/] Two:IR[//]H1))). + rstepl ((One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*]One). + rstepl (One[/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1). + astepl ((OneR[/] Two:IR[//]H1)[^]n). + apply eq_reflexive. + 3: apply AbsIR_wd. + 3: rational. + astepr ((OneR[/] Two:IR[//]H1)[^]S n). + apply eq_reflexive. + astepr ((One[/] Two:IR[//]H1)[^]n[*](One[/] Two:IR[//]H1)). + apply eq_reflexive. Qed. @@ -452,126 +404,94 @@ Lemma plus_resp_continuous : continuous (compose_CSetoid_bin_fun X IR_as_CPsMetricSpace IR_as_CPsMetricSpace f g (csg_op (c:=IR))). -unfold continuous in |- *. -simpl in |- *. -unfold dIR in |- *. -intros X f g H H0. -intros x n H1. -simpl in |- *. -elim (H x (S n) H1). -intros xn H2. -elim (H0 x (S n) H1). -intros x0 H3. -exists (max xn x0). -intros y H6. -astepl (ABSIR (f x[-]f y[+](g x[-]g y))). -apply leEq_less_trans with (ABSIR (f x[-]f y)[+]ABSIR (g x[-]g y)). -apply IR_tri_ineq. - -apply - less_leEq_trans - with ((OneR[/] Zero[+]One[+]One[//]H1)[^]S n[+]ABSIR (g x[-]g y)). -apply plus_resp_less_rht. -apply H2. -apply - less_leEq_trans with (nexp IR (max xn x0) (One[/] Zero[+]One[+]One[//]H1)). -exact H6. - -astepl ((OneR[/] Zero[+]One[+]One[//]H1)[^]max xn x0). -astepr ((OneR[/] Zero[+]One[+]One[//]H1)[^]xn). -apply small_nexp_resp_le. -apply shift_leEq_div. -astepr (Two:IR). -apply pos_two. - -astepl ZeroR. -apply less_leEq. -apply pos_one. - -apply shift_div_leEq. -astepr (Two:IR). -apply pos_two. - -astepr (OneR[+]One). -astepr (Two:IR). -apply less_leEq. -apply one_less_two. - -rational. - -intuition. - -apply - leEq_transitive - with - ((OneR[/] Zero[+]One[+]One[//]H1)[^]S n[+] - (One[/] Zero[+]One[+]One[//]H1)[^]S n). -apply plus_resp_leEq_lft. -apply less_leEq. -apply H3. -apply - less_leEq_trans with (nexp IR (max xn x0) (One[/] Zero[+]One[+]One[//]H1)). -exact H6. - -astepl ((OneR[/] Zero[+]One[+]One[//]H1)[^]max xn x0). -astepr ((OneR[/] Zero[+]One[+]One[//]H1)[^]x0). -apply small_nexp_resp_le. -apply shift_leEq_div. -astepr (Two:IR). -apply pos_two. - -astepl ZeroR. -apply less_leEq. -apply pos_one. - -apply shift_div_leEq. -astepr (Two:IR). -apply pos_two. - -astepr (OneR[+]One). -astepr (Two:IR). -apply less_leEq. -apply one_less_two. - -rational. - -intuition. -apply eq_imp_leEq. -astepl ((Two:IR)[*](One[/] Zero[+]One[+]One[//]H1)[^]S n). -astepr ((OneR[/] Zero[+]One[+]One[//]H1)[^]n). -astepl - ((Two:IR)[*] - (One[^]S n[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H1)). -astepl - ((Two:IR)[*](One[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H1)). -astepl - ((Two:IR)[*] - ((One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1)[*] - (One[/] Zero[+]One[+]One[//]H1))). -2: apply mult_wdr. -2: astepl ((One[/] Zero[+]One[+]One[//]H1)[^]S n). -3: astepl - ((One[/] Zero[+]One[+]One[//]H1)[^]n[*](One[/] Zero[+]One[+]One[//]H1)). -3: astepr - ((One[/] Zero[+]One[+]One[//]H1)[^]n[*](One[/] Zero[+]One[+]One[//]H1)). -3: apply eq_reflexive. - -rstepl - ((One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1)[*]Two[*] - (One[/] Zero[+]One[+]One[//]H1)). -astepl - ((One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1)[*] - (Two[*](One[/] Zero[+]One[+]One[//]H1))). -rstepl ((One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1)[*]One). -rstepl (One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1). -astepl ((OneR[/] Zero[+]One[+]One[//]H1)[^]n). -apply eq_reflexive. - -astepr ((One[/] Zero[+]One[+]One[//]H1)[^]S n). -apply eq_reflexive. - -apply AbsIR_wd. -rational. +Proof. + unfold continuous in |- *. + simpl in |- *. + unfold dIR in |- *. + intros X f g H H0. + intros x n H1. + simpl in |- *. + elim (H x (S n) H1). + intros xn H2. + elim (H0 x (S n) H1). + intros x0 H3. + exists (max xn x0). + intros y H6. + astepl (ABSIR (f x[-]f y[+](g x[-]g y))). + apply leEq_less_trans with (ABSIR (f x[-]f y)[+]ABSIR (g x[-]g y)). + apply IR_tri_ineq. + apply less_leEq_trans with ((OneR[/] Zero[+]One[+]One[//]H1)[^]S n[+]ABSIR (g x[-]g y)). + apply plus_resp_less_rht. + apply H2. + apply less_leEq_trans with (nexp IR (max xn x0) (One[/] Zero[+]One[+]One[//]H1)). + exact H6. + astepl ((OneR[/] Zero[+]One[+]One[//]H1)[^]max xn x0). + astepr ((OneR[/] Zero[+]One[+]One[//]H1)[^]xn). + apply small_nexp_resp_le. + apply shift_leEq_div. + astepr (Two:IR). + apply pos_two. + astepl ZeroR. + apply less_leEq. + apply pos_one. + apply shift_div_leEq. + astepr (Two:IR). + apply pos_two. + astepr (OneR[+]One). + astepr (Two:IR). + apply less_leEq. + apply one_less_two. + rational. + intuition. + apply leEq_transitive with ((OneR[/] Zero[+]One[+]One[//]H1)[^]S n[+] + (One[/] Zero[+]One[+]One[//]H1)[^]S n). + apply plus_resp_leEq_lft. + apply less_leEq. + apply H3. + apply less_leEq_trans with (nexp IR (max xn x0) (One[/] Zero[+]One[+]One[//]H1)). + exact H6. + astepl ((OneR[/] Zero[+]One[+]One[//]H1)[^]max xn x0). + astepr ((OneR[/] Zero[+]One[+]One[//]H1)[^]x0). + apply small_nexp_resp_le. + apply shift_leEq_div. + astepr (Two:IR). + apply pos_two. + astepl ZeroR. + apply less_leEq. + apply pos_one. + apply shift_div_leEq. + astepr (Two:IR). + apply pos_two. + astepr (OneR[+]One). + astepr (Two:IR). + apply less_leEq. + apply one_less_two. + rational. + intuition. + apply eq_imp_leEq. + astepl ((Two:IR)[*](One[/] Zero[+]One[+]One[//]H1)[^]S n). + astepr ((OneR[/] Zero[+]One[+]One[//]H1)[^]n). + astepl ((Two:IR)[*] (One[^]S n[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H1)). + astepl ((Two:IR)[*](One[/] (Zero[+]One[+]One)[^]S n[//]nexp_resp_ap_zero (S n) H1)). + astepl ((Two:IR)[*] ((One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1)[*] + (One[/] Zero[+]One[+]One[//]H1))). + 2: apply mult_wdr. + 2: astepl ((One[/] Zero[+]One[+]One[//]H1)[^]S n). + 3: astepl ((One[/] Zero[+]One[+]One[//]H1)[^]n[*](One[/] Zero[+]One[+]One[//]H1)). + 3: astepr ((One[/] Zero[+]One[+]One[//]H1)[^]n[*](One[/] Zero[+]One[+]One[//]H1)). + 3: apply eq_reflexive. + rstepl ((One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1)[*]Two[*] + (One[/] Zero[+]One[+]One[//]H1)). + astepl ((One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1)[*] + (Two[*](One[/] Zero[+]One[+]One[//]H1))). + rstepl ((One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1)[*]One). + rstepl (One[/] (Zero[+]One[+]One)[^]n[//]nexp_resp_ap_zero n H1). + astepl ((OneR[/] Zero[+]One[+]One[//]H1)[^]n). + apply eq_reflexive. + astepr ((One[/] Zero[+]One[+]One[//]H1)[^]S n). + apply eq_reflexive. + apply AbsIR_wd. + rational. Qed. End Addition. diff --git a/metrics/LipExt.v b/metrics/LipExt.v index 98f998e19..c71964a0f 100644 --- a/metrics/LipExt.v +++ b/metrics/LipExt.v @@ -18,28 +18,28 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) -(* + *) +(* Formalization of the theorem about extension of real-valued Lipschitz -functions. This theorem originally belongs to McShane and Kirchbraun. +functions. This theorem originally belongs to McShane and Kirchbraun. Theorem. Let M - metric space, let X - subset of M. Let f - Lipschitz -function from X to reals with constant C. Then the function defined by +function from X to reals with constant C. Then the function defined by \tilde f (y) = inf_{x \in X} { f(x) + C * d_M (x, y)} @@ -70,159 +70,163 @@ Hypothesis f_lip : lipschitz_c f C. Section BuildExtension. Definition cdsub' (y : M) : CSetoid_fun (SubMetricSpace M P) IR_as_CMetricSpace. -intros. -apply Build_CSetoid_fun with (fun x : (SubMetricSpace M P) => -C [*] (dsub' M P y x)). -red. intros x y0 H1. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H1). -intros H3. -elim (ap_irreflexive_unfolded _ _ H3). -intros H3. -apply (dsub'_strext M P y); auto. +Proof. + intros. + apply Build_CSetoid_fun with (fun x : (SubMetricSpace M P) => C [*] (dsub' M P y x)). + red. intros x y0 H1. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H1). + intros H3. + elim (ap_irreflexive_unfolded _ _ H3). + intros H3. + apply (dsub'_strext M P y); auto. Defined. Lemma f_uni_cont: uni_continuous f. -assert (lipschitz' f). -apply (lip_c_imp_lip (SubMetricSpace M P) IR_as_CMetricSpace f C). -apply f_lip. -assert (lipschitz f). -apply (lipschitz'_imp_lipschitz (SubMetricSpace M P) IR_as_CMetricSpace f); auto. -apply lipschitz_imp_uni_continuous; auto. +Proof. + assert (lipschitz' f). + apply (lip_c_imp_lip (SubMetricSpace M P) IR_as_CMetricSpace f C). + apply f_lip. + assert (lipschitz f). + apply (lipschitz'_imp_lipschitz (SubMetricSpace M P) IR_as_CMetricSpace f); auto. + apply lipschitz_imp_uni_continuous; auto. Qed. Lemma dsub'_is_lipschitz : forall (y : M) (x1 x2 : SubMetricSpace M P), C[*]dIR (dsub' M P y x1) (dsub' M P y x2)[<=]C[*](dsub M P x1 x2). -intros. -apply mult_resp_leEq_lft. -2: apply less_leEq. -2: apply constant_positive. -unfold dsub'. unfold dsub. -case x1. case x2. intros. simpl. - -astepl (dIR (y[-d]scs_elem0) (y[-d]scs_elem)). -apply rev_tri_ineq'. - -unfold dIR. -apply ABSIR_wd. -assert ((y[-d]scs_elem0)[=](scs_elem0[-d]y)). -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. -assert ((y[-d]scs_elem)[=](scs_elem[-d]y)). -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. -algebra. +Proof. + intros. + apply mult_resp_leEq_lft. + 2: apply less_leEq. + 2: apply constant_positive. + unfold dsub'. unfold dsub. + case x1. case x2. intros. simpl. + astepl (dIR (y[-d]scs_elem0) (y[-d]scs_elem)). + apply rev_tri_ineq'. + unfold dIR. + apply ABSIR_wd. + assert ((y[-d]scs_elem0)[=](scs_elem0[-d]y)). + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + assert ((y[-d]scs_elem)[=](scs_elem[-d]y)). + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + algebra. Qed. Lemma exp_prop : forall (k : nat) (n : nat) (H : Two[#]Zero), Two[^]k[*]nexp IR (n + k) (One[/] (Two:IR)[//]H)[=] nexp IR n (One[/] (Two:IR)[//]H). -intros. -astepl ((zexp Two H k)[*](nexp IR (n + k) (One[/] Two[//]H) )). -astepl ((zexp Two H k)[*](zexp Two H (- (n + k)%nat))). -astepr (zexp Two H (k + (- (n + k)%nat))). -apply eq_symmetric. -apply zexp_plus. -astepl (zexp Two H (-n)). -apply (zexp_inv_nexp IR Two H n). -replace (- n)%Z with (k + - (n + k)%nat)%Z; auto with zarith. -apply eq_reflexive. -intros. auto with zarith. -assert ((n + k)%Z = (n + k)%nat). -symmetry. apply inj_plus. -auto with zarith. -apply mult_wd; auto. -apply eq_reflexive. -apply (zexp_inv_nexp IR Two H (n+k)). +Proof. + intros. + astepl ((zexp Two H k)[*](nexp IR (n + k) (One[/] Two[//]H) )). + astepl ((zexp Two H k)[*](zexp Two H (- (n + k)%nat))). + astepr (zexp Two H (k + (- (n + k)%nat))). + apply eq_symmetric. + apply zexp_plus. + astepl (zexp Two H (-n)). + apply (zexp_inv_nexp IR Two H n). + replace (- n)%Z with (k + - (n + k)%nat)%Z; auto with zarith. + apply eq_reflexive. + intros. auto with zarith. + assert ((n + k)%Z = (n + k)%nat). + symmetry. apply inj_plus. + auto with zarith. + apply mult_wd; auto. + apply eq_reflexive. + apply (zexp_inv_nexp IR Two H (n+k)). Qed. Lemma cdsub'_uni_cont : forall y : M, uni_continuous (cdsub' y). -intros. -unfold uni_continuous. -unfold cdsub'. -simpl. -intros. -elim (power_big C Two). intros k H1. -3: apply one_less_two. -2: apply less_leEq; apply constant_positive. -exists (n + k). -intros. -astepl (C[*](dIR (dsub' M P y x) (dsub' M P y y0))). -cut (C[*]dIR (dsub' M P y x) (dsub' M P y y0)[<=]C[*](dsub M P x y0)). -intros. -cut (C[*](dsub M P x y0)[<] nexp IR n (One[/] Two[//]H)). -intros. -apply leEq_less_trans with (C[*](dsub M P x y0)); auto with algebra. -cut (Two[^]k[*](dsub M P x y0)[<] nexp IR n (One[/] Two[//]H)). -intros. -cut (C[*](dsub M P x y0)[<=]Two[^]k[*](dsub M P x y0)). -intros. -apply leEq_less_trans with (Two[^]k[*](dsub M P x y0)); auto with algebra. -apply mult_resp_leEq_rht; auto. -apply dsub_nneg. -astepr (Two[^]k[*](nexp IR (n + k) (One[/] Two[//]H))). -apply mult_resp_less_lft; auto. -apply nexp_resp_pos. -cut ((One:IR)[<]Two). -cut (Zero[<](One:IR)). -intros. -apply less_transitive_unfolded with (One:IR); auto. -apply pos_one. -apply one_less_two. -apply exp_prop. -apply dsub'_is_lipschitz. -unfold dIR. -astepr (ABSIR (C[*](dsub' M P y x[-]dsub' M P y y0))). -apply AbsIR_mult. -apply less_leEq. -apply constant_positive. -apply ABSIR_wd; auto with algebra. +Proof. + intros. + unfold uni_continuous. + unfold cdsub'. + simpl. + intros. + elim (power_big C Two). intros k H1. + 3: apply one_less_two. + 2: apply less_leEq; apply constant_positive. + exists (n + k). + intros. + astepl (C[*](dIR (dsub' M P y x) (dsub' M P y y0))). + cut (C[*]dIR (dsub' M P y x) (dsub' M P y y0)[<=]C[*](dsub M P x y0)). + intros. + cut (C[*](dsub M P x y0)[<] nexp IR n (One[/] Two[//]H)). + intros. + apply leEq_less_trans with (C[*](dsub M P x y0)); auto with algebra. + cut (Two[^]k[*](dsub M P x y0)[<] nexp IR n (One[/] Two[//]H)). + intros. + cut (C[*](dsub M P x y0)[<=]Two[^]k[*](dsub M P x y0)). + intros. + apply leEq_less_trans with (Two[^]k[*](dsub M P x y0)); auto with algebra. + apply mult_resp_leEq_rht; auto. + apply dsub_nneg. + astepr (Two[^]k[*](nexp IR (n + k) (One[/] Two[//]H))). + apply mult_resp_less_lft; auto. + apply nexp_resp_pos. + cut ((One:IR)[<]Two). + cut (Zero[<](One:IR)). + intros. + apply less_transitive_unfolded with (One:IR); auto. + apply pos_one. + apply one_less_two. + apply exp_prop. + apply dsub'_is_lipschitz. + unfold dIR. + astepr (ABSIR (C[*](dsub' M P y x[-]dsub' M P y y0))). + apply AbsIR_mult. + apply less_leEq. + apply constant_positive. + apply ABSIR_wd; auto with algebra. Qed. Definition f_multi_ext (y : M) : CSetoid_fun (SubMetricSpace M P) IR_as_CMetricSpace. -intros. -apply Build_CSetoid_fun with (fun x : (SubMetricSpace M P) => -f (x) [+] (cdsub' y x)). -red. intros x y0 H1. -elim (bin_op_strext_unfolded _ _ _ _ _ _ H1). -apply (csf_strext (SubMetricSpace M P) IR_as_CMetricSpace f). -apply (csf_strext (SubMetricSpace M P) IR_as_CMetricSpace (cdsub' y)). +Proof. + intros. + apply Build_CSetoid_fun with (fun x : (SubMetricSpace M P) => f (x) [+] (cdsub' y x)). + red. intros x y0 H1. + elim (bin_op_strext_unfolded _ _ _ _ _ _ H1). + apply (csf_strext (SubMetricSpace M P) IR_as_CMetricSpace f). + apply (csf_strext (SubMetricSpace M P) IR_as_CMetricSpace (cdsub' y)). Defined. Lemma f_multi_ext_uni_continuous : forall y : M, uni_continuous (A:=SubMetricSpace M P) (B:=IR_as_CPsMetricSpace) (f_multi_ext y). -intros. -unfold f_multi_ext. -apply (plus_resp_uni_continuous (SubMetricSpace M P) f (cdsub' y) - f_uni_cont (cdsub'_uni_cont y)). +Proof. + intros. + unfold f_multi_ext. + apply (plus_resp_uni_continuous (SubMetricSpace M P) f (cdsub' y) f_uni_cont (cdsub'_uni_cont y)). Qed. Lemma inf_f_multi_ext_exists : forall y : M, {z : IR | set_glb_IR (fun v : IR_as_CMetricSpace => {x : SubMetricSpace M P | f_multi_ext y x[=]v}) z}. -intros. -elim (infimum_exists (SubMetricSpace M P) (f_multi_ext y)). -3: apply set_bounded. -intros x H. -exists x. -apply H. -assert (uni_continuous (f_multi_ext y)). -apply f_multi_ext_uni_continuous. -assert (uni_continuous' (f_multi_ext y)). -apply uni_continuous_imp_uni_continuous'; auto. -apply uni_continuous'_imp_uni_continuous''; auto. -elim non_empty. -intros x H. -exists x. apply H. +Proof. + intros. + elim (infimum_exists (SubMetricSpace M P) (f_multi_ext y)). + 3: apply set_bounded. + intros x H. + exists x. + apply H. + assert (uni_continuous (f_multi_ext y)). + apply f_multi_ext_uni_continuous. + assert (uni_continuous' (f_multi_ext y)). + apply uni_continuous_imp_uni_continuous'; auto. + apply uni_continuous'_imp_uni_continuous''; auto. + elim non_empty. + intros x H. + exists x. apply H. Qed. Definition lip_extension_f (y : M) : IR. -intros. -assert ({z : IR | set_glb_IR (fun v : IR_as_CMetricSpace => {x : SubMetricSpace M P | f_multi_ext y x[=]v}) z}). -apply inf_f_multi_ext_exists. -destruct X. -exact x. -Defined. +Proof. + intros. + assert ({z : IR | set_glb_IR (fun v : IR_as_CMetricSpace => {x : SubMetricSpace M P | f_multi_ext y x[=]v}) z}). + apply inf_f_multi_ext_exists. + destruct X. + exact x. +Defined. Lemma lip_extension_strext_case: forall (x : M) (y : M) (z1 : IR) (z2 : IR) (H : z1[<]z2) @@ -234,79 +238,81 @@ Lemma lip_extension_strext_case: forall (x : M) (y : M) (fun v : IR => sigT (fun x0 : subcsetoid_crr M P => f x0[+]C[*]dsub' M P x x0[=]v)) z2), x [#] y. -unfold set_glb_IR. -intros. -destruct H1 as [l s]. destruct H2 as [l0 s0]. -assert {x0 : IR | - sigT (fun x1 : subcsetoid_crr M P => f x1[+]C[*]dsub' M P y x1[=]x0) | - x0[-]z1[<](z2 [-] z1)}. -apply s. -apply shift_zero_less_minus; auto. -destruct X. destruct s1. -assert (z2[<=]f x1[+]C[*]dsub' M P x x1). -apply (l0 (f x1[+]C[*]dsub' M P x x1)). -exists x1. -algebra. -assert (x0 [<] z2). -apply plus_cancel_less with ([--]z1). algebra. -assert (f x1[+]C[*]dsub' M P y x1 [<] f x1[+]C[*]dsub' M P x x1). -apply less_leEq_trans with z2; auto. -astepl (x0). auto. -assert ((from_SubPsMetricSpace M P x1[-d] y)[#](from_SubPsMetricSpace M P x1[-d]x)). -apply less_imp_ap. -apply mult_cancel_less with (z := C). -apply constant_positive. -astepl (C[*]dsub' M P y x1). -astepr (C[*]dsub' M P x x1). -apply plus_cancel_less with (f x1). -astepl (f x1[+]C[*]dsub' M P y x1). -astepr (f x1[+]C[*]dsub' M P x x1). -auto. -set (H1 := csbf_strext _ _ _ (cms_d (c:=M)) _ _ _ _ X1). -elim H1. -assert (Not (from_SubPsMetricSpace M P x1[#]from_SubPsMetricSpace M P x1)). -apply ap_irreflexive_unfolded. -contradiction. -intros. -apply ap_symmetric_unfolded. -auto. +Proof. + unfold set_glb_IR. + intros. + destruct H1 as [l s]. destruct H2 as [l0 s0]. + assert {x0 : IR | sigT (fun x1 : subcsetoid_crr M P => f x1[+]C[*]dsub' M P y x1[=]x0) | + x0[-]z1[<](z2 [-] z1)}. + apply s. + apply shift_zero_less_minus; auto. + destruct X. destruct s1. + assert (z2[<=]f x1[+]C[*]dsub' M P x x1). + apply (l0 (f x1[+]C[*]dsub' M P x x1)). + exists x1. + algebra. + assert (x0 [<] z2). + apply plus_cancel_less with ([--]z1). algebra. + assert (f x1[+]C[*]dsub' M P y x1 [<] f x1[+]C[*]dsub' M P x x1). + apply less_leEq_trans with z2; auto. + astepl (x0). auto. + assert ((from_SubPsMetricSpace M P x1[-d] y)[#](from_SubPsMetricSpace M P x1[-d]x)). + apply less_imp_ap. + apply mult_cancel_less with (z := C). + apply constant_positive. + astepl (C[*]dsub' M P y x1). + astepr (C[*]dsub' M P x x1). + apply plus_cancel_less with (f x1). + astepl (f x1[+]C[*]dsub' M P y x1). + astepr (f x1[+]C[*]dsub' M P x x1). + auto. + set (H1 := csbf_strext _ _ _ (cms_d (c:=M)) _ _ _ _ X1). + elim H1. + assert (Not (from_SubPsMetricSpace M P x1[#]from_SubPsMetricSpace M P x1)). + apply ap_irreflexive_unfolded. + contradiction. + intros. + apply ap_symmetric_unfolded. + auto. Qed. Lemma lip_extension_strext : fun_strext (lip_extension_f). -unfold fun_strext. -unfold lip_extension_f. -intros x y. -elim inf_f_multi_ext_exists. -elim inf_f_multi_ext_exists. -simpl. intros z1 H1 z2 H2 H. -elim (ap_imp_less IR z1 z2); auto; intros. -unfold f_multi_ext. -apply (lip_extension_strext_case x y z1 z2 a H1 H2). -apply ap_symmetric_unfolded. -apply (lip_extension_strext_case y x z2 z1 b H2 H1). -apply ap_symmetric_unfolded. auto. +Proof. + unfold fun_strext. + unfold lip_extension_f. + intros x y. + elim inf_f_multi_ext_exists. + elim inf_f_multi_ext_exists. + simpl. intros z1 H1 z2 H2 H. + elim (ap_imp_less IR z1 z2); auto; intros. + unfold f_multi_ext. + apply (lip_extension_strext_case x y z1 z2 a H1 H2). + apply ap_symmetric_unfolded. + apply (lip_extension_strext_case y x z2 z1 b H2 H1). + apply ap_symmetric_unfolded. auto. Qed. Definition lip_extension := Build_CSetoid_fun M IR_as_CPsMetricSpace (lip_extension_f) (lip_extension_strext). - + Lemma lip_unfolded : forall (x x1: SubMetricSpace M P), f x[-]f x1[<=]C[*]dsub' M P (from_SubPsMetricSpace M P x) x1. -intros. -unfold dsub'. -astepr (C[*](x[-d]x1)). -apply leEq_transitive with (AbsIR (f x[-] f x1)). -apply leEq_AbsIR. -astepl (f x[-d]f x1). -assert (lipschitz_c f C). -apply f_lip. -apply X. -apply mult_wd; algebra. -case x. case x1. intros. simpl. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intros. + unfold dsub'. + astepr (C[*](x[-d]x1)). + apply leEq_transitive with (AbsIR (f x[-] f x1)). + apply leEq_AbsIR. + astepl (f x[-d]f x1). + assert (lipschitz_c f C). + apply f_lip. + apply X. + apply mult_wd; algebra. + case x. case x1. intros. simpl. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. @@ -316,57 +322,49 @@ Section ExtensionProperties. Lemma lip_extension_keeps_fun : forall (x : SubMetricSpace M P), lip_extension (from_SubPsMetricSpace M P x) [=] f x. -intros. -unfold lip_extension. -simpl. -unfold lip_extension_f. -elim inf_f_multi_ext_exists. -unfold set_glb_IR. -simpl. intros y H. -destruct H as [l s]. - -apply leEq_imp_eq. - -apply l. -exists x. -assert (dsub' M P (from_SubPsMetricSpace M P x) x[=]Zero). -unfold dsub'. - -assert (diag_zero M (cms_d (c:=M))). -apply pos_imp_ap_imp_diag_zero. -apply ax_d_pos_imp_ap. -apply (CPsMetricSpace_is_CPsMetricSpace M). -apply ax_d_nneg. -apply (CPsMetricSpace_is_CPsMetricSpace M). -apply H. - -astepl (f x[+]C[*]Zero). -astepl (f x[+]Zero). algebra. - -assert (forall e : IR, Zero [<]e -> f x [-] y [<] e). -intros. -assert (sig2T IR - (fun x0 : IR => - sigT - (fun x1 : subcsetoid_crr M P => - f x1[+]C[*]dsub' M P (from_SubPsMetricSpace M P x) x1[=]x0)) - (fun x : IR => x[-]y[<]e)). -apply s. auto. destruct X0. destruct s0. -assert (f x [<=] f x1[+]C[*]dsub' M P (from_SubPsMetricSpace M P x) x1). -astepr (C[*] dsub' M P (from_SubPsMetricSpace M P x) x1 [+] f x1). -apply shift_leEq_plus. -apply lip_unfolded. -apply leEq_less_trans with (f x1[+]C[*]dsub' M P (from_SubPsMetricSpace M P x) x1[-]y). -apply minus_resp_leEq; auto. -astepl (x0 [-] y); auto. -astepl (f x [-] y [+] y). -astepr (Zero [+] y). -apply plus_resp_leEq. -apply approach_zero; auto. +Proof. + intros. + unfold lip_extension. + simpl. + unfold lip_extension_f. + elim inf_f_multi_ext_exists. + unfold set_glb_IR. + simpl. intros y H. + destruct H as [l s]. + apply leEq_imp_eq. + apply l. + exists x. + assert (dsub' M P (from_SubPsMetricSpace M P x) x[=]Zero). + unfold dsub'. + assert (diag_zero M (cms_d (c:=M))). + apply pos_imp_ap_imp_diag_zero. + apply ax_d_pos_imp_ap. + apply (CPsMetricSpace_is_CPsMetricSpace M). + apply ax_d_nneg. + apply (CPsMetricSpace_is_CPsMetricSpace M). + apply H. + astepl (f x[+]C[*]Zero). + astepl (f x[+]Zero). algebra. + assert (forall e : IR, Zero [<]e -> f x [-] y [<] e). + intros. + assert (sig2T IR (fun x0 : IR => sigT (fun x1 : subcsetoid_crr M P => + f x1[+]C[*]dsub' M P (from_SubPsMetricSpace M P x) x1[=]x0)) (fun x : IR => x[-]y[<]e)). + apply s. auto. destruct X0. destruct s0. + assert (f x [<=] f x1[+]C[*]dsub' M P (from_SubPsMetricSpace M P x) x1). + astepr (C[*] dsub' M P (from_SubPsMetricSpace M P x) x1 [+] f x1). + apply shift_leEq_plus. + apply lip_unfolded. + apply leEq_less_trans with (f x1[+]C[*]dsub' M P (from_SubPsMetricSpace M P x) x1[-]y). + apply minus_resp_leEq; auto. + astepl (x0 [-] y); auto. + astepl (f x [-] y [+] y). + astepr (Zero [+] y). + apply plus_resp_leEq. + apply approach_zero; auto. Qed. Lemma extension_also_lipschitz_case : -forall (y1 : M) (y2 : M) (fy2 : IR) +forall (y1 : M) (y2 : M) (fy2 : IR) (Hfy2 : set_glb_IR (fun v : IR => sigT (fun x : subcsetoid_crr M P => f x[+]C[*]dsub' M P y2 x[=]v)) fy2) (fy1 : IR) @@ -375,76 +373,72 @@ forall (y1 : M) (y2 : M) (fy2 : IR) (e : IR) (X : Zero[<]e), fy2[-]fy1[<=]C[*](y1[-d]y2)[+]e. -intros. -destruct Hfy1. destruct Hfy2 as [l0 s0]. -assert ({x : IR | sigT (fun x0 : SubMetricSpace M P => f x0[+]C[*]dsub' M P y1 x0[=]x) | - x[-]fy1[<]e}). -apply s. auto. destruct X0 as [fx1 Ht Hl1]. destruct Ht as [x1 He1]. - -assert (fy2 [<=] f x1[+]C[*]dsub' M P y2 x1). -apply l0; auto. exists x1. apply eq_reflexive_unfolded. - -assert (fx1[-]e[<=]fy1). -apply less_leEq. -apply shift_minus_less. -apply shift_less_plus'; auto. - -(* Inequalites are simple and symmetric*) - -apply leEq_transitive with ((f x1[+]C[*]dsub' M P y2 x1)[-](fx1[-]e)). -apply minus_resp_leEq_both; auto. -astepl (f x1[+]C[*]dsub' M P y2 x1[-]fx1[+]e). -apply plus_resp_leEq. -astepl (f x1[+]C[*]dsub' M P y2 x1[-](f x1[+]C[*]dsub' M P y1 x1)). -astepl (f x1[+]C[*]dsub' M P y2 x1[-]f x1[-]C[*]dsub' M P y1 x1). -astepl (f x1[-]f x1[+]C[*]dsub' M P y2 x1[-]C[*]dsub' M P y1 x1). -astepl (Zero[+]C[*]dsub' M P y2 x1[-]C[*]dsub' M P y1 x1). -astepl (C[*]dsub' M P y2 x1[-]C[*]dsub' M P y1 x1). -astepl (C[*](dsub' M P y2 x1[-]dsub' M P y1 x1)). -apply mult_resp_leEq_lft. -2: apply less_leEq. -2: apply constant_positive. -unfold dsub'. -astepr (y2[-d]y1). -apply leEq_transitive with (AbsIR ((from_SubPsMetricSpace M P x1[-d]y2)[-] - (from_SubPsMetricSpace M P x1[-d]y1))). -apply leEq_AbsIR. -apply AbsSmall_imp_AbsIR. -apply rev_tri_ineq. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. -rational. +Proof. + intros. + destruct Hfy1. destruct Hfy2 as [l0 s0]. + assert ({x : IR | sigT (fun x0 : SubMetricSpace M P => f x0[+]C[*]dsub' M P y1 x0[=]x) | + x[-]fy1[<]e}). + apply s. auto. destruct X0 as [fx1 Ht Hl1]. destruct Ht as [x1 He1]. + assert (fy2 [<=] f x1[+]C[*]dsub' M P y2 x1). + apply l0; auto. exists x1. apply eq_reflexive_unfolded. + assert (fx1[-]e[<=]fy1). + apply less_leEq. + apply shift_minus_less. + apply shift_less_plus'; auto. + (* Inequalites are simple and symmetric*) + apply leEq_transitive with ((f x1[+]C[*]dsub' M P y2 x1)[-](fx1[-]e)). + apply minus_resp_leEq_both; auto. + astepl (f x1[+]C[*]dsub' M P y2 x1[-]fx1[+]e). + apply plus_resp_leEq. + astepl (f x1[+]C[*]dsub' M P y2 x1[-](f x1[+]C[*]dsub' M P y1 x1)). + astepl (f x1[+]C[*]dsub' M P y2 x1[-]f x1[-]C[*]dsub' M P y1 x1). + astepl (f x1[-]f x1[+]C[*]dsub' M P y2 x1[-]C[*]dsub' M P y1 x1). + astepl (Zero[+]C[*]dsub' M P y2 x1[-]C[*]dsub' M P y1 x1). + astepl (C[*]dsub' M P y2 x1[-]C[*]dsub' M P y1 x1). + astepl (C[*](dsub' M P y2 x1[-]dsub' M P y1 x1)). + apply mult_resp_leEq_lft. + 2: apply less_leEq. + 2: apply constant_positive. + unfold dsub'. + astepr (y2[-d]y1). + apply leEq_transitive with (AbsIR ((from_SubPsMetricSpace M P x1[-d]y2)[-] + (from_SubPsMetricSpace M P x1[-d]y1))). + apply leEq_AbsIR. + apply AbsSmall_imp_AbsIR. + apply rev_tri_ineq. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + rational. Qed. Lemma extension_also_liscphitz : lipschitz_c (lip_extension) C. -unfold lipschitz_c. -unfold lip_extension. -unfold lip_extension_f. -intros y1 y2. intros. simpl. -elim inf_f_multi_ext_exists. -elim inf_f_multi_ext_exists. -unfold f_multi_ext. -unfold dIR. -simpl. -intros fy2 Hfy2 fy1 Hfy1. -apply AbsSmall_imp_AbsIR. - -assert (forall e : IR, Zero[<]e -> AbsSmall (C[*](y1[-d]y2)[+]e) (fy1[-]fy2)). - -intros. -unfold AbsSmall. split. -astepr ([--](fy2 [-] fy1)). -apply inv_resp_leEq. -apply extension_also_lipschitz_case; auto. -rational. -astepr (C[*](y2[-d]y1)[+]e). -astepl (fy1 [-] fy2). -apply (extension_also_lipschitz_case y2 y1 fy1 Hfy1 fy2 Hfy2 e X). -assert (y2[-d]y1[=]y1[-d]y2). -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. -algebra. -apply AbsSmall_approach. auto. +Proof. + unfold lipschitz_c. + unfold lip_extension. + unfold lip_extension_f. + intros y1 y2. intros. simpl. + elim inf_f_multi_ext_exists. + elim inf_f_multi_ext_exists. + unfold f_multi_ext. + unfold dIR. + simpl. + intros fy2 Hfy2 fy1 Hfy1. + apply AbsSmall_imp_AbsIR. + assert (forall e : IR, Zero[<]e -> AbsSmall (C[*](y1[-d]y2)[+]e) (fy1[-]fy2)). + intros. + unfold AbsSmall. split. + astepr ([--](fy2 [-] fy1)). + apply inv_resp_leEq. + apply extension_also_lipschitz_case; auto. + rational. + astepr (C[*](y2[-d]y1)[+]e). + astepl (fy1 [-] fy2). + apply (extension_also_lipschitz_case y2 y1 fy1 Hfy1 fy2 Hfy2 e X). + assert (y2[-d]y1[=]y1[-d]y2). + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + algebra. + apply AbsSmall_approach. auto. Qed. End ExtensionProperties. diff --git a/metrics/Prod_Sub.v b/metrics/Prod_Sub.v index 58bb4d46d..679f6cad5 100644 --- a/metrics/Prod_Sub.v +++ b/metrics/Prod_Sub.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export IR_CPMSpace. @@ -45,65 +45,61 @@ Section prodpsmetrics. The product metric here defined is: $ d_{prod}((a_1,b_1),(a_2,b_2)):= d_A(a_1,a_2)+d_B(b_1,b_2)$ # dprod((a1,b1),(a2,b2)):= dA(a1,b1)+dB(b1,b2)#. -This is %\emph{not}% #not# the one used to make the metric of -$\RR^{2}$ #IR2# out of the metric of $\RR$ #IR#. +This is %\emph{not}% #not# the one used to make the metric of +$\RR^{2}$ #IR2# out of the metric of $\RR$ #IR#. *) Definition dprod0 (A B : CPsMetricSpace) (c d : prodT A B) : IR. -intros A B c d. -case c. -intros c0 c1. -case d. -intros c2 c3. -exact ((c0[-d]c2)[+](c1[-d]c3)). +Proof. + intros A B c d. + case c. + intros c0 c1. + case d. + intros c2 c3. + exact ((c0[-d]c2)[+](c1[-d]c3)). Defined. Lemma dprod0_strext : forall A B : CPsMetricSpace, bin_fun_strext (ProdCSetoid A B) (ProdCSetoid A B) IR (dprod0 A B). -intros A B. -unfold bin_fun_strext in |- *. -intros x1 x2 y1 y2. -unfold dprod0 in |- *. -case x1. -case x2. -case y1. -case y2. -intros c c0 c1 c2 c3 c4 c5 c6 H. -set - (H1 := cs_bin_op_strext IR csg_op (c5[-d]c1) (c3[-d]c) (c6[-d]c2) (c4[-d]c0) H) - in *. -elim H1. -intros. -set (H2 := csbf_strext A A IR cms_d c5 c3 c1 c a) in *. -elim H2. -intros. -left. -simpl in |- *. -left. -exact a0. - -intros. -right. -simpl in |- *. -left. -exact b. - - -intros. -set (H2 := csbf_strext B B IR cms_d c6 c4 c2 c0 b) in *. -elim H2. -intros. -left. -simpl in |- *. -right. -exact a. - -intros. -right. -simpl in |- *. -right. -exact b0. +Proof. + intros A B. + unfold bin_fun_strext in |- *. + intros x1 x2 y1 y2. + unfold dprod0 in |- *. + case x1. + case x2. + case y1. + case y2. + intros c c0 c1 c2 c3 c4 c5 c6 H. + set (H1 := cs_bin_op_strext IR csg_op (c5[-d]c1) (c3[-d]c) (c6[-d]c2) (c4[-d]c0) H) in *. + elim H1. + intros. + set (H2 := csbf_strext A A IR cms_d c5 c3 c1 c a) in *. + elim H2. + intros. + left. + simpl in |- *. + left. + exact a0. + intros. + right. + simpl in |- *. + left. + exact b. + intros. + set (H2 := csbf_strext B B IR cms_d c6 c4 c2 c0 b) in *. + elim H2. + intros. + left. + simpl in |- *. + right. + exact a. + intros. + right. + simpl in |- *. + right. + exact b0. Qed. Definition d_prod0 (A B : CPsMetricSpace) := @@ -112,83 +108,78 @@ Definition d_prod0 (A B : CPsMetricSpace) := Lemma prod0cpsmetricspace_is_CPsMetricSpace : forall A B : CPsMetricSpace, - is_CPsMetricSpace (ProdCSetoid A B) (d_prod0 A B). -intros A B. -apply (Build_is_CPsMetricSpace (ProdCSetoid A B) (d_prod0 A B)). -unfold com in |- *. -intros x y. -unfold d_prod0 in |- *. -simpl in |- *. -unfold dprod0 in |- *. -case x. -case y. -intros. -apply (cs_bin_op_wd IR csg_op). -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. - -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. - -unfold nneg in |- *. -intros. -unfold d_prod0 in |- *. -simpl in |- *. -unfold dprod0 in |- *. -case x. -case y. -intros. -astepl (ZeroR[+]Zero). -apply plus_resp_leEq_both. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. - -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. - -unfold pos_imp_ap in |- *. -intros x y. -unfold d_prod0 in |- *. -simpl in |- *. -unfold dprod0 in |- *. -case x. -case y. -intros c c0 c1 c2 H. -unfold prod_ap in |- *. -unfold prod_rect in |- *. -set (H0 := positive_Sum_two IR (c1[-d]c) (c2[-d]c0) H) in *. -elim H0. -intros. -left. -apply ax_d_pos_imp_ap with (d := cms_d (c:=A)). -apply CPsMetricSpace_is_CPsMetricSpace. -exact a. - -intros. -right. -apply ax_d_pos_imp_ap with (d := cms_d (c:=B)). -apply CPsMetricSpace_is_CPsMetricSpace. -exact b. - -unfold tri_ineq in |- *. -intros. -unfold d_prod0 in |- *. -simpl in |- *. -unfold dprod0 in |- *. -case x. -case y. -case z. -intros c c0 c1 c2 c3 c4. -astepr ((c3[-d]c1)[+]((c4[-d]c2)[+]((c1[-d]c)[+](c2[-d]c0)))). -astepr ((c3[-d]c1)[+]((c4[-d]c2)[+](c1[-d]c)[+](c2[-d]c0))). -astepr ((c3[-d]c1)[+]((c1[-d]c)[+](c4[-d]c2)[+](c2[-d]c0))). -astepr ((c3[-d]c1)[+]((c1[-d]c)[+]((c4[-d]c2)[+](c2[-d]c0)))). -astepr ((c3[-d]c1)[+](c1[-d]c)[+]((c4[-d]c2)[+](c2[-d]c0))). -apply plus_resp_leEq_both. -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. + is_CPsMetricSpace (ProdCSetoid A B) (d_prod0 A B). +Proof. + intros A B. + apply (Build_is_CPsMetricSpace (ProdCSetoid A B) (d_prod0 A B)). + unfold com in |- *. + intros x y. + unfold d_prod0 in |- *. + simpl in |- *. + unfold dprod0 in |- *. + case x. + case y. + intros. + apply (cs_bin_op_wd IR csg_op). + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold nneg in |- *. + intros. + unfold d_prod0 in |- *. + simpl in |- *. + unfold dprod0 in |- *. + case x. + case y. + intros. + astepl (ZeroR[+]Zero). + apply plus_resp_leEq_both. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. + unfold pos_imp_ap in |- *. + intros x y. + unfold d_prod0 in |- *. + simpl in |- *. + unfold dprod0 in |- *. + case x. + case y. + intros c c0 c1 c2 H. + unfold prod_ap in |- *. + unfold prod_rect in |- *. + set (H0 := positive_Sum_two IR (c1[-d]c) (c2[-d]c0) H) in *. + elim H0. + intros. + left. + apply ax_d_pos_imp_ap with (d := cms_d (c:=A)). + apply CPsMetricSpace_is_CPsMetricSpace. + exact a. + intros. + right. + apply ax_d_pos_imp_ap with (d := cms_d (c:=B)). + apply CPsMetricSpace_is_CPsMetricSpace. + exact b. + unfold tri_ineq in |- *. + intros. + unfold d_prod0 in |- *. + simpl in |- *. + unfold dprod0 in |- *. + case x. + case y. + case z. + intros c c0 c1 c2 c3 c4. + astepr ((c3[-d]c1)[+]((c4[-d]c2)[+]((c1[-d]c)[+](c2[-d]c0)))). + astepr ((c3[-d]c1)[+]((c4[-d]c2)[+](c1[-d]c)[+](c2[-d]c0))). + astepr ((c3[-d]c1)[+]((c1[-d]c)[+](c4[-d]c2)[+](c2[-d]c0))). + astepr ((c3[-d]c1)[+]((c1[-d]c)[+]((c4[-d]c2)[+](c2[-d]c0)))). + astepr ((c3[-d]c1)[+](c1[-d]c)[+]((c4[-d]c2)[+](c2[-d]c0))). + apply plus_resp_leEq_both. + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Definition Prod0CPsMetricSpace (A B : CPsMetricSpace) := @@ -204,7 +195,7 @@ Section subpsmetrics. *) (** -The pseudo metric on a subspace $Y$ #Y# of a pseudo metric space $X$ #X# is +The pseudo metric on a subspace $Y$ #Y# of a pseudo metric space $X$ #X# is the pseudo metric on $X$ #X# restricted to $Y$ #Y#. *) @@ -230,15 +221,16 @@ Lemma restr_bin_fun_strext : (f : CSetoid_bin_fun X X IR), bin_fun_strext (Build_SubCSetoid X P) (Build_SubCSetoid X P) IR (restr_bin_fun P f). -intros X P f. -red in |- *. -intros x1 x2 y1 y2. -case y2. -case y1. -case x2. -case x1. -do 8 intro. intro H. -exact (csbf_strext _ _ _ f _ _ _ _ H). +Proof. + intros X P f. + red in |- *. + intros x1 x2 y1 y2. + case y2. + case y1. + case x2. + case x1. + do 8 intro. intro H. + exact (csbf_strext _ _ _ f _ _ _ _ H). Qed. Definition Build_SubCSetoid_bin_fun (X : CPsMetricSpace) @@ -254,62 +246,66 @@ Implicit Arguments dsub [X]. Lemma dsub_com : forall (X : CPsMetricSpace) (P : cms_crr X -> CProp), com (dsub P). -intros X P. -unfold com in |- *. -intros x y. -unfold dsub in |- *. -case y. -case x. -intros a H b H0. -simpl in |- *. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intros X P. + unfold com in |- *. + intros x y. + unfold dsub in |- *. + case y. + case x. + intros a H b H0. + simpl in |- *. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Lemma dsub_nneg : forall (X : CPsMetricSpace) (P : cms_crr X -> CProp), nneg (dsub P). -intros X P. -unfold nneg in |- *. -intros x y. -unfold dsub in |- *. -case y. -case x. -intros a H b H0. -simpl in |- *. -apply ax_d_nneg. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intros X P. + unfold nneg in |- *. + intros x y. + unfold dsub in |- *. + case y. + case x. + intros a H b H0. + simpl in |- *. + apply ax_d_nneg. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Lemma dsub_pos_imp_ap : forall (X : CPsMetricSpace) (P : cms_crr X -> CProp), pos_imp_ap (dsub P). -intros X P. -unfold pos_imp_ap in |- *. -intros x y. -unfold dsub in |- *. -case y. -case x. -intros a H b H0. -simpl in |- *. -apply ax_d_pos_imp_ap. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intros X P. + unfold pos_imp_ap in |- *. + intros x y. + unfold dsub in |- *. + case y. + case x. + intros a H b H0. + simpl in |- *. + apply ax_d_pos_imp_ap. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. Lemma dsub_tri_ineq : forall (X : CPsMetricSpace) (P : cms_crr X -> CProp), tri_ineq (dsub P). -intros X P. -unfold tri_ineq in |- *. -intros x y z. -unfold dsub in |- *. -case z. -case y. -case x. -intros a H b H0 c H1. -simpl in |- *. -apply ax_d_tri_ineq. -apply CPsMetricSpace_is_CPsMetricSpace. +Proof. + intros X P. + unfold tri_ineq in |- *. + intros x y z. + unfold dsub in |- *. + case z. + case y. + case x. + intros a H b H0 c H1. + simpl in |- *. + apply ax_d_tri_ineq. + apply CPsMetricSpace_is_CPsMetricSpace. Qed. -Definition is_SubPsMetricSpace (X : CPsMetricSpace) +Definition is_SubPsMetricSpace (X : CPsMetricSpace) (P : cms_crr X -> CProp) : is_CPsMetricSpace (Build_SubCSetoid X P) (dsub P) := Build_is_CPsMetricSpace (Build_SubCSetoid X P) (dsub P) ( @@ -323,24 +319,25 @@ Definition SubPsMetricSpace (X : CPsMetricSpace) (P : cms_crr X -> CProp) : Implicit Arguments SubPsMetricSpace [X]. -Definition from_SubPsMetricSpace (X : CPsMetricSpace) +Definition from_SubPsMetricSpace (X : CPsMetricSpace) (P : X -> CProp) : SubPsMetricSpace P -> X. -intros X p. -unfold SubPsMetricSpace in |- *. -simpl in |- *. -intro x. -case x. -intros y Q. -exact y. +Proof. + intros X p. + unfold SubPsMetricSpace in |- *. + simpl in |- *. + intro x. + case x. + intros y Q. + exact y. Defined. (** -The function [dsub'] is used in the definition of %''located''% #"located"#. -It enables one to speak about a distance between an element of a +The function [dsub'] is used in the definition of %''located''% #"located"#. +It enables one to speak about a distance between an element of a pseudo metric space and a certain subspace. *) -Definition dsub' (X : CPsMetricSpace) (P : X -> CProp) +Definition dsub' (X : CPsMetricSpace) (P : X -> CProp) (x : X) (y : SubPsMetricSpace P) := from_SubPsMetricSpace X P y[-d]x. Implicit Arguments dsub' [X]. @@ -348,25 +345,25 @@ Implicit Arguments dsub' [X]. Lemma dsub'_strext : forall (X : CPsMetricSpace) (P : X -> CProp) (x : X), fun_strext (dsub' P x). -intros X P x. -unfold fun_strext in |- *. -intros x0 y. -unfold dsub' in |- *. -case y. -case x0. -intros a b c d. -simpl in |- *. -intro H. -set (H1 := csbf_strext _ _ _ (cms_d (c:=X)) _ _ _ _ H) in *. -elim H1. -intuition. - -intro H2. -set (H3 := ap_irreflexive_unfolded X x H2) in *. -intuition. +Proof. + intros X P x. + unfold fun_strext in |- *. + intros x0 y. + unfold dsub' in |- *. + case y. + case x0. + intros a b c d. + simpl in |- *. + intro H. + set (H1 := csbf_strext _ _ _ (cms_d (c:=X)) _ _ _ _ H) in *. + elim H1. + intuition. + intro H2. + set (H3 := ap_irreflexive_unfolded X x H2) in *. + intuition. Qed. -Definition dsub'_as_cs_fun (X : CPsMetricSpace) (P : X -> CProp) +Definition dsub'_as_cs_fun (X : CPsMetricSpace) (P : X -> CProp) (x : X) := Build_CSetoid_fun (SubPsMetricSpace P) IR_as_CPsMetricSpace ( dsub' P x) (dsub'_strext X P x). @@ -376,44 +373,41 @@ Implicit Arguments dsub'_as_cs_fun [X]. Lemma dsub'_uni_continuous'' : forall (X : CPsMetricSpace) (P : X -> CProp) (x : X), uni_continuous'' (dsub'_as_cs_fun P x). -intros X P x. -unfold dsub'_as_cs_fun in |- *. -unfold dsub' in |- *. -apply uni_continuous'_imp_uni_continuous''. -unfold from_SubPsMetricSpace in |- *. -unfold uni_continuous' in |- *. -simpl in |- *. -intro n. -exists n. -intros x0 x1. -case x0. -case x1. -intros. -generalize H. -simpl in |- *. -intro. -apply leEq_transitive with (scs_elem0[-d]scs_elem). -2: exact H0. -unfold dIR in |- *. -astepl (AbsIR ((scs_elem0[-d]x)[-](scs_elem[-d]x))). -astepl (AbsIR ((x[-d]scs_elem0)[-](scs_elem[-d]x))). -astepl (AbsIR ((x[-d]scs_elem0)[-](x[-d]scs_elem))). -apply AbsSmall_imp_AbsIR. -apply rev_tri_ineq. - -apply csf_wd. -apply cg_minus_wd. -intuition. - -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. - -apply csf_wd. -apply cg_minus_wd. -apply ax_d_com. -apply CPsMetricSpace_is_CPsMetricSpace. - -intuition. +Proof. + intros X P x. + unfold dsub'_as_cs_fun in |- *. + unfold dsub' in |- *. + apply uni_continuous'_imp_uni_continuous''. + unfold from_SubPsMetricSpace in |- *. + unfold uni_continuous' in |- *. + simpl in |- *. + intro n. + exists n. + intros x0 x1. + case x0. + case x1. + intros. + generalize H. + simpl in |- *. + intro. + apply leEq_transitive with (scs_elem0[-d]scs_elem). + 2: exact H0. + unfold dIR in |- *. + astepl (AbsIR ((scs_elem0[-d]x)[-](scs_elem[-d]x))). + astepl (AbsIR ((x[-d]scs_elem0)[-](scs_elem[-d]x))). + astepl (AbsIR ((x[-d]scs_elem0)[-](x[-d]scs_elem))). + apply AbsSmall_imp_AbsIR. + apply rev_tri_ineq. + apply csf_wd. + apply cg_minus_wd. + intuition. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + apply csf_wd. + apply cg_minus_wd. + apply ax_d_com. + apply CPsMetricSpace_is_CPsMetricSpace. + intuition. Qed. diff --git a/model/Zmod/Cmod.v b/model/Zmod/Cmod.v index 656fee90a..fa78cabb0 100644 --- a/model/Zmod/Cmod.v +++ b/model/Zmod/Cmod.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export ZMod. Require Export CLogic. @@ -43,101 +43,100 @@ Require Export CLogic. Lemma Zmod_pos:(forall (k l:nat)(H:(l>0)%Z), (k mod l)%Z=0 or {p:positive|(k mod l)%Z =(Zpos p)}):CProp. -simpl. -intros k l. -intro H0. -set (H:= (Z_mod_lt k l H0)). -elim H. -clear H. -intros H1 H2. -elim (Z_le_lt_eq_dec 0 (k mod l)%Z H1). -case (k mod l)%Z. -intuition. -intros p H. -right. -exists p. -reflexivity. - -intros p H3. -2:intuition. -Set Printing Coercions. -cut False. -intuition. -cut (Zneg p < 0)%Z. -intuition. -unfold Zlt. -intuition. +Proof. + simpl. + intros k l. + intro H0. + set (H:= (Z_mod_lt k l H0)). + elim H. + clear H. + intros H1 H2. + elim (Z_le_lt_eq_dec 0 (k mod l)%Z H1). + case (k mod l)%Z. + intuition. + intros p H. + right. + exists p. + reflexivity. + intros p H3. + 2:intuition. + Set Printing Coercions. + cut False. + intuition. + cut (Zneg p < 0)%Z. + intuition. + unfold Zlt. + intuition. Qed. Definition mod_nat: forall (k l:nat)(H:(l>0)%Z),nat. -intros k l H3. -set (H:= (Zmod_pos k l H3)). -elim H. -intro H0. -exact 0. - -intro H0. -elim H0. -intros p H1. -exact (nat_of_P p). +Proof. + intros k l H3. + set (H:= (Zmod_pos k l H3)). + elim H. + intro H0. + exact 0. + intro H0. + elim H0. + intros p H1. + exact (nat_of_P p). Defined. Lemma mod_nat_correct: forall (k l:nat)(H:(l>0)%Z), (k mod l)%Z = (Z_of_nat (mod_nat k l H)). -intros k l H. -unfold mod_nat. -unfold COr_rec. -unfold COr_rect. -case ( Zmod_pos k l H). -tauto. - -unfold sigT_rec. -unfold sigT_rect. -intro H0. -case H0. -Set Printing Coercions. -simpl. -intro x. -set (H1:= (inject_nat_convert x)). -intuition. +Proof. + intros k l H. + unfold mod_nat. + unfold COr_rec. + unfold COr_rect. + case ( Zmod_pos k l H). + tauto. + unfold sigT_rec. + unfold sigT_rect. + intro H0. + case H0. + Set Printing Coercions. + simpl. + intro x. + set (H1:= (inject_nat_convert x)). + intuition. Qed. Lemma nat_Z_div:forall (a b c r:nat)(b' r':Z), a=b*c+r->r((Z_of_nat a)=c*b'+r')%Z->(0<=r' ((Z_of_nat r)=r'). -intros a b c0 r b' r' H H1 H2 H3. -cut (c0>0)%Z. -intro H5. -set (H4:=(Z_div_mod_eq (Z_of_nat a) (Z_of_nat c0) H5)). -2:intuition. -cut ((Z_of_nat a mod (Z_of_nat c0))%Z = r'). -intro H6. -rewrite<- H6. -cut ((Z_of_nat a mod (Z_of_nat c0))%Z= (Z_of_nat r)). -intro H7. -rewrite<- H7. -reflexivity. -rewrite H. -cut (c0>0)%Z. -intro H7. -set (H8:= (Zmod_cancel_multiple c0 r b H7)). -2:intuition. -set (H9:= (inj_mult b c0)). -set (H10:= (inj_plus (b*c0) r)). -rewrite H10. -rewrite H9. -rewrite H8. -apply Zmod_small. -intuition. - -intuition. - -rewrite H2. -replace (Z_of_nat c0 * b' + r')%Z with ( b'*Z_of_nat c0 + r')%Z. -2:intuition. -set (H8:= (Zmod_cancel_multiple c0 r' b' H5)). -rewrite H8. -apply Zmod_small. -intuition. -intuition. +Proof. + intros a b c0 r b' r' H H1 H2 H3. + cut (c0>0)%Z. + intro H5. + set (H4:=(Z_div_mod_eq (Z_of_nat a) (Z_of_nat c0) H5)). + 2:intuition. + cut ((Z_of_nat a mod (Z_of_nat c0))%Z = r'). + intro H6. + rewrite<- H6. + cut ((Z_of_nat a mod (Z_of_nat c0))%Z= (Z_of_nat r)). + intro H7. + rewrite<- H7. + reflexivity. + rewrite H. + cut (c0>0)%Z. + intro H7. + set (H8:= (Zmod_cancel_multiple c0 r b H7)). + 2:intuition. + set (H9:= (inj_mult b c0)). + set (H10:= (inj_plus (b*c0) r)). + rewrite H10. + rewrite H9. + rewrite H8. + apply Zmod_small. + intuition. + intuition. + rewrite H2. + replace (Z_of_nat c0 * b' + r')%Z with ( b'*Z_of_nat c0 + r')%Z. + 2:intuition. + set (H8:= (Zmod_cancel_multiple c0 r' b' H5)). + rewrite H8. + apply Zmod_small. + intuition. + intuition. Qed. diff --git a/model/Zmod/IrrCrit.v b/model/Zmod/IrrCrit.v index bf7d045d6..b23b686b0 100644 --- a/model/Zmod/IrrCrit.v +++ b/model/Zmod/IrrCrit.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* IrrCrit.v, v1.1, 27aug2004, Bart Kirkels *) @@ -46,8 +46,8 @@ Require Export CPoly_Degree. (** * An irreducibility criterion -Let [p] be a (positive) prime number. Our goal is to prove that if an integer -polynomial is irreducible over the prime field Fp, then it is irreducible over +Let [p] be a (positive) prime number. Our goal is to prove that if an integer +polynomial is irreducible over the prime field Fp, then it is irreducible over Z. *) @@ -63,12 +63,13 @@ Definition fp := (Fp p Hprime). Definition zfp (a:Z) := (a:fp). Lemma fpeq_wd : forall a b:Z, a=b -> (zfp a)[=](zfp b). -intros a b heq. -simpl. -unfold zfp in *. -unfold ZModeq in *. -elim heq. -auto with *. +Proof. + intros a b heq. + simpl. + unfold zfp in *. + unfold ZModeq in *. + elim heq. + auto with *. Qed. (** @@ -88,47 +89,45 @@ Fixpoint zxfpx (p:zx) : fpx := Definition P (f g:zx):= f[=]g -> (zxfpx f)[=](zxfpx g). Lemma fpxeq_wd : forall f g:zx, f[=]g -> (zxfpx f)[=](zxfpx g). -apply (cpoly_double_ind Z_as_CRing P); unfold P. - -induction p0 as [|c p0]. -trivial. -intro H. -astepl ((zfp c)[+X*](zxfpx p0)). -apply (_linear_eq_zero fp). -split. -astepr (zfp 0). -apply fpeq_wd. -elim H. -auto. -apply IHp0. -elim H. -auto with *. - -induction p0 as [|c p0]. -trivial. -intro H. -astepr ((zfp c)[+X*](zxfpx p0)). -apply (_zero_eq_linear fp). -split. -astepr (zfp 0). -apply fpeq_wd. -elim H. -auto. -apply IHp0. -elim H. -auto with *. - -intros p0 q c d H1 H2. -astepr ((zfp d)[+X*](zxfpx q)). -astepl ((zfp c)[+X*](zxfpx p0)). -apply (_linear_eq_linear fp). -split. -apply fpeq_wd. -elim H2. -auto. -apply H1. -elim H2. -auto. +Proof. + apply (cpoly_double_ind Z_as_CRing P); unfold P. + induction p0 as [|c p0]. + trivial. + intro H. + astepl ((zfp c)[+X*](zxfpx p0)). + apply (_linear_eq_zero fp). + split. + astepr (zfp 0). + apply fpeq_wd. + elim H. + auto. + apply IHp0. + elim H. + auto with *. + induction p0 as [|c p0]. + trivial. + intro H. + astepr ((zfp c)[+X*](zxfpx p0)). + apply (_zero_eq_linear fp). + split. + astepr (zfp 0). + apply fpeq_wd. + elim H. + auto. + apply IHp0. + elim H. + auto with *. + intros p0 q c d H1 H2. + astepr ((zfp d)[+X*](zxfpx q)). + astepl ((zfp c)[+X*](zxfpx p0)). + apply (_linear_eq_linear fp). + split. + apply fpeq_wd. + elim H2. + auto. + apply H1. + elim H2. + auto. Qed. Hint Resolve fpxeq_wd : algebra. @@ -145,27 +144,30 @@ viewed over a prime field. Lemma mult_zero : forall (R:CRing)(f:cpoly_cring R), (cpoly_mult_op R f (cpoly_zero R))[=](cpoly_zero R). -intros R f. -simpl; apply cpoly_mult_zero. +Proof. + intros R f. + simpl; apply cpoly_mult_zero. Qed. Hint Resolve mult_zero : algebra. Lemma fp_resp_zero : zxfpx(cpoly_zero Z_as_CRing)[=](cpoly_zero fp). -intuition. +Proof. + intuition. Qed. Lemma fpx_resp_mult_cr : forall (c:Z_as_CRing)(f:zx), (cpoly_mult_cr_cs fp (zxfpx f) (zfp c)) [=] (zxfpx (cpoly_mult_cr_cs _ f c)). -induction f as [|c0 f]. -intuition. -astepr (zxfpx ((c[*]c0)[+X*](cpoly_mult_cr_cs _ f c))). -astepr ((zfp (c[*]c0))[+X*](zxfpx (cpoly_mult_cr_cs _ f c))). -astepr (((zfp c)[*](zfp c0))[+X*](zxfpx (cpoly_mult_cr_cs _ f c))). -astepr (((zfp c)[*](zfp c0))[+X*](cpoly_mult_cr_cs fp (zxfpx f) (zfp c))). -astepr (cpoly_mult_cr_cs fp ((zfp c0)[+X*](zxfpx f)) (zfp c)). -intuition. +Proof. + induction f as [|c0 f]. + intuition. + astepr (zxfpx ((c[*]c0)[+X*](cpoly_mult_cr_cs _ f c))). + astepr ((zfp (c[*]c0))[+X*](zxfpx (cpoly_mult_cr_cs _ f c))). + astepr (((zfp c)[*](zfp c0))[+X*](zxfpx (cpoly_mult_cr_cs _ f c))). + astepr (((zfp c)[*](zfp c0))[+X*](cpoly_mult_cr_cs fp (zxfpx f) (zfp c))). + astepr (cpoly_mult_cr_cs fp ((zfp c0)[+X*](zxfpx f)) (zfp c)). + intuition. Qed. Hint Resolve fpx_resp_mult_cr : algebra. @@ -173,75 +175,73 @@ Hint Resolve fpx_resp_mult_cr : algebra. Lemma fpx_resp_plus : forall f g:zx, (cpoly_plus_op fp (zxfpx f) (zxfpx g))[=] (zxfpx (cpoly_plus_op _ f g)). -induction f as [|c f]. -intuition. -induction g as [|c0 g]. -intuition. -astepl (cpoly_plus fp (zxfpx (c[+X*]f)) (zxfpx (c0[+X*]g))). -astepr (zxfpx (cpoly_plus_op _ (c[+X*]f) (c0[+X*]g))). -astepr (zxfpx ((c[+]c0)[+X*](cpoly_plus_op _ f g))). -astepr ((zfp (c[+]c0))[+X*](zxfpx (cpoly_plus_op _ f g))). -astepl (((zfp c)[+](zfp c0))[+X*] - (cpoly_plus_op fp (zxfpx f) (zxfpx g))). -auto with *. +Proof. + induction f as [|c f]. + intuition. + induction g as [|c0 g]. + intuition. + astepl (cpoly_plus fp (zxfpx (c[+X*]f)) (zxfpx (c0[+X*]g))). + astepr (zxfpx (cpoly_plus_op _ (c[+X*]f) (c0[+X*]g))). + astepr (zxfpx ((c[+]c0)[+X*](cpoly_plus_op _ f g))). + astepr ((zfp (c[+]c0))[+X*](zxfpx (cpoly_plus_op _ f g))). + astepl (((zfp c)[+](zfp c0))[+X*] (cpoly_plus_op fp (zxfpx f) (zxfpx g))). + auto with *. Qed. Hint Resolve fpx_resp_plus : algebra. Lemma fpx_resp_mult : forall f g:zx, - (cpoly_mult_op fp (zxfpx f) (zxfpx g)) [=] + (cpoly_mult_op fp (zxfpx f) (zxfpx g)) [=] (zxfpx (cpoly_mult_op _ f g)). -induction f as [|c f]. -intro g. -astepl (cpoly_mult_op fp (cpoly_zero fp)(zxfpx g)). -astepl (cpoly_zero fp). -astepr (zxfpx (cpoly_zero Z_as_CRing)). -astepr (cpoly_zero fp); intuition. - -induction g as [|c0 g]. -astepl (cpoly_mult_op fp (zxfpx (c[+X*]f)) (cpoly_zero fp)). -astepl (cpoly_zero fp). -astepr (zxfpx (cpoly_zero Z_as_CRing)); try algebra. -apply fpxeq_wd. -apply eq_symmetric. -apply (mult_zero Z_as_CRing). - -astepr (zxfpx (cpoly_mult_op Z_as_CRing (c[+X*]f) (c0[+X*]g))). -astepl (cpoly_mult_op fp (zxfpx (c[+X*]f)) (zxfpx (c0[+X*]g))). -astepr (zxfpx (cpoly_plus_op _ ((c[*]c0)[+X*](cpoly_mult_cr_cs _ g c)) - ((Zero:Z_as_CRing)[+X*](cpoly_mult _ f (c0[+X*]g))))). -astepr (zxfpx (((c[*]c0)[+](Zero:Z_as_CRing))[+X*](cpoly_plus_op _ - (cpoly_mult_cr_cs _ g c) (cpoly_mult _ f (c0[+X*]g))))). -astepr (zxfpx ((c[*]c0)[+X*](cpoly_plus_op _ (cpoly_mult_cr_cs _ g c) - (cpoly_mult _ f (c0[+X*]g))))). -astepr ( (zfp c[*]c0) [+X*] (zxfpx (cpoly_plus_op _ (cpoly_mult_cr_cs _ g c) - (cpoly_mult _ f (c0[+X*]g))))). - -astepl (cpoly_mult_op fp ((zfp c)[+X*](zxfpx f)) (zxfpx (c0[+X*]g))). -astepl (cpoly_plus_op fp (cpoly_mult_cr_cs fp (zxfpx (c0[+X*]g)) (zfp c)) - ((zfp (Zero:Z_as_CRing))[+X*](cpoly_mult_op fp (zxfpx f) (zxfpx (c0[+X*]g))))). -astepl (cpoly_plus_op fp (cpoly_mult_cr_cs fp ((zfp c0)[+X*](zxfpx g)) (zfp c)) - ((Zero:fp)[+X*](zxfpx (cpoly_mult_op _ f (c0[+X*]g))))). -astepl (cpoly_plus_op fp (((zfp c)[*](zfp c0))[+X*](cpoly_mult_cr_cs fp (zxfpx g) (zfp c))) - ((Zero:fp)[+X*](zxfpx (cpoly_mult_op _ f (c0[+X*]g))))). -astepl (cpoly_plus_op fp ((zfp (c[*]c0))[+X*](zxfpx (cpoly_mult_cr_cs _ g c))) - ((Zero:fp)[+X*](zxfpx (cpoly_mult_op _ f (c0[+X*]g))))). -astepl ((zfp (c[*]c0)[+](Zero:fp))[+X*](cpoly_plus_op fp - (zxfpx (cpoly_mult_cr_cs _ g c)) (zxfpx (cpoly_mult_op _ f (c0[+X*]g))))). -intuition. +Proof. + induction f as [|c f]. + intro g. + astepl (cpoly_mult_op fp (cpoly_zero fp)(zxfpx g)). + astepl (cpoly_zero fp). + astepr (zxfpx (cpoly_zero Z_as_CRing)). + astepr (cpoly_zero fp); intuition. + induction g as [|c0 g]. + astepl (cpoly_mult_op fp (zxfpx (c[+X*]f)) (cpoly_zero fp)). + astepl (cpoly_zero fp). + astepr (zxfpx (cpoly_zero Z_as_CRing)); try algebra. + apply fpxeq_wd. + apply eq_symmetric. + apply (mult_zero Z_as_CRing). + astepr (zxfpx (cpoly_mult_op Z_as_CRing (c[+X*]f) (c0[+X*]g))). + astepl (cpoly_mult_op fp (zxfpx (c[+X*]f)) (zxfpx (c0[+X*]g))). + astepr (zxfpx (cpoly_plus_op _ ((c[*]c0)[+X*](cpoly_mult_cr_cs _ g c)) + ((Zero:Z_as_CRing)[+X*](cpoly_mult _ f (c0[+X*]g))))). + astepr (zxfpx (((c[*]c0)[+](Zero:Z_as_CRing))[+X*](cpoly_plus_op _ + (cpoly_mult_cr_cs _ g c) (cpoly_mult _ f (c0[+X*]g))))). + astepr (zxfpx ((c[*]c0)[+X*](cpoly_plus_op _ (cpoly_mult_cr_cs _ g c) (cpoly_mult _ f (c0[+X*]g))))). + astepr ( (zfp c[*]c0) [+X*] (zxfpx (cpoly_plus_op _ (cpoly_mult_cr_cs _ g c) + (cpoly_mult _ f (c0[+X*]g))))). + astepl (cpoly_mult_op fp ((zfp c)[+X*](zxfpx f)) (zxfpx (c0[+X*]g))). + astepl (cpoly_plus_op fp (cpoly_mult_cr_cs fp (zxfpx (c0[+X*]g)) (zfp c)) + ((zfp (Zero:Z_as_CRing))[+X*](cpoly_mult_op fp (zxfpx f) (zxfpx (c0[+X*]g))))). + astepl (cpoly_plus_op fp (cpoly_mult_cr_cs fp ((zfp c0)[+X*](zxfpx g)) (zfp c)) + ((Zero:fp)[+X*](zxfpx (cpoly_mult_op _ f (c0[+X*]g))))). + astepl (cpoly_plus_op fp (((zfp c)[*](zfp c0))[+X*](cpoly_mult_cr_cs fp (zxfpx g) (zfp c))) + ((Zero:fp)[+X*](zxfpx (cpoly_mult_op _ f (c0[+X*]g))))). + astepl (cpoly_plus_op fp ((zfp (c[*]c0))[+X*](zxfpx (cpoly_mult_cr_cs _ g c))) + ((Zero:fp)[+X*](zxfpx (cpoly_mult_op _ f (c0[+X*]g))))). + astepl ((zfp (c[*]c0)[+](Zero:fp))[+X*](cpoly_plus_op fp + (zxfpx (cpoly_mult_cr_cs _ g c)) (zxfpx (cpoly_mult_op _ f (c0[+X*]g))))). + intuition. Qed. Hint Resolve fpx_resp_mult : algebra. Lemma fpx_resp_coef : forall (f:zx)(n:nat), (zfp (nth_coeff n f)) [=] (nth_coeff n (zxfpx f)). -induction f. -intuition. -induction n. -intuition. -astepl (zfp (nth_coeff n f)). -astepr (nth_coeff n (zxfpx f)). -apply (IHf n). +Proof. + induction f. + intuition. + induction n. + intuition. + astepl (zfp (nth_coeff n f)). + astepr (nth_coeff n (zxfpx f)). + apply (IHf n). Qed. Hint Resolve fpx_resp_coef : algebra. @@ -253,7 +253,7 @@ Hint Resolve fpx_resp_coef : algebra. *** Definitions We prove the criterion for monic integers of degree greater than 1. This property is first defined, so that reducibility can be defined next. -We then prove that a reducible integer polynomial is reducible over +We then prove that a reducible integer polynomial is reducible over Fp. Finally irreducibility is defined. *) @@ -264,28 +264,28 @@ Definition degree_ge_monic (R:CRing)(n:nat)(f:(cpoly_cring R)) := Lemma fpx_resp_deggemonic : forall (f:zx)(n:nat), degree_ge_monic _ n f -> degree_ge_monic _ n (zxfpx f). -intros f n; unfold degree_ge_monic. -intro X; elim X. -intros m Hm Hfmonm. -exists m. -exact Hm. -elim Hfmonm. -intros Hnthcoeff Hdegf. -unfold monic. -split. -astepl (zfp (nth_coeff m f)). -assert (One[=]nth_coeff m f); intuition. -simpl in H. -rewrite <- H. -intuition. - -red. -intros. -astepl (zfp (nth_coeff m0 f)). -assert (Zero[=]nth_coeff m0 f); intuition. -simpl in H0. -rewrite <- H0. -intuition. +Proof. + intros f n; unfold degree_ge_monic. + intro X; elim X. + intros m Hm Hfmonm. + exists m. + exact Hm. + elim Hfmonm. + intros Hnthcoeff Hdegf. + unfold monic. + split. + astepl (zfp (nth_coeff m f)). + assert (One[=]nth_coeff m f); intuition. + simpl in H. + rewrite <- H. + intuition. + red. + intros. + astepl (zfp (nth_coeff m0 f)). + assert (Zero[=]nth_coeff m0 f); intuition. + simpl in H0. + rewrite <- H0. + intuition. Qed. Hint Resolve fpx_resp_deggemonic : algebra. @@ -297,39 +297,41 @@ Definition reducible (R:CRing)(f:(cpoly_cring R)) := f[=](cpoly_mult_op R g h) }}. Lemma fpx_resp_red : forall f:zx, (reducible _ f)->(reducible fp (zxfpx f)). -intros f Hfred; elim Hfred. -intros Hfok Hfred2; elim Hfred2. -intros g Hgok Hfred3; elim Hfred3. -intros h Hhok Hfgh; unfold reducible. -intuition. -exists (zxfpx g). -intuition. -exists (zxfpx h). -intuition. -astepr (zxfpx (cpoly_mult_op _ g h)). -apply fpxeq_wd. -exact Hfgh. +Proof. + intros f Hfred; elim Hfred. + intros Hfok Hfred2; elim Hfred2. + intros g Hgok Hfred3; elim Hfred3. + intros h Hhok Hfgh; unfold reducible. + intuition. + exists (zxfpx g). + intuition. + exists (zxfpx h). + intuition. + astepr (zxfpx (cpoly_mult_op _ g h)). + apply fpxeq_wd. + exact Hfgh. Qed. Hint Resolve fpx_resp_red : algebra. -Definition irreducible (R:CRing)(f:(cpoly_cring R)) := +Definition irreducible (R:CRing)(f:(cpoly_cring R)) := Not (reducible R f). -(** +(** *** The criterion And now we can state and prove the irreducibility criterion. *) Theorem irrcrit : forall f:zx, (irreducible fp (zxfpx f)) -> (irreducible _ f). -unfold irreducible. -intro f. -cut ((reducible _ f) -> (reducible fp (zxfpx f))). -intros X H X0. -apply H. -apply X. -exact X0. -apply fpx_resp_red. +Proof. + unfold irreducible. + intro f. + cut ((reducible _ f) -> (reducible fp (zxfpx f))). + intros X H X0. + apply H. + apply X. + exact X0. + apply fpx_resp_red. Qed. diff --git a/model/Zmod/ZBasics.v b/model/Zmod/ZBasics.v index 43ac36f7b..3c9b9f6f4 100644 --- a/model/Zmod/ZBasics.v +++ b/model/Zmod/ZBasics.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* ZBasics.v, by Vince Barany *) Require Export ZArith. @@ -46,71 +46,75 @@ Require Export CLogic. Section narith. Lemma le_trans : forall l k n : nat, k <= l -> l <= n -> k <= n. -intros l k n Hkl Hln. -induction n as [| n Hrecn]. -inversion Hln. -rewrite <- H. -exact Hkl. -inversion Hln. -rewrite <- H. -exact Hkl. -apply le_S. -apply Hrecn. -assumption. +Proof. + intros l k n Hkl Hln. + induction n as [| n Hrecn]. + inversion Hln. + rewrite <- H. + exact Hkl. + inversion Hln. + rewrite <- H. + exact Hkl. + apply le_S. + apply Hrecn. + assumption. Qed. Lemma minus_n_Sk : forall n k : nat, k < n -> n - k = S (n - S k). -intros n k Hlt. -induction n as [| n Hrecn]. -inversion Hlt. -rewrite <- minus_Sn_m. -simpl in |- *. -reflexivity. -unfold lt in Hlt. -inversion Hlt. -auto. -apply (le_trans (S k)). -auto. -assumption. +Proof. + intros n k Hlt. + induction n as [| n Hrecn]. + inversion Hlt. + rewrite <- minus_Sn_m. + simpl in |- *. + reflexivity. + unfold lt in Hlt. + inversion Hlt. + auto. + apply (le_trans (S k)). + auto. + assumption. Qed. Lemma le_minus : forall n k : nat, n - k <= n. -intros n. -induction n as [| n Hrecn]. -simpl in |- *. -auto. -intro k. -case k. -simpl in |- *. -auto. -intro k'. -simpl in |- *. -apply (le_trans n). -apply Hrecn. -auto. +Proof. + intros n. + induction n as [| n Hrecn]. + simpl in |- *. + auto. + intro k. + case k. + simpl in |- *. + auto. + intro k'. + simpl in |- *. + apply (le_trans n). + apply Hrecn. + auto. Qed. Lemma minus_n_minus_n_k : forall k n : nat, k <= n -> k = n - (n - k). -intros k n Hle. -induction k as [| k Hreck]. -rewrite <- minus_n_O. -apply minus_n_n. -set (K := k) in |- * at 2. -rewrite Hreck. -unfold K in |- *; clear K. -rewrite (minus_n_Sk n k). -rewrite (minus_n_Sk n (n - S k)). -reflexivity. -unfold lt in |- *. -rewrite <- (minus_n_Sk n k). -apply le_minus. -unfold lt in |- *. -exact Hle. -unfold lt in |- *. -exact Hle. -apply (le_trans (S k)). -auto. -exact Hle. +Proof. + intros k n Hle. + induction k as [| k Hreck]. + rewrite <- minus_n_O. + apply minus_n_n. + set (K := k) in |- * at 2. + rewrite Hreck. + unfold K in |- *; clear K. + rewrite (minus_n_Sk n k). + rewrite (minus_n_Sk n (n - S k)). + reflexivity. + unfold lt in |- *. + rewrite <- (minus_n_Sk n k). + apply le_minus. + unfold lt in |- *. + exact Hle. + unfold lt in |- *. + exact Hle. + apply (le_trans (S k)). + auto. + exact Hle. Qed. @@ -128,88 +132,94 @@ Hint Resolve minus_n_minus_n_k: zarith. Section zarith. Definition Zdec : forall a : Z, {a = 0%Z} + {a <> 0%Z}. -intro a. -case a. -left; reflexivity. -intro; right; discriminate. -intro; right; discriminate. +Proof. + intro a. + case a. + left; reflexivity. + intro; right; discriminate. + intro; right; discriminate. Defined. (* True in any ring *) Lemma unique_unit : forall u : Z, (forall a : Z, (a * u)%Z = a) -> u = 1%Z. -intros. -rewrite <- (Zmult_1_l u). -rewrite (H 1%Z). -reflexivity. +Proof. + intros. + rewrite <- (Zmult_1_l u). + rewrite (H 1%Z). + reflexivity. Qed. Lemma Zmult_zero_div : forall a b : Z, (a * b)%Z = 0%Z -> a = 0%Z \/ b = 0%Z. -intros a b. -case a; case b; intros; auto; try discriminate. +Proof. + intros a b. + case a; case b; intros; auto; try discriminate. Qed. Lemma Zmult_no_zero_div : forall a b : Z, a <> 0%Z -> b <> 0%Z -> (a * b)%Z <> 0%Z. -intros a b Ha Hb. -intro Hfalse. -generalize (Zmult_zero_div a b Hfalse). -tauto. +Proof. + intros a b Ha Hb. + intro Hfalse. + generalize (Zmult_zero_div a b Hfalse). + tauto. Qed. Lemma Zmult_unit_oneforall : forall u a : Z, a <> 0%Z -> (a * u)%Z = a -> forall b : Z, (b * u)%Z = b. -intros u a H0 Hu b. -apply (Zmult_absorb a). -assumption. -rewrite Zmult_assoc. -rewrite (Zmult_comm a b). -rewrite <- Zmult_assoc. -rewrite Hu. -reflexivity. +Proof. + intros u a H0 Hu b. + apply (Zmult_absorb a). + assumption. + rewrite Zmult_assoc. + rewrite (Zmult_comm a b). + rewrite <- Zmult_assoc. + rewrite Hu. + reflexivity. Qed. Lemma Zunit_eq_one : forall u a : Z, a <> 0%Z -> (a * u)%Z = a -> u = 1%Z. -intros u a H1 H2. -apply unique_unit. -intro. -apply (Zmult_unit_oneforall u a H1 H2). +Proof. + intros u a H1 H2. + apply unique_unit. + intro. + apply (Zmult_unit_oneforall u a H1 H2). Qed. Lemma Zmult_intro_lft : forall a b c : Z, a <> 0%Z -> (a * b)%Z = (a * c)%Z -> b = c. -intros a b c Ha Habc. -cut ((b - c)%Z = 0%Z); auto with zarith. -elim (Zmult_zero_div a (b - c)). -intro; elim Ha; assumption. -tauto. -rewrite Zmult_comm; rewrite BinInt.Zmult_minus_distr_r; - rewrite (Zmult_comm b a); rewrite (Zmult_comm c a). -auto with zarith. +Proof. + intros a b c Ha Habc. + cut ((b - c)%Z = 0%Z); auto with zarith. + elim (Zmult_zero_div a (b - c)). + intro; elim Ha; assumption. + tauto. + rewrite Zmult_comm; rewrite BinInt.Zmult_minus_distr_r; + rewrite (Zmult_comm b a); rewrite (Zmult_comm c a). + auto with zarith. Qed. Lemma Zmult_intro_rht : forall a b c : Z, a <> 0%Z -> (b * a)%Z = (c * a)%Z -> b = c. -intros a b c. -rewrite (Zmult_comm b a); rewrite (Zmult_comm c a); apply Zmult_intro_lft. +Proof. + intros a b c. + rewrite (Zmult_comm b a); rewrite (Zmult_comm c a); apply Zmult_intro_lft. Qed. Lemma succ_nat: forall (m:nat),Zpos (P_of_succ_nat m) = (Z_of_nat m + 1)%Z. -intro m. -induction m. -reflexivity. - -simpl. -case (P_of_succ_nat m). -simpl. -reflexivity. - -simpl. -reflexivity. - -simpl. -reflexivity. +Proof. + intro m. + induction m. + reflexivity. + simpl. + case (P_of_succ_nat m). + simpl. + reflexivity. + simpl. + reflexivity. + simpl. + reflexivity. Qed. End zarith. @@ -231,114 +241,137 @@ Hint Resolve Zmult_intro_rht: zarith. Section zineq. Lemma Zgt_Zge: forall (n m:Z), (n>m)%Z -> (n>=m)%Z. -intros n m. -intuition. +Proof. + intros n m. + intuition. Qed. Lemma Zle_antisymm : forall a b : Z, (a >= b)%Z -> (b >= a)%Z -> a = b. -auto with zarith. +Proof. + auto with zarith. Qed. Definition Zlt_irref : forall a : Z, ~ (a < a)%Z := Zlt_irrefl. Lemma Zgt_irref : forall a : Z, ~ (a > a)%Z. -intro a. -intro Hlt. -generalize (Zgt_lt a a Hlt). -apply Zlt_irref. +Proof. + intro a. + intro Hlt. + generalize (Zgt_lt a a Hlt). + apply Zlt_irref. Qed. Lemma Zlt_NEG_0 : forall p : positive, (Zneg p < 0)%Z. -intro p; unfold Zlt in |- *; simpl in |- *; reflexivity. +Proof. + intro p; unfold Zlt in |- *; simpl in |- *; reflexivity. Qed. Lemma Zgt_0_NEG : forall p : positive, (0 > Zneg p)%Z. -intro p; unfold Zgt in |- *; simpl in |- *; reflexivity. +Proof. + intro p; unfold Zgt in |- *; simpl in |- *; reflexivity. Qed. Lemma Zle_NEG_0 : forall p : positive, (Zneg p <= 0)%Z. -intro p; intro H0; inversion H0. +Proof. + intro p; intro H0; inversion H0. Qed. Lemma Zge_0_NEG : forall p : positive, (0 >= Zneg p)%Z. -intro p; intro H0; inversion H0. +Proof. + intro p; intro H0; inversion H0. Qed. Lemma Zle_NEG_1 : forall p : positive, (Zneg p <= -1)%Z. -intro p. -case p; intros; intro H0; inversion H0. +Proof. + intro p. + case p; intros; intro H0; inversion H0. Qed. Lemma Zge_1_NEG : forall p : positive, (-1 >= Zneg p)%Z. -intro p. -case p; intros; intro H0; inversion H0. +Proof. + intro p. + case p; intros; intro H0; inversion H0. Qed. Lemma Zlt_0_POS : forall p : positive, (0 < Zpos p)%Z. -intro p; unfold Zlt in |- *; simpl in |- *; reflexivity. +Proof. + intro p; unfold Zlt in |- *; simpl in |- *; reflexivity. Qed. Lemma Zgt_POS_0 : forall p : positive, (Zpos p > 0)%Z. -intro p; unfold Zgt in |- *; simpl in |- *; reflexivity. +Proof. + intro p; unfold Zgt in |- *; simpl in |- *; reflexivity. Qed. Lemma Zle_0_POS : forall p : positive, (0 <= Zpos p)%Z. -intro p; intro H0; inversion H0. +Proof. + intro p; intro H0; inversion H0. Qed. Lemma Zge_POS_0 : forall p : positive, (Zpos p >= 0)%Z. -intro p; intro H0; inversion H0. +Proof. + intro p; intro H0; inversion H0. Qed. Lemma Zle_1_POS : forall p : positive, (1 <= Zpos p)%Z. -intro p. -case p; intros; intro H0; inversion H0. +Proof. + intro p. + case p; intros; intro H0; inversion H0. Qed. Lemma Zge_POS_1 : forall p : positive, (Zpos p >= 1)%Z. -intro p. -case p; intros; intro H0; inversion H0. +Proof. + intro p. + case p; intros; intro H0; inversion H0. Qed. Lemma Zle_neg_pos : forall p q : positive, (Zneg p <= Zpos q)%Z. -intros; unfold Zle in |- *; simpl in |- *; discriminate. +Proof. + intros; unfold Zle in |- *; simpl in |- *; discriminate. Qed. Lemma ZPOS_neq_ZERO : forall p : positive, Zpos p <> 0%Z. -intros; intro; discriminate. +Proof. + intros; intro; discriminate. Qed. Lemma ZNEG_neq_ZERO : forall p : positive, Zneg p <> 0%Z. -intros; intro; discriminate. +Proof. + intros; intro; discriminate. Qed. Lemma Zge_gt_succ : forall a b : Z, (a >= b + 1)%Z -> (a > b)%Z. -auto with zarith. +Proof. + auto with zarith. Qed. Lemma Zge_gt_pred : forall a b : Z, (a - 1 >= b)%Z -> (a > b)%Z. -auto with zarith. +Proof. + auto with zarith. Qed. Lemma Zgt_ge_succ : forall a b : Z, (a + 1 > b)%Z -> (a >= b)%Z. -auto with zarith. +Proof. + auto with zarith. Qed. Lemma Zgt_ge_pred : forall a b : Z, (a > b - 1)%Z -> (a >= b)%Z. -auto with zarith. +Proof. + auto with zarith. Qed. Lemma Zlt_asymmetric : forall a b : Z, {(a < b)%Z} + {a = b} + {(a > b)%Z}. -intros a b. -set (d := (a - b)%Z). -replace a with (b + d)%Z; [ idtac | unfold d in |- *; omega ]. -case d; simpl in |- *. -left; right; auto with zarith. -intro p. - right. - rewrite <- (Zplus_0_r b). - replace (b + 0 + Zpos p)%Z with (b + Zpos p)%Z; auto with zarith. -intro p. +Proof. + intros a b. + set (d := (a - b)%Z). + replace a with (b + d)%Z; [ idtac | unfold d in |- *; omega ]. + case d; simpl in |- *. + left; right; auto with zarith. + intro p. + right. + rewrite <- (Zplus_0_r b). + replace (b + 0 + Zpos p)%Z with (b + Zpos p)%Z; auto with zarith. + intro p. left; left. rewrite <- (Zplus_0_r b). replace (b + 0 + Zneg p)%Z with (b + Zneg p)%Z; auto with zarith. @@ -347,150 +380,144 @@ intro p. Qed. Lemma Zle_neq_lt : forall a b : Z, (a <= b)%Z -> a <> b -> (a < b)%Z. -auto with zarith. +Proof. + auto with zarith. Qed. Lemma Zmult_pos_mon_le_lft : forall a b c : Z, (a >= b)%Z -> (c >= 0)%Z -> (c * a >= c * b)%Z. -auto with zarith. +Proof. + auto with zarith. Qed. Lemma Zmult_pos_mon_le_rht : forall a b c : Z, (a >= b)%Z -> (c >= 0)%Z -> (a * c >= b * c)%Z. -auto with zarith. +Proof. + auto with zarith. Qed. Lemma Zmult_pos_mon_lt_lft : forall a b c : Z, (a > b)%Z -> (c > 0)%Z -> (c * a > c * b)%Z. -intros a b c. -induction c as [| p| p]; auto with zarith. -intros Hab H0. -induction p as [p Hrecp| p Hrecp| ]; auto with zarith. -replace (Zpos (xI p)) with (2 * Zpos p + 1)%Z; auto with zarith. -repeat rewrite Zmult_plus_distr_l. -cut (2 * Zpos p * a > 2 * Zpos p * b)%Z; auto with zarith. -repeat rewrite <- Zmult_assoc. -cut (Zpos p * a > Zpos p * b)%Z; auto with zarith. -replace (Zpos (xO p)) with (2 * Zpos p)%Z; auto with zarith. -repeat rewrite <- Zmult_assoc. -cut (Zpos p * a > Zpos p * b)%Z; auto with zarith. -intros Hab H0. -inversion H0. +Proof. + intros a b c. + induction c as [| p| p]; auto with zarith. + intros Hab H0. + induction p as [p Hrecp| p Hrecp| ]; auto with zarith. + replace (Zpos (xI p)) with (2 * Zpos p + 1)%Z; auto with zarith. + repeat rewrite Zmult_plus_distr_l. + cut (2 * Zpos p * a > 2 * Zpos p * b)%Z; auto with zarith. + repeat rewrite <- Zmult_assoc. + cut (Zpos p * a > Zpos p * b)%Z; auto with zarith. + replace (Zpos (xO p)) with (2 * Zpos p)%Z; auto with zarith. + repeat rewrite <- Zmult_assoc. + cut (Zpos p * a > Zpos p * b)%Z; auto with zarith. + intros Hab H0. + inversion H0. Qed. Lemma Zmult_pos_mon_lt_rht : forall a b c : Z, (a > b)%Z -> (c > 0)%Z -> (a * c > b * c)%Z. -intros a b c; rewrite (Zmult_comm a c); rewrite (Zmult_comm b c); - apply Zmult_pos_mon_lt_lft. + intros a b c; rewrite (Zmult_comm a c); rewrite (Zmult_comm b c); apply Zmult_pos_mon_lt_lft. Qed. Lemma Zmult_pos_mon : forall a b : Z, (a * b > 0)%Z -> (a * b >= a)%Z. -intros a b. -case a. -auto with zarith. -case b. -auto with zarith. -intros. -set (pp := Zpos p0) in |- * at 2. -rewrite <- (Zmult_1_l pp). -unfold pp in |- *; clear pp. -rewrite Zmult_comm. -apply Zmult_pos_mon_le_rht. -apply Zge_POS_1. -apply Zge_POS_0. -intros p q; simpl in |- *; intro H0; inversion H0. -intros p H0. -apply (Zge_trans (Zneg p * b) 0 (Zneg p)). -auto with zarith. -apply Zge_0_NEG. +Proof. + intros a b. + case a. + auto with zarith. + case b. + auto with zarith. + intros. + set (pp := Zpos p0) in |- * at 2. + rewrite <- (Zmult_1_l pp). + unfold pp in |- *; clear pp. + rewrite Zmult_comm. + apply Zmult_pos_mon_le_rht. + apply Zge_POS_1. + apply Zge_POS_0. + intros p q; simpl in |- *; intro H0; inversion H0. + intros p H0. + apply (Zge_trans (Zneg p * b) 0 (Zneg p)). + auto with zarith. + apply Zge_0_NEG. Qed. Lemma Zdiv_pos_pos : forall a b : Z, (a * b > 0)%Z -> (a > 0)%Z -> (b > 0)%Z. -intros a b; induction a as [| p| p]; - [ induction b as [| p| p] - | induction b as [| p0| p0] - | induction b as [| p0| p0] ]; unfold Zlt, Zgt in |- *; - simpl in |- *; intros; try discriminate; auto. +Proof. + intros a b; induction a as [| p| p]; [ induction b as [| p| p] | induction b as [| p0| p0] + | induction b as [| p0| p0] ]; unfold Zlt, Zgt in |- *; + simpl in |- *; intros; try discriminate; auto. Qed. Lemma Zdiv_pos_nonneg : forall a b : Z, (a * b > 0)%Z -> (a >= 0)%Z -> (b > 0)%Z. -intros a b; induction a as [| p| p]; - [ induction b as [| p| p] - | induction b as [| p0| p0] - | induction b as [| p0| p0] ]; unfold Zlt, Zgt, Zle, Zge in |- *; - simpl in |- *; intros H0 H1; (try discriminate; auto); ( - try elim H1; auto). +Proof. + intros a b; induction a as [| p| p]; [ induction b as [| p| p] | induction b as [| p0| p0] + | induction b as [| p0| p0] ]; unfold Zlt, Zgt, Zle, Zge in |- *; + simpl in |- *; intros H0 H1; (try discriminate; auto); ( try elim H1; auto). Qed. Lemma Zdiv_pos_neg : forall a b : Z, (a * b > 0)%Z -> (a < 0)%Z -> (b < 0)%Z. -intros a b; induction a as [| p| p]; - [ induction b as [| p| p] - | induction b as [| p0| p0] - | induction b as [| p0| p0] ]; unfold Zlt, Zgt in |- *; - simpl in |- *; intros; try discriminate; auto. +Proof. + intros a b; induction a as [| p| p]; [ induction b as [| p| p] | induction b as [| p0| p0] + | induction b as [| p0| p0] ]; unfold Zlt, Zgt in |- *; + simpl in |- *; intros; try discriminate; auto. Qed. Lemma Zdiv_pos_nonpos : forall a b : Z, (a * b > 0)%Z -> (a <= 0)%Z -> (b < 0)%Z. -intros a b; induction a as [| p| p]; - [ induction b as [| p| p] - | induction b as [| p0| p0] - | induction b as [| p0| p0] ]; unfold Zlt, Zgt, Zle, Zge in |- *; - simpl in |- *; intros H0 H1; (try discriminate; auto); ( - try elim H1; auto). +Proof. + intros a b; induction a as [| p| p]; [ induction b as [| p| p] | induction b as [| p0| p0] + | induction b as [| p0| p0] ]; unfold Zlt, Zgt, Zle, Zge in |- *; + simpl in |- *; intros H0 H1; (try discriminate; auto); ( try elim H1; auto). Qed. Lemma Zdiv_neg_pos : forall a b : Z, (a * b < 0)%Z -> (a > 0)%Z -> (b < 0)%Z. -intros a b; induction a as [| p| p]; - [ induction b as [| p| p] - | induction b as [| p0| p0] - | induction b as [| p0| p0] ]; unfold Zlt, Zgt in |- *; - simpl in |- *; intros; try discriminate; auto. +Proof. + intros a b; induction a as [| p| p]; [ induction b as [| p| p] | induction b as [| p0| p0] + | induction b as [| p0| p0] ]; unfold Zlt, Zgt in |- *; + simpl in |- *; intros; try discriminate; auto. Qed. Lemma Zdiv_neg_nonneg : forall a b : Z, (a * b < 0)%Z -> (a >= 0)%Z -> (b < 0)%Z. -intros a b; induction a as [| p| p]; - [ induction b as [| p| p] - | induction b as [| p0| p0] - | induction b as [| p0| p0] ]; unfold Zlt, Zgt, Zle, Zge in |- *; - simpl in |- *; intros H0 H1; (try discriminate; auto); ( - try elim H1; auto). +Proof. + intros a b; induction a as [| p| p]; [ induction b as [| p| p] | induction b as [| p0| p0] + | induction b as [| p0| p0] ]; unfold Zlt, Zgt, Zle, Zge in |- *; + simpl in |- *; intros H0 H1; (try discriminate; auto); ( try elim H1; auto). Qed. Lemma Zdiv_neg_neg : forall a b : Z, (a * b < 0)%Z -> (a < 0)%Z -> (b > 0)%Z. -intros a b; induction a as [| p| p]; - [ induction b as [| p| p] - | induction b as [| p0| p0] - | induction b as [| p0| p0] ]; unfold Zlt, Zgt in |- *; - simpl in |- *; intros; try discriminate; auto. +Proof. + intros a b; induction a as [| p| p]; [ induction b as [| p| p] | induction b as [| p0| p0] + | induction b as [| p0| p0] ]; unfold Zlt, Zgt in |- *; + simpl in |- *; intros; try discriminate; auto. Qed. Lemma Zdiv_neg_nonpos : forall a b : Z, (a * b < 0)%Z -> (a <= 0)%Z -> (b > 0)%Z. -intros a b; induction a as [| p| p]; - [ induction b as [| p| p] - | induction b as [| p0| p0] - | induction b as [| p0| p0] ]; unfold Zlt, Zgt, Zle, Zge in |- *; - simpl in |- *; intros H0 H1; (try discriminate; auto); ( - try elim H1; auto). +Proof. + intros a b; induction a as [| p| p]; [ induction b as [| p| p] | induction b as [| p0| p0] + | induction b as [| p0| p0] ]; unfold Zlt, Zgt, Zle, Zge in |- *; + simpl in |- *; intros H0 H1; (try discriminate; auto); ( try elim H1; auto). Qed. Lemma Zcompat_lt_plus: forall (n m p:Z),(n < m)%Z-> (p+n < p+m)%Z. -intros n m p. -intuition. +Proof. + intros n m p. + intuition. Qed. Transparent Zplus. -Lemma lt_succ_Z_of_nat: forall (m:nat)( k n:Z), +Lemma lt_succ_Z_of_nat: forall (m:nat)( k n:Z), (Z_of_nat (S m)<(k+n))%Z -> (Z_of_nat m <(k+n))%Z. -intros m k n. -simpl. -set (H:=(succ_nat m)). -rewrite H. -intuition. +Proof. + intros m k n. + simpl. + set (H:=(succ_nat m)). + rewrite H. + intuition. Qed. Opaque Zplus. @@ -551,89 +578,99 @@ Section zabs. Lemma Zabs_idemp : forall a : Z, Zabs (Zabs a) = Zabs a. -intro a; case a; auto. +Proof. + intro a; case a; auto. Qed. Lemma Zabs_nonneg : forall (a : Z) (p : positive), Zabs a <> Zneg p. -intros; case a; intros; discriminate. +Proof. + intros; case a; intros; discriminate. Qed. Lemma Zabs_geq_zero : forall a : Z, (0 <= Zabs a)%Z. -intro a. -case a; unfold Zabs in |- *; auto with zarith. +Proof. + intro a. + case a; unfold Zabs in |- *; auto with zarith. Qed. Lemma Zabs_elim_nonneg : forall a : Z, (0 <= a)%Z -> Zabs a = a. -intro a. -case a; auto. -intros p Hp; elim Hp. -apply Zgt_0_NEG. +Proof. + intro a. + case a; auto. + intros p Hp; elim Hp. + apply Zgt_0_NEG. Qed. Lemma Zabs_zero : forall a : Z, Zabs a = 0%Z -> a = 0%Z. -intro a. -case a. -tauto. -intros; discriminate. -intros; discriminate. +Proof. + intro a. + case a. + tauto. + intros; discriminate. + intros; discriminate. Qed. Lemma Zabs_Zopp : forall a : Z, Zabs (- a) = Zabs a. -intro a. -case a; auto with zarith. +Proof. + intro a. + case a; auto with zarith. Qed. Lemma Zabs_geq : forall a : Z, (a <= Zabs a)%Z. -intro a. -unfold Zabs in |- *. -case a; auto with zarith. -Qed. - -Lemma Zabs_Zopp_geq : forall a : Z, (- a <= Zabs a)%Z. -intro a. -rewrite <- Zabs_Zopp. -apply Zabs_geq. -Qed. - -Lemma Zabs_Zminus_symm : forall a b : Z, Zabs (a - b) = Zabs (b - a). -intros a b. -replace (a - b)%Z with (- (b - a))%Z; auto with zarith. -apply Zabs_Zopp. +Proof. + intro a. + unfold Zabs in |- *. + case a; auto with zarith. + Qed. + Lemma Zabs_Zopp_geq : forall a : Z, (- a <= Zabs a)%Z. + intro a. + rewrite <- Zabs_Zopp. + apply Zabs_geq. + Qed. + Lemma Zabs_Zminus_symm : forall a b : Z, Zabs (a - b) = Zabs (b - a). + intros a b. + replace (a - b)%Z with (- (b - a))%Z; auto with zarith. + apply Zabs_Zopp. Qed. Lemma Zabs_lt_pos : forall a b : Z, (Zabs a < b)%Z -> (0 < b)%Z. -intros a b Hab. -unfold Zlt in |- *. -elim (Zcompare_Gt_Lt_antisym b 0). -intros H1 H2. -apply H1. -fold (b > 0)%Z in |- *. -apply (Zgt_le_trans b (Zabs a) 0); auto with zarith. +Proof. + intros a b Hab. + unfold Zlt in |- *. + elim (Zcompare_Gt_Lt_antisym b 0). + intros H1 H2. + apply H1. + fold (b > 0)%Z in |- *. + apply (Zgt_le_trans b (Zabs a) 0); auto with zarith. Qed. Lemma Zabs_le_pos : forall a b : Z, (Zabs a <= b)%Z -> (0 <= b)%Z. -intros a b Hab. -apply (Zle_trans 0 (Zabs a) b). -auto with zarith. -assumption. +Proof. + intros a b Hab. + apply (Zle_trans 0 (Zabs a) b). + auto with zarith. + assumption. Qed. Lemma Zabs_lt_elim : forall a b : Z, (a < b)%Z -> (- a < b)%Z -> (Zabs a < b)%Z. -intros a b. -case a; auto with zarith. +Proof. + intros a b. + case a; auto with zarith. Qed. Lemma Zabs_le_elim : forall a b : Z, (a <= b)%Z -> (- a <= b)%Z -> (Zabs a <= b)%Z. -intros a b. -case a; auto with zarith. +Proof. + intros a b. + case a; auto with zarith. Qed. Lemma Zabs_mult_compat : forall a b : Z, (Zabs a * Zabs b)%Z = Zabs (a * b). -intros a b. -case a; case b; intros; auto with zarith. +Proof. + intros a b. + case a; case b; intros; auto with zarith. Qed. @@ -643,83 +680,74 @@ Let case_POS : forall p q r : positive, (Zpos q + Zneg p)%Z = Zpos r -> (Zabs (Zpos q + Zneg p) <= Zabs (Zpos q) + Zabs (Zneg p))%Z. -intros p q r Hr. -rewrite Hr. -simpl in |- *. -rewrite <- Hr. -fold (Zpos q + Zpos p)%Z in |- *. -unfold Zle in |- *. -rewrite (Zcompare_plus_compat (Zneg p) (Zpos p) (Zpos q)). -apply (ZBasics.Zle_neg_pos p). -Defined. - -Let case_NEG : - forall p q r : positive, - (Zpos q + Zneg p)%Z = Zneg r -> - (Zabs (Zpos q + Zneg p) <= Zabs (Zpos q) + Zabs (Zneg p))%Z. -intros p q r Hr. -rewrite <- (Zopp_involutive (Zpos q + Zneg p)) in Hr. -rewrite <- (Zopp_involutive (Zneg r)) in Hr. -generalize (Zopp_inj (- (Zpos q + Zneg p)) (- Zneg r) Hr). -intro Hr'. rewrite Zopp_plus_distr in Hr'. unfold Zopp in Hr'. -rewrite <- (Zabs_Zopp (Zpos q + Zneg p)). rewrite Zopp_plus_distr. unfold Zopp in |- *. -rewrite <- (Zabs_Zopp (Zpos q)). unfold Zopp in |- *. -rewrite <- (Zabs_Zopp (Zneg p)). unfold Zopp in |- *. -rewrite (Zplus_comm (Zneg q) (Zpos p)). -rewrite (Zplus_comm (Zabs (Zneg q)) (Zabs (Zpos p))). -rewrite Zplus_comm in Hr'. -apply (case_POS _ _ _ Hr'). -Defined. - -Lemma Zabs_triangle : forall a b : Z, (Zabs (a + b) <= Zabs a + Zabs b)%Z. -intros a b. -case a; case b; auto with zarith. -intros p q. -generalize (case_POS p q) (case_NEG p q). -case (Zpos q + Zneg p)%Z. -auto with zarith. -intros p0 case_POS0 case_NEG0. apply (case_POS0 p0). reflexivity. -intros p0 case_POS0 case_NEG0. apply (case_NEG0 p0). reflexivity. -intros p q. -rewrite (Zplus_comm (Zneg q) (Zpos p)). -rewrite (Zplus_comm (Zabs (Zneg q)) (Zabs (Zpos p))). -generalize (case_POS q p) (case_NEG q p). -case (Zpos p + Zneg q)%Z. -auto with zarith. -intros p0 case_POS0 case_NEG0. apply (case_POS0 p0). reflexivity. -intros p0 case_POS0 case_NEG0. apply (case_NEG0 p0). reflexivity. -Qed. - - -(* triangle inequality with Zminus *) - -Lemma Zabs_Zminus_triangle : - forall a b : Z, (Zabs (Zabs a - Zabs b) <= Zabs (a - b))%Z. - assert (case : forall a b : Z, (Zabs a - Zabs b <= Zabs (a - b))%Z). - intros a b. +Proof. + intros p q r Hr. + rewrite Hr. + simpl in |- *. + rewrite <- Hr. + fold (Zpos q + Zpos p)%Z in |- *. unfold Zle in |- *. - unfold Zminus in |- *. - rewrite <- - (Zcompare_plus_compat (Zabs a + - Zabs b) (Zabs (a + - b)) (Zabs b)) - . - rewrite (Zplus_comm (Zabs a) (- Zabs b)). - rewrite Zplus_assoc. - rewrite (Zplus_comm (Zabs b) (- Zabs b)). - rewrite Zplus_opp_l. - rewrite Zplus_0_l. + rewrite (Zcompare_plus_compat (Zneg p) (Zpos p) (Zpos q)). + apply (ZBasics.Zle_neg_pos p). + Defined. + Let case_NEG : forall p q r : positive, (Zpos q + Zneg p)%Z = Zneg r -> + (Zabs (Zpos q + Zneg p) <= Zabs (Zpos q) + Zabs (Zneg p))%Z. + intros p q r Hr. + rewrite <- (Zopp_involutive (Zpos q + Zneg p)) in Hr. + rewrite <- (Zopp_involutive (Zneg r)) in Hr. + generalize (Zopp_inj (- (Zpos q + Zneg p)) (- Zneg r) Hr). + intro Hr'. rewrite Zopp_plus_distr in Hr'. unfold Zopp in Hr'. + rewrite <- (Zabs_Zopp (Zpos q + Zneg p)). rewrite Zopp_plus_distr. unfold Zopp in |- *. + rewrite <- (Zabs_Zopp (Zpos q)). unfold Zopp in |- *. + rewrite <- (Zabs_Zopp (Zneg p)). unfold Zopp in |- *. + rewrite (Zplus_comm (Zneg q) (Zpos p)). + rewrite (Zplus_comm (Zabs (Zneg q)) (Zabs (Zpos p))). + rewrite Zplus_comm in Hr'. + apply (case_POS _ _ _ Hr'). + Defined. + Lemma Zabs_triangle : forall a b : Z, (Zabs (a + b) <= Zabs a + Zabs b)%Z. + intros a b. + case a; case b; auto with zarith. + intros p q. + generalize (case_POS p q) (case_NEG p q). + case (Zpos q + Zneg p)%Z. + auto with zarith. + intros p0 case_POS0 case_NEG0. apply (case_POS0 p0). reflexivity. + intros p0 case_POS0 case_NEG0. apply (case_NEG0 p0). reflexivity. + intros p q. + rewrite (Zplus_comm (Zneg q) (Zpos p)). + rewrite (Zplus_comm (Zabs (Zneg q)) (Zabs (Zpos p))). + generalize (case_POS q p) (case_NEG q p). + case (Zpos p + Zneg q)%Z. + auto with zarith. + intros p0 case_POS0 case_NEG0. apply (case_POS0 p0). reflexivity. + intros p0 case_POS0 case_NEG0. apply (case_NEG0 p0). reflexivity. + Qed. + (* triangle inequality with Zminus *) + Lemma Zabs_Zminus_triangle : forall a b : Z, (Zabs (Zabs a - Zabs b) <= Zabs (a - b))%Z. + assert (case : forall a b : Z, (Zabs a - Zabs b <= Zabs (a - b))%Z). + intros a b. + unfold Zle in |- *. + unfold Zminus in |- *. + rewrite <- (Zcompare_plus_compat (Zabs a + - Zabs b) (Zabs (a + - b)) (Zabs b)) . + rewrite (Zplus_comm (Zabs a) (- Zabs b)). + rewrite Zplus_assoc. + rewrite (Zplus_comm (Zabs b) (- Zabs b)). + rewrite Zplus_opp_l. + rewrite Zplus_0_l. assert (l : forall a b : Z, a = (b + (a - b))%Z). - auto with zarith. - set (a' := a) in |- * at 2. - rewrite (l a b). - unfold a' in |- *. - fold (a - b)%Z in |- *. - apply (Zabs_triangle b (a - b)). -intros a b. -apply Zabs_le_elim. -apply case. -replace (- (Zabs a - Zabs b))%Z with (Zabs b - Zabs a)%Z; auto with zarith. -rewrite Zabs_Zminus_symm. -apply case. + auto with zarith. + set (a' := a) in |- * at 2. + rewrite (l a b). + unfold a' in |- *. + fold (a - b)%Z in |- *. + apply (Zabs_triangle b (a - b)). + intros a b. + apply Zabs_le_elim. + apply case. + replace (- (Zabs a - Zabs b))%Z with (Zabs b - Zabs a)%Z; auto with zarith. + rewrite Zabs_Zminus_symm. + apply case. Qed. @@ -752,50 +780,59 @@ Hint Resolve Zabs_Zminus_triangle: zarith. Section zsign. Lemma Zsgn_mult_compat : forall a b : Z, (Zsgn a * Zsgn b)%Z = Zsgn (a * b). -intros a b. -case a; case b; intros; auto with zarith. +Proof. + intros a b. + case a; case b; intros; auto with zarith. Qed. Lemma Zmult_sgn_abs : forall a : Z, (Zsgn a * Zabs a)%Z = a. -intro a. -case a; intros; auto with zarith. +Proof. + intro a. + case a; intros; auto with zarith. Qed. Lemma Zmult_sgn_eq_abs : forall a : Z, Zabs a = (Zsgn a * a)%Z. -intro a. -case a; intros; auto with zarith. +Proof. + intro a. + case a; intros; auto with zarith. Qed. Lemma Zsgn_plus_l : forall a b : Z, Zsgn a = Zsgn b -> Zsgn (a + b) = Zsgn a. -intros a b. -case a; case b; simpl in |- *; auto; intros; try discriminate. +Proof. + intros a b. + case a; case b; simpl in |- *; auto; intros; try discriminate. Qed. Lemma Zsgn_plus_r : forall a b : Z, Zsgn a = Zsgn b -> Zsgn (a + b) = Zsgn b. -intros. -rewrite Zplus_comm. -apply Zsgn_plus_l. -auto. +Proof. + intros. + rewrite Zplus_comm. + apply Zsgn_plus_l. + auto. Qed. Lemma Zsgn_opp : forall z : Z, Zsgn (- z) = (- Zsgn z)%Z. -intro z. -case z; simpl in |- *; auto. +Proof. + intro z. + case z; simpl in |- *; auto. Qed. Lemma Zsgn_ZERO : forall z : Z, Zsgn z = 0%Z -> z = 0%Z. -intros z. -case z; simpl in |- *; intros; auto; try discriminate. +Proof. + intros z. + case z; simpl in |- *; intros; auto; try discriminate. Qed. Lemma Zsgn_pos : forall z : Z, Zsgn z = 1%Z -> (z > 0)%Z. -intros z. -case z; simpl in |- *; intros; auto with zarith; try discriminate. +Proof. + intros z. + case z; simpl in |- *; intros; auto with zarith; try discriminate. Qed. Lemma Zsgn_neg : forall z : Z, Zsgn z = (-1)%Z -> (z < 0)%Z. -intros z. -case z; simpl in |- *; intros; auto with zarith; try discriminate. +Proof. + intros z. + case z; simpl in |- *; intros; auto with zarith; try discriminate. Qed. End zsign. diff --git a/model/Zmod/ZDivides.v b/model/Zmod/ZDivides.v index 1831734f6..54833359a 100644 --- a/model/Zmod/ZDivides.v +++ b/model/Zmod/ZDivides.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* ZDivides.v, by Vince Barany *) Require Export ZBasics. @@ -54,38 +54,43 @@ Definition Zdivides (a b : Z) : Prop := exists q : Z, (q * a)%Z = b. Section zdivides. Lemma Zdivides_ref : forall a : Z, Zdivides a a. -intro. -exists 1%Z. -auto with zarith. +Proof. + intro. + exists 1%Z. + auto with zarith. Qed. Lemma Zdivides_trans : forall a b c : Z, Zdivides a b -> Zdivides b c -> Zdivides a c. -intros. -unfold Zdivides in H; elim H; intros. -unfold Zdivides in H0; elim H0; intros. -exists (x0 * x)%Z. -rewrite <- H2. -rewrite <- H1. -auto with zarith. +Proof. + intros. + unfold Zdivides in H; elim H; intros. + unfold Zdivides in H0; elim H0; intros. + exists (x0 * x)%Z. + rewrite <- H2. + rewrite <- H1. + auto with zarith. Qed. Lemma Zdivides_zero_rht : forall z : Z, Zdivides z 0. -intro. -exists 0%Z. -auto with zarith. +Proof. + intro. + exists 0%Z. + auto with zarith. Qed. Lemma Zdivides_zero_lft : forall z : Z, Zdivides 0 z -> z = 0%Z. -intro z. -intro Hdiv; elim Hdiv. -auto with zarith. +Proof. + intro z. + intro Hdiv; elim Hdiv. + auto with zarith. Qed. Lemma Zdivides_one : forall z : Z, Zdivides 1 z. -intro. -exists z. -auto with zarith. +Proof. + intro. + exists z. + auto with zarith. Qed. @@ -93,692 +98,735 @@ Qed. Lemma Zdivides_mult_intro_lft : forall a b c : Z, Zdivides (a * b) c -> Zdivides b c. -intros a b c H. -unfold Zdivides in H; elim H; intros q H_. -exists (q * a)%Z. -rewrite <- Zmult_assoc. -assumption. +Proof. + intros a b c H. + unfold Zdivides in H; elim H; intros q H_. + exists (q * a)%Z. + rewrite <- Zmult_assoc. + assumption. Qed. Lemma Zdivides_mult_intro_rht : forall a b c : Z, Zdivides (a * b) c -> Zdivides a c. -intros a b c H. -unfold Zdivides in H; elim H; intros q H_. -exists (q * b)%Z. -rewrite <- Zmult_assoc. -rewrite (Zmult_comm b a). -assumption. +Proof. + intros a b c H. + unfold Zdivides in H; elim H; intros q H_. + exists (q * b)%Z. + rewrite <- Zmult_assoc. + rewrite (Zmult_comm b a). + assumption. Qed. Lemma Zdivides_mult_lft : forall a b : Z, Zdivides b (a * b). -intros. -exists a. -auto with zarith. +Proof. + intros. + exists a. + auto with zarith. Qed. Lemma Zdivides_mult_rht : forall a b : Z, Zdivides a (a * b). -intros. -exists b. -auto with zarith. +Proof. + intros. + exists b. + auto with zarith. Qed. Lemma Zdivides_mult_elim_lft : forall a b c : Z, Zdivides a c -> Zdivides a (b * c). -intros. -apply (Zdivides_trans a c (b * c)). -assumption. -apply Zdivides_mult_lft. +Proof. + intros. + apply (Zdivides_trans a c (b * c)). + assumption. + apply Zdivides_mult_lft. Qed. Lemma Zdivides_mult_elim_rht : forall a b c : Z, Zdivides a b -> Zdivides a (b * c). -intros. -apply (Zdivides_trans a b (b * c)). -assumption. -apply Zdivides_mult_rht. +Proof. + intros. + apply (Zdivides_trans a b (b * c)). + assumption. + apply Zdivides_mult_rht. Qed. Lemma Zdivides_mult_cancel_lft : forall a b c : Z, Zdivides a b -> Zdivides (c * a) (c * b). -intros. -unfold Zdivides in H; elim H; intros. -exists x. -rewrite <- H0. -rewrite Zmult_assoc. -rewrite Zmult_assoc. -rewrite (Zmult_comm x c). -reflexivity. +Proof. + intros. + unfold Zdivides in H; elim H; intros. + exists x. + rewrite <- H0. + rewrite Zmult_assoc. + rewrite Zmult_assoc. + rewrite (Zmult_comm x c). + reflexivity. Qed. Lemma Zdivides_mult_cancel_rht : forall a b c : Z, Zdivides a b -> Zdivides (a * c) (b * c). -intros. -unfold Zdivides in H; elim H; intros. -exists x. -rewrite <- H0. -auto with zarith. +Proof. + intros. + unfold Zdivides in H; elim H; intros. + exists x. + rewrite <- H0. + auto with zarith. Qed. Let Zdiv_one_is_one : forall a : Z, (a > 0)%Z -> Zdivides a 1 -> a = 1%Z. -intros a H0 H1. -unfold Zdivides in H1; elim H1; intros q H1_. -apply Zle_antisymm. -auto with zarith. -rewrite <- (Zplus_0_l a). -rewrite <- H1_. -rewrite <- (Zmult_1_l (0 + a)). -rewrite (Zplus_0_l a). -apply (Zmult_pos_mon_le_rht q 1 a); auto with zarith. -cut (q > 0)%Z; auto with zarith. -rewrite Zmult_comm in H1_. -apply (Zdiv_pos_pos a); auto with zarith. +Proof. + intros a H0 H1. + unfold Zdivides in H1; elim H1; intros q H1_. + apply Zle_antisymm. + auto with zarith. + rewrite <- (Zplus_0_l a). + rewrite <- H1_. + rewrite <- (Zmult_1_l (0 + a)). + rewrite (Zplus_0_l a). + apply (Zmult_pos_mon_le_rht q 1 a); auto with zarith. + cut (q > 0)%Z; auto with zarith. + rewrite Zmult_comm in H1_. + apply (Zdiv_pos_pos a); auto with zarith. Defined. Lemma Zdivides_antisymm : forall a b : Z, (a > 0)%Z -> (b > 0)%Z -> Zdivides a b -> Zdivides b a -> a = b. -intros a b H01 H02 H1 H2. -unfold Zdivides in H1; elim H1; intros q1 H1_. -unfold Zdivides in H2; elim H2; intros q2 H2_. -generalize H2_; intro H12_. -rewrite <- H1_ in H12_. -rewrite Zmult_assoc in H12_. -rewrite Zmult_comm in H12_. -rewrite <- H1_. -rewrite <- (Zmult_1_l a). -assert (Zdivides q1 1). -replace 1%Z with (q2 * q1)%Z. -apply Zdivides_mult_elim_lft. -apply Zdivides_ref. -apply (Zunit_eq_one (q2 * q1) a). -auto with zarith. -assumption. -replace q1 with 1%Z. -auto with zarith. -symmetry in |- *. -rewrite Zmult_comm in H1_; rewrite <- H1_ in H02. -apply Zdiv_one_is_one; auto. -apply (Zdiv_pos_pos a); auto. +Proof. + intros a b H01 H02 H1 H2. + unfold Zdivides in H1; elim H1; intros q1 H1_. + unfold Zdivides in H2; elim H2; intros q2 H2_. + generalize H2_; intro H12_. + rewrite <- H1_ in H12_. + rewrite Zmult_assoc in H12_. + rewrite Zmult_comm in H12_. + rewrite <- H1_. + rewrite <- (Zmult_1_l a). + assert (Zdivides q1 1). + replace 1%Z with (q2 * q1)%Z. + apply Zdivides_mult_elim_lft. + apply Zdivides_ref. + apply (Zunit_eq_one (q2 * q1) a). + auto with zarith. + assumption. + replace q1 with 1%Z. + auto with zarith. + symmetry in |- *. + rewrite Zmult_comm in H1_; rewrite <- H1_ in H02. + apply Zdiv_one_is_one; auto. + apply (Zdiv_pos_pos a); auto. Qed. Lemma Zdivides_plus_elim : forall a b c : Z, Zdivides a b -> Zdivides a c -> Zdivides a (b + c). -intros a b c H1 H2. -unfold Zdivides in H1; elim H1; intros q1 H1_. -unfold Zdivides in H2; elim H2; intros q2 H2_. -exists (q1 + q2)%Z. -rewrite Zmult_plus_distr_l. -auto with zarith. +Proof. + intros a b c H1 H2. + unfold Zdivides in H1; elim H1; intros q1 H1_. + unfold Zdivides in H2; elim H2; intros q2 H2_. + exists (q1 + q2)%Z. + rewrite Zmult_plus_distr_l. + auto with zarith. Qed. Lemma Zdivides_opp_elim_lft : forall a b : Z, Zdivides a b -> Zdivides (- a) b. -intros a b H. -unfold Zdivides in H; elim H; intros q H_. -exists (- q)%Z. -rewrite Zmult_opp_opp. -assumption. +Proof. + intros a b H. + unfold Zdivides in H; elim H; intros q H_. + exists (- q)%Z. + rewrite Zmult_opp_opp. + assumption. Qed. Lemma Zdivides_opp_elim_rht : forall a b : Z, Zdivides a b -> Zdivides a (- b). -intros a b H. -unfold Zdivides in H; elim H; intros q H_. -exists (- q)%Z. -rewrite Zopp_mult_distr_l_reverse. -auto with zarith. +Proof. + intros a b H. + unfold Zdivides in H; elim H; intros q H_. + exists (- q)%Z. + rewrite Zopp_mult_distr_l_reverse. + auto with zarith. Qed. Lemma Zdivides_opp_elim : forall a b : Z, Zdivides a b -> Zdivides (- a) (- b). -intros. -apply Zdivides_opp_elim_lft. -apply Zdivides_opp_elim_rht. -assumption. +Proof. + intros. + apply Zdivides_opp_elim_lft. + apply Zdivides_opp_elim_rht. + assumption. Qed. Lemma Zdivides_opp_intro_lft : forall a b : Z, Zdivides (- a) b -> Zdivides a b. -intros a b H. -rewrite <- (Zopp_involutive a). -apply (Zdivides_opp_elim_lft _ _ H). +Proof. + intros a b H. + rewrite <- (Zopp_involutive a). + apply (Zdivides_opp_elim_lft _ _ H). Qed. Lemma Zdivides_opp_intro_rht : forall a b : Z, Zdivides a (- b) -> Zdivides a b. -intros a b H. -rewrite <- (Zopp_involutive b). -apply (Zdivides_opp_elim_rht _ _ H). +Proof. + intros a b H. + rewrite <- (Zopp_involutive b). + apply (Zdivides_opp_elim_rht _ _ H). Qed. Lemma Zdivides_opp_intro : forall a b : Z, Zdivides (- a) (- b) -> Zdivides a b. -intros. -apply Zdivides_opp_intro_lft. -apply Zdivides_opp_intro_rht. -assumption. +Proof. + intros. + apply Zdivides_opp_intro_lft. + apply Zdivides_opp_intro_rht. + assumption. Qed. Lemma Zdivides_minus_elim : forall a b c : Z, Zdivides a b -> Zdivides a c -> Zdivides a (b - c). -intros. -unfold Zminus in |- *. -apply Zdivides_plus_elim. -assumption. -apply Zdivides_opp_elim_rht. -assumption. +Proof. + intros. + unfold Zminus in |- *. + apply Zdivides_plus_elim. + assumption. + apply Zdivides_opp_elim_rht. + assumption. Qed. Lemma Zdivides_mult_elim : forall a b c d : Z, Zdivides a b -> Zdivides c d -> Zdivides (a * c) (b * d). -intros a b c d H1 H2. -unfold Zdivides in H1; elim H1; intros q1 H1_. -unfold Zdivides in H2; elim H2; intros q2 H2_. -exists (q1 * q2)%Z. -rewrite <- H1_. -rewrite <- H2_. -rewrite Zmult_assoc. -rewrite Zmult_assoc. -rewrite <- (Zmult_assoc q1 q2 a). -rewrite (Zmult_comm q2 a). -rewrite Zmult_assoc. -reflexivity. +Proof. + intros a b c d H1 H2. + unfold Zdivides in H1; elim H1; intros q1 H1_. + unfold Zdivides in H2; elim H2; intros q2 H2_. + exists (q1 * q2)%Z. + rewrite <- H1_. + rewrite <- H2_. + rewrite Zmult_assoc. + rewrite Zmult_assoc. + rewrite <- (Zmult_assoc q1 q2 a). + rewrite (Zmult_comm q2 a). + rewrite Zmult_assoc. + reflexivity. Qed. Lemma Zdivides_mult_ll : forall a b c d : Z, (a * b)%Z = (c * d)%Z -> a <> 0%Z -> Zdivides a c -> Zdivides d b. -intros a b c d Heq Ha Hdiv. -elim Hdiv; intros x Hx. -rewrite <- Hx in Heq. -exists x. -apply (Zmult_intro_lft a). -assumption. -rewrite Heq. -rewrite Zmult_assoc. -rewrite (Zmult_comm x a). -auto. +Proof. + intros a b c d Heq Ha Hdiv. + elim Hdiv; intros x Hx. + rewrite <- Hx in Heq. + exists x. + apply (Zmult_intro_lft a). + assumption. + rewrite Heq. + rewrite Zmult_assoc. + rewrite (Zmult_comm x a). + auto. Qed. Lemma Zdivides_mult_lr : forall a b c d : Z, (a * b)%Z = (d * c)%Z -> a <> 0%Z -> Zdivides a c -> Zdivides d b. -intros a b c d; rewrite (Zmult_comm d c); apply Zdivides_mult_ll. +Proof. + intros a b c d; rewrite (Zmult_comm d c); apply Zdivides_mult_ll. Qed. Lemma Zdivides_mult_rl : forall a b c d : Z, (b * a)%Z = (c * d)%Z -> a <> 0%Z -> Zdivides a c -> Zdivides d b. -intros a b c d; rewrite (Zmult_comm b a); apply Zdivides_mult_ll. +Proof. + intros a b c d; rewrite (Zmult_comm b a); apply Zdivides_mult_ll. Qed. Lemma Zdivides_mult_rr : forall a b c d : Z, (b * a)%Z = (d * c)%Z -> a <> 0%Z -> Zdivides a c -> Zdivides d b. -intros a b c d; rewrite (Zmult_comm b a); rewrite (Zmult_comm d c); - apply Zdivides_mult_ll. + intros a b c d; rewrite (Zmult_comm b a); rewrite (Zmult_comm d c); apply Zdivides_mult_ll. Qed. Lemma Zdivides_abs_elim_lft : forall a b : Z, Zdivides a b -> Zdivides (Zabs a) b. -intros a b. -case a; simpl in |- *; auto. -intros p H. -generalize (Zdivides_opp_elim_lft (Zneg p) b H). -simpl in |- *; auto. +Proof. + intros a b. + case a; simpl in |- *; auto. + intros p H. + generalize (Zdivides_opp_elim_lft (Zneg p) b H). + simpl in |- *; auto. Qed. Lemma Zdivides_abs_elim_rht : forall a b : Z, Zdivides a b -> Zdivides a (Zabs b). -intros a b. -case b; simpl in |- *; auto. -intros p H. -generalize (Zdivides_opp_elim_rht a (Zneg p) H). -simpl in |- *; auto. +Proof. + intros a b. + case b; simpl in |- *; auto. + intros p H. + generalize (Zdivides_opp_elim_rht a (Zneg p) H). + simpl in |- *; auto. Qed. Lemma Zdivides_abs_elim : forall a b : Z, Zdivides a b -> Zdivides (Zabs a) (Zabs b). -intros. -apply Zdivides_abs_elim_lft. -apply Zdivides_abs_elim_rht. -assumption. +Proof. + intros. + apply Zdivides_abs_elim_lft. + apply Zdivides_abs_elim_rht. + assumption. Qed. Lemma Zdivides_abs_intro_lft : forall a b : Z, Zdivides (Zabs a) b -> Zdivides a b. -intros a b. -case a; simpl in |- *; auto. -intros p; apply (Zdivides_opp_intro_lft (Zneg p) b). +Proof. + intros a b. + case a; simpl in |- *; auto. + intros p; apply (Zdivides_opp_intro_lft (Zneg p) b). Qed. Lemma Zdivides_abs_intro_rht : forall a b : Z, Zdivides a (Zabs b) -> Zdivides a b. -intros a b. -case b; simpl in |- *; auto. -intros p; apply (Zdivides_opp_intro_rht a (Zneg p)). +Proof. + intros a b. + case b; simpl in |- *; auto. + intros p; apply (Zdivides_opp_intro_rht a (Zneg p)). Qed. Lemma Zdivides_abs_intro : forall a b : Z, Zdivides (Zabs a) (Zabs b) -> Zdivides a b. -intros. -apply Zdivides_abs_intro_lft. -apply Zdivides_abs_intro_rht. -assumption. +Proof. + intros. + apply Zdivides_abs_intro_lft. + apply Zdivides_abs_intro_rht. + assumption. Qed. Lemma Zdivisor_pos_le : forall a b : Z, (a > 0)%Z -> Zdivides b a -> (a >= b)%Z. -unfold Zdivides in |- *. -intros. -elim H0. -intros. -rewrite <- H1. -rewrite Zmult_comm. -apply Zmult_pos_mon. -rewrite Zmult_comm. -rewrite H1. -assumption. +Proof. + unfold Zdivides in |- *. + intros. + elim H0. + intros. + rewrite <- H1. + rewrite Zmult_comm. + apply Zmult_pos_mon. + rewrite Zmult_comm. + rewrite H1. + assumption. Qed. Lemma Zdivisor_small : forall a b : Z, Zdivides b a -> (Zabs a < b)%Z -> a = 0%Z. -intros a b Hdiv Hlt. -generalize (Zdivides_abs_elim_rht _ _ Hdiv); intro Hdivabs. -set (A := a). assert (HA : A = a). auto. generalize HA. -case A. -auto. -intros p Hp. -assert (Hfalse : (b < b)%Z). -apply (Zle_lt_trans b (Zabs a) b). -apply Zge_le. -apply (Zdivisor_pos_le (Zabs a) b). -rewrite <- Hp; simpl in |- *; auto with zarith. -assumption. -assumption. -elim (Zlt_irrefl b Hfalse). -intros p Hp. -assert (Hfalse : (b < b)%Z). -apply (Zle_lt_trans b (Zabs a) b). -apply Zge_le. -apply (Zdivisor_pos_le (Zabs a) b). -rewrite <- Hp; simpl in |- *. -auto with zarith. -assumption. -assumption. -elim (Zlt_irrefl b Hfalse). +Proof. + intros a b Hdiv Hlt. + generalize (Zdivides_abs_elim_rht _ _ Hdiv); intro Hdivabs. + set (A := a). assert (HA : A = a). auto. generalize HA. + case A. + auto. + intros p Hp. + assert (Hfalse : (b < b)%Z). + apply (Zle_lt_trans b (Zabs a) b). + apply Zge_le. + apply (Zdivisor_pos_le (Zabs a) b). + rewrite <- Hp; simpl in |- *; auto with zarith. + assumption. + assumption. + elim (Zlt_irrefl b Hfalse). + intros p Hp. + assert (Hfalse : (b < b)%Z). + apply (Zle_lt_trans b (Zabs a) b). + apply Zge_le. + apply (Zdivisor_pos_le (Zabs a) b). + rewrite <- Hp; simpl in |- *. + auto with zarith. + assumption. + assumption. + elim (Zlt_irrefl b Hfalse). Qed. Lemma Zmodeq_small : forall a b c : Z, (0 <= a < c)%Z -> (0 <= b < c)%Z -> Zdivides c (a - b) -> a = b. -intros a b c Ha Hb Hc. -cut ((a - b)%Z = 0%Z); auto with zarith. -apply (Zdivisor_small (a - b) c). -assumption. -apply Zabs_lt_elim; auto with zarith. +Proof. + intros a b c Ha Hb Hc. + cut ((a - b)%Z = 0%Z); auto with zarith. + apply (Zdivisor_small (a - b) c). + assumption. + apply Zabs_lt_elim; auto with zarith. Qed. Lemma Zdiv_remainder_unique : forall a b q1 r1 q2 r2 : Z, a = (q1 * b + r1)%Z -> (0 <= r1 < b)%Z -> a = (q2 * b + r2)%Z -> (0 <= r2 < b)%Z -> r1 = r2. -intros a b q1 r1 q2 r2 Hq1 Hr1 Hq2 Hr2. -apply (Zmodeq_small r1 r2 b). -assumption. -assumption. -assert ((r1 - r2)%Z = ((q2 - q1) * b)%Z). - rewrite Hq1 in Hq2. - rewrite BinInt.Zmult_minus_distr_r. - auto with zarith. -rewrite H. -apply Zdivides_mult_elim_lft. -apply Zdivides_ref. +Proof. + intros a b q1 r1 q2 r2 Hq1 Hr1 Hq2 Hr2. + apply (Zmodeq_small r1 r2 b). + assumption. + assumption. + assert ((r1 - r2)%Z = ((q2 - q1) * b)%Z). + rewrite Hq1 in Hq2. + rewrite BinInt.Zmult_minus_distr_r. + auto with zarith. + rewrite H. + apply Zdivides_mult_elim_lft. + apply Zdivides_ref. Qed. Lemma Zdiv_quotient_unique : forall a b q1 r1 q2 r2 : Z, a = (q1 * b + r1)%Z -> (0 <= r1 < b)%Z -> a = (q2 * b + r2)%Z -> (0 <= r2 < b)%Z -> q1 = q2. -intros a b q1 r1 q2 r2 Hq1 Hr1 Hq2 Hr2. -assert (Hr : r1 = r2). - apply (Zdiv_remainder_unique a b q1 r1 q2 r2); assumption. -rewrite Hr in Hq1. -rewrite Hq1 in Hq2. -assert (Hb0 : b <> 0%Z). - assert (Hbpos : (0 < b)%Z). - apply (Zle_lt_trans 0 r1 b). - tauto. - tauto. - auto with zarith. -assert (Hb : (q1 * b)%Z = (q2 * b)%Z). - auto with zarith. -apply (Zmult_intro_rht _ _ _ Hb0 Hb). +Proof. + intros a b q1 r1 q2 r2 Hq1 Hr1 Hq2 Hr2. + assert (Hr : r1 = r2). + apply (Zdiv_remainder_unique a b q1 r1 q2 r2); assumption. + rewrite Hr in Hq1. + rewrite Hq1 in Hq2. + assert (Hb0 : b <> 0%Z). + assert (Hbpos : (0 < b)%Z). + apply (Zle_lt_trans 0 r1 b). + tauto. + tauto. + auto with zarith. + assert (Hb : (q1 * b)%Z = (q2 * b)%Z). + auto with zarith. + apply (Zmult_intro_rht _ _ _ Hb0 Hb). Qed. Lemma Zmod0_Zopp : forall a b : Z, b <> 0%Z -> (a mod b)%Z = 0%Z -> (a mod - b)%Z = 0%Z. -intros a b. -generalize (Z_mod_lt (Zabs a) (Zabs b)). -case a. -case b; unfold Zabs, Zopp, Zmod, Zdiv_eucl in |- *; auto with zarith. -case b; unfold Zabs, Zopp, Zmod, Zdiv_eucl in |- *. - auto with zarith. - intros p q. - elim (Zdiv_eucl_POS q (Zpos p)); intros Q R. - intros Hlt Hp HR; rewrite HR; auto with zarith. - intros p q. +Proof. + intros a b. + generalize (Z_mod_lt (Zabs a) (Zabs b)). + case a. + case b; unfold Zabs, Zopp, Zmod, Zdiv_eucl in |- *; auto with zarith. + case b; unfold Zabs, Zopp, Zmod, Zdiv_eucl in |- *. + auto with zarith. + intros p q. + elim (Zdiv_eucl_POS q (Zpos p)); intros Q R. + intros Hlt Hp HR; rewrite HR; auto with zarith. + intros p q. elim (Zdiv_eucl_POS q (Zpos p)); intros Q R. - case R. - auto with zarith. + case R. + auto with zarith. intro r'; intros H0 H1 H2. - cut (Zpos r' = Zpos p); auto with zarith. + cut (Zpos r' = Zpos p); auto with zarith. fold (- Zpos p)%Z in H2. auto with zarith. - intro r'; intros H0 H1 H2. - elim H0; auto with zarith. -case b; unfold Zabs, Zopp, Zmod, Zdiv_eucl in |- *. - auto with zarith. - intros p q. - elim (Zdiv_eucl_POS q (Zpos p)); intros Q R. - case R; intros r' H0; intros; try (cut (Zpos r' = Zpos p); elim H0); + intro r'; intros H0 H1 H2. + elim H0; auto with zarith. + case b; unfold Zabs, Zopp, Zmod, Zdiv_eucl in |- *. auto with zarith. - intros p q. + intros p q. elim (Zdiv_eucl_POS q (Zpos p)); intros Q R. - case R; intros; try discriminate; try tauto. + case R; intros r' H0; intros; try (cut (Zpos r' = Zpos p); elim H0); auto with zarith. + intros p q. + elim (Zdiv_eucl_POS q (Zpos p)); intros Q R. + case R; intros; try discriminate; try tauto. Qed. Lemma Zdiv_Zopp : forall a b : Z, (a mod b)%Z = 0%Z -> (a / - b)%Z = (- (a / b))%Z. -intros a b. -unfold Zmod, Zdiv, Zdiv_eucl in |- *. -case a. - auto. - intro A. - case b; unfold Zopp in |- *. - auto. - intro B. +Proof. + intros a b. + unfold Zmod, Zdiv, Zdiv_eucl in |- *. + case a. + auto. + intro A. + case b; unfold Zopp in |- *. + auto. + intro B. elim (Zdiv_eucl_POS A (Zpos B)); intros q r. intro Hr; rewrite Hr; auto. intro B. - generalize (Z_mod_lt (Zpos A) (Zpos B)). - unfold Zmod, Zdiv_eucl in |- *. - elim (Zdiv_eucl_POS A (Zpos B)); intros q r. - case r. - intros _ HR; fold (- q)%Z in |- *; fold (- - q)%Z in |- *; - rewrite Zopp_involutive; auto. - intros R Hlt HR. - assert (H : Zpos R = Zpos B). - rewrite <- (Zplus_0_r (Zpos B)); rewrite <- HR; rewrite Zplus_assoc; - fold (- Zpos B)%Z in |- *. - auto with zarith. - rewrite H in Hlt. - elim Hlt; auto with zarith. - intros R Hlt HR. - elim Hlt; auto with zarith; intro Hfalse; elim Hfalse; auto with zarith. + generalize (Z_mod_lt (Zpos A) (Zpos B)). + unfold Zmod, Zdiv_eucl in |- *. + elim (Zdiv_eucl_POS A (Zpos B)); intros q r. + case r. + intros _ HR; fold (- q)%Z in |- *; fold (- - q)%Z in |- *; rewrite Zopp_involutive; auto. + intros R Hlt HR. + assert (H : Zpos R = Zpos B). + rewrite <- (Zplus_0_r (Zpos B)); rewrite <- HR; rewrite Zplus_assoc; fold (- Zpos B)%Z in |- *. + auto with zarith. + rewrite H in Hlt. + elim Hlt; auto with zarith. + intros R Hlt HR. + elim Hlt; auto with zarith; intro Hfalse; elim Hfalse; auto with zarith. intro A. case b; unfold Zopp in |- *. - auto. - intro B. - generalize (Z_mod_lt (Zpos A) (Zpos B)). - unfold Zmod, Zdiv_eucl in |- *. - elim (Zdiv_eucl_POS A (Zpos B)); intros q r. - case r. - intros _ HR; fold (- q)%Z in |- *; fold (- - q)%Z in |- *; - rewrite Zopp_involutive; auto. - intros R Hlt HR. - assert (H : Zpos R = Zpos B). - rewrite <- (Zplus_0_r (Zpos R)); rewrite <- HR; unfold Zminus in |- *; - rewrite Zplus_assoc; auto with zarith. - rewrite H in Hlt. - elim Hlt; auto with zarith. - intros R Hlt HR. - elim Hlt; auto with zarith; intro Hfalse; elim Hfalse; auto with zarith. + auto. intro B. - generalize (Z_mod_lt (Zpos A) (Zpos B)). - unfold Zmod, Zdiv_eucl in |- *. - elim (Zdiv_eucl_POS A (Zpos B)); intros q r. - case r. - intros _ HR; fold (- q)%Z in |- *; auto. - intros; discriminate. - intros; discriminate. + generalize (Z_mod_lt (Zpos A) (Zpos B)). + unfold Zmod, Zdiv_eucl in |- *. + elim (Zdiv_eucl_POS A (Zpos B)); intros q r. + case r. + intros _ HR; fold (- q)%Z in |- *; fold (- - q)%Z in |- *; rewrite Zopp_involutive; auto. + intros R Hlt HR. + assert (H : Zpos R = Zpos B). + rewrite <- (Zplus_0_r (Zpos R)); rewrite <- HR; unfold Zminus in |- *; + rewrite Zplus_assoc; auto with zarith. + rewrite H in Hlt. + elim Hlt; auto with zarith. + intros R Hlt HR. + elim Hlt; auto with zarith; intro Hfalse; elim Hfalse; auto with zarith. + intro B. + generalize (Z_mod_lt (Zpos A) (Zpos B)). + unfold Zmod, Zdiv_eucl in |- *. + elim (Zdiv_eucl_POS A (Zpos B)); intros q r. + case r. + intros _ HR; fold (- q)%Z in |- *; auto. + intros; discriminate. + intros; discriminate. Qed. Lemma Zmod0_Zdivides_pos : forall a b : Z, (b > 0)%Z -> Zdivides b a -> (a mod b)%Z = 0%Z. -intros a b Hb Hdiv. -elim Hdiv; intros q Hq. -rewrite (Z_div_mod_eq a b) in Hq; rewrite <- (Zplus_0_r (q * b)) in Hq. -symmetry in |- *. -apply (Zdiv_remainder_unique (q * b + 0) b q 0 (a / b) (a mod b)). -reflexivity. -auto with zarith. -rewrite (Zmult_comm (a / b) b); exact Hq. -apply Z_mod_lt; auto with zarith. -exact Hb. +Proof. + intros a b Hb Hdiv. + elim Hdiv; intros q Hq. + rewrite (Z_div_mod_eq a b) in Hq; rewrite <- (Zplus_0_r (q * b)) in Hq. + symmetry in |- *. + apply (Zdiv_remainder_unique (q * b + 0) b q 0 (a / b) (a mod b)). + reflexivity. + auto with zarith. + rewrite (Zmult_comm (a / b) b); exact Hq. + apply Z_mod_lt; auto with zarith. + exact Hb. Qed. Lemma Zdivides_Zmod0_pos : forall a b : Z, (b > 0)%Z -> (a mod b)%Z = 0%Z -> Zdivides b a. -intros a b Hb Hmod. -rewrite (Z_div_mod_eq a b). -rewrite (Zmult_comm b (a / b)); rewrite Hmod; rewrite Zplus_0_r. -exists (a / b)%Z. -reflexivity. -exact Hb. +Proof. + intros a b Hb Hmod. + rewrite (Z_div_mod_eq a b). + rewrite (Zmult_comm b (a / b)); rewrite Hmod; rewrite Zplus_0_r. + exists (a / b)%Z. + reflexivity. + exact Hb. Qed. Lemma Zmod0_Zdivides : forall a b : Z, b <> 0%Z -> Zdivides b a -> (a mod b)%Z = 0%Z. -intros a b. -case b. - tauto. - intros p _; apply Zmod0_Zdivides_pos; auto with zarith. +Proof. + intros a b. + case b. + tauto. + intros p _; apply Zmod0_Zdivides_pos; auto with zarith. intros p _. - generalize (Zmod0_Zdivides_pos a (Zpos p)); intro H. - fold (- Zpos p)%Z in |- *. - intro Hdiv. - apply Zmod0_Zopp. + generalize (Zmod0_Zdivides_pos a (Zpos p)); intro H. + fold (- Zpos p)%Z in |- *. + intro Hdiv. + apply Zmod0_Zopp. intro; discriminate. - apply H. + apply H. auto with zarith. - rewrite <- (Zopp_involutive (Zpos p)). - apply Zdivides_opp_elim_lft. - assumption. + rewrite <- (Zopp_involutive (Zpos p)). + apply Zdivides_opp_elim_lft. + assumption. Qed. Lemma Zdivides_Zmod0 : forall a b : Z, b <> 0%Z -> (a mod b)%Z = 0%Z -> Zdivides b a. -intros a b. -case b. - tauto. - intros p _; apply Zdivides_Zmod0_pos; auto with zarith. +Proof. + intros a b. + case b. + tauto. + intros p _; apply Zdivides_Zmod0_pos; auto with zarith. intros p _. - generalize (Zdivides_Zmod0_pos a (Zpos p)); intro H. - fold (- Zpos p)%Z in |- *. - intro Hmod. - apply Zdivides_opp_elim_lft. - apply H. + generalize (Zdivides_Zmod0_pos a (Zpos p)); intro H. + fold (- Zpos p)%Z in |- *. + intro Hmod. + apply Zdivides_opp_elim_lft. + apply H. auto with zarith. - rewrite <- (Zopp_involutive (Zpos p)). - apply Zmod0_Zopp. + rewrite <- (Zopp_involutive (Zpos p)). + apply Zmod0_Zopp. simpl in |- *; intros; discriminate. - assumption. + assumption. Qed. Lemma Zmod_mult_cancel_lft : forall a b : Z, ((a * b) mod a)%Z = 0%Z. -intros a b. -case a. -auto with zarith. -intro p. - apply Zmod0_Zdivides_pos. - auto with zarith. - apply Zdivides_mult_elim_rht. - apply Zdivides_ref. -intro p. - apply Zmod0_Zdivides. - auto with zarith. +Proof. + intros a b. + case a. + auto with zarith. + intro p. + apply Zmod0_Zdivides_pos. + auto with zarith. + apply Zdivides_mult_elim_rht. + apply Zdivides_ref. + intro p. + apply Zmod0_Zdivides. + auto with zarith. apply Zdivides_mult_elim_rht. apply Zdivides_ref. Qed. Lemma Zmod_mult_cancel_rht : forall a b : Z, ((a * b) mod b)%Z = 0%Z. -intros a b. -rewrite Zmult_comm. -apply Zmod_mult_cancel_lft. +Proof. + intros a b. + rewrite Zmult_comm. + apply Zmod_mult_cancel_lft. Qed. Lemma Zdiv_mult_cancel_lft : forall a b : Z, a <> 0%Z -> (a * b / a)%Z = b. -intros a b. -case a. - auto with zarith. - intros p _. - apply - (Zdiv_quotient_unique (Zpos p * b) (Zpos p) (Zpos p * b / Zpos p) - ((Zpos p * b) mod Zpos p) b 0). - rewrite (Zmult_comm (Zpos p * b / Zpos p) (Zpos p)). - apply Z_div_mod_eq; auto with zarith. - apply Z_mod_lt; auto with zarith. - rewrite Zplus_0_r; auto with zarith. +Proof. + intros a b. + case a. + auto with zarith. + intros p _. + apply (Zdiv_quotient_unique (Zpos p * b) (Zpos p) (Zpos p * b / Zpos p) + ((Zpos p * b) mod Zpos p) b 0). + rewrite (Zmult_comm (Zpos p * b / Zpos p) (Zpos p)). + apply Z_div_mod_eq; auto with zarith. + apply Z_mod_lt; auto with zarith. + rewrite Zplus_0_r; auto with zarith. auto with zarith. - intros p _. - fold (- Zpos p)%Z in |- *. - rewrite Zdiv_Zopp. + intros p _. + fold (- Zpos p)%Z in |- *. + rewrite Zdiv_Zopp. cut ((- Zpos p * b / Zpos p)%Z = (- b)%Z); auto with zarith. unfold Zopp in |- *; fold (- b)%Z in |- *. - apply - (Zdiv_quotient_unique (Zneg p * b) (Zpos p) (Zneg p * b / Zpos p) - ((Zneg p * b) mod Zpos p) (- b) 0). - rewrite (Zmult_comm (Zneg p * b / Zpos p) (Zpos p)). - apply Z_div_mod_eq; auto with zarith. - apply Z_mod_lt; auto with zarith. - rewrite Zplus_0_r; rewrite Zmult_opp_comm; fold (- Zpos p)%Z in |- *; - auto with zarith. + apply (Zdiv_quotient_unique (Zneg p * b) (Zpos p) (Zneg p * b / Zpos p) + ((Zneg p * b) mod Zpos p) (- b) 0). + rewrite (Zmult_comm (Zneg p * b / Zpos p) (Zpos p)). + apply Z_div_mod_eq; auto with zarith. + apply Z_mod_lt; auto with zarith. + rewrite Zplus_0_r; rewrite Zmult_opp_comm; fold (- Zpos p)%Z in |- *; auto with zarith. auto with zarith. - rewrite Zmult_opp_comm. - apply Zmod_mult_cancel_lft. + rewrite Zmult_opp_comm. + apply Zmod_mult_cancel_lft. Qed. Lemma Zdiv_mult_cancel_rht : forall a b : Z, b <> 0%Z -> (a * b / b)%Z = a. -intros a b. -rewrite Zmult_comm. -apply Zdiv_mult_cancel_lft. +Proof. + intros a b. + rewrite Zmult_comm. + apply Zdiv_mult_cancel_lft. Qed. Lemma Zdiv_plus_elim : forall a b d : Z, Zdivides d a -> Zdivides d b -> ((a + b) / d)%Z = (a / d + b / d)%Z. -intros a b d Ha Hb. -case (Zdec d). -intro Hd; rewrite Hd; case (a + b)%Z; case a; case b; simpl in |- *; auto. -intro Hd. -elim Ha; clear Ha; intros x Ha; rewrite <- Ha. -elim Hb; clear Hb; intros y Hb; rewrite <- Hb. -rewrite <- Zmult_plus_distr_l. -repeat rewrite Zdiv_mult_cancel_rht; auto. +Proof. + intros a b d Ha Hb. + case (Zdec d). + intro Hd; rewrite Hd; case (a + b)%Z; case a; case b; simpl in |- *; auto. + intro Hd. + elim Ha; clear Ha; intros x Ha; rewrite <- Ha. + elim Hb; clear Hb; intros y Hb; rewrite <- Hb. + rewrite <- Zmult_plus_distr_l. + repeat rewrite Zdiv_mult_cancel_rht; auto. Qed. Lemma Zdiv_elim : forall a b d : Z, d <> 0%Z -> Zdivides d a -> Zdivides d b -> (a / d)%Z = (b / d)%Z -> a = b. -intros a b d Hd Ha Hb. -elim Ha; clear Ha; intros x Ha; rewrite <- Ha. -elim Hb; clear Hb; intros y Hb; rewrite <- Hb. -repeat rewrite Zdiv_mult_cancel_rht; auto. -intro Hxy; rewrite Hxy; auto. +Proof. + intros a b d Hd Ha Hb. + elim Ha; clear Ha; intros x Ha; rewrite <- Ha. + elim Hb; clear Hb; intros y Hb; rewrite <- Hb. + repeat rewrite Zdiv_mult_cancel_rht; auto. + intro Hxy; rewrite Hxy; auto. Qed. Lemma Zabs_div_lft : forall a : Z, (Zabs a / a)%Z = Zsgn a. -intro a. -rewrite Zmult_sgn_eq_abs. -case (Zdec a). -intro Ha. rewrite Ha. simpl in |- *. auto with zarith. -apply Zdiv_mult_cancel_rht. +Proof. + intro a. + rewrite Zmult_sgn_eq_abs. + case (Zdec a). + intro Ha. rewrite Ha. simpl in |- *. auto with zarith. + apply Zdiv_mult_cancel_rht. Qed. Lemma Zabs_div_rht : forall a : Z, (a / Zabs a)%Z = Zsgn a. -intro a. -set (A := Zabs a). -set (sa := Zsgn a). -replace a with (Zabs a * Zsgn a)%Z. -unfold sa in |- *; clear sa. -case (Zdec A). -unfold A in |- *; intro HA. - cut (a = 0%Z); auto with zarith. - intro Ha; rewrite Ha; auto with zarith. -unfold A in |- *; apply Zdiv_mult_cancel_lft. -rewrite Zmult_comm. -auto with zarith. +Proof. + intro a. + set (A := Zabs a). + set (sa := Zsgn a). + replace a with (Zabs a * Zsgn a)%Z. + unfold sa in |- *; clear sa. + case (Zdec A). + unfold A in |- *; intro HA. + cut (a = 0%Z); auto with zarith. + intro Ha; rewrite Ha; auto with zarith. + unfold A in |- *; apply Zdiv_mult_cancel_lft. + rewrite Zmult_comm. + auto with zarith. Qed. Lemma Zdiv_same : forall a : Z, a <> 0%Z -> (a / a)%Z = 1%Z. -intros a. -case a. -tauto. -intros; apply Z_div_same; auto with zarith. -intros A HA. -fold (- Zpos A)%Z in |- *. -rewrite Zdiv_Zopp. -simpl in |- *. -replace (Zpos A) with (Zabs (Zneg A)); auto. -rewrite Zabs_div_rht. -auto. -replace (- Zpos A)%Z with (-1 * Zpos A)%Z; auto with zarith. -apply Zmod_mult_cancel_rht. +Proof. + intros a. + case a. + tauto. + intros; apply Z_div_same; auto with zarith. + intros A HA. + fold (- Zpos A)%Z in |- *. + rewrite Zdiv_Zopp. + simpl in |- *. + replace (Zpos A) with (Zabs (Zneg A)); auto. + rewrite Zabs_div_rht. + auto. + replace (- Zpos A)%Z with (-1 * Zpos A)%Z; auto with zarith. + apply Zmod_mult_cancel_rht. Qed. Lemma Zmult_div_simpl_1 : forall a b c d : Z, (a * b)%Z = (c * d)%Z -> a <> 0%Z -> Zdivides a c -> Zdivides d b. -intros a b c d Heq Ha Hdiv. -elim Hdiv; intros x Hx. -rewrite <- Hx in Heq. -rewrite (Zmult_comm x a) in Heq. -rewrite <- Zmult_assoc in Heq. -exists x. -apply (Zmult_intro_lft a); auto. +Proof. + intros a b c d Heq Ha Hdiv. + elim Hdiv; intros x Hx. + rewrite <- Hx in Heq. + rewrite (Zmult_comm x a) in Heq. + rewrite <- Zmult_assoc in Heq. + exists x. + apply (Zmult_intro_lft a); auto. Qed. Lemma Zmult_div_simpl_2 : forall a b c d : Z, (a * b)%Z = (d * c)%Z -> a <> 0%Z -> Zdivides a c -> Zdivides d b. -intros a b c d; rewrite (Zmult_comm d c); apply Zmult_div_simpl_1. +Proof. + intros a b c d; rewrite (Zmult_comm d c); apply Zmult_div_simpl_1. Qed. Lemma Zmult_div_simpl_3 : forall a b c d : Z, (b * a)%Z = (c * d)%Z -> a <> 0%Z -> Zdivides a c -> Zdivides d b. -intros a b c d; rewrite (Zmult_comm b a); apply Zmult_div_simpl_1. +Proof. + intros a b c d; rewrite (Zmult_comm b a); apply Zmult_div_simpl_1. Qed. Lemma Zmult_div_simpl_4 : forall a b c d : Z, (b * a)%Z = (d * c)%Z -> a <> 0%Z -> Zdivides a c -> Zdivides d b. -intros a b c d; rewrite (Zmult_comm b a); rewrite (Zmult_comm d c); - apply Zmult_div_simpl_1. + intros a b c d; rewrite (Zmult_comm b a); rewrite (Zmult_comm d c); apply Zmult_div_simpl_1. Qed. Lemma Zdivides_dec : forall a b : Z, {Zdivides a b} + {~ Zdivides a b}. -intros a b. -case (Zdec b). -intro Hb. - rewrite Hb. - left. - apply Zdivides_zero_rht. -intro Hb. +Proof. + intros a b. + case (Zdec b). + intro Hb. + rewrite Hb. + left. + apply Zdivides_zero_rht. + intro Hb. case (Zdec a). - intro Ha. - rewrite Ha. - right. - intro H0. - rewrite (Zdivides_zero_lft b H0) in Hb. - elim Hb. - auto. + intro Ha. + rewrite Ha. + right. + intro H0. + rewrite (Zdivides_zero_lft b H0) in Hb. + elim Hb. + auto. intro Ha. generalize (Zdivides_Zmod0 b a Ha). - generalize (Zmod0_Zdivides b a Ha). + generalize (Zmod0_Zdivides b a Ha). case (Zdec (b mod a)); auto. Qed. @@ -849,55 +897,57 @@ Section ineq. Lemma Zmod_POS_nonNEG : forall a b p : positive, (Zpos a mod Zpos b)%Z <> Zneg p. -intros a b p. -generalize (Z_mod_lt (Zpos a) (Zpos b)). -intro H. -elim H. -intros H0 H1. -intro Hfalse. -rewrite Hfalse in H0. -elim H0. -auto with zarith. -auto with zarith. +Proof. + intros a b p. + generalize (Z_mod_lt (Zpos a) (Zpos b)). + intro H. + elim H. + intros H0 H1. + intro Hfalse. + rewrite Hfalse in H0. + elim H0. + auto with zarith. + auto with zarith. Qed. Lemma Zdiv_POS : forall a b : positive, (Zpos b * (Zpos a / Zpos b) <= Zpos a)%Z. -intros a b. -rewrite <- (Zplus_0_r (Zpos b * (Zpos a / Zpos b))). -set (lhs := (Zpos b * (Zpos a / Zpos b) + 0)%Z) in *. -rewrite (Z_div_mod_eq (Zpos a) (Zpos b)). -unfold lhs in |- *. -apply Zplus_le_compat_l. -auto with zarith. -generalize (Z_mod_lt (Zpos a) (Zpos b)). -intro H. -elim H. -auto with zarith. -auto with zarith. -auto with zarith. +Proof. + intros a b. + rewrite <- (Zplus_0_r (Zpos b * (Zpos a / Zpos b))). + set (lhs := (Zpos b * (Zpos a / Zpos b) + 0)%Z) in *. + rewrite (Z_div_mod_eq (Zpos a) (Zpos b)). + unfold lhs in |- *. + apply Zplus_le_compat_l. + auto with zarith. + generalize (Z_mod_lt (Zpos a) (Zpos b)). + intro H. + elim H. + auto with zarith. + auto with zarith. + auto with zarith. Qed. Lemma Zmod_lt_POS : forall a b : positive, (Zpos a < Zpos b)%Z -> (Zpos a mod Zpos b)%Z = Zpos a. -intros a b Hlt. -apply - (Zdiv_remainder_unique (Zpos a) (Zpos b) (Zpos a / Zpos b) - (Zpos a mod Zpos b) 0 (Zpos a)); auto with zarith. -rewrite Zmult_comm. -apply Z_div_mod_eq; auto with zarith. -apply Z_mod_lt; auto with zarith. +Proof. + intros a b Hlt. + apply (Zdiv_remainder_unique (Zpos a) (Zpos b) (Zpos a / Zpos b) + (Zpos a mod Zpos b) 0 (Zpos a)); auto with zarith. + rewrite Zmult_comm. + apply Z_div_mod_eq; auto with zarith. + apply Z_mod_lt; auto with zarith. Qed. Lemma Zdiv_lt_POS : forall a b : positive, (Zpos a < Zpos b)%Z -> (Zpos a / Zpos b)%Z = 0%Z. -intros a b Hlt. -apply - (Zdiv_quotient_unique (Zpos a) (Zpos b) (Zpos a / Zpos b) - (Zpos a mod Zpos b) 0 (Zpos a)); auto with zarith. -rewrite Zmult_comm. -apply Z_div_mod_eq; auto with zarith. -apply Z_mod_lt; auto with zarith. +Proof. + intros a b Hlt. + apply (Zdiv_quotient_unique (Zpos a) (Zpos b) (Zpos a / Zpos b) + (Zpos a mod Zpos b) 0 (Zpos a)); auto with zarith. + rewrite Zmult_comm. + apply Z_div_mod_eq; auto with zarith. + apply Z_mod_lt; auto with zarith. Qed. End ineq. diff --git a/model/Zmod/ZGcd.v b/model/Zmod/ZGcd.v index 67a4be811..3f65e044e 100644 --- a/model/Zmod/ZGcd.v +++ b/model/Zmod/ZGcd.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* ZGcd.v, by Vince Barany *) Require Export ZDivides. @@ -57,29 +57,29 @@ Definition pp_lt (x y : pp) := let (c, d) := y in (b ?= d)%positive Datatypes.Eq = Datatypes.Lt. Lemma pp_lt_wf : Wf.well_founded pp_lt. -red in |- *. intros x. -assert - (forall (n : nat) (a b : positive), nat_of_P b < n -> Acc pp_lt (a, b)). - simple induction n. - intros a b H0. - elim (lt_n_O _ H0). - intros n0 Hind a b HSn0. - assert (Hdisj : nat_of_P b < n0 \/ nat_of_P b = n0). - omega. - elim Hdisj. - apply Hind. - intro Heq. - assert (Hy : forall y : pp, pp_lt y (a, b) -> Acc pp_lt y). - intro y; elim y; intros c d Hdb. - unfold pp_lt in Hdb. - assert (Hd : nat_of_P d < n0). - rewrite <- Heq. - apply nat_of_P_lt_Lt_compare_morphism. - exact Hdb. - apply Hind. - exact Hd. - exact (Acc_intro (a, b) Hy). - elim x; intros a b. +Proof. + red in |- *. intros x. + assert (forall (n : nat) (a b : positive), nat_of_P b < n -> Acc pp_lt (a, b)). + simple induction n. + intros a b H0. + elim (lt_n_O _ H0). + intros n0 Hind a b HSn0. + assert (Hdisj : nat_of_P b < n0 \/ nat_of_P b = n0). + omega. + elim Hdisj. + apply Hind. + intro Heq. + assert (Hy : forall y : pp, pp_lt y (a, b) -> Acc pp_lt y). + intro y; elim y; intros c d Hdb. + unfold pp_lt in Hdb. + assert (Hd : nat_of_P d < n0). + rewrite <- Heq. + apply nat_of_P_lt_Lt_compare_morphism. + exact Hdb. + apply Hind. + exact Hd. + exact (Acc_intro (a, b) Hy). + elim x; intros a b. apply (H (S (nat_of_P b))). auto. Qed. @@ -87,27 +87,29 @@ Qed. Lemma rem_lt : forall a b r : positive, (Zpos a mod Zpos b)%Z = Zpos r -> pp_lt (b, r) (a, b). -intros a b r Hr. -generalize (Z_mod_lt (Zpos a) (Zpos b)). -intro H; elim H; clear H. -intros H0 H1. -rewrite Hr in H1. -unfold pp_lt in |- *. -auto with zarith. -auto with zarith. +Proof. + intros a b r Hr. + generalize (Z_mod_lt (Zpos a) (Zpos b)). + intro H; elim H; clear H. + intros H0 H1. + rewrite Hr in H1. + unfold pp_lt in |- *. + auto with zarith. + auto with zarith. Qed. Lemma rem_dec : forall a b : positive, ((Zpos a mod Zpos b)%Z = 0%Z) or ({r : positive| (Zpos a mod Zpos b)%Z = Zpos r}). -intros a b. -set (r := (Zpos a mod Zpos b)%Z) in *. -assert (Hr : r = (Zpos a mod Zpos b)%Z); auto; generalize Hr. -case (Zpos a mod Zpos b)%Z. -intros; left; auto. -intros p Hp; right; exists p; auto. -intros p Hp; unfold r in Hp; elim (Zmod_POS_nonNEG _ _ _ Hp). +Proof. + intros a b. + set (r := (Zpos a mod Zpos b)%Z) in *. + assert (Hr : r = (Zpos a mod Zpos b)%Z); auto; generalize Hr. + case (Zpos a mod Zpos b)%Z. + intros; left; auto. + intros p Hp; right; exists p; auto. + intros p Hp; unfold r in Hp; elim (Zmod_POS_nonNEG _ _ _ Hp). Defined. (* @@ -137,14 +139,14 @@ Lemma pp_gcd_ind_ext : (forall (y : pp) (p : pp_lt y x), f y p = g y p) -> pp_gcd_ind x f = pp_gcd_ind x g. Proof. -intros x; elim x; intros a b. -intros f g Hext. -simpl in |- *. -case (rem_dec a b). -auto. -intro Hex; elim Hex; intros r Hr. -rewrite Hext. -auto. + intros x; elim x; intros a b. + intros f g Hext. + simpl in |- *. + case (rem_dec a b). + auto. + intro Hex; elim Hex; intros r Hr. + rewrite Hext. + auto. Qed. Definition p_gcd_duv (a b : positive) := @@ -158,45 +160,49 @@ Definition p_gcd_coeff_b (a b : positive) := Lemma p_gcd_duv_rec_zero : forall a b : positive, (Zpos a mod Zpos b)%Z = 0%Z -> p_gcd_duv a b = (b, (0%Z, 1%Z)). -intros a b Hr. -unfold p_gcd_duv. -rewrite Fix_eq. -simpl. -case (rem_dec a b). -auto. -intro Hex; elim Hex; intros r' Hr'. -rewrite Hr in Hr'. -discriminate. -apply pp_gcd_ind_ext. +Proof. + intros a b Hr. + unfold p_gcd_duv. + rewrite Fix_eq. + simpl. + case (rem_dec a b). + auto. + intro Hex; elim Hex; intros r' Hr'. + rewrite Hr in Hr'. + discriminate. + apply pp_gcd_ind_ext. Qed. Lemma p_gcd_rec_zero : forall a b : positive, (Zpos a mod Zpos b)%Z = 0%Z -> p_gcd a b = b. -intros a b H0. -unfold p_gcd in |- *. -rewrite p_gcd_duv_rec_zero. -reflexivity. -exact H0. +Proof. + intros a b H0. + unfold p_gcd in |- *. + rewrite p_gcd_duv_rec_zero. + reflexivity. + exact H0. Qed. Lemma p_gcd_coeff_a_rec_zero : forall a b : positive, (Zpos a mod Zpos b)%Z = 0%Z -> p_gcd_coeff_a a b = 0%Z. -intros a b H0. -unfold p_gcd_coeff_a in |- *. -rewrite p_gcd_duv_rec_zero. -reflexivity. -exact H0. +Proof. + intros a b H0. + unfold p_gcd_coeff_a in |- *. + rewrite p_gcd_duv_rec_zero. + reflexivity. + exact H0. Qed. Lemma p_gcd_coeff_b_rec_zero : forall a b : positive, (Zpos a mod Zpos b)%Z = 0%Z -> p_gcd_coeff_b a b = 1%Z. -intros a b H0. -unfold p_gcd_coeff_b in |- *. -rewrite p_gcd_duv_rec_zero. -reflexivity. -exact H0. +Proof. + intros a b H0. + unfold p_gcd_coeff_b in |- *. + rewrite p_gcd_duv_rec_zero. + reflexivity. + exact H0. Qed. Lemma @@ -206,39 +212,42 @@ Lemma p_gcd_duv a b = (let (d, uv) := p_gcd_duv b r in let (u, v) := uv in (d, (v, (u - Zpos a / Zpos b * v)%Z))). -intros a b r Hr. -unfold p_gcd_duv. -fold (p_gcd_duv b r). -rewrite Fix_eq; simpl. -case (rem_dec a b). -rewrite Hr; intros; discriminate. -intro Hex; elim Hex; intros r' Hr'. -fold (p_gcd_duv b r'). -rewrite Hr in Hr'. -inversion Hr'. -auto. -apply pp_gcd_ind_ext. +Proof. + intros a b r Hr. + unfold p_gcd_duv. + fold (p_gcd_duv b r). + rewrite Fix_eq; simpl. + case (rem_dec a b). + rewrite Hr; intros; discriminate. + intro Hex; elim Hex; intros r' Hr'. + fold (p_gcd_duv b r'). + rewrite Hr in Hr'. + inversion Hr'. + auto. + apply pp_gcd_ind_ext. Qed. Lemma p_gcd_rec : forall a b r : positive, (Zpos a mod Zpos b)%Z = Zpos r -> p_gcd a b = p_gcd b r. -intros a b r Hr. -unfold p_gcd in |- *. -rewrite (p_gcd_duv_rec a b r Hr). -elim (p_gcd_duv b r); intros d uv; elim uv; intros u v. -reflexivity. +Proof. + intros a b r Hr. + unfold p_gcd in |- *. + rewrite (p_gcd_duv_rec a b r Hr). + elim (p_gcd_duv b r); intros d uv; elim uv; intros u v. + reflexivity. Qed. Lemma p_gcd_rec_coeff_a : forall a b r : positive, (Zpos a mod Zpos b)%Z = Zpos r -> p_gcd_coeff_a a b = p_gcd_coeff_b b r. -intros a b r Hr. -unfold p_gcd_coeff_a in |- *. -unfold p_gcd_coeff_b in |- *. -rewrite (p_gcd_duv_rec a b r Hr). -elim (p_gcd_duv b r); intros d uv; elim uv; intros u v. -reflexivity. +Proof. + intros a b r Hr. + unfold p_gcd_coeff_a in |- *. + unfold p_gcd_coeff_b in |- *. + rewrite (p_gcd_duv_rec a b r Hr). + elim (p_gcd_duv b r); intros d uv; elim uv; intros u v. + reflexivity. Qed. Lemma p_gcd_rec_coeff_b : @@ -246,12 +255,13 @@ Lemma p_gcd_rec_coeff_b : (Zpos a mod Zpos b)%Z = Zpos r -> p_gcd_coeff_b a b = (p_gcd_coeff_a b r - Zpos a / Zpos b * p_gcd_coeff_b b r)%Z. -intros a b r Hr. -unfold p_gcd_coeff_a in |- *. -unfold p_gcd_coeff_b in |- *. -rewrite (p_gcd_duv_rec a b r Hr). -elim (p_gcd_duv b r); intros d uv; elim uv; intros u v. -reflexivity. +Proof. + intros a b r Hr. + unfold p_gcd_coeff_a in |- *. + unfold p_gcd_coeff_b in |- *. + rewrite (p_gcd_duv_rec a b r Hr). + elim (p_gcd_duv b r); intros d uv; elim uv; intros u v. + reflexivity. Qed. Lemma pp_gcd_lin_comb : @@ -260,20 +270,16 @@ Lemma pp_gcd_lin_comb : Zpos (p_gcd a b) = (p_gcd_coeff_a a b * Zpos a + p_gcd_coeff_b a b * Zpos b)%Z. Proof. -apply - (well_founded_ind pp_lt_wf - (fun x : pp => - let (a, b) := x in - Zpos (p_gcd a b) = - (p_gcd_coeff_a a b * Zpos a + p_gcd_coeff_b a b * Zpos b)%Z)). -intros x; elim x; intros a b. -unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *. -intros Hind. -case (rem_dec a b). -intros Hr. - rewrite (p_gcd_duv_rec_zero a b Hr). - auto with zarith. -intros Hr. + apply (well_founded_ind pp_lt_wf (fun x : pp => let (a, b) := x in Zpos (p_gcd a b) = + (p_gcd_coeff_a a b * Zpos a + p_gcd_coeff_b a b * Zpos b)%Z)). + intros x; elim x; intros a b. + unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *. + intros Hind. + case (rem_dec a b). + intros Hr. + rewrite (p_gcd_duv_rec_zero a b Hr). + auto with zarith. + intros Hr. elim Hr; clear Hr; intros r Hr. generalize (Hind (b, r) (rem_lt a b r Hr)). rewrite (p_gcd_duv_rec a b r Hr). @@ -281,14 +287,14 @@ intros Hr. intro Hd'; rewrite Hd'. set (q := (Zpos a / Zpos b)%Z) in *. rewrite (Z_div_mod_eq (Zpos a) (Zpos b)). - fold q in |- *. - rewrite Hr. - rewrite Zmult_plus_distr_r. - rewrite BinInt.Zmult_minus_distr_r. - rewrite (Zmult_assoc v' (Zpos b) q). - rewrite (Zmult_comm (v' * Zpos b) q). - rewrite (Zmult_assoc q v' (Zpos b)). - omega. + fold q in |- *. + rewrite Hr. + rewrite Zmult_plus_distr_r. + rewrite BinInt.Zmult_minus_distr_r. + rewrite (Zmult_assoc v' (Zpos b) q). + rewrite (Zmult_comm (v' * Zpos b) q). + rewrite (Zmult_assoc q v' (Zpos b)). + omega. auto with zarith. Qed. @@ -296,8 +302,9 @@ Lemma p_gcd_lin_comb : forall a b : positive, Zpos (p_gcd a b) = (p_gcd_coeff_a a b * Zpos a + p_gcd_coeff_b a b * Zpos b)%Z. -intros a b. -apply (pp_gcd_lin_comb (a, b)). +Proof. + intros a b. + apply (pp_gcd_lin_comb (a, b)). Qed. Lemma pp_gcd_is_divisor : @@ -305,97 +312,96 @@ Lemma pp_gcd_is_divisor : let (a, b) := ab in Zdivides (Zpos (p_gcd a b)) (Zpos a) /\ Zdivides (Zpos (p_gcd a b)) (Zpos b). Proof. -apply - (well_founded_ind pp_lt_wf - (fun y : pp => - let (u, v) := y in - Zdivides (Zpos (p_gcd u v)) (Zpos u) /\ - Zdivides (Zpos (p_gcd u v)) (Zpos v))). -intro x; elim x; intros a b. -unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *. -intros Hind. -case (rem_dec a b). -intros Hr. - rewrite (p_gcd_duv_rec_zero a b Hr). - auto with zarith. -intros Hr; elim Hr; clear Hr; intros r Hr. + apply (well_founded_ind pp_lt_wf (fun y : pp => let (u, v) := y in + Zdivides (Zpos (p_gcd u v)) (Zpos u) /\ Zdivides (Zpos (p_gcd u v)) (Zpos v))). + intro x; elim x; intros a b. + unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *. + intros Hind. + case (rem_dec a b). + intros Hr. + rewrite (p_gcd_duv_rec_zero a b Hr). + auto with zarith. + intros Hr; elim Hr; clear Hr; intros r Hr. generalize (Hind (b, r) (rem_lt a b r Hr)). rewrite (p_gcd_duv_rec a b r Hr). elim (p_gcd_duv b r); intros d' uv'; elim uv'; intros u' v'. intro Hd'. split. - rewrite (Z_div_mod_eq (Zpos a) (Zpos b)). - rewrite Hr. - apply Zdivides_plus_elim. - apply Zdivides_mult_elim_rht. - tauto. - tauto. - auto with zarith. + rewrite (Z_div_mod_eq (Zpos a) (Zpos b)). + rewrite Hr. + apply Zdivides_plus_elim. + apply Zdivides_mult_elim_rht. + tauto. + tauto. + auto with zarith. tauto. Qed. Lemma p_gcd_is_divisor : forall a b : positive, Zdivides (Zpos (p_gcd a b)) (Zpos a) /\ Zdivides (Zpos (p_gcd a b)) (Zpos b). -intros a b. -apply (pp_gcd_is_divisor (a, b)). +Proof. + intros a b. + apply (pp_gcd_is_divisor (a, b)). Qed. Lemma p_gcd_duv_symm : forall a b : positive, a <> b -> p_gcd_duv a b = (p_gcd b a, (p_gcd_coeff_b b a, p_gcd_coeff_a b a)). -intros a b Hdiff. -unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *. -set (rel := (Zpos a ?= Zpos b)%Z) in *. -cut ((Zpos a ?= Zpos b)%Z = rel). -case rel. -intro Hegal. - assert (Heq : Zpos a = Zpos b). - apply Zle_antisymm. - intro H; rewrite H in Hegal; discriminate. - apply Zle_ge; intro H; rewrite H in Hegal; discriminate. - inversion Heq. - tauto. -intro Hlt. - rewrite (p_gcd_duv_rec a b a). - elim (p_gcd_duv b a); intros d uv; elim uv; intros u v. - cut ((Zpos a / Zpos b)%Z = 0%Z). - intros H0; rewrite H0. - rewrite Zmult_0_l. - unfold Zminus in |- *. - simpl in |- *. - rewrite Zplus_0_r. - reflexivity. - apply (Zdiv_lt_POS a b Hlt). - apply (Zmod_lt_POS a b Hlt). -intro Hgt. - rewrite (p_gcd_duv_rec b a b). - elim (p_gcd_duv a b); intros d uv; elim uv; intros u v. - cut ((Zpos b / Zpos a)%Z = 0%Z). - intros H0; rewrite H0. - rewrite Zmult_0_l. - unfold Zminus in |- *; simpl in |- *. - rewrite Zplus_0_r. - reflexivity. - apply (Zdiv_lt_POS b a); apply Zgt_lt; assumption. - apply (Zmod_lt_POS b a); apply Zgt_lt; assumption. +Proof. + intros a b Hdiff. + unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *. + set (rel := (Zpos a ?= Zpos b)%Z) in *. + cut ((Zpos a ?= Zpos b)%Z = rel). + case rel. + intro Hegal. + assert (Heq : Zpos a = Zpos b). + apply Zle_antisymm. + intro H; rewrite H in Hegal; discriminate. + apply Zle_ge; intro H; rewrite H in Hegal; discriminate. + inversion Heq. + tauto. + intro Hlt. + rewrite (p_gcd_duv_rec a b a). + elim (p_gcd_duv b a); intros d uv; elim uv; intros u v. + cut ((Zpos a / Zpos b)%Z = 0%Z). + intros H0; rewrite H0. + rewrite Zmult_0_l. + unfold Zminus in |- *. + simpl in |- *. + rewrite Zplus_0_r. + reflexivity. + apply (Zdiv_lt_POS a b Hlt). + apply (Zmod_lt_POS a b Hlt). + intro Hgt. + rewrite (p_gcd_duv_rec b a b). + elim (p_gcd_duv a b); intros d uv; elim uv; intros u v. + cut ((Zpos b / Zpos a)%Z = 0%Z). + intros H0; rewrite H0. + rewrite Zmult_0_l. + unfold Zminus in |- *; simpl in |- *. + rewrite Zplus_0_r. + reflexivity. + apply (Zdiv_lt_POS b a); apply Zgt_lt; assumption. + apply (Zmod_lt_POS b a); apply Zgt_lt; assumption. auto. Qed. Lemma p_gcd_symm : forall a b : positive, p_gcd a b = p_gcd b a. -intros a b. -case (Zdec (Zpos a - Zpos b)). -intro H0. - cut (Zpos a = Zpos b). - intro Heq. inversion Heq. reflexivity. - auto with zarith. -intro Hdiff. +Proof. + intros a b. + case (Zdec (Zpos a - Zpos b)). + intro H0. + cut (Zpos a = Zpos b). + intro Heq. inversion Heq. reflexivity. + auto with zarith. + intro Hdiff. cut (a <> b). - intro Hneq. - unfold p_gcd in |- *. - rewrite (p_gcd_duv_symm a b Hneq). - auto. + intro Hneq. + unfold p_gcd in |- *. + rewrite (p_gcd_duv_symm a b Hneq). + auto. intro Hfalse. apply Hdiff. rewrite Hfalse. @@ -422,61 +428,62 @@ Definition Zis_gcd (a b d : Z) := Lemma Zis_gcd_unique : forall a b d e : Z, Zis_gcd a b d -> Zis_gcd a b e -> d = e. -intros a b d e. -unfold Zis_gcd in |- *. -intros Hd He. -elim Hd; intros Hdl Hdr. -elim He; intros Hel Her. -induction a as [| p| p]. -induction b as [| p| p]. -transitivity 0%Z. -apply Hdl; reflexivity; reflexivity. -symmetry in |- *. -apply Hel; reflexivity; reflexivity. -elim Hdr. intros Hd0 Hddiv. -elim Her. intros He0 Hediv. -elim Hddiv; intros _ Hddiv2. -elim Hddiv2; intros _ Hdgcd. -elim Hediv; intros _ Hediv2. -elim Hediv2; intros _ Hegcd. -apply (Zdivides_antisymm _ _ Hd0 He0). -apply Hegcd; tauto. -apply Hdgcd; tauto. -right; discriminate. -right; discriminate. -elim Hdr. intros Hd0 Hddiv. -elim Her. intros He0 Hediv. -elim Hddiv; intros _ Hddiv2. -elim Hddiv2; intros _ Hdgcd. -elim Hediv; intros _ Hediv2. -elim Hediv2; intros _ Hegcd. -apply (Zdivides_antisymm _ _ Hd0 He0). -apply Hegcd; tauto. -apply Hdgcd; tauto. -right. discriminate. -right. discriminate. -elim Hdr. intros Hd0 Hddiv. -elim Her. intros He0 Hediv. -elim Hddiv; intros _ Hddiv2. -elim Hddiv2; intros _ Hdgcd. -elim Hediv; intros _ Hediv2. -elim Hediv2; intros _ Hegcd. -apply (Zdivides_antisymm _ _ Hd0 He0). -apply Hegcd; tauto. -apply Hdgcd; tauto. -left. discriminate. -left. discriminate. -elim Hdr. intros Hd0 Hddiv. -elim Her. intros He0 Hediv. -elim Hddiv; intros _ Hddiv2. -elim Hddiv2; intros _ Hdgcd. -elim Hediv; intros _ Hediv2. -elim Hediv2; intros _ Hegcd. -apply (Zdivides_antisymm _ _ Hd0 He0). -apply Hegcd; tauto. -apply Hdgcd; tauto. -left. discriminate. -left. discriminate. +Proof. + intros a b d e. + unfold Zis_gcd in |- *. + intros Hd He. + elim Hd; intros Hdl Hdr. + elim He; intros Hel Her. + induction a as [| p| p]. + induction b as [| p| p]. + transitivity 0%Z. + apply Hdl; reflexivity; reflexivity. + symmetry in |- *. + apply Hel; reflexivity; reflexivity. + elim Hdr. intros Hd0 Hddiv. + elim Her. intros He0 Hediv. + elim Hddiv; intros _ Hddiv2. + elim Hddiv2; intros _ Hdgcd. + elim Hediv; intros _ Hediv2. + elim Hediv2; intros _ Hegcd. + apply (Zdivides_antisymm _ _ Hd0 He0). + apply Hegcd; tauto. + apply Hdgcd; tauto. + right; discriminate. + right; discriminate. + elim Hdr. intros Hd0 Hddiv. + elim Her. intros He0 Hediv. + elim Hddiv; intros _ Hddiv2. + elim Hddiv2; intros _ Hdgcd. + elim Hediv; intros _ Hediv2. + elim Hediv2; intros _ Hegcd. + apply (Zdivides_antisymm _ _ Hd0 He0). + apply Hegcd; tauto. + apply Hdgcd; tauto. + right. discriminate. + right. discriminate. + elim Hdr. intros Hd0 Hddiv. + elim Her. intros He0 Hediv. + elim Hddiv; intros _ Hddiv2. + elim Hddiv2; intros _ Hdgcd. + elim Hediv; intros _ Hediv2. + elim Hediv2; intros _ Hegcd. + apply (Zdivides_antisymm _ _ Hd0 He0). + apply Hegcd; tauto. + apply Hdgcd; tauto. + left. discriminate. + left. discriminate. + elim Hdr. intros Hd0 Hddiv. + elim Her. intros He0 Hediv. + elim Hddiv; intros _ Hddiv2. + elim Hddiv2; intros _ Hdgcd. + elim Hediv; intros _ Hediv2. + elim Hediv2; intros _ Hegcd. + apply (Zdivides_antisymm _ _ Hd0 He0). + apply Hegcd; tauto. + apply Hdgcd; tauto. + left. discriminate. + left. discriminate. Qed. @@ -509,93 +516,103 @@ Definition Zgcd_coeff_b (a b : Z) := Lemma Zgcd_duv_zero_rht : forall a : Z, Zgcd_duv a 0 = (Zabs a, (Zsgn a, 0%Z)). -intro a. -case a; auto with zarith. +Proof. + intro a. + case a; auto with zarith. Qed. Lemma Zgcd_zero_rht : forall a : Z, Zgcd a 0 = Zabs a. -intro a. -unfold Zgcd in |- *. -rewrite Zgcd_duv_zero_rht. -reflexivity. +Proof. + intro a. + unfold Zgcd in |- *. + rewrite Zgcd_duv_zero_rht. + reflexivity. Qed. Lemma Zgcd_coeff_a_zero_rht : forall a : Z, Zgcd_coeff_a a 0 = Zsgn a. -intro a. -unfold Zgcd_coeff_a in |- *. -rewrite Zgcd_duv_zero_rht. -reflexivity. +Proof. + intro a. + unfold Zgcd_coeff_a in |- *. + rewrite Zgcd_duv_zero_rht. + reflexivity. Qed. Lemma Zgcd_coeff_b_zero_rht : forall a : Z, Zgcd_coeff_b a 0 = 0%Z. -intro a. -unfold Zgcd_coeff_b in |- *. -rewrite Zgcd_duv_zero_rht. -reflexivity. +Proof. + intro a. + unfold Zgcd_coeff_b in |- *. + rewrite Zgcd_duv_zero_rht. + reflexivity. Qed. Lemma Zgcd_duv_Zopp_l : forall a b : Z, Zgcd_duv (- a) b = (let (d, uv) := Zgcd_duv a b in let (u, v) := uv in (d, ((- u)%Z, v))). -intros a b. -case a; case b; intros; simpl in |- *; repeat rewrite Zopp_involutive; - reflexivity. +Proof. + intros a b. + case a; case b; intros; simpl in |- *; repeat rewrite Zopp_involutive; reflexivity. Qed. Lemma Zgcd_Zopp_l : forall a b : Z, Zgcd (- a) b = Zgcd a b. -intros a b. -case a; case b; auto with zarith. +Proof. + intros a b. + case a; case b; auto with zarith. Qed. Lemma Zgcd_coeff_a_Zopp_l : forall a b : Z, Zgcd_coeff_a (- a) b = (- Zgcd_coeff_a a b)%Z. -intros. -unfold Zgcd_coeff_a in |- *. -rewrite Zgcd_duv_Zopp_l. -elim (Zgcd_duv a b); intros d uv; elim uv; intros u v. -reflexivity. +Proof. + intros. + unfold Zgcd_coeff_a in |- *. + rewrite Zgcd_duv_Zopp_l. + elim (Zgcd_duv a b); intros d uv; elim uv; intros u v. + reflexivity. Qed. Lemma Zgcd_coeff_b_Zopp_l : forall a b : Z, Zgcd_coeff_b (- a) b = Zgcd_coeff_b a b. -intros. -unfold Zgcd_coeff_b in |- *. -rewrite Zgcd_duv_Zopp_l. -elim (Zgcd_duv a b); intros d uv; elim uv; intros u v. -reflexivity. +Proof. + intros. + unfold Zgcd_coeff_b in |- *. + rewrite Zgcd_duv_Zopp_l. + elim (Zgcd_duv a b); intros d uv; elim uv; intros u v. + reflexivity. Qed. Lemma Zgcd_duv_Zopp_r : forall a b : Z, Zgcd_duv a (- b) = (let (d, uv) := Zgcd_duv a b in let (u, v) := uv in (d, (u, (- v)%Z))). -intros a b. -case a; case b; intros; simpl in |- *; repeat rewrite Zopp_involutive; - reflexivity. +Proof. + intros a b. + case a; case b; intros; simpl in |- *; repeat rewrite Zopp_involutive; reflexivity. Qed. Lemma Zgcd_Zopp_r : forall a b : Z, Zgcd a (- b) = Zgcd a b. -intros a b. -case a; case b; auto with zarith. +Proof. + intros a b. + case a; case b; auto with zarith. Qed. Lemma Zgcd_coeff_a_Zopp_r : forall a b : Z, Zgcd_coeff_a a (- b) = Zgcd_coeff_a a b. -intros. -unfold Zgcd_coeff_a in |- *. -rewrite Zgcd_duv_Zopp_r. -elim (Zgcd_duv a b); intros d uv; elim uv; intros u v. -reflexivity. +Proof. + intros. + unfold Zgcd_coeff_a in |- *. + rewrite Zgcd_duv_Zopp_r. + elim (Zgcd_duv a b); intros d uv; elim uv; intros u v. + reflexivity. Qed. Lemma Zgcd_coeff_b_Zopp_r : forall a b : Z, Zgcd_coeff_b a (- b) = (- Zgcd_coeff_b a b)%Z. -intros. -unfold Zgcd_coeff_b in |- *. -rewrite Zgcd_duv_Zopp_r. -elim (Zgcd_duv a b); intros d uv; elim uv; intros u v. -reflexivity. +Proof. + intros. + unfold Zgcd_coeff_b in |- *. + rewrite Zgcd_duv_Zopp_r. + elim (Zgcd_duv a b); intros d uv; elim uv; intros u v. + reflexivity. Qed. Lemma Zgcd_duv_abs : @@ -603,35 +620,39 @@ Lemma Zgcd_duv_abs : Zgcd_duv a b = (let (d, uv) := Zgcd_duv (Zabs a) (Zabs b) in let (u, v) := uv in (d, ((Zsgn a * u)%Z, (Zsgn b * v)%Z))). -intros a b. -case a; case b; intros; unfold Zabs, Zsgn, Zgcd_duv in |- *; - repeat (fold (- (1))%Z in |- *; rewrite <- Zopp_mult_distr_l); - repeat rewrite Zmult_1_l; reflexivity. +Proof. + intros a b. + case a; case b; intros; unfold Zabs, Zsgn, Zgcd_duv in |- *; + repeat (fold (- (1))%Z in |- *; rewrite <- Zopp_mult_distr_l); + repeat rewrite Zmult_1_l; reflexivity. Qed. Lemma Zgcd_abs : forall a b : Z, Zgcd a b = Zgcd (Zabs a) (Zabs b). -intros a b. -case a; case b; auto with zarith. +Proof. + intros a b. + case a; case b; auto with zarith. Qed. Lemma Zgcd_coeff_a_abs : forall a b : Z, Zgcd_coeff_a a b = (Zsgn a * Zgcd_coeff_a (Zabs a) (Zabs b))%Z. -intros. -unfold Zgcd_coeff_a in |- *. -rewrite Zgcd_duv_abs. -elim (Zgcd_duv (Zabs a) (Zabs b)); intros d uv; elim uv; intros u v. -reflexivity. +Proof. + intros. + unfold Zgcd_coeff_a in |- *. + rewrite Zgcd_duv_abs. + elim (Zgcd_duv (Zabs a) (Zabs b)); intros d uv; elim uv; intros u v. + reflexivity. Qed. Lemma Zgcd_coeff_b_abs : forall a b : Z, Zgcd_coeff_b a b = (Zsgn b * Zgcd_coeff_b (Zabs a) (Zabs b))%Z. -intros. -unfold Zgcd_coeff_b in |- *. -rewrite Zgcd_duv_abs. -elim (Zgcd_duv (Zabs a) (Zabs b)); intros d uv; elim uv; intros u v. -reflexivity. +Proof. + intros. + unfold Zgcd_coeff_b in |- *. + rewrite Zgcd_duv_abs. + elim (Zgcd_duv (Zabs a) (Zabs b)); intros d uv; elim uv; intros u v. + reflexivity. Qed. Let Zgcd_duv_rec_subsubcase : @@ -639,16 +660,17 @@ Let Zgcd_duv_rec_subsubcase : Zgcd_duv (Zpos a) (Zpos b) = (let (d, uv) := Zgcd_duv (Zpos b) (Zpos a mod Zpos b) in let (u, v) := uv in (d, (v, (u - Zpos a / Zpos b * v)%Z))). -intros a b. -unfold Zgcd_duv in |- *. -unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *. -case (rem_dec a b). -intro Hr. - rewrite Hr. - rewrite (p_gcd_duv_rec_zero a b Hr). - rewrite Zmult_0_r. - auto with zarith. -intro Hr; elim Hr; clear Hr; intros r Hr. +Proof. + intros a b. + unfold Zgcd_duv in |- *. + unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *. + case (rem_dec a b). + intro Hr. + rewrite Hr. + rewrite (p_gcd_duv_rec_zero a b Hr). + rewrite Zmult_0_r. + auto with zarith. + intro Hr; elim Hr; clear Hr; intros r Hr. rewrite Hr. rewrite (p_gcd_duv_rec a b r Hr). elim (p_gcd_duv b r); intros d' uv'; elim uv'; intros u' v'. @@ -660,24 +682,23 @@ Let Zgcd_duv_rec_subcase : Zgcd_duv a (Zpos pb) = (let (d, uv) := Zgcd_duv (Zpos pb) (Zabs a mod Zpos pb) in let (u, v) := uv in (d, ((Zsgn a * v)%Z, (u - Zabs a / Zpos pb * v)%Z))). -intros a pb. -case a. -unfold Zgcd_duv in |- *; simpl in |- *; reflexivity. -intro pa. -unfold Zabs, Zsgn in |- *. -rewrite Zgcd_duv_rec_subsubcase. -elim (Zgcd_duv (Zpos pb) (Zpos pa mod Zpos pb)); intros d uv; elim uv; - intros u v. -rewrite Zmult_1_l. -reflexivity. -intro pa. -rewrite (Zgcd_duv_abs (Zneg pa) (Zpos pb)). -unfold Zabs, Zsgn in |- *. -rewrite Zgcd_duv_rec_subsubcase. -elim (Zgcd_duv (Zpos pb) (Zpos pa mod Zpos pb)); intros d uv; elim uv; - intros u v. -rewrite Zmult_1_l. -reflexivity. +Proof. + intros a pb. + case a. + unfold Zgcd_duv in |- *; simpl in |- *; reflexivity. + intro pa. + unfold Zabs, Zsgn in |- *. + rewrite Zgcd_duv_rec_subsubcase. + elim (Zgcd_duv (Zpos pb) (Zpos pa mod Zpos pb)); intros d uv; elim uv; intros u v. + rewrite Zmult_1_l. + reflexivity. + intro pa. + rewrite (Zgcd_duv_abs (Zneg pa) (Zpos pb)). + unfold Zabs, Zsgn in |- *. + rewrite Zgcd_duv_rec_subsubcase. + elim (Zgcd_duv (Zpos pb) (Zpos pa mod Zpos pb)); intros d uv; elim uv; intros u v. + rewrite Zmult_1_l. + reflexivity. Qed. Lemma Zgcd_duv_rec : @@ -687,60 +708,61 @@ Lemma Zgcd_duv_rec : (let (d, uv) := Zgcd_duv b (Zabs a mod Zabs b) in let (u, v) := uv in (d, ((Zsgn a * v)%Z, (u - Zsgn b * (Zabs a / Zabs b) * v)%Z))). -intros a b Hb. -set (B := b) in *. -cut (B = b). -case b. -intro HB'. - rewrite HB' in Hb. - elim Hb. - reflexivity. -intros pb HB'. - rewrite HB'. - rewrite Zgcd_duv_rec_subcase. - unfold Zabs, Zsgn in |- *. fold (Zabs a) in |- *. fold (Zsgn a) in |- *. - elim (Zgcd_duv (Zpos pb) (Zabs a mod Zpos pb)); intros d uv; elim uv; - intros u v. - rewrite Zmult_1_l. - reflexivity. -intros pb HB'. - rewrite HB'. - fold (- Zpos pb)%Z in |- *. - rewrite Zgcd_duv_Zopp_r. - rewrite Zgcd_duv_Zopp_l. - rewrite Zgcd_duv_rec_subcase. - unfold Zopp, Zabs, Zsgn in |- *. fold (Zabs a) in |- *. fold (Zsgn a) in |- *. - elim (Zgcd_duv (Zpos pb) (Zabs a mod Zpos pb)); intros d uv; elim uv; - intros u v. - fold (- u)%Z in |- *. - rewrite Zopp_mult_distr_l_reverse. - unfold Zminus in |- *. - rewrite <- Zopp_plus_distr. - auto with zarith. +Proof. + intros a b Hb. + set (B := b) in *. + cut (B = b). + case b. + intro HB'. + rewrite HB' in Hb. + elim Hb. + reflexivity. + intros pb HB'. + rewrite HB'. + rewrite Zgcd_duv_rec_subcase. + unfold Zabs, Zsgn in |- *. fold (Zabs a) in |- *. fold (Zsgn a) in |- *. + elim (Zgcd_duv (Zpos pb) (Zabs a mod Zpos pb)); intros d uv; elim uv; intros u v. + rewrite Zmult_1_l. + reflexivity. + intros pb HB'. + rewrite HB'. + fold (- Zpos pb)%Z in |- *. + rewrite Zgcd_duv_Zopp_r. + rewrite Zgcd_duv_Zopp_l. + rewrite Zgcd_duv_rec_subcase. + unfold Zopp, Zabs, Zsgn in |- *. fold (Zabs a) in |- *. fold (Zsgn a) in |- *. + elim (Zgcd_duv (Zpos pb) (Zabs a mod Zpos pb)); intros d uv; elim uv; intros u v. + fold (- u)%Z in |- *. + rewrite Zopp_mult_distr_l_reverse. + unfold Zminus in |- *. + rewrite <- Zopp_plus_distr. + auto with zarith. auto. Qed. Lemma Zgcd_rec : forall a b : Z, b <> 0%Z -> Zgcd a b = Zgcd b (Zabs a mod Zabs b). -intros a b Hb. -unfold Zgcd in |- *. -rewrite Zgcd_duv_rec. -elim (Zgcd_duv b (Zabs a mod Zabs b)); intros d uv; elim uv; intros u v. -reflexivity. -exact Hb. +Proof. + intros a b Hb. + unfold Zgcd in |- *. + rewrite Zgcd_duv_rec. + elim (Zgcd_duv b (Zabs a mod Zabs b)); intros d uv; elim uv; intros u v. + reflexivity. + exact Hb. Qed. Lemma Zgcd_coeff_a_rec : forall a b : Z, b <> 0%Z -> Zgcd_coeff_a a b = (Zsgn a * Zgcd_coeff_b b (Zabs a mod Zabs b))%Z. -intros a b Hb. -unfold Zgcd_coeff_a in |- *. -unfold Zgcd_coeff_b in |- *. -rewrite Zgcd_duv_rec. -elim (Zgcd_duv b (Zabs a mod Zabs b)); intros d uv; elim uv; intros u v. -reflexivity. -exact Hb. +Proof. + intros a b Hb. + unfold Zgcd_coeff_a in |- *. + unfold Zgcd_coeff_b in |- *. + rewrite Zgcd_duv_rec. + elim (Zgcd_duv b (Zabs a mod Zabs b)); intros d uv; elim uv; intros u v. + reflexivity. + exact Hb. Qed. Lemma Zgcd_coeff_b_rec : @@ -749,196 +771,209 @@ Lemma Zgcd_coeff_b_rec : Zgcd_coeff_b a b = (Zgcd_coeff_a b (Zabs a mod Zabs b) - Zsgn b * (Zabs a / Zabs b) * Zgcd_coeff_b b (Zabs a mod Zabs b))%Z. -intros a b Hb. -unfold Zgcd_coeff_a in |- *. -unfold Zgcd_coeff_b in |- *. -rewrite Zgcd_duv_rec. -elim (Zgcd_duv b (Zabs a mod Zabs b)); intros d uv; elim uv; intros u v. -reflexivity. -exact Hb. +Proof. + intros a b Hb. + unfold Zgcd_coeff_a in |- *. + unfold Zgcd_coeff_b in |- *. + rewrite Zgcd_duv_rec. + elim (Zgcd_duv b (Zabs a mod Zabs b)); intros d uv; elim uv; intros u v. + reflexivity. + exact Hb. Qed. Lemma Zgcd_duv_divisor : forall a b : Z, a <> 0%Z -> Zdivides b a -> Zgcd_duv a b = (Zabs b, (0%Z, Zsgn b)). -intros a b Ha. -case b. -intros Hdiv. - replace a with 0%Z; simpl in |- *; auto. - symmetry in |- *. - auto with zarith. -intros pb Hdiv. - simpl in |- *. - rewrite Zgcd_duv_rec_subcase. - replace (Zabs a mod Zpos pb)%Z with 0%Z. - rewrite Zgcd_duv_zero_rht. - rewrite Zmult_0_r. - rewrite Zmult_0_r. +Proof. + intros a b Ha. + case b. + intros Hdiv. + replace a with 0%Z; simpl in |- *; auto. + symmetry in |- *. + auto with zarith. + intros pb Hdiv. + simpl in |- *. + rewrite Zgcd_duv_rec_subcase. + replace (Zabs a mod Zpos pb)%Z with 0%Z. + rewrite Zgcd_duv_zero_rht. + rewrite Zmult_0_r. + rewrite Zmult_0_r. + simpl in |- *. + reflexivity. + symmetry in |- *. + auto with zarith. + intros pb Hdiv. simpl in |- *. - reflexivity. - symmetry in |- *. - auto with zarith. -intros pb Hdiv. - simpl in |- *. fold (- Zpos pb)%Z in |- *. rewrite Zgcd_duv_Zopp_r. rewrite Zgcd_duv_rec_subcase. replace (Zabs a mod Zpos pb)%Z with 0%Z. - rewrite Zgcd_duv_zero_rht. - rewrite Zmult_0_r. - rewrite Zmult_0_r. - simpl in |- *. - reflexivity. + rewrite Zgcd_duv_zero_rht. + rewrite Zmult_0_r. + rewrite Zmult_0_r. + simpl in |- *. + reflexivity. symmetry in |- *. auto with zarith. Qed. Lemma Zgcd_divisor : forall a b : Z, a <> 0%Z -> Zdivides b a -> Zgcd a b = Zabs b. -intros. -unfold Zgcd in |- *. -rewrite Zgcd_duv_divisor; auto. +Proof. + intros. + unfold Zgcd in |- *. + rewrite Zgcd_duv_divisor; auto. Qed. Lemma Zgcd_coeff_a_divisor : forall a b : Z, a <> 0%Z -> Zdivides b a -> Zgcd_coeff_a a b = 0%Z. -intros. -unfold Zgcd_coeff_a in |- *. -rewrite Zgcd_duv_divisor; auto. +Proof. + intros. + unfold Zgcd_coeff_a in |- *. + rewrite Zgcd_duv_divisor; auto. Qed. Lemma Zgcd_coeff_b_divisor : forall a b : Z, a <> 0%Z -> Zdivides b a -> Zgcd_coeff_b a b = Zsgn b. -intros. -unfold Zgcd_coeff_b in |- *. -rewrite Zgcd_duv_divisor; auto. +Proof. + intros. + unfold Zgcd_coeff_b in |- *. + rewrite Zgcd_duv_divisor; auto. Qed. Lemma Zgcd_duv_symm : forall a b : Z, Zabs a <> Zabs b -> Zgcd_duv a b = (Zgcd b a, (Zgcd_coeff_b b a, Zgcd_coeff_a b a)). -intros a b. -unfold Zgcd, Zgcd_coeff_a, Zgcd_coeff_b in |- *. -cut (forall p q : positive, Zpos p <> Zpos q -> p <> q). - -case a; case b; simpl in |- *; intros; - unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *; - try rewrite p_gcd_duv_symm; auto. - -intros p q Hneq; intro Hfalse. -apply Hneq; rewrite Hfalse; auto. +Proof. + intros a b. + unfold Zgcd, Zgcd_coeff_a, Zgcd_coeff_b in |- *. + cut (forall p q : positive, Zpos p <> Zpos q -> p <> q). + case a; case b; simpl in |- *; intros; unfold p_gcd, p_gcd_coeff_a, p_gcd_coeff_b in |- *; + try rewrite p_gcd_duv_symm; auto. + intros p q Hneq; intro Hfalse. + apply Hneq; rewrite Hfalse; auto. Qed. Lemma Zgcd_symm : forall a b : Z, Zgcd a b = Zgcd b a. -intros a b. -case a; case b; simpl in |- *; intros; unfold Zgcd, Zgcd_duv in |- *; - try rewrite p_gcd_symm; auto. +Proof. + intros a b. + case a; case b; simpl in |- *; intros; unfold Zgcd, Zgcd_duv in |- *; try rewrite p_gcd_symm; auto. Qed. Lemma Zgcd_coeff_a_symm : forall a b : Z, Zabs a <> Zabs b -> Zgcd_coeff_a a b = Zgcd_coeff_b b a. -intros a b Hneq. -unfold Zgcd_coeff_a, Zgcd_coeff_b in |- *. -rewrite (Zgcd_duv_symm a b Hneq). -auto. +Proof. + intros a b Hneq. + unfold Zgcd_coeff_a, Zgcd_coeff_b in |- *. + rewrite (Zgcd_duv_symm a b Hneq). + auto. Qed. Lemma Zgcd_coeff_b_symm : forall a b : Z, Zabs a <> Zabs b -> Zgcd_coeff_b a b = Zgcd_coeff_a b a. -intros a b Hneq. -unfold Zgcd_coeff_a, Zgcd_coeff_b in |- *. -rewrite (Zgcd_duv_symm a b Hneq). -auto. +Proof. + intros a b Hneq. + unfold Zgcd_coeff_a, Zgcd_coeff_b in |- *. + rewrite (Zgcd_duv_symm a b Hneq). + auto. Qed. Lemma Zgcd_is_divisor : forall a b : Z, Zdivides (Zgcd a b) a. -intros a b. -case a. -auto with zarith. -case b. -auto with zarith. -intros pb pa; generalize (p_gcd_is_divisor pa pb); tauto. -intros pb pa; generalize (p_gcd_is_divisor pa pb); tauto. -case b. -auto with zarith. -intros pb pa; generalize (p_gcd_is_divisor pa pb); intro H. -apply Zdivides_opp_intro_rht; simpl in |- *. -tauto. -intros pb pa; generalize (p_gcd_is_divisor pa pb); intro H. -apply Zdivides_opp_intro_rht; simpl in |- *. -tauto. +Proof. + intros a b. + case a. + auto with zarith. + case b. + auto with zarith. + intros pb pa; generalize (p_gcd_is_divisor pa pb); tauto. + intros pb pa; generalize (p_gcd_is_divisor pa pb); tauto. + case b. + auto with zarith. + intros pb pa; generalize (p_gcd_is_divisor pa pb); intro H. + apply Zdivides_opp_intro_rht; simpl in |- *. + tauto. + intros pb pa; generalize (p_gcd_is_divisor pa pb); intro H. + apply Zdivides_opp_intro_rht; simpl in |- *. + tauto. Qed. Definition Zgcd_is_divisor_lft := Zgcd_is_divisor. Lemma Zgcd_is_divisor_rht : forall a b : Z, Zdivides (Zgcd a b) b. -intros a b. -rewrite Zgcd_symm. -apply Zgcd_is_divisor_lft. +Proof. + intros a b. + rewrite Zgcd_symm. + apply Zgcd_is_divisor_lft. Qed. Lemma Zgcd_lin_comb : forall a b : Z, Zgcd a b = (Zgcd_coeff_a a b * a + Zgcd_coeff_b a b * b)%Z. -intros a b. -unfold Zgcd, Zgcd_coeff_a, Zgcd_coeff_b in |- *. -case a; case b; simpl in |- *; intros; repeat rewrite Zmult_opp_comm; - simpl in |- *; try rewrite p_gcd_lin_comb; auto. +Proof. + intros a b. + unfold Zgcd, Zgcd_coeff_a, Zgcd_coeff_b in |- *. + case a; case b; simpl in |- *; intros; repeat rewrite Zmult_opp_comm; + simpl in |- *; try rewrite p_gcd_lin_comb; auto. Qed. Lemma Zgcd_zero : forall a b : Z, Zgcd a b = 0%Z -> a = 0%Z /\ b = 0%Z. -intros a b. -case a; case b; unfold Zgcd in |- *; simpl in |- *; intros; try discriminate; - try tauto. +Proof. + intros a b. + case a; case b; unfold Zgcd in |- *; simpl in |- *; intros; try discriminate; try tauto. Qed. Lemma Zgcd_nonneg : forall a b : Z, (0 <= Zgcd a b)%Z. -intros a b. -case a; case b; unfold Zgcd in |- *; simpl in |- *; auto with zarith. +Proof. + intros a b. + case a; case b; unfold Zgcd in |- *; simpl in |- *; auto with zarith. Qed. Lemma Zgcd_nonzero : forall a b : Z, 0%Z <> Zgcd a b -> a <> 0%Z \/ b <> 0%Z. -intros a b. -case a. -case b. - rewrite Zgcd_zero_rht; simpl in |- *; tauto. - intros; right; intro; discriminate. - intros; right; intro; discriminate. -intros; left; intro; discriminate. -intros; left; intro; discriminate. +Proof. + intros a b. + case a. + case b. + rewrite Zgcd_zero_rht; simpl in |- *; tauto. + intros; right; intro; discriminate. + intros; right; intro; discriminate. + intros; left; intro; discriminate. + intros; left; intro; discriminate. Qed. Lemma Zgcd_pos : forall a b : Z, a <> 0%Z \/ b <> 0%Z -> (0 < Zgcd a b)%Z. -intros a b Hab. -generalize (Zgcd_nonneg a b); intro Hnonneg. -cut (Zgcd a b <> 0%Z). -auto with zarith. -intro H0. -generalize (Zgcd_zero a b H0). -tauto. +Proof. + intros a b Hab. + generalize (Zgcd_nonneg a b); intro Hnonneg. + cut (Zgcd a b <> 0%Z). + auto with zarith. + intro H0. + generalize (Zgcd_zero a b H0). + tauto. Qed. Lemma Zgcd_is_gcd : forall a b : Z, Zis_gcd a b (Zgcd a b). -intros a b. -unfold Zis_gcd in |- *. -split. intros Ha Hb; rewrite Ha; rewrite Hb; auto with zarith. -intros Hab. -split. generalize (Zgcd_pos a b Hab); auto with zarith. -split. apply Zgcd_is_divisor_lft. -split. apply Zgcd_is_divisor_rht. -intros q Hq. -rewrite Zgcd_lin_comb. -apply Zdivides_plus_elim. -apply Zdivides_mult_elim_lft; tauto. -apply Zdivides_mult_elim_lft; tauto. +Proof. + intros a b. + unfold Zis_gcd in |- *. + split. intros Ha Hb; rewrite Ha; rewrite Hb; auto with zarith. + intros Hab. + split. generalize (Zgcd_pos a b Hab); auto with zarith. + split. apply Zgcd_is_divisor_lft. + split. apply Zgcd_is_divisor_rht. + intros q Hq. + rewrite Zgcd_lin_comb. + apply Zdivides_plus_elim. + apply Zdivides_mult_elim_lft; tauto. + apply Zdivides_mult_elim_lft; tauto. Qed. Lemma Zgcd_intro : forall a b d : Z, Zis_gcd a b d -> Zgcd a b = d. -intros a b d Hisgcd. -apply (Zis_gcd_unique a b (Zgcd a b) d). -apply Zgcd_is_gcd. -exact Hisgcd. +Proof. + intros a b d Hisgcd. + apply (Zis_gcd_unique a b (Zgcd a b) d). + apply Zgcd_is_gcd. + exact Hisgcd. Qed. Lemma Zgcd_intro_unfolded : @@ -949,313 +984,336 @@ Lemma Zgcd_intro_unfolded : Zdivides d b -> (forall q : Z, Zdivides q a /\ Zdivides q b -> Zdivides q d) -> Zgcd a b = d. Proof. -intros. -apply Zgcd_intro. -unfold Zis_gcd in |- *. -tauto. + intros. + apply Zgcd_intro. + unfold Zis_gcd in |- *. + tauto. Qed. Lemma Zdiv_gcd_elim_lft : forall a b q : Z, Zdivides a q -> Zdivides (Zgcd a b) q. -intros a b q Hdiv; apply (Zdivides_trans (Zgcd a b) a q); - [ apply Zgcd_is_divisor_lft | assumption ]. + intros a b q Hdiv; apply (Zdivides_trans (Zgcd a b) a q); [ apply Zgcd_is_divisor_lft | assumption ]. Qed. Lemma Zdiv_gcd_elim_rht : forall a b q : Z, Zdivides b q -> Zdivides (Zgcd a b) q. -intros a b q Hdiv; apply (Zdivides_trans (Zgcd a b) b q); - [ apply Zgcd_is_divisor_rht | assumption ]. + intros a b q Hdiv; apply (Zdivides_trans (Zgcd a b) b q); [ apply Zgcd_is_divisor_rht | assumption ]. Qed. Lemma Zdiv_gcd_elim : forall a b q : Z, Zdivides q a -> Zdivides q b -> Zdivides q (Zgcd a b). -intros a b q Ha Hb. -cut (a <> 0%Z \/ b <> 0%Z -> Zdivides q (Zgcd a b)). -case (Zdec a); case (Zdec b); auto. -intros Hb0 Ha0; rewrite Ha0 in Ha; rewrite Ha0; rewrite Hb0. -rewrite Zgcd_zero_rht; auto. -intro Hnon0; generalize (Zgcd_is_gcd a b); unfold Zis_gcd in |- *; intro H; - elim H; clear H; intros H0 H1; elim H1; clear H1. -intros _ H1; elim H1; clear H1; intros _ H1; elim H1; clear H1; intros _ Hdiv. -generalize (Hdiv q); intro Hq; auto. -auto. +Proof. + intros a b q Ha Hb. + cut (a <> 0%Z \/ b <> 0%Z -> Zdivides q (Zgcd a b)). + case (Zdec a); case (Zdec b); auto. + intros Hb0 Ha0; rewrite Ha0 in Ha; rewrite Ha0; rewrite Hb0. + rewrite Zgcd_zero_rht; auto. + intro Hnon0; generalize (Zgcd_is_gcd a b); unfold Zis_gcd in |- *; intro H; + elim H; clear H; intros H0 H1; elim H1; clear H1. + intros _ H1; elim H1; clear H1; intros _ H1; elim H1; clear H1; intros _ Hdiv. + generalize (Hdiv q); intro Hq; auto. + auto. Qed. Lemma Zgcd_mod0_lft : forall a b : Z, Zgcd a b <> 0%Z -> (a mod Zgcd a b)%Z = 0%Z. -intros; apply Zmod0_Zdivides; auto; apply Zgcd_is_divisor_lft. +Proof. + intros; apply Zmod0_Zdivides; auto; apply Zgcd_is_divisor_lft. Qed. Lemma Zgcd_mod0_rht : forall a b : Z, Zgcd a b <> 0%Z -> (b mod Zgcd a b)%Z = 0%Z. -intros a b. -rewrite Zgcd_symm. -apply Zgcd_mod0_lft. +Proof. + intros a b. + rewrite Zgcd_symm. + apply Zgcd_mod0_lft. Qed. Lemma Zgcd_div_mult_lft : forall a b : Z, Zgcd a b <> 0%Z -> a = (a / Zgcd a b * Zgcd a b)%Z. -intros a b H0. -generalize (Zgcd_mod0_lft a b); intro Hmod0. -rewrite <- Zplus_0_r. -rewrite <- Hmod0. -rewrite Zmult_comm. -apply Z_div_mod_eq. -generalize (Zgcd_nonneg a b). -auto with zarith. -assumption. +Proof. + intros a b H0. + generalize (Zgcd_mod0_lft a b); intro Hmod0. + rewrite <- Zplus_0_r. + rewrite <- Hmod0. + rewrite Zmult_comm. + apply Z_div_mod_eq. + generalize (Zgcd_nonneg a b). + auto with zarith. + assumption. Qed. Lemma Zgcd_div_mult_rht : forall a b : Z, Zgcd a b <> 0%Z -> b = (b / Zgcd a b * Zgcd a b)%Z. -intros a b. -rewrite Zgcd_symm. -apply Zgcd_div_mult_lft. +Proof. + intros a b. + rewrite Zgcd_symm. + apply Zgcd_div_mult_lft. Qed. Lemma Zgcd_idemp : forall a : Z, (a > 0)%Z -> Zgcd a a = a. -intros a Ha. -rewrite Zgcd_rec. -rewrite Z_mod_same. -rewrite Zgcd_zero_rht. -auto with zarith. -replace (Zabs a) with a. -assumption. -symmetry in |- *; auto with zarith. -auto with zarith. +Proof. + intros a Ha. + rewrite Zgcd_rec. + rewrite Z_mod_same. + rewrite Zgcd_zero_rht. + auto with zarith. + replace (Zabs a) with a. + assumption. + symmetry in |- *; auto with zarith. + auto with zarith. Qed. Lemma Zgcd_zero_lft : forall a : Z, Zgcd 0 a = Zabs a. -intro a. -rewrite Zgcd_symm. -apply Zgcd_zero_rht. +Proof. + intro a. + rewrite Zgcd_symm. + apply Zgcd_zero_rht. Qed. Lemma Zgcd_one_lft : forall a : Z, Zgcd 1 a = 1%Z. -intro a. -generalize (Zgcd_is_divisor_lft 1 a). -cut (0 < Zgcd 1 a)%Z. -auto with zarith. -apply Zgcd_pos. -left; intro; discriminate. +Proof. + intro a. + generalize (Zgcd_is_divisor_lft 1 a). + cut (0 < Zgcd 1 a)%Z. + auto with zarith. + apply Zgcd_pos. + left; intro; discriminate. Qed. Lemma Zgcd_one_rht : forall a : Z, Zgcd a 1 = 1%Z. -intro a. -rewrite Zgcd_symm. -apply Zgcd_one_lft. +Proof. + intro a. + rewrite Zgcd_symm. + apply Zgcd_one_lft. Qed. Lemma Zgcd_le_lft : forall a b : Z, (a > 0)%Z -> (Zgcd a b <= a)%Z. -intros a b Ha. -generalize (Zgcd_is_divisor_lft a b). -auto with zarith. +Proof. + intros a b Ha. + generalize (Zgcd_is_divisor_lft a b). + auto with zarith. Qed. Lemma Zgcd_le_rht : forall a b : Z, (b > 0)%Z -> (Zgcd a b <= b)%Z. -intros. -rewrite Zgcd_symm. -apply Zgcd_le_lft. -assumption. +Proof. + intros. + rewrite Zgcd_symm. + apply Zgcd_le_lft. + assumption. Qed. Lemma Zgcd_gcd_rl : forall a b : Z, Zgcd a (Zgcd a b) = Zgcd a b. -intros a b. -case (Zdec a). -intro H0; rewrite H0; repeat rewrite Zgcd_zero_lft; auto with zarith. -intro H0. -replace (Zgcd a b) with (Zabs (Zgcd a b)). -rewrite Zgcd_abs. -replace (Zabs (Zabs (Zgcd a b))) with (Zgcd a b). -apply Zgcd_divisor. -auto with zarith. -apply Zdivides_abs_elim_rht. -apply Zgcd_is_divisor_lft. -generalize (Zgcd_nonneg a b); rewrite Zabs_idemp; auto with zarith. -generalize (Zgcd_nonneg a b); auto with zarith. +Proof. + intros a b. + case (Zdec a). + intro H0; rewrite H0; repeat rewrite Zgcd_zero_lft; auto with zarith. + intro H0. + replace (Zgcd a b) with (Zabs (Zgcd a b)). + rewrite Zgcd_abs. + replace (Zabs (Zabs (Zgcd a b))) with (Zgcd a b). + apply Zgcd_divisor. + auto with zarith. + apply Zdivides_abs_elim_rht. + apply Zgcd_is_divisor_lft. + generalize (Zgcd_nonneg a b); rewrite Zabs_idemp; auto with zarith. + generalize (Zgcd_nonneg a b); auto with zarith. Qed. Lemma Zgcd_gcd_rr : forall a b : Z, Zgcd b (Zgcd a b) = Zgcd a b. -intros a b; rewrite (Zgcd_symm a b); apply Zgcd_gcd_rl. +Proof. + intros a b; rewrite (Zgcd_symm a b); apply Zgcd_gcd_rl. Qed. Lemma Zgcd_gcd_ll : forall a b : Z, Zgcd (Zgcd a b) a = Zgcd a b. -intros a b; rewrite (Zgcd_symm (Zgcd a b) a); apply Zgcd_gcd_rl. +Proof. + intros a b; rewrite (Zgcd_symm (Zgcd a b) a); apply Zgcd_gcd_rl. Qed. Lemma Zgcd_gcd_lr : forall a b : Z, Zgcd (Zgcd a b) b = Zgcd a b. -intros a b; rewrite (Zgcd_symm a b); rewrite (Zgcd_symm (Zgcd b a) b); - apply Zgcd_gcd_rl. + intros a b; rewrite (Zgcd_symm a b); rewrite (Zgcd_symm (Zgcd b a) b); apply Zgcd_gcd_rl. Qed. Lemma Zgcd_mult_elim_ll : forall a b : Z, Zgcd (b * a) a = Zabs a. -intros a b. -elim (Zdec (b * a)). -intro Hab; rewrite Hab; rewrite Zgcd_zero_lft; reflexivity. -intro Hab; apply Zgcd_divisor; auto with zarith. +Proof. + intros a b. + elim (Zdec (b * a)). + intro Hab; rewrite Hab; rewrite Zgcd_zero_lft; reflexivity. + intro Hab; apply Zgcd_divisor; auto with zarith. Qed. Lemma Zgcd_mult_elim_lr : forall a b : Z, Zgcd (a * b) a = Zabs a. -intros. -rewrite Zmult_comm. -apply Zgcd_mult_elim_ll. +Proof. + intros. + rewrite Zmult_comm. + apply Zgcd_mult_elim_ll. Qed. Lemma Zgcd_mult_elim_rl : forall a b : Z, Zgcd a (b * a) = Zabs a. -intros. -rewrite Zgcd_symm. -apply Zgcd_mult_elim_ll. +Proof. + intros. + rewrite Zgcd_symm. + apply Zgcd_mult_elim_ll. Qed. Lemma Zgcd_mult_elim_rr : forall a b : Z, Zgcd a (a * b) = Zabs a. -intros. -rewrite Zmult_comm. -rewrite Zgcd_symm. -apply Zgcd_mult_elim_ll. +Proof. + intros. + rewrite Zmult_comm. + rewrite Zgcd_symm. + apply Zgcd_mult_elim_ll. Qed. Lemma Zgcd_plus_elim_rr : forall a b c : Z, Zdivides a c -> Zgcd a (b + c) = Zgcd a b. -intros a b c Hdiv. -elim (Zdec a). -intro H0; rewrite H0; repeat rewrite Zgcd_zero_lft. -replace c with 0%Z. rewrite Zplus_0_r; auto. -rewrite H0 in Hdiv. -symmetry in |- *. -auto with zarith. -intro Ha. -apply Zdivides_antisymm. -generalize (Zgcd_pos a (b + c)); auto with zarith. -generalize (Zgcd_pos a b); auto with zarith. -rewrite (Zgcd_lin_comb a b). -apply Zdivides_plus_elim. -apply Zdivides_mult_elim_lft. -apply Zgcd_is_divisor_lft. -apply Zdivides_mult_elim_lft. -set (x := (b + c)%Z) in *; replace b with (b + c - c)%Z. unfold x in |- *. -apply Zdivides_minus_elim. -apply Zgcd_is_divisor_rht. -apply (Zdivides_trans (Zgcd a (b + c)) a c). -apply Zgcd_is_divisor_lft. -assumption. -omega. -rewrite (Zgcd_lin_comb a (b + c)). -apply Zdivides_plus_elim. -apply Zdivides_mult_elim_lft. -apply Zgcd_is_divisor_lft. -apply Zdivides_mult_elim_lft. -apply Zdivides_plus_elim. -apply Zgcd_is_divisor_rht. -apply (Zdivides_trans (Zgcd a b) a c). -apply Zgcd_is_divisor_lft. -assumption. +Proof. + intros a b c Hdiv. + elim (Zdec a). + intro H0; rewrite H0; repeat rewrite Zgcd_zero_lft. + replace c with 0%Z. rewrite Zplus_0_r; auto. + rewrite H0 in Hdiv. + symmetry in |- *. + auto with zarith. + intro Ha. + apply Zdivides_antisymm. + generalize (Zgcd_pos a (b + c)); auto with zarith. + generalize (Zgcd_pos a b); auto with zarith. + rewrite (Zgcd_lin_comb a b). + apply Zdivides_plus_elim. + apply Zdivides_mult_elim_lft. + apply Zgcd_is_divisor_lft. + apply Zdivides_mult_elim_lft. + set (x := (b + c)%Z) in *; replace b with (b + c - c)%Z. unfold x in |- *. + apply Zdivides_minus_elim. + apply Zgcd_is_divisor_rht. + apply (Zdivides_trans (Zgcd a (b + c)) a c). + apply Zgcd_is_divisor_lft. + assumption. + omega. + rewrite (Zgcd_lin_comb a (b + c)). + apply Zdivides_plus_elim. + apply Zdivides_mult_elim_lft. + apply Zgcd_is_divisor_lft. + apply Zdivides_mult_elim_lft. + apply Zdivides_plus_elim. + apply Zgcd_is_divisor_rht. + apply (Zdivides_trans (Zgcd a b) a c). + apply Zgcd_is_divisor_lft. + assumption. Qed. Lemma Zgcd_plus_elim_rl : forall a b c : Z, Zdivides a c -> Zgcd a (c + b) = Zgcd a b. -intros a b c. -rewrite Zplus_comm. -apply Zgcd_plus_elim_rr. +Proof. + intros a b c. + rewrite Zplus_comm. + apply Zgcd_plus_elim_rr. Qed. Lemma Zgcd_plus_elim_lr : forall a b c : Z, Zdivides b c -> Zgcd (a + c) b = Zgcd a b. -intros a b c. -rewrite (Zgcd_symm a b). -rewrite (Zgcd_symm (a + c) b). -apply Zgcd_plus_elim_rr. +Proof. + intros a b c. + rewrite (Zgcd_symm a b). + rewrite (Zgcd_symm (a + c) b). + apply Zgcd_plus_elim_rr. Qed. Lemma Zgcd_plus_elim_ll : forall a b c : Z, Zdivides b c -> Zgcd (c + a) b = Zgcd a b. -intros a b c. -rewrite Zplus_comm. -apply Zgcd_plus_elim_lr. +Proof. + intros a b c. + rewrite Zplus_comm. + apply Zgcd_plus_elim_lr. Qed. Lemma Zgcd_minus_elim_rr : forall a b c : Z, Zdivides a c -> Zgcd a (b - c) = Zgcd a b. -intros a b c Hdiv. -unfold Zminus in |- *. -apply Zgcd_plus_elim_rr. -auto with zarith. +Proof. + intros a b c Hdiv. + unfold Zminus in |- *. + apply Zgcd_plus_elim_rr. + auto with zarith. Qed. Lemma Zgcd_minus_elim_rl : forall a b c : Z, Zdivides a c -> Zgcd a (c - b) = Zgcd a b. -intros a b c Hdiv. -replace (c - b)%Z with (- (b - c))%Z. -rewrite Zgcd_Zopp_r. -apply Zgcd_minus_elim_rr. -assumption. -omega. +Proof. + intros a b c Hdiv. + replace (c - b)%Z with (- (b - c))%Z. + rewrite Zgcd_Zopp_r. + apply Zgcd_minus_elim_rr. + assumption. + omega. Qed. Lemma Zgcd_minus_elim_lr : forall a b c : Z, Zdivides b c -> Zgcd (a - c) b = Zgcd a b. -intros a b c. -rewrite (Zgcd_symm a b). -rewrite (Zgcd_symm (a - c) b). -apply Zgcd_minus_elim_rr. +Proof. + intros a b c. + rewrite (Zgcd_symm a b). + rewrite (Zgcd_symm (a - c) b). + apply Zgcd_minus_elim_rr. Qed. Lemma Zgcd_minus_elim_ll : forall a b c : Z, Zdivides b c -> Zgcd (c - a) b = Zgcd a b. -intros a b c. -rewrite (Zgcd_symm a b). -rewrite (Zgcd_symm (c - a) b). -apply Zgcd_minus_elim_rl. +Proof. + intros a b c. + rewrite (Zgcd_symm a b). + rewrite (Zgcd_symm (c - a) b). + apply Zgcd_minus_elim_rl. Qed. Lemma Zgcd_mod_lft : forall a b : Z, (b > 0)%Z -> Zgcd (a mod b) b = Zgcd a b. -intros a b Hb. -replace (a mod b)%Z with (a - b * (a / b))%Z. -apply Zgcd_minus_elim_lr. -apply Zdivides_mult_elim_rht. -apply Zdivides_ref. -generalize (Z_div_mod_eq a b Hb). -auto with zarith. +Proof. + intros a b Hb. + replace (a mod b)%Z with (a - b * (a / b))%Z. + apply Zgcd_minus_elim_lr. + apply Zdivides_mult_elim_rht. + apply Zdivides_ref. + generalize (Z_div_mod_eq a b Hb). + auto with zarith. Qed. Lemma Zgcd_mod_rht : forall a b : Z, (a > 0)%Z -> Zgcd a (b mod a) = Zgcd a b. -intros a b Ha. -repeat rewrite (Zgcd_symm a); apply Zgcd_mod_lft; exact Ha. +Proof. + intros a b Ha. + repeat rewrite (Zgcd_symm a); apply Zgcd_mod_lft; exact Ha. Qed. Lemma Zgcd_div_gcd_1 : forall a b : Z, Zgcd a b <> 0%Z -> Zgcd (a / Zgcd a b) (b / Zgcd a b) = 1%Z. -intros a b Hab. -apply Zdivides_antisymm; auto with zarith. -apply Zlt_gt. -apply Zgcd_pos. -generalize (Zgcd_nonzero a b); intro Hnz; elim Hnz; auto. -intro Ha; left; intro Hfalse; generalize (Zgcd_div_mult_lft a b); - rewrite Hfalse; simpl in |- *; tauto. -intro Hb; right; intro Hfalse; generalize (Zgcd_div_mult_rht a b); - rewrite Hfalse; simpl in |- *; tauto. -cut - (1%Z = - (Zgcd_coeff_a a b * (a / Zgcd a b) + Zgcd_coeff_b a b * (b / Zgcd a b))%Z). -intro H1; rewrite H1. -apply Zdivides_plus_elim. -apply Zdivides_mult_elim_lft. -apply Zgcd_is_divisor_lft. -apply Zdivides_mult_elim_lft. -apply Zgcd_is_divisor_rht. -generalize (Zgcd_lin_comb a b); intro Hlincomb; - generalize (Zgcd_is_divisor_lft a b); intro Hdivb; - elim Hdivb; intros y Hy; generalize (Zgcd_is_divisor_rht a b); - intro Hdiva; elim Hdiva; intros x Hx; set (d := Zgcd a b). -move d after Hy. -fold d in Hx; fold d in Hy. -replace 1%Z with (Zgcd a b / d)%Z; auto with zarith. -rewrite Hlincomb. -set (u := Zgcd_coeff_a a b); set (v := Zgcd_coeff_b a b). -rewrite Zdiv_plus_elim; auto with zarith. -rewrite <- Hx; rewrite <- Hy. -repeat rewrite Zmult_assoc. -repeat rewrite Zdiv_mult_cancel_rht; auto. +Proof. + intros a b Hab. + apply Zdivides_antisymm; auto with zarith. + apply Zlt_gt. + apply Zgcd_pos. + generalize (Zgcd_nonzero a b); intro Hnz; elim Hnz; auto. + intro Ha; left; intro Hfalse; generalize (Zgcd_div_mult_lft a b); + rewrite Hfalse; simpl in |- *; tauto. + intro Hb; right; intro Hfalse; generalize (Zgcd_div_mult_rht a b); + rewrite Hfalse; simpl in |- *; tauto. + cut (1%Z = (Zgcd_coeff_a a b * (a / Zgcd a b) + Zgcd_coeff_b a b * (b / Zgcd a b))%Z). + intro H1; rewrite H1. + apply Zdivides_plus_elim. + apply Zdivides_mult_elim_lft. + apply Zgcd_is_divisor_lft. + apply Zdivides_mult_elim_lft. + apply Zgcd_is_divisor_rht. + generalize (Zgcd_lin_comb a b); intro Hlincomb; generalize (Zgcd_is_divisor_lft a b); intro Hdivb; + elim Hdivb; intros y Hy; generalize (Zgcd_is_divisor_rht a b); + intro Hdiva; elim Hdiva; intros x Hx; set (d := Zgcd a b). + move d after Hy. + fold d in Hx; fold d in Hy. + replace 1%Z with (Zgcd a b / d)%Z; auto with zarith. + rewrite Hlincomb. + set (u := Zgcd_coeff_a a b); set (v := Zgcd_coeff_b a b). + rewrite Zdiv_plus_elim; auto with zarith. + rewrite <- Hx; rewrite <- Hy. + repeat rewrite Zmult_assoc. + repeat rewrite Zdiv_mult_cancel_rht; auto. Qed. @@ -1345,124 +1403,132 @@ Section zrelprime. Definition Zrelprime (a b : Z) := Zgcd a b = 1%Z. Lemma Zrelprime_dec : forall a b : Z, {Zrelprime a b} + {~ Zrelprime a b}. -intros a b. -unfold Zrelprime in |- *. -case (Zdec (Zgcd a b - 1)). -intro H1. - left. - auto with zarith. -intro Hn1. +Proof. + intros a b. + unfold Zrelprime in |- *. + case (Zdec (Zgcd a b - 1)). + intro H1. + left. + auto with zarith. + intro Hn1. right. auto with zarith. Qed. Lemma Zrelprime_irref : forall a : Z, (a > 1)%Z -> ~ Zrelprime a a. -intros a Ha. -unfold Zrelprime in |- *. -rewrite Zgcd_idemp. -auto with zarith. -auto with zarith. +Proof. + intros a Ha. + unfold Zrelprime in |- *. + rewrite Zgcd_idemp. + auto with zarith. + auto with zarith. Qed. Lemma Zrelprime_symm : forall a b : Z, Zrelprime a b -> Zrelprime b a. -unfold Zrelprime in |- *. -intros. -rewrite Zgcd_symm. -assumption. +Proof. + unfold Zrelprime in |- *. + intros. + rewrite Zgcd_symm. + assumption. Qed. Lemma Zrelprime_one_lft : forall a : Z, Zrelprime 1 a. -intro a. -unfold Zrelprime in |- *. -apply Zgcd_one_lft. +Proof. + intro a. + unfold Zrelprime in |- *. + apply Zgcd_one_lft. Qed. Lemma Zrelprime_one_rht : forall a : Z, Zrelprime a 1. -intro a. -unfold Zrelprime in |- *. -apply Zgcd_one_rht. +Proof. + intro a. + unfold Zrelprime in |- *. + apply Zgcd_one_rht. Qed. Lemma Zrelprime_nonzero_rht : forall a b : Z, Zrelprime a b -> Zabs a <> 1%Z -> b <> 0%Z. -intros a b H Ha. -intro Hfalse. -rewrite Hfalse in H. -unfold Zrelprime in H. -rewrite Zgcd_zero_rht in H. -tauto. +Proof. + intros a b H Ha. + intro Hfalse. + rewrite Hfalse in H. + unfold Zrelprime in H. + rewrite Zgcd_zero_rht in H. + tauto. Qed. Lemma Zrelprime_nonzero_lft : forall a b : Z, Zrelprime a b -> Zabs b <> 1%Z -> a <> 0%Z. -intros. -apply (Zrelprime_nonzero_rht b a). -apply Zrelprime_symm. -assumption. -assumption. +Proof. + intros. + apply (Zrelprime_nonzero_rht b a). + apply Zrelprime_symm. + assumption. + assumption. Qed. Lemma Zrelprime_mult_intro : forall a b x y : Z, Zrelprime (a * x) (b * y) -> Zrelprime a b. -intros a b x y. -unfold Zrelprime in |- *. -intro H1. -apply Zgcd_intro_unfolded; auto with zarith. -generalize (Zgcd_nonzero (a * x) (b * y)); rewrite H1; intro H0; elim H0; - auto with zarith. -intros q Hq. -rewrite <- H1. -apply Zdiv_gcd_elim; apply Zdivides_mult_elim_rht; tauto. +Proof. + intros a b x y. + unfold Zrelprime in |- *. + intro H1. + apply Zgcd_intro_unfolded; auto with zarith. + generalize (Zgcd_nonzero (a * x) (b * y)); rewrite H1; intro H0; elim H0; auto with zarith. + intros q Hq. + rewrite <- H1. + apply Zdiv_gcd_elim; apply Zdivides_mult_elim_rht; tauto. Qed. Lemma Zrelprime_divides_intro : forall a b p q : Z, Zdivides a p -> Zdivides b q -> Zrelprime p q -> Zrelprime a b. -intros a b p q Ha Hb; elim Ha; intros x Hx; rewrite <- Hx; elim Hb; - intros y Hy; rewrite <- Hy; rewrite (Zmult_comm x a); - rewrite (Zmult_comm y b); apply Zrelprime_mult_intro. +Proof. + intros a b p q Ha Hb; elim Ha; intros x Hx; rewrite <- Hx; elim Hb; + intros y Hy; rewrite <- Hy; rewrite (Zmult_comm x a); + rewrite (Zmult_comm y b); apply Zrelprime_mult_intro. Qed. Lemma Zrelprime_div_mult_intro : forall a b c : Z, Zrelprime a b -> Zdivides a (b * c) -> Zdivides a c. -intros a b c Hab Hdiv. -case (Zdec (Zabs a - 1)). -intro H1. -exists (c * Zsgn a)%Z. -rewrite <- Zmult_assoc. -replace (Zsgn a * a)%Z with (Zabs a); auto with zarith. -replace (Zabs a) with 1%Z; auto with zarith. -intro Hn1. -unfold Zrelprime in Hab. -generalize (Zgcd_lin_comb a b). -rewrite Hab. -set (u := Zgcd_coeff_a a b); set (v := Zgcd_coeff_b a b). -intro H1. -replace c with (u * a * c + v * b * c)%Z. -apply Zdivides_plus_elim. -auto with zarith. -rewrite <- Zmult_assoc. -auto with zarith. -symmetry in |- *. -rewrite <- (Zmult_1_l c). -replace (u * a * (1 * c))%Z with (u * a * c)%Z. -replace (v * b * (1 * c))%Z with (v * b * c)%Z. -rewrite H1. -auto with zarith. -rewrite Zmult_1_l; auto. -rewrite Zmult_1_l; auto. +Proof. + intros a b c Hab Hdiv. + case (Zdec (Zabs a - 1)). + intro H1. + exists (c * Zsgn a)%Z. + rewrite <- Zmult_assoc. + replace (Zsgn a * a)%Z with (Zabs a); auto with zarith. + replace (Zabs a) with 1%Z; auto with zarith. + intro Hn1. + unfold Zrelprime in Hab. + generalize (Zgcd_lin_comb a b). + rewrite Hab. + set (u := Zgcd_coeff_a a b); set (v := Zgcd_coeff_b a b). + intro H1. + replace c with (u * a * c + v * b * c)%Z. + apply Zdivides_plus_elim. + auto with zarith. + rewrite <- Zmult_assoc. + auto with zarith. + symmetry in |- *. + rewrite <- (Zmult_1_l c). + replace (u * a * (1 * c))%Z with (u * a * c)%Z. + replace (v * b * (1 * c))%Z with (v * b * c)%Z. + rewrite H1. + auto with zarith. + rewrite Zmult_1_l; auto. + rewrite Zmult_1_l; auto. Qed. Lemma Zrelprime_mult_div_simpl : forall a b x y : Z, Zrelprime a b -> (x * a)%Z = (y * b)%Z -> Zdivides b x. -intros a b x y Hab Heq. -case (Zdec a). -intro Ha; rewrite Ha in Hab; unfold Zrelprime in Hab; - rewrite Zgcd_zero_lft in Hab. - exists (Zsgn b * x)%Z; rewrite Zmult_comm; rewrite Zmult_assoc; - rewrite (Zmult_comm b (Zsgn b)); rewrite <- Zmult_sgn_eq_abs; - rewrite Hab; apply Zmult_1_l. -intro Ha. +Proof. + intros a b x y Hab Heq. + case (Zdec a). + intro Ha; rewrite Ha in Hab; unfold Zrelprime in Hab; rewrite Zgcd_zero_lft in Hab. + exists (Zsgn b * x)%Z; rewrite Zmult_comm; rewrite Zmult_assoc; + rewrite (Zmult_comm b (Zsgn b)); rewrite <- Zmult_sgn_eq_abs; rewrite Hab; apply Zmult_1_l. + intro Ha. apply (Zmult_div_simpl_3 a x y b Heq Ha). apply (Zrelprime_div_mult_intro a b y Hab). exists x. @@ -1472,77 +1538,79 @@ Qed. Lemma Zrelprime_div_mult_elim : forall a b c : Z, Zrelprime a b -> Zdivides a c -> Zdivides b c -> Zdivides (a * b) c. -intros a b c Hab Ha Hb. -elim Ha; intros x Hx. -elim Hb; intros y Hy. -rewrite <- Hx. -rewrite (Zmult_comm x a). -cut (Zdivides b x); auto with zarith. -apply (Zrelprime_mult_div_simpl a b x y Hab). -rewrite Hx; rewrite Hy; auto. +Proof. + intros a b c Hab Ha Hb. + elim Ha; intros x Hx. + elim Hb; intros y Hy. + rewrite <- Hx. + rewrite (Zmult_comm x a). + cut (Zdivides b x); auto with zarith. + apply (Zrelprime_mult_div_simpl a b x y Hab). + rewrite Hx; rewrite Hy; auto. Qed. Lemma Zrelprime_gcd_mult_elim_lft : forall a b c : Z, Zrelprime a b -> Zgcd (a * b) c = (Zgcd a c * Zgcd b c)%Z. -intros a b c. -unfold Zrelprime in |- *. -case (Zdec (a * b)). -intro Hab0. - generalize (Zmult_zero_div a b Hab0); intro Hab. - elim Hab; intro H1; rewrite Hab0; rewrite H1; repeat rewrite Zgcd_zero_lft; - repeat rewrite Zgcd_zero_rht; intro H2; rewrite Zgcd_abs; - rewrite H2; rewrite Zgcd_one_lft; auto with zarith. -intros Hab0 Hrelprime. +Proof. + intros a b c. + unfold Zrelprime in |- *. + case (Zdec (a * b)). + intro Hab0. + generalize (Zmult_zero_div a b Hab0); intro Hab. + elim Hab; intro H1; rewrite Hab0; rewrite H1; repeat rewrite Zgcd_zero_lft; + repeat rewrite Zgcd_zero_rht; intro H2; rewrite Zgcd_abs; + rewrite H2; rewrite Zgcd_one_lft; auto with zarith. + intros Hab0 Hrelprime. apply Zdivides_antisymm. - apply Zlt_gt; apply Zgcd_pos; auto. - rewrite <- (Zmult_0_r (Zgcd a c)). - apply Zmult_pos_mon_lt_lft. - apply Zlt_gt; apply Zgcd_pos; left; rewrite Zmult_comm in Hab0; - auto with zarith. - apply Zlt_gt; apply Zgcd_pos; left; auto with zarith. + apply Zlt_gt; apply Zgcd_pos; auto. + rewrite <- (Zmult_0_r (Zgcd a c)). + apply Zmult_pos_mon_lt_lft. + apply Zlt_gt; apply Zgcd_pos; left; rewrite Zmult_comm in Hab0; auto with zarith. + apply Zlt_gt; apply Zgcd_pos; left; auto with zarith. rewrite (Zgcd_lin_comb a c); rewrite (Zgcd_lin_comb b c). repeat rewrite Zmult_plus_distr_r; repeat rewrite Zmult_plus_distr_l. apply Zdivides_plus_elim; apply Zdivides_plus_elim; auto with zarith. apply Zdiv_gcd_elim. - apply Zdivides_mult_elim; auto with zarith. + apply Zdivides_mult_elim; auto with zarith. apply Zrelprime_div_mult_elim; auto with zarith. - apply (Zrelprime_divides_intro (Zgcd a c) (Zgcd b c) a b); auto with zarith. + apply (Zrelprime_divides_intro (Zgcd a c) (Zgcd b c) a b); auto with zarith. Qed. Lemma Zrelprime_gcd_mult_elim_rht : forall a b c : Z, Zrelprime a b -> Zgcd c (a * b) = (Zgcd c a * Zgcd c b)%Z. -intros a b c; rewrite (Zgcd_symm c (a * b)); rewrite (Zgcd_symm c a); - rewrite (Zgcd_symm c b); apply Zrelprime_gcd_mult_elim_lft. +Proof. + intros a b c; rewrite (Zgcd_symm c (a * b)); rewrite (Zgcd_symm c a); + rewrite (Zgcd_symm c b); apply Zrelprime_gcd_mult_elim_lft. Qed. Lemma Zrelprime_mult_elim_lft : forall a b c : Z, Zrelprime a c -> Zrelprime b c -> Zrelprime (a * b) c. -intros a b c. -unfold Zrelprime in |- *. -intros Ha Hb. -generalize (Zgcd_lin_comb a c); rewrite Ha; set (p := Zgcd_coeff_a a c) in *; - set (q := Zgcd_coeff_b a c) in *. -generalize (Zgcd_lin_comb b c); rewrite Hb; set (r := Zgcd_coeff_a b c) in *; - set (s := Zgcd_coeff_b b c) in *. -intros Hla Hlb. -apply Zdivides_antisymm. -apply Zlt_gt; apply Zgcd_pos. -case (Zdec c); auto. -intro Hc0. - left. - rewrite Hc0 in Ha; rewrite Zgcd_zero_rht in Ha; rewrite Hc0 in Hb; - rewrite Zgcd_zero_rht in Hb; intro Hfalse. - generalize (Zmult_zero_div _ _ Hfalse); intro H0; elim H0. - intro Ha0; rewrite Ha0 in Ha; discriminate. - intro Hb0; rewrite Hb0 in Hb; discriminate. -auto with zarith. -replace 1%Z with ((r * b + s * c) * (p * a + q * c))%Z. -repeat rewrite Zmult_plus_distr_r; repeat rewrite Zmult_plus_distr_l; - rewrite (Zmult_comm p a); rewrite (Zmult_comm a b); - apply Zdivides_plus_elim; apply Zdivides_plus_elim; +Proof. + intros a b c. + unfold Zrelprime in |- *. + intros Ha Hb. + generalize (Zgcd_lin_comb a c); rewrite Ha; set (p := Zgcd_coeff_a a c) in *; + set (q := Zgcd_coeff_b a c) in *. + generalize (Zgcd_lin_comb b c); rewrite Hb; set (r := Zgcd_coeff_a b c) in *; + set (s := Zgcd_coeff_b b c) in *. + intros Hla Hlb. + apply Zdivides_antisymm. + apply Zlt_gt; apply Zgcd_pos. + case (Zdec c); auto. + intro Hc0. + left. + rewrite Hc0 in Ha; rewrite Zgcd_zero_rht in Ha; rewrite Hc0 in Hb; + rewrite Zgcd_zero_rht in Hb; intro Hfalse. + generalize (Zmult_zero_div _ _ Hfalse); intro H0; elim H0. + intro Ha0; rewrite Ha0 in Ha; discriminate. + intro Hb0; rewrite Hb0 in Hb; discriminate. + auto with zarith. + replace 1%Z with ((r * b + s * c) * (p * a + q * c))%Z. + repeat rewrite Zmult_plus_distr_r; repeat rewrite Zmult_plus_distr_l; + rewrite (Zmult_comm p a); rewrite (Zmult_comm a b); + apply Zdivides_plus_elim; apply Zdivides_plus_elim; auto with zarith. + rewrite <- Hla; rewrite <- Hlb; auto with zarith. auto with zarith. -rewrite <- Hla; rewrite <- Hlb; auto with zarith. -auto with zarith. Qed. @@ -1582,26 +1650,27 @@ Definition Prime := Lemma prime_rel_prime : Prime -> forall x : positive, (Zpos x < Zpos p)%Z -> Zrelprime (Zpos p) (Zpos x). -intros Hprime x Hx. -unfold Prime in Hprime. -elim Hprime. -intros H1 Hdiv. -unfold Zrelprime in |- *. -set (d := Zgcd (Zpos p) (Zpos x)). -cut (0 < d)%Z. -cut (d < Zpos p)%Z. -cut (Zdivides d (Zpos p)). -cut (d = Zgcd (Zpos p) (Zpos x)); auto. -case d. -auto with zarith. -intros D HD HDiv HDlt HDpos. - generalize (Hdiv D HDiv); intro H0; elim H0. - intro HD1; rewrite HD1; auto. - intro HDp; rewrite HDp in HDlt; elim (Zlt_irref _ HDlt). -auto with zarith. -unfold d in |- *; auto with zarith. -apply (Zle_lt_trans d (Zpos x) (Zpos p)); unfold d in |- *; auto with zarith. -unfold d in |- *; apply Zgcd_pos; auto with zarith. +Proof. + intros Hprime x Hx. + unfold Prime in Hprime. + elim Hprime. + intros H1 Hdiv. + unfold Zrelprime in |- *. + set (d := Zgcd (Zpos p) (Zpos x)). + cut (0 < d)%Z. + cut (d < Zpos p)%Z. + cut (Zdivides d (Zpos p)). + cut (d = Zgcd (Zpos p) (Zpos x)); auto. + case d. + auto with zarith. + intros D HD HDiv HDlt HDpos. + generalize (Hdiv D HDiv); intro H0; elim H0. + intro HD1; rewrite HD1; auto. + intro HDp; rewrite HDp in HDlt; elim (Zlt_irref _ HDlt). + auto with zarith. + unfold d in |- *; auto with zarith. + apply (Zle_lt_trans d (Zpos x) (Zpos p)); unfold d in |- *; auto with zarith. + unfold d in |- *; apply Zgcd_pos; auto with zarith. Qed. diff --git a/model/Zmod/ZMod.v b/model/Zmod/ZMod.v index 9f87e88da..756988a42 100644 --- a/model/Zmod/ZMod.v +++ b/model/Zmod/ZMod.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* ZMod.v, by Vince Barany *) Require Export ZGcd. @@ -50,196 +50,206 @@ Section zmod. Definition Zmod_same := Z_mod_same. Lemma Zmod_zero_lft : forall m : Z, (0 mod m)%Z = 0%Z. -intro m. -case m; auto. +Proof. + intro m. + case m; auto. Qed. Lemma Zmod_zero_rht : forall a : Z, (a mod 0)%Z = 0%Z. -intro a. -case a; auto. +Proof. + intro a. + case a; auto. Qed. Lemma Zmod_Zmod : forall m a : Z, (m > 0)%Z -> ((a mod m) mod m)%Z = (a mod m)%Z. -intros m a Hm. -apply - (Zdiv_remainder_unique (a mod m) m (a mod m / m) ((a mod m) mod m) 0 - (a mod m)). -rewrite Zmult_comm. -apply Z_div_mod_eq; auto. -apply Z_mod_lt; auto. -auto with zarith. -apply Z_mod_lt; auto. +Proof. + intros m a Hm. + apply (Zdiv_remainder_unique (a mod m) m (a mod m / m) ((a mod m) mod m) 0 (a mod m)). + rewrite Zmult_comm. + apply Z_div_mod_eq; auto. + apply Z_mod_lt; auto. + auto with zarith. + apply Z_mod_lt; auto. Qed. Lemma Zmod_cancel_multiple : forall m a b : Z, (m > 0)%Z -> ((b * m + a) mod m)%Z = (a mod m)%Z. -intros m a b Hm. -rewrite Zplus_comm. -apply Z_mod_plus. -exact Hm. +Proof. + intros m a b Hm. + rewrite Zplus_comm. + apply Z_mod_plus. + exact Hm. Qed. Lemma Zmod_multiple : forall m a : Z, (m > 0)%Z -> ((a * m) mod m)%Z = 0%Z. -intros m a Hm. -rewrite <- (Zplus_0_r (a * m)). -rewrite Zmod_cancel_multiple; auto. +Proof. + intros m a Hm. + rewrite <- (Zplus_0_r (a * m)). + rewrite Zmod_cancel_multiple; auto. Qed. Lemma Zmod_minus_intro : forall m a b : Z, (m > 0)%Z -> ((a - b) mod m)%Z = 0%Z -> (a mod m)%Z = (b mod m)%Z. -intros m a b Hm H0. -assert (Hdiv : Zdivides m (a - b)); auto with zarith. -elim Hdiv; intros q Hq. -replace a with (q * m + b)%Z; auto with zarith. -apply Zmod_cancel_multiple. -assumption. +Proof. + intros m a b Hm H0. + assert (Hdiv : Zdivides m (a - b)); auto with zarith. + elim Hdiv; intros q Hq. + replace a with (q * m + b)%Z; auto with zarith. + apply Zmod_cancel_multiple. + assumption. Qed. Lemma Zmod_plus_compat : forall m a b : Z, (m > 0)%Z -> ((a + b) mod m)%Z = ((a mod m + b mod m) mod m)%Z. -intros m a b Hm. -rewrite <- (Zmod_Zmod m (a + b) Hm). -apply Zmod_minus_intro. -exact Hm. -apply Zmod0_Zdivides. -auto with zarith. -replace (a mod m)%Z with (a - m * (a / m))%Z. -replace (b mod m)%Z with (b - m * (b / m))%Z. -replace ((a + b) mod m)%Z with (a + b - m * ((a + b) / m))%Z. -unfold Zminus in |- *; repeat rewrite Zplus_assoc. -repeat rewrite Zopp_plus_distr; repeat rewrite Zopp_involutive. -rewrite (Zplus_comm (a + b) (- (m * ((a + b) / m)))). -repeat rewrite <- Zplus_assoc. -apply Zdivides_plus_elim. -auto with zarith. -rewrite (Zplus_assoc (m * (a / m)) (- b) (m * (b / m))). -rewrite (Zplus_comm (m * (a / m)) (- b)). -rewrite <- (Zplus_assoc (- b) (m * (a / m)) (m * (b / m))). -rewrite (Zplus_assoc (- a) (- b) (m * (a / m) + m * (b / m))). -rewrite <- Zopp_plus_distr. -repeat rewrite Zplus_assoc. -rewrite Zplus_opp_r. -auto with zarith. -generalize (Z_div_mod_eq (a + b) m Hm); auto with zarith. -generalize (Z_div_mod_eq b m Hm); auto with zarith. -generalize (Z_div_mod_eq a m Hm); auto with zarith. +Proof. + intros m a b Hm. + rewrite <- (Zmod_Zmod m (a + b) Hm). + apply Zmod_minus_intro. + exact Hm. + apply Zmod0_Zdivides. + auto with zarith. + replace (a mod m)%Z with (a - m * (a / m))%Z. + replace (b mod m)%Z with (b - m * (b / m))%Z. + replace ((a + b) mod m)%Z with (a + b - m * ((a + b) / m))%Z. + unfold Zminus in |- *; repeat rewrite Zplus_assoc. + repeat rewrite Zopp_plus_distr; repeat rewrite Zopp_involutive. + rewrite (Zplus_comm (a + b) (- (m * ((a + b) / m)))). + repeat rewrite <- Zplus_assoc. + apply Zdivides_plus_elim. + auto with zarith. + rewrite (Zplus_assoc (m * (a / m)) (- b) (m * (b / m))). + rewrite (Zplus_comm (m * (a / m)) (- b)). + rewrite <- (Zplus_assoc (- b) (m * (a / m)) (m * (b / m))). + rewrite (Zplus_assoc (- a) (- b) (m * (a / m) + m * (b / m))). + rewrite <- Zopp_plus_distr. + repeat rewrite Zplus_assoc. + rewrite Zplus_opp_r. + auto with zarith. + generalize (Z_div_mod_eq (a + b) m Hm); auto with zarith. + generalize (Z_div_mod_eq b m Hm); auto with zarith. + generalize (Z_div_mod_eq a m Hm); auto with zarith. Qed. Lemma Zmod_plus_compat_rht : forall m a b : Z, (m > 0)%Z -> ((a + b) mod m)%Z = ((a + b mod m) mod m)%Z. -intros m a b Hm. -rewrite (Zmod_plus_compat m a b Hm). -rewrite <- (Zmod_Zmod m (a + b mod m) Hm). -rewrite (Zmod_plus_compat m a (b mod m) Hm). -rewrite Zmod_Zmod; auto. -rewrite Zmod_Zmod; auto. +Proof. + intros m a b Hm. + rewrite (Zmod_plus_compat m a b Hm). + rewrite <- (Zmod_Zmod m (a + b mod m) Hm). + rewrite (Zmod_plus_compat m a (b mod m) Hm). + rewrite Zmod_Zmod; auto. + rewrite Zmod_Zmod; auto. Qed. Lemma Zmod_plus_compat_lft : forall m a b : Z, (m > 0)%Z -> ((a + b) mod m)%Z = ((a mod m + b) mod m)%Z. -intros m a b Hm. -rewrite (Zplus_comm a b). -rewrite (Zplus_comm (a mod m) b). -apply Zmod_plus_compat_rht. -auto. +Proof. + intros m a b Hm. + rewrite (Zplus_comm a b). + rewrite (Zplus_comm (a mod m) b). + apply Zmod_plus_compat_rht. + auto. Qed. Lemma Zmod_opp_elim : forall m a : Z, (m > 0)%Z -> (- a mod m)%Z = ((m - a mod m) mod m)%Z. -intros m a Hm. -apply Zmod_minus_intro. -exact Hm. -replace (- a - (m - a mod m))%Z with (- m + (a mod m - a))%Z; - auto with zarith. -replace (- m)%Z with (-1 * m)%Z; auto with zarith. -rewrite Zmod_cancel_multiple; auto. -replace (a mod m - a)%Z with (- (a / m) * m)%Z; auto with zarith. -generalize (Z_div_mod_eq a m Hm). -set (q := (a / m)%Z); set (r := (a mod m)%Z); intro Ha; rewrite Ha. -rewrite Zplus_comm; unfold Zminus in |- *; rewrite Zopp_plus_distr; - rewrite Zplus_assoc; rewrite Zplus_opp_r; rewrite Zplus_0_l; - rewrite Zopp_mult_distr_l_reverse; rewrite Zmult_comm; - reflexivity. +Proof. + intros m a Hm. + apply Zmod_minus_intro. + exact Hm. + replace (- a - (m - a mod m))%Z with (- m + (a mod m - a))%Z; auto with zarith. + replace (- m)%Z with (-1 * m)%Z; auto with zarith. + rewrite Zmod_cancel_multiple; auto. + replace (a mod m - a)%Z with (- (a / m) * m)%Z; auto with zarith. + generalize (Z_div_mod_eq a m Hm). + set (q := (a / m)%Z); set (r := (a mod m)%Z); intro Ha; rewrite Ha. + rewrite Zplus_comm; unfold Zminus in |- *; rewrite Zopp_plus_distr; + rewrite Zplus_assoc; rewrite Zplus_opp_r; rewrite Zplus_0_l; + rewrite Zopp_mult_distr_l_reverse; rewrite Zmult_comm; reflexivity. Qed. Lemma Zmod_minus_elim : forall m a b : Z, (m > 0)%Z -> (a mod m)%Z = (b mod m)%Z -> ((a - b) mod m)%Z = 0%Z. -intros m a b Hm Heq. -unfold Zminus in |- *. -rewrite (Zmod_plus_compat m a (- b) Hm). -rewrite Heq. -rewrite Zmod_opp_elim; auto. -rewrite <- (Zmod_plus_compat m b (m - b mod m) Hm). -unfold Zminus in |- *. -rewrite Zplus_assoc. -rewrite (Zplus_comm b m). -rewrite <- Zplus_assoc. -fold (b - b mod m)%Z in |- *. -replace (b - b mod m)%Z with (b / m * m)%Z. -rewrite Zplus_comm. -rewrite Zmod_cancel_multiple; auto. -apply Zmod_same; auto. -set (q := (b / m)%Z); set (r := (b mod m)%Z). -rewrite (Z_div_mod_eq b m Hm). -fold q in |- *; fold r in |- *. -rewrite Zmult_comm. -unfold Zminus in |- *. -rewrite <- Zplus_assoc. -rewrite Zplus_opp_r. -auto with zarith. +Proof. + intros m a b Hm Heq. + unfold Zminus in |- *. + rewrite (Zmod_plus_compat m a (- b) Hm). + rewrite Heq. + rewrite Zmod_opp_elim; auto. + rewrite <- (Zmod_plus_compat m b (m - b mod m) Hm). + unfold Zminus in |- *. + rewrite Zplus_assoc. + rewrite (Zplus_comm b m). + rewrite <- Zplus_assoc. + fold (b - b mod m)%Z in |- *. + replace (b - b mod m)%Z with (b / m * m)%Z. + rewrite Zplus_comm. + rewrite Zmod_cancel_multiple; auto. + apply Zmod_same; auto. + set (q := (b / m)%Z); set (r := (b mod m)%Z). + rewrite (Z_div_mod_eq b m Hm). + fold q in |- *; fold r in |- *. + rewrite Zmult_comm. + unfold Zminus in |- *. + rewrite <- Zplus_assoc. + rewrite Zplus_opp_r. + auto with zarith. Qed. Lemma Zmod_mult_compat : forall m a b : Z, (m > 0)%Z -> ((a * b) mod m)%Z = ((a mod m * (b mod m)) mod m)%Z. -intros m a b Hm. -rewrite <- (Zmod_Zmod m (a * b) Hm). -apply Zmod_minus_intro; auto. -apply Zmod0_Zdivides. -auto with zarith. -replace (a mod m)%Z with (a - m * (a / m))%Z. -replace (b mod m)%Z with (b - m * (b / m))%Z. -replace ((a * b) mod m)%Z with (a * b - m * (a * b / m))%Z. -unfold Zminus in |- *; repeat rewrite Zplus_assoc. -repeat rewrite Zmult_plus_distr_l. -repeat rewrite Zmult_plus_distr_r. -repeat rewrite Zopp_plus_distr; repeat rewrite Zopp_involutive. -rewrite (Zplus_comm (a * b)). -repeat rewrite <- Zplus_assoc. -apply Zdivides_plus_elim. -auto with zarith. -repeat rewrite Zplus_assoc. -rewrite Zplus_opp_r. -repeat rewrite Zopp_mult_distr_l_reverse; repeat rewrite Zopp_mult_distr_r; - repeat rewrite Zopp_involutive. -simpl in |- *. -apply Zdivides_plus_elim; auto with zarith. -generalize (Z_div_mod_eq (a * b) m Hm); auto with zarith. -generalize (Z_div_mod_eq b m Hm); auto with zarith. -generalize (Z_div_mod_eq a m Hm); auto with zarith. +Proof. + intros m a b Hm. + rewrite <- (Zmod_Zmod m (a * b) Hm). + apply Zmod_minus_intro; auto. + apply Zmod0_Zdivides. + auto with zarith. + replace (a mod m)%Z with (a - m * (a / m))%Z. + replace (b mod m)%Z with (b - m * (b / m))%Z. + replace ((a * b) mod m)%Z with (a * b - m * (a * b / m))%Z. + unfold Zminus in |- *; repeat rewrite Zplus_assoc. + repeat rewrite Zmult_plus_distr_l. + repeat rewrite Zmult_plus_distr_r. + repeat rewrite Zopp_plus_distr; repeat rewrite Zopp_involutive. + rewrite (Zplus_comm (a * b)). + repeat rewrite <- Zplus_assoc. + apply Zdivides_plus_elim. + auto with zarith. + repeat rewrite Zplus_assoc. + rewrite Zplus_opp_r. + repeat rewrite Zopp_mult_distr_l_reverse; repeat rewrite Zopp_mult_distr_r; + repeat rewrite Zopp_involutive. + simpl in |- *. + apply Zdivides_plus_elim; auto with zarith. + generalize (Z_div_mod_eq (a * b) m Hm); auto with zarith. + generalize (Z_div_mod_eq b m Hm); auto with zarith. + generalize (Z_div_mod_eq a m Hm); auto with zarith. Qed. Lemma Zmod_mult_compat_rht : forall m a b : Z, (m > 0)%Z -> ((a * b) mod m)%Z = ((a * (b mod m)) mod m)%Z. -intros m a b Hm. -rewrite (Zmod_mult_compat m a b Hm). -rewrite <- (Zmod_Zmod m (a * (b mod m)) Hm). -rewrite (Zmod_mult_compat m a (b mod m) Hm). -rewrite Zmod_Zmod; auto. -rewrite Zmod_Zmod; auto. +Proof. + intros m a b Hm. + rewrite (Zmod_mult_compat m a b Hm). + rewrite <- (Zmod_Zmod m (a * (b mod m)) Hm). + rewrite (Zmod_mult_compat m a (b mod m) Hm). + rewrite Zmod_Zmod; auto. + rewrite Zmod_Zmod; auto. Qed. Lemma Zmod_mult_compat_lft : forall m a b : Z, (m > 0)%Z -> ((a * b) mod m)%Z = ((a mod m * b) mod m)%Z. -intros m a b Hm. -rewrite (Zmult_comm a b). -rewrite (Zmult_comm (a mod m) b). -apply Zmod_mult_compat_rht. -auto. +Proof. + intros m a b Hm. + rewrite (Zmult_comm a b). + rewrite (Zmult_comm (a mod m) b). + apply Zmod_mult_compat_rht. + auto. Qed. Lemma Zmod_mult_elim_lft : @@ -247,17 +257,17 @@ Lemma Zmod_mult_elim_lft : (m > 0)%Z -> Zrelprime a m -> ((a * b) mod m)%Z = ((a * c) mod m)%Z -> (b mod m)%Z = (c mod m)%Z. -intros m a b c Hm Hrelprime Hmulteq. -assert (Hm0 : m <> 0%Z); auto with zarith. -generalize (Zdivides_Zmod0 _ _ Hm0 (Zmod_minus_elim m _ _ Hm Hmulteq)); - intro Hdiv. -rewrite (Zmult_comm a b) in Hdiv; rewrite (Zmult_comm a c) in Hdiv; - rewrite <- BinInt.Zmult_minus_distr_r in Hdiv. -apply Zmod_minus_intro; auto. -apply Zmod0_Zdivides. auto with zarith. -apply (Zrelprime_div_mult_intro m a (b - c)). -apply Zrelprime_symm; assumption. -rewrite Zmult_comm; assumption. +Proof. + intros m a b c Hm Hrelprime Hmulteq. + assert (Hm0 : m <> 0%Z); auto with zarith. + generalize (Zdivides_Zmod0 _ _ Hm0 (Zmod_minus_elim m _ _ Hm Hmulteq)); intro Hdiv. + rewrite (Zmult_comm a b) in Hdiv; rewrite (Zmult_comm a c) in Hdiv; + rewrite <- BinInt.Zmult_minus_distr_r in Hdiv. + apply Zmod_minus_intro; auto. + apply Zmod0_Zdivides. auto with zarith. + apply (Zrelprime_div_mult_intro m a (b - c)). + apply Zrelprime_symm; assumption. + rewrite Zmult_comm; assumption. Qed. Lemma Zmod_mult_elim_rht : @@ -265,112 +275,116 @@ Lemma Zmod_mult_elim_rht : (m > 0)%Z -> Zrelprime a m -> ((b * a) mod m)%Z = ((c * a) mod m)%Z -> (b mod m)%Z = (c mod m)%Z. -intros m a b c; rewrite (Zmult_comm b a); rewrite (Zmult_comm c a); - apply Zmod_mult_elim_lft. + intros m a b c; rewrite (Zmult_comm b a); rewrite (Zmult_comm c a); apply Zmod_mult_elim_lft. Qed. Lemma Zmod_opp_zero : forall m a : Z, (m > 0)%Z -> (a mod m)%Z = 0%Z -> (- a mod m)%Z = 0%Z. -intros m a Hm Ha. -rewrite (Zmod_opp_elim m a Hm). -rewrite Ha. -unfold Zminus in |- *; simpl in |- *; rewrite Zplus_0_r. -apply (Z_mod_same m Hm). +Proof. + intros m a Hm Ha. + rewrite (Zmod_opp_elim m a Hm). + rewrite Ha. + unfold Zminus in |- *; simpl in |- *; rewrite Zplus_0_r. + apply (Z_mod_same m Hm). Qed. Lemma Zmod_small : forall m a : Z, (m > 0)%Z -> (0 <= a < m)%Z -> (a mod m)%Z = a. -intros m a Hm Ha. -apply (Zmodeq_small (a mod m) a m). -apply (Z_mod_lt a m Hm). -exact Ha. -replace (a mod m - a)%Z with (- m * (a / m))%Z. -auto with zarith. -generalize (Z_div_mod_eq a m Hm). -set (q := (a / m)%Z); set (r := (a mod m)%Z); intro H; rewrite H. -rewrite Zplus_comm; unfold Zminus in |- *; rewrite Zopp_plus_distr; - rewrite Zplus_assoc; rewrite Zplus_opp_r; rewrite Zplus_0_l; - rewrite Zopp_mult_distr_l_reverse; rewrite Zmult_comm; - reflexivity. +Proof. + intros m a Hm Ha. + apply (Zmodeq_small (a mod m) a m). + apply (Z_mod_lt a m Hm). + exact Ha. + replace (a mod m - a)%Z with (- m * (a / m))%Z. + auto with zarith. + generalize (Z_div_mod_eq a m Hm). + set (q := (a / m)%Z); set (r := (a mod m)%Z); intro H; rewrite H. + rewrite Zplus_comm; unfold Zminus in |- *; rewrite Zopp_plus_distr; + rewrite Zplus_assoc; rewrite Zplus_opp_r; rewrite Zplus_0_l; + rewrite Zopp_mult_distr_l_reverse; rewrite Zmult_comm; reflexivity. Qed. Lemma Zmod_opp_nonzero : forall m a : Z, (m > 0)%Z -> (a mod m)%Z <> 0%Z -> (- a mod m)%Z = (m - a mod m)%Z. -intros m a Hm Ha. -rewrite (Zmod_opp_elim m a Hm). -apply Zmod_small. -exact Hm. -generalize (Z_mod_lt a m Hm); intro Hlt. -auto with zarith. +Proof. + intros m a Hm Ha. + rewrite (Zmod_opp_elim m a Hm). + apply Zmod_small. + exact Hm. + generalize (Z_mod_lt a m Hm); intro Hlt. + auto with zarith. Qed. Lemma Zmod_one_lft : forall m : Z, (m > 1)%Z -> (1 mod m)%Z = 1%Z. -intros m Hm. -apply Zmod_small; auto with zarith. +Proof. + intros m Hm. + apply Zmod_small; auto with zarith. Qed. Lemma Zmod_one_rht : forall a : Z, (a mod 1)%Z = 0%Z. -intro a. -generalize (Z_mod_lt a 1). -auto with zarith. +Proof. + intro a. + generalize (Z_mod_lt a 1). + auto with zarith. Qed. Lemma Zmod_lin_comb : forall m a : Z, (m > 0)%Z -> (Zgcd a m < m)%Z -> ((a * Zgcd_coeff_a a m) mod m)%Z = Zgcd a m. -intros m a Hm Hgcd. -generalize (Zgcd_lin_comb a m); intro Hlincomb. -rewrite (Z_div_mod_eq (Zgcd_coeff_a a m * a) m Hm) in Hlincomb. -rewrite Zmult_comm in Hlincomb. -rewrite Zplus_comm in Hlincomb. -rewrite Zplus_assoc in Hlincomb. -rewrite <- Zmult_plus_distr_l in Hlincomb. -replace (Zgcd a m) with (Zgcd a m mod m)%Z. -rewrite Hlincomb. -rewrite Zmod_plus_compat; auto. -rewrite Zmod_Zmod; auto. -rewrite <- Zmod_plus_compat; auto. -apply Zmod_minus_intro; auto. -set (u := Zgcd_coeff_a a m). -set (v := Zgcd_coeff_b a m). -rewrite (Zplus_comm ((v + u * a / m) * m) (u * a)). -unfold Zminus in |- *. -rewrite Zopp_plus_distr. -rewrite Zplus_assoc. -rewrite (Zmult_comm a u). -rewrite Zplus_opp_r. -rewrite Zplus_0_l. -rewrite <- Zopp_mult_distr_l_reverse. -apply Zmod_multiple; auto. -apply Zmod_small; auto. -auto with zarith. +Proof. + intros m a Hm Hgcd. + generalize (Zgcd_lin_comb a m); intro Hlincomb. + rewrite (Z_div_mod_eq (Zgcd_coeff_a a m * a) m Hm) in Hlincomb. + rewrite Zmult_comm in Hlincomb. + rewrite Zplus_comm in Hlincomb. + rewrite Zplus_assoc in Hlincomb. + rewrite <- Zmult_plus_distr_l in Hlincomb. + replace (Zgcd a m) with (Zgcd a m mod m)%Z. + rewrite Hlincomb. + rewrite Zmod_plus_compat; auto. + rewrite Zmod_Zmod; auto. + rewrite <- Zmod_plus_compat; auto. + apply Zmod_minus_intro; auto. + set (u := Zgcd_coeff_a a m). + set (v := Zgcd_coeff_b a m). + rewrite (Zplus_comm ((v + u * a / m) * m) (u * a)). + unfold Zminus in |- *. + rewrite Zopp_plus_distr. + rewrite Zplus_assoc. + rewrite (Zmult_comm a u). + rewrite Zplus_opp_r. + rewrite Zplus_0_l. + rewrite <- Zopp_mult_distr_l_reverse. + apply Zmod_multiple; auto. + apply Zmod_small; auto. + auto with zarith. Qed. Lemma Zmod_relprime_inv : forall m a : Z, (m > 1)%Z -> Zrelprime a m -> ((a * Zgcd_coeff_a a m) mod m)%Z = 1%Z. -intros m a Hm H1. -unfold Zrelprime in H1. -generalize (Zgcd_lin_comb a m). -intro Hlc. -rewrite H1 in Hlc. -rewrite (Zmult_comm (Zgcd_coeff_a a m) a) in Hlc. -assert (Hqr : (a * Zgcd_coeff_a a m)%Z = (- Zgcd_coeff_b a m * m + 1)%Z). -rewrite Zplus_comm. -rewrite Hlc. -rewrite <- Zplus_assoc. -rewrite Zopp_mult_distr_l_reverse. -auto with zarith. -generalize (Z_div_mod_eq (a * Zgcd_coeff_a a m) m); intro Hdivmod; - assert (Hm0 : (m > 0)%Z); auto with zarith; generalize (Hdivmod Hm0); - clear Hdivmod; intro Hdivmod. -rewrite (Zmult_comm m (a * Zgcd_coeff_a a m / m)) in Hdivmod. -apply (Zdiv_remainder_unique _ _ _ _ (- Zgcd_coeff_b a m) 1 Hdivmod). -apply Z_mod_lt. -auto with zarith. -exact Hqr. -auto with zarith. +Proof. + intros m a Hm H1. + unfold Zrelprime in H1. + generalize (Zgcd_lin_comb a m). + intro Hlc. + rewrite H1 in Hlc. + rewrite (Zmult_comm (Zgcd_coeff_a a m) a) in Hlc. + assert (Hqr : (a * Zgcd_coeff_a a m)%Z = (- Zgcd_coeff_b a m * m + 1)%Z). + rewrite Zplus_comm. + rewrite Hlc. + rewrite <- Zplus_assoc. + rewrite Zopp_mult_distr_l_reverse. + auto with zarith. + generalize (Z_div_mod_eq (a * Zgcd_coeff_a a m) m); intro Hdivmod; + assert (Hm0 : (m > 0)%Z); auto with zarith; generalize (Hdivmod Hm0); clear Hdivmod; intro Hdivmod. + rewrite (Zmult_comm m (a * Zgcd_coeff_a a m / m)) in Hdivmod. + apply (Zdiv_remainder_unique _ _ _ _ (- Zgcd_coeff_b a m) 1 Hdivmod). + apply Z_mod_lt. + auto with zarith. + exact Hqr. + auto with zarith. Qed. End zmod. @@ -411,217 +425,242 @@ Variable m : positive. Definition Zmodeq (a b : Z) := Zdivides m (a - b). Lemma Zmodeq_dec : forall a b : Z, {Zmodeq a b} + {~ Zmodeq a b}. -intros a b. -unfold Zmodeq in |- *. -apply Zdivides_dec. +Proof. + intros a b. + unfold Zmodeq in |- *. + apply Zdivides_dec. Qed. Lemma Zmodeq_modeq : forall a b : Z, Zmodeq a b -> (a mod m)%Z = (b mod m)%Z. -intros a b H. -apply Zmod_minus_intro. -auto with zarith. -unfold Zmodeq in H. -apply Zmod0_Zdivides. -intro Hfalse; inversion Hfalse. -assumption. +Proof. + intros a b H. + apply Zmod_minus_intro. + auto with zarith. + unfold Zmodeq in H. + apply Zmod0_Zdivides. + intro Hfalse; inversion Hfalse. + assumption. Qed. Lemma Zmodeq_eqmod : forall a b : Z, (a mod m)%Z = (b mod m)%Z -> Zmodeq a b. -intros a b H. -unfold Zmodeq in |- *. -apply Zdivides_Zmod0. -intro Hfalse; inversion Hfalse. -apply Zmod_minus_elim; auto with zarith. +Proof. + intros a b H. + unfold Zmodeq in |- *. + apply Zdivides_Zmod0. + intro Hfalse; inversion Hfalse. + apply Zmod_minus_elim; auto with zarith. Qed. Lemma Zmodeq_refl : forall a : Z, Zmodeq a a. -intros. -unfold Zmodeq in |- *. -unfold Zminus in |- *. -rewrite Zplus_opp_r. -apply Zdivides_zero_rht. +Proof. + intros. + unfold Zmodeq in |- *. + unfold Zminus in |- *. + rewrite Zplus_opp_r. + apply Zdivides_zero_rht. Qed. Lemma Zmodeq_symm : forall a b : Z, Zmodeq a b -> Zmodeq b a. -unfold Zmodeq in |- *. -intros. -replace (b - a)%Z with (- (a - b))%Z; auto with zarith. +Proof. + unfold Zmodeq in |- *. + intros. + replace (b - a)%Z with (- (a - b))%Z; auto with zarith. Qed. Lemma Zmodeq_trans : forall a b c : Z, Zmodeq b a -> Zmodeq a c -> Zmodeq b c. -unfold Zmodeq in |- *. -intros. -replace (b - c)%Z with (b - a + (a - c))%Z; auto with zarith. +Proof. + unfold Zmodeq in |- *. + intros. + replace (b - c)%Z with (b - a + (a - c))%Z; auto with zarith. Qed. Lemma Zmodeq_zero : forall a : Z, Zmodeq a 0 <-> Zdivides m a. -unfold Zmodeq in |- *; unfold Zdivides in |- *. -intros. -unfold Zminus in |- *. -simpl in |- *. -rewrite Zplus_0_r. -tauto. +Proof. + unfold Zmodeq in |- *; unfold Zdivides in |- *. + intros. + unfold Zminus in |- *. + simpl in |- *. + rewrite Zplus_0_r. + tauto. Qed. Lemma Zmodeq_rem : forall a : Z, Zmodeq a (a mod m). -intros. -unfold Zmodeq in |- *. -exists (a / m)%Z. -rewrite Zmult_comm. -generalize (Z_div_mod_eq a m). -cut (m > 0)%Z; auto with zarith. +Proof. + intros. + unfold Zmodeq in |- *. + exists (a / m)%Z. + rewrite Zmult_comm. + generalize (Z_div_mod_eq a m). + cut (m > 0)%Z; auto with zarith. Qed. Lemma Zmodeq_plus_compat : forall a b c d : Z, Zmodeq a b -> Zmodeq c d -> Zmodeq (a + c) (b + d). -intros a b c d. -unfold Zmodeq in |- *. -unfold Zdivides in |- *. -intros Hab Hcd. -elim Hab. -intros q1 H1. -elim Hcd. -intros q2 H2. -exists (q1 + q2)%Z. -rewrite Zmult_plus_distr_l. -auto with zarith. +Proof. + intros a b c d. + unfold Zmodeq in |- *. + unfold Zdivides in |- *. + intros Hab Hcd. + elim Hab. + intros q1 H1. + elim Hcd. + intros q2 H2. + exists (q1 + q2)%Z. + rewrite Zmult_plus_distr_l. + auto with zarith. Qed. Definition Zmodeq_plus_elim := Zmodeq_plus_compat. Lemma Zmodeq_plus_elim_lft : forall a b c : Z, Zmodeq a b -> Zmodeq (c + a) (c + b). -intros. -apply Zmodeq_plus_compat. -apply Zmodeq_refl. -assumption. +Proof. + intros. + apply Zmodeq_plus_compat. + apply Zmodeq_refl. + assumption. Qed. Lemma Zmodeq_plus_elim_rht : forall a b c : Z, Zmodeq a b -> Zmodeq (a + c) (b + c). -intros. -apply Zmodeq_plus_compat. -assumption. -apply Zmodeq_refl. +Proof. + intros. + apply Zmodeq_plus_compat. + assumption. + apply Zmodeq_refl. Qed. Lemma Zmodeq_mult_elim_lft : forall a b c : Z, Zmodeq a b -> Zmodeq (c * a) (c * b). -intros. -unfold Zmodeq in |- *. -unfold Zminus in |- *. -rewrite (Zmult_comm c b). -rewrite <- Zopp_mult_distr_l_reverse. -rewrite (Zmult_comm c a). -rewrite <- Zmult_plus_distr_l. -fold (a - b)%Z in |- *. -apply Zdivides_mult_elim_rht. -assumption. +Proof. + intros. + unfold Zmodeq in |- *. + unfold Zminus in |- *. + rewrite (Zmult_comm c b). + rewrite <- Zopp_mult_distr_l_reverse. + rewrite (Zmult_comm c a). + rewrite <- Zmult_plus_distr_l. + fold (a - b)%Z in |- *. + apply Zdivides_mult_elim_rht. + assumption. Qed. Lemma Zmodeq_mult_elim_rht : forall a b c : Z, Zmodeq a b -> Zmodeq (a * c) (b * c). -intros. -rewrite (Zmult_comm a c). -rewrite (Zmult_comm b c). -apply Zmodeq_mult_elim_lft. -assumption. +Proof. + intros. + rewrite (Zmult_comm a c). + rewrite (Zmult_comm b c). + apply Zmodeq_mult_elim_lft. + assumption. Qed. Lemma Zmodeq_mult_compat : forall a b c d : Z, Zmodeq a b -> Zmodeq c d -> Zmodeq (a * c) (b * d). -intros a b c d Hab Hcd. -apply (Zmodeq_trans (b * c)). -apply Zmodeq_mult_elim_rht; assumption. -apply Zmodeq_mult_elim_lft; assumption. +Proof. + intros a b c d Hab Hcd. + apply (Zmodeq_trans (b * c)). + apply Zmodeq_mult_elim_rht; assumption. + apply Zmodeq_mult_elim_lft; assumption. Qed. Definition Zmodeq_mult_elim := Zmodeq_mult_compat. Lemma Zmodeq_opp_elim : forall a b : Z, Zmodeq a b -> Zmodeq (- a) (- b). -intros a b H. -replace (- a)%Z with (-1 * a)%Z; auto with zarith. -replace (- b)%Z with (-1 * b)%Z; auto with zarith. -apply Zmodeq_mult_elim. -apply Zmodeq_refl. -exact H. +Proof. + intros a b H. + replace (- a)%Z with (-1 * a)%Z; auto with zarith. + replace (- b)%Z with (-1 * b)%Z; auto with zarith. + apply Zmodeq_mult_elim. + apply Zmodeq_refl. + exact H. Qed. Lemma Zmodeq_opp_intro : forall a b : Z, Zmodeq (- a) (- b) -> Zmodeq a b. -intros a b H. -rewrite <- (Zopp_involutive a). -rewrite <- (Zopp_involutive b). -apply (Zmodeq_opp_elim _ _ H). +Proof. + intros a b H. + rewrite <- (Zopp_involutive a). + rewrite <- (Zopp_involutive b). + apply (Zmodeq_opp_elim _ _ H). Qed. Lemma Zmodeq_gcd_compat_lft : forall a b : Z, Zmodeq a b -> Zgcd m a = Zgcd m b. -unfold Zmodeq in |- *. -intros a b H0. -elim H0; intros q Hq. -replace (Zgcd m b) with (Zgcd m (b + q * m)); auto with zarith. -rewrite Hq. -replace (b + (a - b))%Z with a; auto with zarith. +Proof. + unfold Zmodeq in |- *. + intros a b H0. + elim H0; intros q Hq. + replace (Zgcd m b) with (Zgcd m (b + q * m)); auto with zarith. + rewrite Hq. + replace (b + (a - b))%Z with a; auto with zarith. Qed. Lemma Zmodeq_gcd_compat_rht : forall a b : Z, Zmodeq a b -> Zgcd a m = Zgcd b m. -intros. -rewrite (Zgcd_symm a m). -rewrite (Zgcd_symm b m). -apply Zmodeq_gcd_compat_lft. -assumption. +Proof. + intros. + rewrite (Zgcd_symm a m). + rewrite (Zgcd_symm b m). + apply Zmodeq_gcd_compat_lft. + assumption. Qed. Lemma Zmodeq_relprime : forall a b : Z, Zmodeq a b -> Zrelprime a m -> Zrelprime b m. -intros a b H. -unfold Zrelprime in |- *. -rewrite (Zmodeq_gcd_compat_rht a b H). -tauto. +Proof. + intros a b H. + unfold Zrelprime in |- *. + rewrite (Zmodeq_gcd_compat_rht a b H). + tauto. Qed. Lemma Zmodeq_mod_elim : forall a b : Z, Zmodeq a b -> Zmodeq (a mod m) (b mod m). -intros a b H. -apply Zmodeq_eqmod. -rewrite Zmod_Zmod; auto with zarith. -rewrite Zmod_Zmod; auto with zarith. +Proof. + intros a b H. + apply Zmodeq_eqmod. + rewrite Zmod_Zmod; auto with zarith. + rewrite Zmod_Zmod; auto with zarith. Qed. Lemma Zmodeq_mod_elim_lft : forall a b : Z, Zmodeq a b -> Zmodeq (a mod m) b. -intros a b H. -apply Zmodeq_eqmod. -rewrite Zmod_Zmod; auto with zarith. +Proof. + intros a b H. + apply Zmodeq_eqmod. + rewrite Zmod_Zmod; auto with zarith. Qed. Lemma Zmodeq_mod_elim_rht : forall a b : Z, Zmodeq a b -> Zmodeq a (b mod m). -intros a b H. -apply Zmodeq_eqmod. -rewrite Zmod_Zmod; auto with zarith. +Proof. + intros a b H. + apply Zmodeq_eqmod. + rewrite Zmod_Zmod; auto with zarith. Qed. Lemma Zmodeq_mod_intro : forall a b : Z, Zmodeq (a mod m) (b mod m) -> Zmodeq a b. -intros a b H. -apply Zmodeq_eqmod. -rewrite <- (Zmod_Zmod m a); auto with zarith. -rewrite <- (Zmod_Zmod m b); auto with zarith. +Proof. + intros a b H. + apply Zmodeq_eqmod. + rewrite <- (Zmod_Zmod m a); auto with zarith. + rewrite <- (Zmod_Zmod m b); auto with zarith. Qed. Lemma Zmodeq_mod_intro_lft : forall a b : Z, Zmodeq (a mod m) b -> Zmodeq a b. -intros a b H. -apply Zmodeq_eqmod. -rewrite <- (Zmod_Zmod m a); auto with zarith. +Proof. + intros a b H. + apply Zmodeq_eqmod. + rewrite <- (Zmod_Zmod m a); auto with zarith. Qed. Lemma Zmodeq_mod_intro_rht : forall a b : Z, Zmodeq a (b mod m) -> Zmodeq a b. -intros a b H. -apply Zmodeq_eqmod. -rewrite <- (Zmod_Zmod m b); auto with zarith. +Proof. + intros a b H. + apply Zmodeq_eqmod. + rewrite <- (Zmod_Zmod m b); auto with zarith. Qed. diff --git a/model/Zmod/Zm.v b/model/Zmod/Zm.v index 8d511e9f8..c241d452d 100644 --- a/model/Zmod/Zm.v +++ b/model/Zmod/Zm.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* Zm.v, by Vince Barany *) Require Export ZMod. @@ -54,7 +54,8 @@ Section zm. Variable m:positive. Lemma m_gt_0 : m>0. -red; simpl; reflexivity. +Proof. + red; simpl; reflexivity. Qed. (* This was a "Local"! *) @@ -70,43 +71,47 @@ Definition ZModeq (a b:Z) : Prop := (Zmodeq m a b). Definition ZModap (a b:Z) : CProp := (CNot (Zmodeq m a b)). Lemma Zmodeq_wd : forall a b:Z, a=b -> a mod m = b mod m. -intros a b Heq. -elim Heq. -auto. +Proof. + intros a b Heq. + elim Heq. + auto. Qed. Lemma Zmodap_irreflexive: (irreflexive ZModap). -red. -intro x. -intro H. -elim H. -apply Zmodeq_refl. +Proof. + red. + intro x. + intro H. + elim H. + apply Zmodeq_refl. Qed. Lemma Zmodap_symmetric: (Csymmetric ZModap). -red. -intros x y H. -intro H0. -elim H. -apply Zmodeq_symm. -exact H0. +Proof. + red. + intros x y H. + intro H0. + elim H. + apply Zmodeq_symm. + exact H0. Qed. Lemma Zmodap_cotransitive: (cotransitive ZModap). -red. -intros x y H. -intros z. -elim (Zmodeq_dec m x z). -elim (Zmodeq_dec m y z). -intros Hyz Hxz. - elim H. - apply (Zmodeq_trans _ _ _ _ Hxz (Zmodeq_symm _ _ _ Hyz)). -intros _ Hxz. - right. - intro Hzy. - apply H. - apply (Zmodeq_trans _ _ _ _ Hxz Hzy). -intro H_xz. +Proof. + red. + intros x y H. + intros z. + elim (Zmodeq_dec m x z). + elim (Zmodeq_dec m y z). + intros Hyz Hxz. + elim H. + apply (Zmodeq_trans _ _ _ _ Hxz (Zmodeq_symm _ _ _ Hyz)). + intros _ Hxz. + right. + intro Hzy. + apply H. + apply (Zmodeq_trans _ _ _ _ Hxz Hzy). + intro H_xz. left. intro Hxz. elim H_xz. @@ -114,18 +119,19 @@ intro H_xz. Qed. Lemma Zmodap_tight_apart: (tight_apart ZModeq ZModap). -red. -intros x y. -split. -elim (Zmodeq_dec m x y). -intros H Hnn. - exact H. -intros Hn Hnn. - elim Hnn. +Proof. + red. + intros x y. + split. + elim (Zmodeq_dec m x y). + intros H Hnn. + exact H. + intros Hn Hnn. + elim Hnn. + intro H. + elim Hn. + exact H. intro H. - elim Hn. - exact H. -intro H. intro Hnn. elim Hnn. exact H. @@ -134,12 +140,13 @@ Qed. (* Begin_Tex_Verb *) Lemma Zm_is_CSetoid : (is_CSetoid _ ZModeq ZModap). -(* End_Tex_Verb *) -apply Build_is_CSetoid. -exact Zmodap_irreflexive. -exact Zmodap_symmetric. -exact Zmodap_cotransitive. -exact Zmodap_tight_apart. +Proof. + (* End_Tex_Verb *) + apply Build_is_CSetoid. + exact Zmodap_irreflexive. + exact Zmodap_symmetric. + exact Zmodap_cotransitive. + exact Zmodap_tight_apart. Qed. (* Begin_Tex_Verb *) @@ -162,20 +169,21 @@ Definition Zm_plus (a b:Zm_csetoid) : Zm_csetoid := (a+b). (* Begin_Tex_Verb *) Lemma Zm_plus_strext : (bin_fun_strext _ _ _ Zm_plus). -(* End_Tex_Verb *) -red. -intros. -elim (Zmodeq_dec m x1 x2). -elim (Zmodeq_dec m y1 y2). -intros Hyeq Hxeq. - elim X. - auto with zarith. -intros Hyneq _. - right. - intro Hyeq. - elim Hyneq. - exact Hyeq. -intros Hxneq. +Proof. + (* End_Tex_Verb *) + red. + intros. + elim (Zmodeq_dec m x1 x2). + elim (Zmodeq_dec m y1 y2). + intros Hyeq Hxeq. + elim X. + auto with zarith. + intros Hyneq _. + right. + intro Hyeq. + elim Hyneq. + exact Hyeq. + intros Hxneq. left. intro Hxeq. elim Hxneq. @@ -184,9 +192,10 @@ Qed. (* Begin_Tex_Verb *) Lemma Zm_plus_wd : (bin_fun_wd _ _ _ Zm_plus). -(* End_Tex_Verb *) -apply bin_fun_strext_imp_wd. -exact Zm_plus_strext. +Proof. + (* End_Tex_Verb *) + apply bin_fun_strext_imp_wd. + exact Zm_plus_strext. Qed. (* Begin_Tex_Verb *) @@ -197,14 +206,15 @@ Definition Zm_plus_op := (* Begin_Tex_Verb *) Lemma Zm_plus_associative : (associative Zm_plus_op). -(* End_Tex_Verb *) -red. -intros x y z. -simpl. -unfold ZModeq. -unfold Zm_plus. -rewrite Zplus_assoc. -apply Zmodeq_refl. +Proof. + (* End_Tex_Verb *) + red. + intros x y z. + simpl. + unfold ZModeq. + unfold Zm_plus. + rewrite Zplus_assoc. + apply Zmodeq_refl. Qed. @@ -215,33 +225,36 @@ Definition Zm_csemi_grp := (* Begin_Tex_Verb *) Lemma Zm_plus_zero_rht: (is_rht_unit Zm_plus_op 0). -(* End_Tex_Verb *) -red; simpl. -intros. -unfold ZModeq. -unfold Zm_plus. -rewrite Zplus_0_r. -auto with zarith. +Proof. + (* End_Tex_Verb *) + red; simpl. + intros. + unfold ZModeq. + unfold Zm_plus. + rewrite Zplus_0_r. + auto with zarith. Qed. (* Begin_Tex_Verb *) Lemma Zm_plus_zero_lft: (is_lft_unit Zm_plus_op 0). -(* End_Tex_Verb *) -red; simpl. -intros. -unfold ZModeq. -auto with zarith. +Proof. + (* End_Tex_Verb *) + red; simpl. + intros. + unfold ZModeq. + auto with zarith. Qed. (* Begin_Tex_Verb *) Lemma Zm_plus_commutes: (commutes Zm_plus_op). -(* End_Tex_Verb *) -red; simpl. -intros. -unfold ZModeq. -unfold Zm_plus. -rewrite Zplus_comm. -auto with zarith. +Proof. + (* End_Tex_Verb *) + red; simpl. + intros. + unfold ZModeq. + unfold Zm_plus. + rewrite Zplus_comm. + auto with zarith. Qed. (* Begin_Tex_Verb *) @@ -263,23 +276,25 @@ Definition Zm_opp (x:Zm_cmonoid) : Zm_cmonoid := -x. (* Begin_Tex_Verb *) Lemma Zm_opp_strext : (un_op_strext _ Zm_opp). -(* End_Tex_Verb *) -red; red; simpl. -intros x y. -unfold ZModeq; unfold ZModap; unfold Zm_plus; unfold Zm_opp. -intro Hneq. -intro Heq. -apply Hneq. -apply Zmodeq_opp_elim. -exact Heq. +Proof. + (* End_Tex_Verb *) + red; red; simpl. + intros x y. + unfold ZModeq; unfold ZModap; unfold Zm_plus; unfold Zm_opp. + intro Hneq. + intro Heq. + apply Hneq. + apply Zmodeq_opp_elim. + exact Heq. Qed. (* Begin_Tex_Verb *) Lemma Zm_opp_well_def : (un_op_wd _ Zm_opp). -(* End_Tex_Verb *) -unfold un_op_wd. -apply fun_strext_imp_wd. -exact Zm_opp_strext. +Proof. + (* End_Tex_Verb *) + unfold un_op_wd. + apply fun_strext_imp_wd. + exact Zm_opp_strext. Qed. (* Begin_Tex_Verb *) @@ -289,15 +304,16 @@ Definition Zm_opp_op := (* Begin_Tex_Verb *) Lemma Zm_is_CGroup : (is_CGroup _ Zm_opp_op). -(* End_Tex_Verb *) -unfold is_CGroup. -unfold is_inverse. -simpl. -unfold ZModeq; unfold Zm_plus; unfold Zm_opp. -intro. -rewrite Zplus_opp_r. -rewrite Zplus_opp_l. -auto with zarith. +Proof. + (* End_Tex_Verb *) + unfold is_CGroup. + unfold is_inverse. + simpl. + unfold ZModeq; unfold Zm_plus; unfold Zm_opp. + intro. + rewrite Zplus_opp_r. + rewrite Zplus_opp_l. + auto with zarith. Qed. (* Begin_Tex_Verb *) @@ -305,8 +321,9 @@ Definition Zm_cgroup := (Build_CGroup _ _ Zm_is_CGroup). (* End_Tex_Verb *) Lemma Zm_is_CAbGroup : (is_CAbGroup Zm_cgroup). -unfold is_CAbGroup. -exact Zm_plus_commutes. +Proof. + unfold is_CAbGroup. + exact Zm_plus_commutes. Qed. Definition Zm_cabgroup := (Build_CAbGroup _ Zm_is_CAbGroup). @@ -322,10 +339,11 @@ Section zm_ring. Hypothesis Hnontriv: ~(m=xH). Lemma m_gt_1: m>1. -unfold Zgt. -generalize Hnontriv. -case m; simpl; intros; auto. -elim Hnontriv0; auto. +Proof. + unfold Zgt. + generalize Hnontriv. + case m; simpl; intros; auto. + elim Hnontriv0; auto. Qed. (* Dit was een Local! *) @@ -339,22 +357,23 @@ Definition Zm_mult (x y:Zm_cabgroup) : Zm_cabgroup := x*y. (* Begin_Tex_Verb *) Lemma Zm_mult_strext : (bin_fun_strext _ _ _ Zm_mult). -(* End_Tex_Verb *) -red; simpl. -unfold ZModap;unfold Zm_mult; simpl. -intros x1 x2 y1 y2. -intro H. -elim (Zmodeq_dec m x1 x2). -elim (Zmodeq_dec m y1 y2). -intros Hyeq Hxeq. - elim H. - apply Zmodeq_mult_elim; auto with zarith. -intros Hyneq _. - right. - intro Hyeq. - elim Hyneq. - exact Hyeq. -intros Hxneq. +Proof. + (* End_Tex_Verb *) + red; simpl. + unfold ZModap;unfold Zm_mult; simpl. + intros x1 x2 y1 y2. + intro H. + elim (Zmodeq_dec m x1 x2). + elim (Zmodeq_dec m y1 y2). + intros Hyeq Hxeq. + elim H. + apply Zmodeq_mult_elim; auto with zarith. + intros Hyneq _. + right. + intro Hyeq. + elim Hyneq. + exact Hyeq. + intros Hxneq. left. intro Hxeq. elim Hxneq. @@ -363,9 +382,10 @@ Qed. (* Begin_Tex_Verb *) Lemma Zm_mult_wd : (bin_fun_wd _ _ _ Zm_mult). -(* End_Tex_Verb *) -apply bin_fun_strext_imp_wd. -exact Zm_mult_strext. +Proof. + (* End_Tex_Verb *) + apply bin_fun_strext_imp_wd. + exact Zm_mult_strext. Qed. @@ -376,97 +396,107 @@ Definition Zm_mult_op := (Build_CSetoid_bin_op _ _ Zm_mult_strext). (* Begin_Tex_Verb *) Lemma Zm_mult_assoc : (associative Zm_mult_op). -(* End_Tex_Verb *) -unfold associative. -intros x y z. -simpl. -unfold ZModeq; unfold Zm_mult. -rewrite Zmult_assoc. -apply Zmodeq_refl. +Proof. + (* End_Tex_Verb *) + unfold associative. + intros x y z. + simpl. + unfold ZModeq; unfold Zm_mult. + rewrite Zmult_assoc. + apply Zmodeq_refl. Qed. (* Begin_Tex_Verb *) Lemma Zm_mult_commutative: forall x y:Zm_cabgroup, (Zm_mult_op x y) [=] (Zm_mult_op y x). -(* End_Tex_Verb *) -intros x y. -simpl. -unfold ZModeq; unfold Zm_mult. -rewrite Zmult_comm. -apply Zmodeq_refl. +Proof. + (* End_Tex_Verb *) + intros x y. + simpl. + unfold ZModeq; unfold Zm_mult. + rewrite Zmult_comm. + apply Zmodeq_refl. Qed. (* Begin_Tex_Verb *) Lemma Zm_mult_one : forall x:Zm_cabgroup, (Zm_mult_op x 1)[=]x. -(* End_Tex_Verb *) -intro. -simpl. -unfold ZModeq; unfold Zm_mult. -rewrite Zmult_1_r. -apply Zmodeq_refl. +Proof. + (* End_Tex_Verb *) + intro. + simpl. + unfold ZModeq; unfold Zm_mult. + rewrite Zmult_1_r. + apply Zmodeq_refl. Qed. Lemma Zm_mult_onel : forall x:Zm_cabgroup, (Zm_mult_op 1 x)[=]x. -intro. -astepl (Zm_mult_op x 1). -exact (Zm_mult_one x). -exact (Zm_mult_commutative x 1). +Proof. + intro. + astepl (Zm_mult_op x 1). + exact (Zm_mult_one x). + exact (Zm_mult_commutative x 1). Qed. Definition Zm_mult_semigroup := (Build_CSemiGroup Zm_csetoid Zm_mult_op Zm_mult_assoc). Lemma Zm_mult_one_r : is_rht_unit Zm_mult_op 1. -red. -exact Zm_mult_one. +Proof. + red. + exact Zm_mult_one. Qed. Lemma Zm_mult_one_l : is_lft_unit Zm_mult_op 1. -red. -exact Zm_mult_onel. +Proof. + red. + exact Zm_mult_onel. Qed. (* Begin_Tex_Verb *) Lemma Zm_mult_monoid: (is_CMonoid Zm_mult_semigroup 1). -(* End_Tex_Verb *) -apply Build_is_CMonoid. -exact Zm_mult_one_r. -exact Zm_mult_one_l. +Proof. + (* End_Tex_Verb *) + apply Build_is_CMonoid. + exact Zm_mult_one_r. + exact Zm_mult_one_l. Qed. (* Begin_Tex_Verb *) Lemma Zm_mult_plus_dist : (distributive Zm_mult_op Zm_plus_op). -(* End_Tex_Verb *) -red; simpl. -intros x y z. -unfold ZModeq; unfold Zm_mult; unfold Zm_plus. -rewrite <-Zmult_plus_distr_r. -apply Zmodeq_refl. +Proof. + (* End_Tex_Verb *) + red; simpl. + intros x y z. + unfold ZModeq; unfold Zm_mult; unfold Zm_plus. + rewrite <-Zmult_plus_distr_r. + apply Zmodeq_refl. Qed. (* Begin_Tex_Verb *) Lemma Zm_non_triv : (ZModap 1 0). -(* End_Tex_Verb *) -unfold ZModap. -intro Hfalse. -generalize (Zmodeq_modeq _ _ _ Hfalse). -rewrite Zmod_zero_lft. -rewrite Zmod_one_lft; auto. -intro H. -assert False. discriminate. elim H0. -(* Discriminate in itself caused an error in Coq *) -exact m_gt_1. +Proof. + (* End_Tex_Verb *) + unfold ZModap. + intro Hfalse. + generalize (Zmodeq_modeq _ _ _ Hfalse). + rewrite Zmod_zero_lft. + rewrite Zmod_one_lft; auto. + intro H. + assert False. discriminate. elim H0. + (* Discriminate in itself caused an error in Coq *) + exact m_gt_1. Qed. (* Begin_Tex_Verb *) Lemma Zm_is_CRing : (is_CRing Zm_cabgroup 1 Zm_mult_op). -(* End_Tex_Verb *) -apply Build_is_CRing with Zm_mult_assoc. -exact Zm_mult_monoid. -exact Zm_mult_commutative. -exact Zm_mult_plus_dist. -exact Zm_non_triv. +Proof. + (* End_Tex_Verb *) + apply Build_is_CRing with Zm_mult_assoc. + exact Zm_mult_monoid. + exact Zm_mult_commutative. + exact Zm_mult_plus_dist. + exact Zm_non_triv. Qed. End zm_def. @@ -481,7 +511,7 @@ Definition Zm := Zm_cring. Section zm_ring_basics. -Definition Zm_mult_ord (a:Zm)(h:nat) := (a[^]h[=]One) /\ +Definition Zm_mult_ord (a:Zm)(h:nat) := (a[^]h[=]One) /\ forall k:nat, (lt k h)->~(a[^]k[=]One). @@ -506,19 +536,22 @@ Section zp_def. Hypothesis Hprime: (Prime m). Lemma p_not_1: ~m=xH. -unfold Prime in Hprime. -elim Hprime; intros; assumption. +Proof. + unfold Prime in Hprime. + elim Hprime; intros; assumption. Qed. Lemma p_gt_0: m>0. -red; simpl; reflexivity. +Proof. + red; simpl; reflexivity. Qed. Lemma p_gt_1: m>1. -unfold Zgt. -generalize p_not_1. -case m; simpl; intro H; auto. -elim H; auto. +Proof. + unfold Zgt. + generalize p_not_1. + case m; simpl; intro H; auto. + elim H; auto. Qed. @@ -539,37 +572,37 @@ Variable x: Zp. Hypothesis Hx: x[#]Zero. Lemma Zp_nonz_mod: 0<(Zmod x m)(x[#]y)). -(* End_Tex_Verb *) -intros x y Hx Hy. -simpl. -unfold ZModap; unfold Zp_inv. -intro Hinv. -intro Heq. -generalize (Zmodeq_modeq _ _ _ Heq); clear Heq; intro Heq. -elim Hinv. -apply Zmodeq_eqmod. -generalize (Zmod_relprime_inv m x p_gt_1 (Zp_nonz_relprime x Hx)). -rewrite <- (Zmod_relprime_inv m y p_gt_1 (Zp_nonz_relprime y Hy)). -rewrite (Zmod_mult_compat m x); auto. -rewrite (Zmod_mult_compat m y); auto. -(*unfold p.*) -rewrite Heq. -rewrite <-Zmod_mult_compat; auto. -rewrite <-Zmod_mult_compat; auto. -intro Hmult. -apply (Zmod_mult_elim_lft _ _ _ _ p_gt_0 (Zp_nonz_relprime y Hy) Hmult). -exact m_gt_0. -exact m_gt_0. -exact p_gt_0. -exact p_gt_0. +Proof. + (* End_Tex_Verb *) + intros x y Hx Hy. + simpl. + unfold ZModap; unfold Zp_inv. + intro Hinv. + intro Heq. + generalize (Zmodeq_modeq _ _ _ Heq); clear Heq; intro Heq. + elim Hinv. + apply Zmodeq_eqmod. + generalize (Zmod_relprime_inv m x p_gt_1 (Zp_nonz_relprime x Hx)). + rewrite <- (Zmod_relprime_inv m y p_gt_1 (Zp_nonz_relprime y Hy)). + rewrite (Zmod_mult_compat m x); auto. + rewrite (Zmod_mult_compat m y); auto. + (*unfold p.*) + rewrite Heq. + rewrite <-Zmod_mult_compat; auto. + rewrite <-Zmod_mult_compat; auto. + intro Hmult. + apply (Zmod_mult_elim_lft _ _ _ _ p_gt_0 (Zp_nonz_relprime y Hy) Hmult). + exact m_gt_0. + exact m_gt_0. + exact p_gt_0. + exact p_gt_0. Qed. (* Begin_Tex_Verb *) Lemma Zp_is_CField: (is_CField Zp Zp_inv). -(* End_Tex_Verb *) -red; red. -intros x. -simpl; unfold ZModap; unfold ZModeq; unfold Zm_mult; unfold Zp_inv. -intros Hx. -elim (Zp_nonz_mod x Hx); intros Hxmod0 Hxmodp. -split. -apply Zmodeq_eqmod. -rewrite Zmod_one_lft; auto. -(*rewrite <-Zmod_mult_compat; auto.*) -(*rewrite Zmod_Zmod; auto.*) -apply Zmod_relprime_inv; auto. -exact p_gt_1. -apply Zrelprime_symm. -unfold Zrelprime. -rewrite <-Zgcd_mod_rht; auto. -generalize Hxmod0. -set (d:=(Zmod x m)). -cut (d=(Zmod x m)); auto. -case d. -intros _ Hfalse; - elim (Zlt_irref _ Hfalse). -intros D HD _. - rewrite <-HD in Hxmodp. - (*fold p;*) - (*rewrite <-HD.*) - elim (prime_rel_prime m Hprime D Hxmodp); auto. -intros D _ Hfalse; - elim (Zge_0_NEG _ Hfalse). -exact p_gt_0. -exact p_gt_1. -(*rewrite Zm_mult_commutative.*) -apply Zmodeq_eqmod. -rewrite Zmod_one_lft; auto. -cut ((x * Zgcd_coeff_a x m) mod m = 1). -intro H; elim H. -apply Zmodeq_wd. -apply Zmult_comm. -apply Zmod_relprime_inv; auto. -exact p_gt_1. -apply Zrelprime_symm. -unfold Zrelprime. -rewrite <-Zgcd_mod_rht; auto. -generalize Hxmod0. -set (d:=(Zmod x m)). -cut (d=(Zmod x m)); auto. -case d. -intros _ Hfalse; - elim (Zlt_irref _ Hfalse). -intros D HD _. - rewrite <-HD in Hxmodp. - (*fold p; rewrite <-HD.*) - elim (prime_rel_prime m Hprime D Hxmodp); auto. -intros D _ Hfalse; - elim (Zge_0_NEG _ Hfalse). -exact p_gt_0. -exact p_gt_1. +Proof. + (* End_Tex_Verb *) + red; red. + intros x. + simpl; unfold ZModap; unfold ZModeq; unfold Zm_mult; unfold Zp_inv. + intros Hx. + elim (Zp_nonz_mod x Hx); intros Hxmod0 Hxmodp. + split. + apply Zmodeq_eqmod. + rewrite Zmod_one_lft; auto. + (*rewrite <-Zmod_mult_compat; auto.*) + (*rewrite Zmod_Zmod; auto.*) + apply Zmod_relprime_inv; auto. + exact p_gt_1. + apply Zrelprime_symm. + unfold Zrelprime. + rewrite <-Zgcd_mod_rht; auto. + generalize Hxmod0. + set (d:=(Zmod x m)). + cut (d=(Zmod x m)); auto. + case d. + intros _ Hfalse; elim (Zlt_irref _ Hfalse). + intros D HD _. + rewrite <-HD in Hxmodp. + (*fold p;*) + (*rewrite <-HD.*) + elim (prime_rel_prime m Hprime D Hxmodp); auto. + intros D _ Hfalse; elim (Zge_0_NEG _ Hfalse). + exact p_gt_0. + exact p_gt_1. + (*rewrite Zm_mult_commutative.*) + apply Zmodeq_eqmod. + rewrite Zmod_one_lft; auto. + cut ((x * Zgcd_coeff_a x m) mod m = 1). + intro H; elim H. + apply Zmodeq_wd. + apply Zmult_comm. + apply Zmod_relprime_inv; auto. + exact p_gt_1. + apply Zrelprime_symm. + unfold Zrelprime. + rewrite <-Zgcd_mod_rht; auto. + generalize Hxmod0. + set (d:=(Zmod x m)). + cut (d=(Zmod x m)); auto. + case d. + intros _ Hfalse; elim (Zlt_irref _ Hfalse). + intros D HD _. + rewrite <-HD in Hxmodp. + (*fold p; rewrite <-HD.*) + elim (prime_rel_prime m Hprime D Hxmodp); auto. + intros D _ Hfalse; elim (Zge_0_NEG _ Hfalse). + exact p_gt_0. + exact p_gt_1. Qed. diff --git a/model/abgroups/CRabgroup.v b/model/abgroups/CRabgroup.v index b30235b81..a0f588bd2 100644 --- a/model/abgroups/CRabgroup.v +++ b/model/abgroups/CRabgroup.v @@ -32,14 +32,12 @@ Open Local Scope uc_scope. Lemma CRisCAbGroup : is_CAbGroup CRasCGroup. Proof. -intros x y. -change (x+y==y+x)%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR y)) by - apply CR_plus_as_Cauchy_IR_plus. -stepr ((CRasCauchy_IR y)[+](CRasCauchy_IR x)) by - apply CR_plus_as_Cauchy_IR_plus. -apply cag_commutes. + intros x y. + change (x+y==y+x)%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR y)) by apply CR_plus_as_Cauchy_IR_plus. + stepr ((CRasCauchy_IR y)[+](CRasCauchy_IR x)) by apply CR_plus_as_Cauchy_IR_plus. + apply cag_commutes. Qed. Definition CRasCAbGroup : CAbGroup := diff --git a/model/abgroups/QSposabgroup.v b/model/abgroups/QSposabgroup.v index a5c42d66f..be5deba56 100644 --- a/model/abgroups/QSposabgroup.v +++ b/model/abgroups/QSposabgroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export QSposgroup. @@ -45,9 +45,9 @@ The positive rational numbers form with the operation $(x,y) \mapsto xy/2$ #(x Lemma Qpos_multdiv2_is_CAbGroup : is_CAbGroup Qpos_multdiv2_as_CGroup. Proof. -intros x y. -simpl. -QposRing. + intros x y. + simpl. + QposRing. Qed. Definition Qpos_multdiv2_as_CAbGroup := Build_CAbGroup diff --git a/model/abgroups/Qabgroup.v b/model/abgroups/Qabgroup.v index 978b84ed3..60fb38490 100644 --- a/model/abgroups/Qabgroup.v +++ b/model/abgroups/Qabgroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qgroup. Require Import CAbGroups. @@ -41,14 +41,14 @@ Require Import CAbGroups. ** Example of an abelian group: $\langle$#⟨#[Q],[[+]]$\rangle$#⟩# *) -(** Addition is commutative, so the rationals form with the addition a +(** Addition is commutative, so the rationals form with the addition a CAbGroup. *) Lemma Q_is_CAbGroup : is_CAbGroup Q_as_CGroup. Proof. -red in |- *. -exact Qplus_is_commut1. + red in |- *. + exact Qplus_is_commut1. Qed. Definition Q_as_CAbGroup := Build_CAbGroup Q_as_CGroup Q_is_CAbGroup. diff --git a/model/abgroups/Qposabgroup.v b/model/abgroups/Qposabgroup.v index 75be294eb..be2ed80ca 100644 --- a/model/abgroups/Qposabgroup.v +++ b/model/abgroups/Qposabgroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qposgroup. @@ -44,8 +44,9 @@ The positive rationals form with the multiplication a CAbgroup. *) Definition Qpos_mult_is_CAbGroup : is_CAbGroup Qpos_as_CGroup. -intros x y; simpl. -QposRing. +Proof. + intros x y; simpl. + QposRing. Qed. Definition Qpos_mult_as_CAbGroup := Build_CAbGroup diff --git a/model/abgroups/Zabgroup.v b/model/abgroups/Zabgroup.v index e2afef147..a920b74d1 100644 --- a/model/abgroups/Zabgroup.v +++ b/model/abgroups/Zabgroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Zgroup. @@ -42,11 +42,11 @@ Require Import CAbGroups. ** Example of an abelian group: $\langle$#⟨#[Z],[[+]]$\rangle$#⟩# *) -Lemma Z_is_CAbGroup : is_CAbGroup Z_as_CGroup. +Lemma Z_is_CAbGroup : is_CAbGroup Z_as_CGroup. Proof. -red in |- *. -simpl in |- *. -exact Zplus_is_commut. + red in |- *. + simpl in |- *. + exact Zplus_is_commut. Qed. Definition Z_as_CAbGroup := Build_CAbGroup Z_as_CGroup Z_is_CAbGroup. diff --git a/model/fields/CRfield.v b/model/fields/CRfield.v index 949d834f0..7ed47e837 100644 --- a/model/fields/CRfield.v +++ b/model/fields/CRfield.v @@ -33,41 +33,38 @@ Open Local Scope uc_scope. Lemma CRisCField : is_CField CRasCRing CRinv. Proof. -intros x x_. -split. -change (x*(CRinv x x_)==(' 1%Q))%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR (CRinv x x_))) by - apply CR_mult_as_Cauchy_IR_mult. -stepl ((CRasCauchy_IR x)[*](f_rcpcl (CRasCauchy_IR x) (CR_nonZero_as_Cauchy_IR_nonZero_1 _ x_))) by - apply bin_op_is_wd_un_op_rht; apply CR_inv_as_Cauchy_IR_inv. -apply: eq_transitive. -apply field_mult_inv. -apply: CR_inject_Q_as_Cauchy_IR_inject_Q. - -change ((CRinv x x_)*x==(' 1%Q))%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR (CRinv x x_))[*](CRasCauchy_IR x)) by - apply CR_mult_as_Cauchy_IR_mult. -stepl ((f_rcpcl (CRasCauchy_IR x) (CR_nonZero_as_Cauchy_IR_nonZero_1 _ x_))[*](CRasCauchy_IR x)) by - apply bin_op_is_wd_un_op_lft; apply CR_inv_as_Cauchy_IR_inv. -apply: eq_transitive. -apply field_mult_inv_op. -apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + intros x x_. + split. + change (x*(CRinv x x_)==(' 1%Q))%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR (CRinv x x_))) by apply CR_mult_as_Cauchy_IR_mult. + stepl ((CRasCauchy_IR x)[*](f_rcpcl (CRasCauchy_IR x) (CR_nonZero_as_Cauchy_IR_nonZero_1 _ x_))) by + apply bin_op_is_wd_un_op_rht; apply CR_inv_as_Cauchy_IR_inv. + apply: eq_transitive. + apply field_mult_inv. + apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + change ((CRinv x x_)*x==(' 1%Q))%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR (CRinv x x_))[*](CRasCauchy_IR x)) by apply CR_mult_as_Cauchy_IR_mult. + stepl ((f_rcpcl (CRasCauchy_IR x) (CR_nonZero_as_Cauchy_IR_nonZero_1 _ x_))[*](CRasCauchy_IR x)) by + apply bin_op_is_wd_un_op_lft; apply CR_inv_as_Cauchy_IR_inv. + apply: eq_transitive. + apply field_mult_inv_op. + apply: CR_inject_Q_as_Cauchy_IR_inject_Q. Qed. Lemma CRinv_strext : forall x y x_ y_, CRapart (CRinv x x_) (CRinv y y_) -> CRapart x y. Proof. -intros x y x_ y_ H. -apply CR_ap_as_Cauchy_IR_ap_2. -apply cf_rcpsx with - (CR_nonZero_as_Cauchy_IR_nonZero_1 _ x_) (CR_nonZero_as_Cauchy_IR_nonZero_1 _ y_). -stepl (CRasCauchy_IR (CRinv x x_)%CR) by - apply eq_symmetric; apply (CR_inv_as_Cauchy_IR_inv_short x x_). -stepr (CRasCauchy_IR (CRinv y y_)%CR) by - apply eq_symmetric; apply (CR_inv_as_Cauchy_IR_inv_short y y_). -apply CR_ap_as_Cauchy_IR_ap_1. -apply H. + intros x y x_ y_ H. + apply CR_ap_as_Cauchy_IR_ap_2. + apply cf_rcpsx with + (CR_nonZero_as_Cauchy_IR_nonZero_1 _ x_) (CR_nonZero_as_Cauchy_IR_nonZero_1 _ y_). + stepl (CRasCauchy_IR (CRinv x x_)%CR) by + apply eq_symmetric; apply (CR_inv_as_Cauchy_IR_inv_short x x_). + stepr (CRasCauchy_IR (CRinv y y_)%CR) by + apply eq_symmetric; apply (CR_inv_as_Cauchy_IR_inv_short y y_). + apply CR_ap_as_Cauchy_IR_ap_1. + apply H. Qed. Definition CRasCField : CField := diff --git a/model/fields/Qfield.v b/model/fields/Qfield.v index 4a7281602..eb7bd435c 100644 --- a/model/fields/Qfield.v +++ b/model/fields/Qfield.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qring. Require Import CFields. @@ -45,10 +45,10 @@ So, [Q] not only forms a ring, but even a field. Lemma Q_is_CField : is_CField Q_as_CRing Qinv. Proof. -red in |- *. -intro. -unfold is_inverse in |- *. -apply Qinv_is_inv. + red in |- *. + intro. + unfold is_inverse in |- *. + apply Qinv_is_inv. Qed. Definition Q_as_CField := Build_CField _ _ Q_is_CField Qinv_strext. diff --git a/model/groups/CRgroup.v b/model/groups/CRgroup.v index 0cf625eeb..bec27df50 100644 --- a/model/groups/CRgroup.v +++ b/model/groups/CRgroup.v @@ -32,16 +32,14 @@ Open Local Scope uc_scope. Lemma CRopp_strext : un_op_strext CRasCSetoid CRopp. Proof. -intros x y H. -change (CRapart x y)%CR. -apply CR_ap_as_Cauchy_IR_ap_2. -apply: un_op_strext_unfolded. -stepl (CRasCauchy_IR (-x)%CR) by - apply eq_symmetric; apply CR_opp_as_Cauchy_IR_opp. -stepr (CRasCauchy_IR (-y)%CR) by - apply eq_symmetric; apply CR_opp_as_Cauchy_IR_opp. -apply CR_ap_as_Cauchy_IR_ap_1. -apply H. + intros x y H. + change (CRapart x y)%CR. + apply CR_ap_as_Cauchy_IR_ap_2. + apply: un_op_strext_unfolded. + stepl (CRasCauchy_IR (-x)%CR) by apply eq_symmetric; apply CR_opp_as_Cauchy_IR_opp. + stepr (CRasCauchy_IR (-y)%CR) by apply eq_symmetric; apply CR_opp_as_Cauchy_IR_opp. + apply CR_ap_as_Cauchy_IR_ap_1. + apply H. Qed. Definition CRoppasUnOp : CSetoid_un_op CRasCSetoid := @@ -49,26 +47,23 @@ Build_CSetoid_fun _ _ _ CRopp_strext. Lemma CRisCGroup : is_CGroup CRasCMonoid CRoppasUnOp. Proof. -split. -change (x-x==(inject_Q 0%Q))%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR (- x)%CR)) by - apply CR_plus_as_Cauchy_IR_plus. -stepl ((CRasCauchy_IR x)[+][--](CRasCauchy_IR x)) by - apply plus_resp_eq; apply CR_opp_as_Cauchy_IR_opp. -apply: eq_transitive. -apply cg_rht_inv_unfolded. -apply: CR_inject_Q_as_Cauchy_IR_inject_Q. - -change (-x + x==(inject_Q 0%Q))%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR (-x)%CR)[+](CRasCauchy_IR x)) by - apply CR_plus_as_Cauchy_IR_plus. -stepl ([--](CRasCauchy_IR x)[+](CRasCauchy_IR x)) by - apply bin_op_is_wd_un_op_lft; apply CR_opp_as_Cauchy_IR_opp. -apply: eq_transitive. -apply cg_lft_inv_unfolded. -apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + split. + change (x-x==(inject_Q 0%Q))%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR (- x)%CR)) by apply CR_plus_as_Cauchy_IR_plus. + stepl ((CRasCauchy_IR x)[+][--](CRasCauchy_IR x)) by + apply plus_resp_eq; apply CR_opp_as_Cauchy_IR_opp. + apply: eq_transitive. + apply cg_rht_inv_unfolded. + apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + change (-x + x==(inject_Q 0%Q))%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR (-x)%CR)[+](CRasCauchy_IR x)) by apply CR_plus_as_Cauchy_IR_plus. + stepl ([--](CRasCauchy_IR x)[+](CRasCauchy_IR x)) by + apply bin_op_is_wd_un_op_lft; apply CR_opp_as_Cauchy_IR_opp. + apply: eq_transitive. + apply cg_lft_inv_unfolded. + apply: CR_inject_Q_as_Cauchy_IR_inject_Q. Qed. Definition CRasCGroup : CGroup := diff --git a/model/groups/QSposgroup.v b/model/groups/QSposgroup.v index f9b40e95d..a0cb3637d 100644 --- a/model/groups/QSposgroup.v +++ b/model/groups/QSposgroup.v @@ -18,36 +18,36 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export QSposmonoid. Require Import CGroups. (** ** Example of a group: $\langle$#⟨#[Qpos],$(x,y) \mapsto xy/2$ #(x,y) ↦ xy/2#$\rangle$#⟩# -The positive rationals form with the operation $(x,y) \mapsto xy/2$ +The positive rationals form with the operation $(x,y) \mapsto xy/2$ #(x,y) ↦ xy/2# a CGroup. *) Lemma Qpos_multdiv2_is_CGroup : is_CGroup Qpos_multdiv2_as_CMonoid divmult4. Proof. -intro x. -unfold is_inverse. -split; simpl; autorewrite with QposElim; field; discriminate. + intro x. + unfold is_inverse. + split; simpl; autorewrite with QposElim; field; discriminate. Qed. Definition Qpos_multdiv2_as_CGroup := Build_CGroup diff --git a/model/groups/Qgroup.v b/model/groups/Qgroup.v index 5d2c83179..86ab562d2 100644 --- a/model/groups/Qgroup.v +++ b/model/groups/Qgroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qmonoid. Require Import CGroups. @@ -44,12 +44,12 @@ The rational numbers with addition form a group. The inverse function is taking Lemma Q_is_CGroup : is_CGroup Q_as_CMonoid Qopp_is_fun. Proof. -red in |- *. -split. -apply Qplus_inverse_r. -eapply eq_transitive_unfolded. -apply Qplus_is_commut0. -apply Qplus_inverse_r. + red in |- *. + split. + apply Qplus_inverse_r. + eapply eq_transitive_unfolded. + apply Qplus_is_commut0. + apply Qplus_inverse_r. Qed. Definition Q_as_CGroup := Build_CGroup Q_as_CMonoid Qopp_is_fun Q_is_CGroup. diff --git a/model/groups/Qposgroup.v b/model/groups/Qposgroup.v index fce25ed9b..a75ec2e5f 100644 --- a/model/groups/Qposgroup.v +++ b/model/groups/Qposgroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qposmonoid. Require Export CGroups. @@ -44,8 +44,8 @@ The positive rational numbers form a multiplicative group. Lemma Qpos_is_CGroup : is_CGroup Qpos_mult_as_CMonoid Qpos_inv_op. Proof. -intros x. -split; simpl; autorewrite with QposElim; field; apply Qpos_nonzero. + intros x. + split; simpl; autorewrite with QposElim; field; apply Qpos_nonzero. Qed. diff --git a/model/groups/Zgroup.v b/model/groups/Zgroup.v index 98b78eb35..843690a82 100644 --- a/model/groups/Zgroup.v +++ b/model/groups/Zgroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Zmonoid. @@ -42,14 +42,14 @@ Require Import CGroups. ** Example of a group: $\langle$#⟨#[Z],[[+]]$\rangle$#⟩# *) -Lemma Z_is_CGroup : is_CGroup Z_as_CMonoid Zopp_is_fun. +Lemma Z_is_CGroup : is_CGroup Z_as_CMonoid Zopp_is_fun. Proof. -red in |- *. -simpl in |- *. -intro x. -split; simpl in |- *. -apply Zplus_opp_r. -apply Zplus_opp_l. + red in |- *. + simpl in |- *. + intro x. + split; simpl in |- *. + apply Zplus_opp_r. + apply Zplus_opp_l. Qed. Definition Z_as_CGroup := Build_CGroup Z_as_CMonoid Zopp_is_fun Z_is_CGroup. diff --git a/model/metric2/CRmetric.v b/model/metric2/CRmetric.v index e692c5c2d..5fa50098a 100644 --- a/model/metric2/CRmetric.v +++ b/model/metric2/CRmetric.v @@ -41,7 +41,8 @@ Definition inject_Q : Q -> CR := (@Cunit Q_as_MetricSpace). (* begin hide *) Add Morphism (inject_Q) with signature Qeq ==> (@st_eq _) as inject_Q_wd. -exact (uc_wd (@Cunit Q_as_MetricSpace)). +Proof. + exact (uc_wd (@Cunit Q_as_MetricSpace)). Qed. (* end hide *) diff --git a/model/metric2/L1metric.v b/model/metric2/L1metric.v index 79c017d0e..ed2779aeb 100644 --- a/model/metric2/L1metric.v +++ b/model/metric2/L1metric.v @@ -62,91 +62,95 @@ Eval compute in (Mesh test2). *) Lemma L1ball_dec : forall e a b, {L1Ball e a b}+{~L1Ball e a b}. -intros e a b. -unfold L1Ball. -set (d:=L1Distance a b). -destruct (Qlt_le_dec_fast e d) as [Hdc|Hdc]. -right. abstract auto with *. -left. exact Hdc. +Proof. + intros e a b. + unfold L1Ball. + set (d:=L1Distance a b). + destruct (Qlt_le_dec_fast e d) as [Hdc|Hdc]. + right. abstract auto with *. + left. exact Hdc. Defined. (** The integral of the glue of two step functions. *) Lemma Integral_glue : forall o s t, (IntegralQ (glue o s t) == o*(IntegralQ s) + (1-o)*(IntegralQ t))%Q. Proof. -intros o s t. -unfold IntegralQ. -simpl. -rewrite Qred_correct. -reflexivity. + intros o s t. + unfold IntegralQ. + simpl. + rewrite Qred_correct. + reflexivity. Qed. (** The integral of the split of a step function. *) -Lemma IntegralSplit : forall (o:OpenUnit) x, +Lemma IntegralSplit : forall (o:OpenUnit) x, (IntegralQ x == affineCombo o (IntegralQ (SplitL x o)) (IntegralQ (SplitR x o)))%Q. Proof. -intros o x. -revert o. -induction x using StepF_ind. -unfold IntegralQ. simpl. intros. unfold affineCombo; simpl in x; ring. -intros p. -rewrite Integral_glue. -apply SplitLR_glue_ind; intros H. - rewrite Integral_glue. - unfold affineCombo in *. - rewrite (IHx1 (OpenUnitDiv p o H)). - unfold IntegralQ; simpl; fold IntegralQ. unfold affineCombo; field; auto with *. (*why does this not work*) + intros o x. + revert o. + induction x using StepF_ind. + unfold IntegralQ. simpl. intros. unfold affineCombo; simpl in x; ring. + intros p. rewrite Integral_glue. - simpl. unfold IntegralQ; simpl; fold IntegralQ. - repeat rewrite Qred_correct. - unfold affineCombo in *. - rewrite -> (IHx2 (OpenUnitDualDiv p o H)). - unfold IntegralQ; simpl; fold IntegralQ. unfold affineCombo; field; auto with *. -unfold affineCombo in *. -rewrite H. -reflexivity. + apply SplitLR_glue_ind; intros H. + rewrite Integral_glue. + unfold affineCombo in *. + rewrite (IHx1 (OpenUnitDiv p o H)). + unfold IntegralQ; simpl; fold IntegralQ. unfold affineCombo; field; auto with *. (*why does this not work*) + rewrite Integral_glue. + simpl. unfold IntegralQ; simpl; fold IntegralQ. + repeat rewrite Qred_correct. + unfold affineCombo in *. + rewrite -> (IHx2 (OpenUnitDualDiv p o H)). + unfold IntegralQ; simpl; fold IntegralQ. unfold affineCombo; field; auto with *. + unfold affineCombo in *. + rewrite H. + reflexivity. Qed. (* begin hide *) Hint Resolve IntegralSplit : StepQArith. -Add Morphism IntegralQ +Add Morphism IntegralQ with signature (@StepF_eq _) ==> Qeq as IntegralQ_wd. -induction x using StepF_ind. -intros x2 H. simpl. induction x2 using StepF_ind. +Proof. + induction x using StepF_ind. + intros x2 H. simpl. induction x2 using StepF_ind. auto with *. + rewrite Integral_glue. + simpl. + destruct H as [H0 H1] using (eq_glue_ind x2_1). + rewrite <- IHx2_1; auto with *. + rewrite <- IHx2_2; auto with *. + simpl in x; unfold affineCombo; ring. + intros y H. + destruct H as [H0 H1] using (glue_eq_ind x1). rewrite Integral_glue. - simpl. - destruct H as [H0 H1] using (eq_glue_ind x2_1). - rewrite <- IHx2_1; auto with *. - rewrite <- IHx2_2; auto with *. - simpl in x; unfold affineCombo; ring. -intros y H. -destruct H as [H0 H1] using (glue_eq_ind x1). -rewrite Integral_glue. -rewrite (IHx1 _ H0). -rewrite (IHx2 _ H1). -symmetry. -apply IntegralSplit. + rewrite (IHx1 _ H0). + rewrite (IHx2 _ H1). + symmetry. + apply IntegralSplit. Qed. -Add Morphism L1Norm +Add Morphism L1Norm with signature (@StepF_eq _) ==> Qeq as L1Norm_wd. -unfold L1Norm. -intros x y Hxy. -rewrite Hxy. -reflexivity. +Proof. + unfold L1Norm. + intros x y Hxy. + rewrite Hxy. + reflexivity. Qed. -Add Morphism L1Distance +Add Morphism L1Distance with signature (@StepF_eq _) ==> (@StepF_eq _) ==> Qeq as L1Distance_wd. -unfold L1Distance. -intros x1 x2 Hx y1 y2 Hy. -rewrite Hx. -rewrite Hy. -reflexivity. +Proof. + unfold L1Distance. + intros x1 x2 Hx y1 y2 Hy. + rewrite Hx. + rewrite Hy. + reflexivity. Qed. Hint Rewrite Integral_glue: StepF_rew. @@ -156,282 +160,275 @@ functions. *) Lemma Integral_plus:forall s t, ((IntegralQ s)+(IntegralQ t)==(IntegralQ (s + t)))%Q. Proof. -apply StepF_ind2; try reflexivity. - intros s s0 t t0 Hs Ht. - rewrite Hs Ht; auto. -intros o s s0 t t0 H0 H1. -unfold StepQplus. -rewriteStepF. -replace LHS - with (o*(IntegralQ s + IntegralQ t) + (1-o)*(IntegralQ s0 + IntegralQ t0))%Q - by ring. -rewrite H0 H1. -reflexivity. + apply StepF_ind2; try reflexivity. + intros s s0 t t0 Hs Ht. + rewrite Hs Ht; auto. + intros o s s0 t t0 H0 H1. + unfold StepQplus. + rewriteStepF. + replace LHS with (o*(IntegralQ s + IntegralQ t) + (1-o)*(IntegralQ s0 + IntegralQ t0))%Q by ring. + rewrite H0 H1. + reflexivity. Qed. Lemma Integral_opp:forall s, (-(IntegralQ s)==(IntegralQ (- s)))%Q. Proof. -induction s using StepF_ind. - reflexivity. -unfold StepQopp in *. -rewriteStepF. -rewrite <- IHs1. -rewrite <- IHs2. -ring. + induction s using StepF_ind. + reflexivity. + unfold StepQopp in *. + rewriteStepF. + rewrite <- IHs1. + rewrite <- IHs2. + ring. Qed. Lemma Integral_minus:forall s t, ((IntegralQ s)-(IntegralQ t)==(IntegralQ (s - t)))%Q. Proof. -intros s t. -unfold Qminus. -rewrite Integral_opp Integral_plus. -apply IntegralQ_wd. -ring. + intros s t. + unfold Qminus. + rewrite Integral_opp Integral_plus. + apply IntegralQ_wd. + ring. Qed. -Lemma Integral_scale :forall q x, +Lemma Integral_scale :forall q x, (q*(IntegralQ x) == (IntegralQ (QscaleS q^@>x)))%Q. Proof. -intros q x. -induction x using StepF_ind. - reflexivity. -rewriteStepF. -rewrite <- IHx1. -rewrite <- IHx2. -ring. + intros q x. + induction x using StepF_ind. + reflexivity. + rewriteStepF. + rewrite <- IHx1. + rewrite <- IHx2. + ring. Qed. Lemma Abs_Integral : forall x, (Qabs (IntegralQ x) <= IntegralQ (QabsS ^@> x))%Q. Proof. -intros x. -induction x using StepF_ind. - apply Qle_refl. -rewriteStepF. -eapply Qle_trans. -apply Qabs_triangle. -do 2 rewrite Qabs_Qmult. -rewrite (Qabs_pos o); auto with *. -rewrite (Qabs_pos (1-o)); auto with *. -apply: plus_resp_leEq_both;simpl; - apply: mult_resp_leEq_lft; simpl; auto with *. + intros x. + induction x using StepF_ind. + apply Qle_refl. + rewriteStepF. + eapply Qle_trans. + apply Qabs_triangle. + do 2 rewrite Qabs_Qmult. + rewrite (Qabs_pos o); auto with *. + rewrite (Qabs_pos (1-o)); auto with *. + apply: plus_resp_leEq_both;simpl; apply: mult_resp_leEq_lft; simpl; auto with *. Qed. Lemma Abs_Integral_Norm : forall x, (Qabs (IntegralQ x) <= L1Norm x)%Q. Proof. -exact Abs_Integral. + exact Abs_Integral. Qed. (** The integral of a nonnegative function is nonnegative. *) -Lemma Integral_resp_nonneg :forall x, +Lemma Integral_resp_nonneg :forall x, (constStepF (0:QS)) <= x -> (0 <= (IntegralQ x))%Q. Proof. -intros x. -unfold StepQ_le. -rewriteStepF. -induction x using StepF_ind. - auto. -rewriteStepF. -intros [Hxl Hxr]. -apply: plus_resp_nonneg; - apply: mult_resp_nonneg; simpl; auto with *. + intros x. + unfold StepQ_le. + rewriteStepF. + induction x using StepF_ind. + auto. + rewriteStepF. + intros [Hxl Hxr]. + apply: plus_resp_nonneg; apply: mult_resp_nonneg; simpl; auto with *. Qed. -Lemma Integral_resp_le :forall x y, +Lemma Integral_resp_le :forall x y, x <= y -> (IntegralQ x <= IntegralQ y)%Q. Proof. -intros x y H. -rewrite Qle_minus_iff. -rewrite Integral_opp Integral_plus. -apply Integral_resp_nonneg. -revert H. -apply StepF_imp_imp. -unfold StepF_imp. -rewriteStepF. -set (g:= QleS 0). -pose (f:=(ap - (compose (@ap _ _ _) (compose (compose imp) QleS)) - (compose (compose g) (compose (flip QplusS) QoppS)))). -cut (StepFfoldProp (f ^@> x <@> y)). - unfold f. - evalStepF. + intros x y H. + rewrite Qle_minus_iff. + rewrite Integral_opp Integral_plus. + apply Integral_resp_nonneg. + revert H. + apply StepF_imp_imp. + unfold StepF_imp. + rewriteStepF. + set (g:= QleS 0). + pose (f:=(ap (compose (@ap _ _ _) (compose (compose imp) QleS)) + (compose (compose g) (compose (flip QplusS) QoppS)))). + cut (StepFfoldProp (f ^@> x <@> y)). + unfold f. + evalStepF. + tauto. + apply StepFfoldPropForall_Map2. + intros a b. + change (a <= b -> 0 <= b + (- a))%Q. + rewrite Qle_minus_iff. tauto. -apply StepFfoldPropForall_Map2. -intros a b. -change (a <= b -> 0 <= b + (- a))%Q. -rewrite Qle_minus_iff. -tauto. Qed. (** Properties of the L1 norm. *) Lemma L1Norm_glue : forall o s t, (L1Norm (glue o s t) == o*L1Norm s + (1-o)*L1Norm t)%Q. Proof. -intros o s t. -unfold L1Norm. -rewrite <- Integral_glue. -reflexivity. + intros o s t. + unfold L1Norm. + rewrite <- Integral_glue. + reflexivity. Qed. Lemma L1Norm_nonneg : forall x, (0 <= (L1Norm x))%Q. Proof. -intros x. -apply Integral_resp_nonneg. -unfold StepQ_le. -rewriteStepF. -set (g:=QleS 0). -cut (StepFfoldProp ((compose g QabsS) ^@> x)). - evalStepF. - tauto. -apply StepFfoldPropForall_Map. -intros a. -apply: Qabs_nonneg. + intros x. + apply Integral_resp_nonneg. + unfold StepQ_le. + rewriteStepF. + set (g:=QleS 0). + cut (StepFfoldProp ((compose g QabsS) ^@> x)). + evalStepF. + tauto. + apply StepFfoldPropForall_Map. + intros a. + apply: Qabs_nonneg. Qed. -Lemma L1Norm_Zero : forall s, +Lemma L1Norm_Zero : forall s, (L1Norm s <= 0)%Q -> s == (constStepF (0:QS)). Proof. -intros s. -intros Hs. -induction s using StepF_ind. - apply: Qle_antisym. - eapply Qle_trans;[apply Qle_Qabs|assumption]. - rewrite <- (Qopp_involutive x). - change 0 with (- (- 0))%Q. - apply Qopp_le_compat. - eapply Qle_trans;[apply Qle_Qabs|]. - rewrite Qabs_opp. - assumption. -unfold L1Norm, StepQabs in *. -rewrite MapGlue in Hs. -rewrite -> Integral_glue in Hs. -apply glue_StepF_eq. - apply IHs1. + intros s. + intros Hs. + induction s using StepF_ind. + apply: Qle_antisym. + eapply Qle_trans;[apply Qle_Qabs|assumption]. + rewrite <- (Qopp_involutive x). + change 0 with (- (- 0))%Q. + apply Qopp_le_compat. + eapply Qle_trans;[apply Qle_Qabs|]. + rewrite Qabs_opp. + assumption. + unfold L1Norm, StepQabs in *. + rewrite MapGlue in Hs. + rewrite -> Integral_glue in Hs. + apply glue_StepF_eq. + apply IHs1. + unfold L1Norm. + setoid_replace 0 with (0/o) by (field; auto with *). + apply Qle_shift_div_l; auto with *. + rewrite Qmult_comm. + apply Qle_trans with (-((1 - o) * IntegralQ (QabsS ^@> s2)))%Q. + rewrite Qle_minus_iff. + rewrite -> Qle_minus_iff in Hs. + replace RHS with (0 + + - (o * IntegralQ (QabsS ^@> s1) + (1 - o) * IntegralQ (QabsS ^@> s2)))%Q by ring. + assumption. + change 0 with (-0)%Q. + apply Qopp_le_compat. + apply: mult_resp_nonneg; simpl; auto with *. + apply: L1Norm_nonneg. + apply IHs2. unfold L1Norm. - setoid_replace 0 with (0/o) by (field; auto with *). + setoid_replace 0 with (0/(1-o)) by (field; auto with *). apply Qle_shift_div_l; auto with *. rewrite Qmult_comm. - apply Qle_trans with (-((1 - o) * IntegralQ (QabsS ^@> s2)))%Q. + apply Qle_trans with (-(o * IntegralQ (QabsS ^@> s1)))%Q. rewrite Qle_minus_iff. rewrite -> Qle_minus_iff in Hs. replace RHS with (0 + - - (o * IntegralQ (QabsS ^@> s1) + (1 - o) * IntegralQ (QabsS ^@> s2)))%Q by ring. + - (o * IntegralQ (QabsS ^@> s1) + (1 - o) * IntegralQ (QabsS ^@> s2)))%Q by ring. assumption. change 0 with (-0)%Q. apply Qopp_le_compat. apply: mult_resp_nonneg; simpl; auto with *. - apply: L1Norm_nonneg. -apply IHs2. -unfold L1Norm. -setoid_replace 0 with (0/(1-o)) by (field; auto with *). -apply Qle_shift_div_l; auto with *. -rewrite Qmult_comm. -apply Qle_trans with (-(o * IntegralQ (QabsS ^@> s1)))%Q. - rewrite Qle_minus_iff. - rewrite -> Qle_minus_iff in Hs. - replace RHS with (0 + - - (o * IntegralQ (QabsS ^@> s1) + (1 - o) * IntegralQ (QabsS ^@> s2)))%Q by ring. - assumption. -change 0 with (-0)%Q. -apply Qopp_le_compat. -apply: mult_resp_nonneg; simpl; auto with *. -apply L1Norm_nonneg. + apply L1Norm_nonneg. Qed. -Lemma L1Norm_scale : forall q s, +Lemma L1Norm_scale : forall q s, (L1Norm (QscaleS q ^@> s) == Qabs q * L1Norm s)%Q. Proof. -intros q s. -unfold L1Norm. -rewrite Integral_scale. -apply IntegralQ_wd. -unfold StepF_eq. -set (g:= st_eqS QS). -set (q0 := (QscaleS q)). -set (q1 := (QscaleS (Qabs q))). -set (f:= ap - (compose g (compose QabsS q0)) - (compose q1 QabsS)). -cut (StepFfoldProp (f ^@> s)). - unfold f. - evalStepF. - tauto. -apply StepFfoldPropForall_Map. -intros a. -apply: Qabs_Qmult. + intros q s. + unfold L1Norm. + rewrite Integral_scale. + apply IntegralQ_wd. + unfold StepF_eq. + set (g:= st_eqS QS). + set (q0 := (QscaleS q)). + set (q1 := (QscaleS (Qabs q))). + set (f:= ap (compose g (compose QabsS q0)) (compose q1 QabsS)). + cut (StepFfoldProp (f ^@> s)). + unfold f. + evalStepF. + tauto. + apply StepFfoldPropForall_Map. + intros a. + apply: Qabs_Qmult. Qed. (** L1 ball has all the required properties. *) Lemma L1ball_refl : forall e x, (L1Ball e x x). Proof. -intros e x. -unfold L1Ball, L1Distance. -setoid_replace (x-x) with (constStepF (0:QS)) by ring. -change (0 <= e)%Q. -auto with *. + intros e x. + unfold L1Ball, L1Distance. + setoid_replace (x-x) with (constStepF (0:QS)) by ring. + change (0 <= e)%Q. + auto with *. Qed. Lemma L1ball_sym : forall e x y, (L1Ball e x y) -> (L1Ball e y x). Proof. -intros e x y. -unfold L1Ball, L1Distance. -unfold L1Norm. -setoid_replace (x-y) with (-(y-x)) by ring. -rewrite StepQabsOpp. -auto. + intros e x y. + unfold L1Ball, L1Distance. + unfold L1Norm. + setoid_replace (x-y) with (-(y-x)) by ring. + rewrite StepQabsOpp. + auto. Qed. Lemma L1ball_triangle : forall e d x y z, (L1Ball e x y) -> (L1Ball d y z) -> (L1Ball (e+d) x z). Proof. -intros e d x y z. -unfold L1Ball, L1Distance. -unfold L1Norm. -setoid_replace (x-z) with ((x-y)+(y-z)) by ring. -intros He Hd. -autorewrite with QposElim. -apply Qle_trans with (IntegralQ (StepQabs (x-y) + StepQabs (y-z)))%Q. - apply Integral_resp_le. - apply StepQabs_triangle. -rewrite <- Integral_plus. -apply: plus_resp_leEq_both; assumption. + intros e d x y z. + unfold L1Ball, L1Distance. + unfold L1Norm. + setoid_replace (x-z) with ((x-y)+(y-z)) by ring. + intros He Hd. + autorewrite with QposElim. + apply Qle_trans with (IntegralQ (StepQabs (x-y) + StepQabs (y-z)))%Q. + apply Integral_resp_le. + apply StepQabs_triangle. + rewrite <- Integral_plus. + apply: plus_resp_leEq_both; assumption. Qed. Lemma L1ball_closed : forall e x y, (forall d, (L1Ball (e+d) x y)) -> (L1Ball e x y). Proof. -unfold L1Ball. intros e a b H. -assert (forall x, (forall d : Qpos, x <= e+d) -> x <= e)%Q. - intros. apply: shift_zero_leEq_minus'. - apply inv_cancel_leEq. apply approach_zero_weak. - intros. replace LHS with (x[-](e:Q)). + unfold L1Ball. intros e a b H. + assert (forall x, (forall d : Qpos, x <= e+d) -> x <= e)%Q. + intros. apply: shift_zero_leEq_minus'. + apply inv_cancel_leEq. apply approach_zero_weak. + intros. replace LHS with (x[-](e:Q)). apply: shift_minus_leEq;simpl. replace RHS with (e+e0)%Q by ring. rewrite <- (QposAsmkQpos X). - apply (H0 (mkQpos X)). - unfold cg_minus; simpl; ring. -apply H0. exact H. + apply (H0 (mkQpos X)). + unfold cg_minus; simpl; ring. + apply H0. exact H. Qed. Lemma L1ball_eq : forall x y, (forall e : Qpos, L1Ball e x y) -> StepF_eq x y. Proof. -intros x y H. -unfold L1Ball in H. -setoid_replace y with (constStepF (0:QS)+y) by ring. -set (z:=constStepF (0:QS)). -setoid_replace x with (x - y + y) by ring. -apply StepQplus_wd; try reflexivity. -unfold z; clear z. -apply L1Norm_Zero. -apply Qnot_lt_le. -intro H0. -assert (H1:0<(1#2)*( L1Norm (QminusS ^@> x <@> y))). - apply: mult_resp_pos; simpl; auto with *. -apply: (Qle_not_lt _ _ (H (mkQpos H1))). -autorewrite with QposElim. -rewrite -> Qlt_minus_iff. -unfold L1Distance. -unfold StepQminus. -ring_simplify. -assumption. + intros x y H. + unfold L1Ball in H. + setoid_replace y with (constStepF (0:QS)+y) by ring. + set (z:=constStepF (0:QS)). + setoid_replace x with (x - y + y) by ring. + apply StepQplus_wd; try reflexivity. + unfold z; clear z. + apply L1Norm_Zero. + apply Qnot_lt_le. + intro H0. + assert (H1:0<(1#2)*( L1Norm (QminusS ^@> x <@> y))). + apply: mult_resp_pos; simpl; auto with *. + apply: (Qle_not_lt _ _ (H (mkQpos H1))). + autorewrite with QposElim. + rewrite -> Qlt_minus_iff. + unfold L1Distance. + unfold StepQminus. + ring_simplify. + assumption. Qed. Definition L1S : Setoid := Build_Setoid (StepF_Sth QS). @@ -441,24 +438,26 @@ Canonical Structure L1S. (** *** Example of a Metric Space *) -Lemma L1_is_MetricSpace : +Lemma L1_is_MetricSpace : (is_MetricSpace L1S L1Ball). -split. - apply: L1ball_refl. - apply: L1ball_sym. - apply: L1ball_triangle. - apply: L1ball_closed. -apply: L1ball_eq. +Proof. + split. + apply: L1ball_refl. + apply: L1ball_sym. + apply: L1ball_triangle. + apply: L1ball_closed. + apply: L1ball_eq. Qed. (* begin hide *) Add Morphism L1Ball with signature QposEq ==> (@StepF_eq _) ==> (@StepF_eq _) ==> iff as L1Ball_wd. -intros x1 x2 Hx y1 y2 Hy z1 z2 Hz. -unfold L1Ball. -change (x1 == x2)%Q in Hx. -rewrite Hx. -rewrite Hy. -rewrite Hz. -reflexivity. +Proof. + intros x1 x2 Hx y1 y2 Hy z1 z2 Hz. + unfold L1Ball. + change (x1 == x2)%Q in Hx. + rewrite Hx. + rewrite Hy. + rewrite Hz. + reflexivity. Qed. (* end hide *) Definition L1StepQ : MetricSpace := @@ -469,72 +468,66 @@ Canonical Structure L1StepQ. (** The L1 metric is a prelength space. *) Lemma L1StepQPrelengthSpace : PrelengthSpace L1StepQ. Proof. -intros x y e d1 d2 He Hxy. -change (e < (d1+d2)%Qpos) in He. -set (d:=(d1+d2)%Qpos) in *. -simpl in *. -unfold L1Ball in *. -unfold L1Distance in *. -pose (d1':=constStepF (d1:QS)). -pose (d2':=constStepF (d2:QS)). -pose (d':=constStepF ((/d):QS)). -set (f:=(d'*(x*d2' + y*d1'))%SQ). -assert (X:(((d1' + d2')*d')==constStepF (1:QS))%SQ). - change (constStepF ((d1 + d2)%Qpos/(d1 + d2)%Qpos:QS)==constStepF (X:=QS) 1). - apply constStepF_wd. - simpl. - field. - apply Qpos_nonzero. -exists (f). - setoid_replace (x - f)%SQ - with (d1' * d' * (x - y))%SQ. - change ((d1' * d')%SQ * (x - y)%SQ) with - (QscaleS (d1/d)%Qpos ^@> (x-y)%SQ). + intros x y e d1 d2 He Hxy. + change (e < (d1+d2)%Qpos) in He. + set (d:=(d1+d2)%Qpos) in *. + simpl in *. + unfold L1Ball in *. + unfold L1Distance in *. + pose (d1':=constStepF (d1:QS)). + pose (d2':=constStepF (d2:QS)). + pose (d':=constStepF ((/d):QS)). + set (f:=(d'*(x*d2' + y*d1'))%SQ). + assert (X:(((d1' + d2')*d')==constStepF (1:QS))%SQ). + change (constStepF ((d1 + d2)%Qpos/(d1 + d2)%Qpos:QS)==constStepF (X:=QS) 1). + apply constStepF_wd. + simpl. + field. + apply Qpos_nonzero. + exists (f). + setoid_replace (x - f)%SQ with (d1' * d' * (x - y))%SQ. + change ((d1' * d')%SQ * (x - y)%SQ) with (QscaleS (d1/d)%Qpos ^@> (x-y)%SQ). + rewrite L1Norm_scale. + rewrite Qabs_pos; auto with *. + autorewrite with QposElim. + replace LHS with ((d1*L1Norm (x - y))/d) by (field; apply Qpos_nonzero). + apply Qle_shift_div_r; auto with *. + apply: mult_resp_leEq_lft; simpl; auto with *. + apply Qle_trans with e; auto with *. + setoid_replace (x - f) with (constStepF (1:QS)*x - f) by ring. + rewrite <- X. + unfold f. + ring. + setoid_replace (f -y) with (d2' * d' * (x - y))%SQ. + change ((d2' * d')%SQ * (x - y)%SQ) with (QscaleS (d2/d)%Qpos ^@> (x-y)%SQ). rewrite L1Norm_scale. rewrite Qabs_pos; auto with *. autorewrite with QposElim. - replace LHS with ((d1*L1Norm (x - y))/d) by - (field; apply Qpos_nonzero). + replace LHS with ((d2*L1Norm (x - y))/d) by (field; apply Qpos_nonzero). apply Qle_shift_div_r; auto with *. - apply: mult_resp_leEq_lft; simpl; auto with *. + apply: mult_resp_leEq_lft; simpl;auto with *. apply Qle_trans with e; auto with *. - setoid_replace (x - f) with (constStepF (1:QS)*x - f) by ring. + setoid_replace (f- y) with (f - constStepF (1:QS)*y) by ring. rewrite <- X. unfold f. ring. -setoid_replace (f -y) - with (d2' * d' * (x - y))%SQ. - change ((d2' * d')%SQ * (x - y)%SQ) with - (QscaleS (d2/d)%Qpos ^@> (x-y)%SQ). - rewrite L1Norm_scale. - rewrite Qabs_pos; auto with *. - autorewrite with QposElim. - replace LHS with ((d2*L1Norm (x - y))/d) by - (field; apply Qpos_nonzero). - apply Qle_shift_div_r; auto with *. - apply: mult_resp_leEq_lft; simpl;auto with *. - apply Qle_trans with e; auto with *. -setoid_replace (f- y) with (f - constStepF (1:QS)*y) by ring. -rewrite <- X. -unfold f. -ring. Qed. (** Integration is uniformly continuous. *) Lemma integral_uc_prf : is_UniformlyContinuousFunction IntegralQ Qpos2QposInf. Proof. -intros e x y. -simpl in *. -rewrite Qball_Qabs. -rewrite Integral_minus. -unfold L1Ball, L1Distance. -generalize (x - y). -clear x y. -intros x. -intros Hx. -eapply Qle_trans. - apply Abs_Integral_Norm. -assumption. + intros e x y. + simpl in *. + rewrite Qball_Qabs. + rewrite Integral_minus. + unfold L1Ball, L1Distance. + generalize (x - y). + clear x y. + intros x. + intros Hx. + eapply Qle_trans. + apply Abs_Integral_Norm. + assumption. Qed. Open Local Scope uc_scope. diff --git a/model/metric2/LinfDistMonad.v b/model/metric2/LinfDistMonad.v index d3fa73403..61a81a629 100644 --- a/model/metric2/LinfDistMonad.v +++ b/model/metric2/LinfDistMonad.v @@ -1,5 +1,5 @@ (* -Copyright © 2007-2008 +Copyright © 2007-2008 Russell O’Connor Bas Spitters @@ -29,7 +29,7 @@ Require Export StepFunctionSetoid. Require Import Qauto. (** ** Completion distributes over Step Functions -We prove the that StepF distributes over Complete using the function +We prove the that StepF distributes over Complete using the function swap (which we call dist) as in Jones, Duponcheel - composing monads *) Set Implicit Arguments. @@ -38,7 +38,7 @@ Open Local Scope Q_scope. Open Local Scope sfstscope. Section Dist. -(* M= Complete, N= StepF +(* M= Complete, N= StepF dist = distribComplete*) Open Local Scope sfstscope. Variable X: MetricSpace. @@ -50,74 +50,75 @@ Definition dist_raw (x:StepFSup (Complete X)) (e:QposInf): (StepFSup X):= Lemma dist_prf : forall (x:StepFSup (Complete X)), is_RegularFunction (dist_raw x). Proof. -unfold dist_raw. -intros x a b. -induction x using StepF_ind. -apply: regFun_prf. -simpl (ball (m:=StepFSup X)). -set (f:=(fun z : RegularFunction X => approximate z a)) in *. -set (g:=(fun z : RegularFunction X => approximate z b)) in *. -simpl. -fold (glue o (Map f x1) (Map f x2)). -fold (glue o (Map g x1) (Map g x2)). -setoid_rewrite (StepFSupBallGlueGlue). -auto. + unfold dist_raw. + intros x a b. + induction x using StepF_ind. + apply: regFun_prf. + simpl (ball (m:=StepFSup X)). + set (f:=(fun z : RegularFunction X => approximate z a)) in *. + set (g:=(fun z : RegularFunction X => approximate z b)) in *. + simpl. + fold (glue o (Map f x1) (Map f x2)). + fold (glue o (Map g x1) (Map g x2)). + setoid_rewrite (StepFSupBallGlueGlue). + auto. Qed. Definition dist1 (x:StepFSup (Complete X)): (Complete (StepFSup X)). -intro x. exists (dist_raw x). -abstract (apply (dist_prf x)). +Proof. + intro x. exists (dist_raw x). + abstract (apply (dist_prf x)). Defined. Add Morphism dist1 with signature (@st_eq _) ==> (@st_eq _) as dist1_wd. -induction x. - induction y. +Proof. + induction x. + induction y. + intros H d1 d2. + apply: H. intros H d1 d2. - apply: H. - intros H d1 d2. - destruct H. - split. - apply IHy1; assumption. - apply IHy2; assumption. -intros y H d1 d2. -simpl. -unfold dist_raw. -simpl. -destruct H as [Hl Hr] using (glue_eq_ind x1 x2 y o). -rewrite <- (glueSplit (Map (fun z : RegularFunction X => approximate z d2) y) o). -unfold SplitL, SplitR. + destruct H. + split. + apply IHy1; assumption. + apply IHy2; assumption. + intros y H d1 d2. + simpl. + unfold dist_raw. + simpl. + destruct H as [Hl Hr] using (glue_eq_ind x1 x2 y o). + rewrite <- (glueSplit (Map (fun z : RegularFunction X => approximate z d2) y) o). + unfold SplitL, SplitR. rewrite StepFunction.SplitLMap StepFunction.SplitRMap. -fold (glue o (Map (fun z : RegularFunction X => approximate z d1) x1) - (Map (fun z : RegularFunction X => approximate z d1) x2)). -rewrite StepFSupBallGlueGlue. -split; revert d1 d2. - apply: IHx1; assumption. -apply: IHx2; assumption. + fold (glue o (Map (fun z : RegularFunction X => approximate z d1) x1) + (Map (fun z : RegularFunction X => approximate z d1) x2)). + rewrite StepFSupBallGlueGlue. + split; revert d1 d2. + apply: IHx1; assumption. + apply: IHx2; assumption. Qed. Lemma dist1_uc : is_UniformlyContinuousFunction dist1 Qpos2QposInf. Proof. -intros e. -apply: StepF_ind2. - simpl (ball_ex). - intros s s0 t t0 Hs Ht H. - rewrite <- Hs, <- Ht. + intros e. + apply: StepF_ind2. + simpl (ball_ex). + intros s s0 t t0 Hs Ht H. + rewrite <- Hs, <- Ht. + assumption. + intros. assumption. - intros. - assumption. -intros o s s0 t t0 Hl Hr H d1 d2. -simpl. -unfold dist_raw. -simpl. -fold (glue o (Map (fun z : RegularFunction X => approximate z d1) s) - (Map (fun z : RegularFunction X => approximate z d1) s0)). -fold (glue o - (Map (fun z : RegularFunction X => approximate z d2) t) - (Map (fun z : RegularFunction X => approximate z d2) t0)). -simpl in *. -rewrite -> StepFSupBallGlueGlue in H |- *. -split; revert d1 d2; tauto. + intros o s s0 t t0 Hl Hr H d1 d2. + simpl. + unfold dist_raw. + simpl. + fold (glue o (Map (fun z : RegularFunction X => approximate z d1) s) + (Map (fun z : RegularFunction X => approximate z d1) s0)). + fold (glue o (Map (fun z : RegularFunction X => approximate z d2) t) + (Map (fun z : RegularFunction X => approximate z d2) t0)). + simpl in *. + rewrite -> StepFSupBallGlueGlue in H |- *. + split; revert d1 d2; tauto. Qed. Open Local Scope uc_scope. @@ -125,78 +126,69 @@ Open Local Scope sfstscope. Open Local Scope sfscope. Definition dist: (StepFSup (Complete X))-->(Complete (StepFSup X)). -apply (@Build_UniformlyContinuousFunction _ _ dist1 (fun e => e)). -abstract (exact dist1_uc). +Proof. + apply (@Build_UniformlyContinuousFunction _ _ dist1 (fun e => e)). + abstract (exact dist1_uc). Defined. End Dist. Implicit Arguments dist [X]. Definition distconst(X : MetricSpace):(Complete X)->Complete (StepFSup X). -intros X0 x. exists (fun e => (constStepF (approximate x e ))). -abstract (intros e1 e2; simpl; unfold StepFSupBall, StepFfoldProp; -simpl; apply x). +Proof. + intros X0 x. exists (fun e => (constStepF (approximate x e ))). + abstract (intros e1 e2; simpl; unfold StepFSupBall, StepFfoldProp; simpl; apply x). Defined. Lemma distConst(X : MetricSpace):forall (x:Complete X), (st_eq (dist (constStepF x)) (distconst x)). -intros. intros e1 e2. simpl. unfold dist_raw. simpl. -unfold StepFSupBall, StepFfoldProp;simpl; apply x. +Proof. + intros. intros e1 e2. simpl. unfold dist_raw. simpl. + unfold StepFSupBall, StepFfoldProp;simpl; apply x. Qed. Lemma dist_glue(X:MetricSpace)(o:OpenUnit): forall (x y:(StepFSup (Complete X))), (st_eq (dist (glue o x y)) (Cmap2_slow (glue_uc _ o) (dist x) (dist y))). -intros. simpl. intros e e1. simpl. -unfold dist_raw. simpl. -unfold Cmap_slow_fun. simpl. -unfold Cap_slow_raw. simpl. -unfold dist_raw. -fold - (glue o - (Map (fun z : RegularFunction X => approximate z e) x) - (Map (fun z : RegularFunction X => approximate z e) y)). -rewrite StepFSupBallGlueGlue. -assert (forall w:StepF (Complete X), StepFSupBall (X:=X) (e + e1) - (Map (fun z : RegularFunction X => approximate z e) w) - (Map - (fun z : RegularFunction X => - approximate z ((1 # 2) * ((1 # 2) * e1))%Qpos) w)). -induction w using StepF_ind. - unfold StepFSupBall. unfold StepFfoldProp. simpl. -rewrite <- ball_Cunit. -apply ball_triangle with x0. -apply ball_approx_l. -apply ball_weak_le with ((1 # 2) * ((1 # 2) * e1))%Qpos. -rewrite Qle_minus_iff. -replace RHS with (e1 - (1#2)*(1#2)*e1). -replace RHS with ((3#4)*e1) by ring. -Qauto_nonneg. auto with *. - apply ball_approx_r. -simpl. -change (StepFSupBall (X:=X) (e + e1) - (glue o0 - (Map (fun z : RegularFunction X => approximate z e) w1) - (Map (fun z : RegularFunction X => approximate z e) w2)) - (glue o0 - (Map - (fun z : RegularFunction X => - approximate z ((1 # 2) * ((1 # 2) * e1))%Qpos) w1) - (Map - (fun z : RegularFunction X => - approximate z ((1 # 2) * ((1 # 2) * e1))%Qpos) w2))). -rewrite StepFSupBallGlueGlue. -intuition. - -split;auto. +Proof. + intros. simpl. intros e e1. simpl. + unfold dist_raw. simpl. + unfold Cmap_slow_fun. simpl. + unfold Cap_slow_raw. simpl. + unfold dist_raw. + fold (glue o (Map (fun z : RegularFunction X => approximate z e) x) + (Map (fun z : RegularFunction X => approximate z e) y)). + rewrite StepFSupBallGlueGlue. + assert (forall w:StepF (Complete X), StepFSupBall (X:=X) (e + e1) + (Map (fun z : RegularFunction X => approximate z e) w) (Map (fun z : RegularFunction X => + approximate z ((1 # 2) * ((1 # 2) * e1))%Qpos) w)). + induction w using StepF_ind. + unfold StepFSupBall. unfold StepFfoldProp. simpl. + rewrite <- ball_Cunit. + apply ball_triangle with x0. + apply ball_approx_l. + apply ball_weak_le with ((1 # 2) * ((1 # 2) * e1))%Qpos. + rewrite Qle_minus_iff. + replace RHS with (e1 - (1#2)*(1#2)*e1). + replace RHS with ((3#4)*e1) by ring. + Qauto_nonneg. auto with *. + apply ball_approx_r. + simpl. + change (StepFSupBall (X:=X) (e + e1) (glue o0 (Map (fun z : RegularFunction X => approximate z e) w1) + (Map (fun z : RegularFunction X => approximate z e) w2)) (glue o0 (Map + (fun z : RegularFunction X => approximate z ((1 # 2) * ((1 # 2) * e1))%Qpos) w1) (Map + (fun z : RegularFunction X => approximate z ((1 # 2) * ((1 # 2) * e1))%Qpos) w2))). + rewrite StepFSupBallGlueGlue. + intuition. + split;auto. Qed. Section DistributionLaws. (** Now we show the laws for dist are satified, except for the last one which we have not completed yet. *) -(* M= Complete, N= StepF +(* M= Complete, N= StepF dist = distribComplete*) -(* +(* prod≔mapM joinN . distN mapM joinN: MNN-> MN distN: NMN -> MNN *) @@ -216,46 +208,32 @@ NM->NM->MN = NM -> MN ->MN*) Lemma distmapmap: forall X Y (f : UniformlyContinuousSpace X Y), (ucEq (uc_compose (dist) (Map_uc (@Cmap_slow _ _ f))) (uc_compose (Cmap_slow (Map_uc f)) (dist))). -intros. -intro x. -induction x using StepF_ind. - intros e e1. simpl. - unfold dist_raw. simpl. - change (ballS Y (e + e1) (Cmap_slow_raw f x e) - (f (approximate x - (QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e1))))). - unfold Cmap_slow_raw. simpl. - set (ee:=(QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e))). - set (ee1:=(QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e1))). - rewrite <- ball_Cunit. - assert (H:ball (m:=(Complete Y)) (e + e1) - ((Cmap_slow f) (Cunit (approximate x ee))) ((Cmap_slow f) (Cunit (approximate x ee1)))). +Proof. + intros. + intro x. + induction x using StepF_ind. + intros e e1. simpl. + unfold dist_raw. simpl. + change (ballS Y (e + e1) (Cmap_slow_raw f x e) (f (approximate x + (QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e1))))). + unfold Cmap_slow_raw. simpl. + set (ee:=(QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e))). + set (ee1:=(QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e1))). + rewrite <- ball_Cunit. + assert (H:ball (m:=(Complete Y)) (e + e1) + ((Cmap_slow f) (Cunit (approximate x ee))) ((Cmap_slow f) (Cunit (approximate x ee1)))). apply ball_triangle with (Cmap_slow f x);apply: (uc_prf (Cmap_slow f));[apply: ball_ex_approx_l|apply: ball_ex_approx_r]. - apply H. -intros e1 e2. simpl. unfold dist_raw. simpl. -(* Why do we need to fold glue??*) -change -(StepFSupBall (X:=Y) (e1 + e2) - (glue o - (Map (fun z : RegularFunction Y => approximate z e1) - (Map (Cmap_slow_fun f) x1)) - (Map (fun z : RegularFunction Y => approximate z e1) - (Map (Cmap_slow_fun f) x2))) - (glue o - (Map f - (Map - (fun z : RegularFunction X => - approximate z - (QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e2))) - x1)) - (Map f - (Map - (fun z : RegularFunction X => - approximate z - (QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e2))) - x2)))). -rewrite (@StepFSupBallGlueGlue Y (e1+e2) o). -split; [apply IHx1|apply IHx2]. + apply H. + intros e1 e2. simpl. unfold dist_raw. simpl. + (* Why do we need to fold glue??*) + change (StepFSupBall (X:=Y) (e1 + e2) (glue o (Map (fun z : RegularFunction Y => approximate z e1) + (Map (Cmap_slow_fun f) x1)) (Map (fun z : RegularFunction Y => approximate z e1) + (Map (Cmap_slow_fun f) x2))) (glue o (Map f (Map (fun z : RegularFunction X => approximate z + (QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e2))) x1)) (Map f (Map + (fun z : RegularFunction X => approximate z + (QposInf_bind (fun y' : Qpos => ((1 # 2) * y')%Qpos) (mu f e2))) x2)))). + rewrite (@StepFSupBallGlueGlue Y (e1+e2) o). + split; [apply IHx1|apply IHx2]. Qed. (* dist . returnM≍mapM returnN*) @@ -264,50 +242,48 @@ Lemma distreturn: forall X, (uc_compose dist (StFReturn_uc _)) (@Cmap_slow _ _ (StFReturn_uc X))). Proof. -intros X x. simpl. -unfold StFReturn_uc. -intros e e1. simpl. unfold dist_raw. simpl. -unfold StepFSupBall. -(* From here onwards the proof is too difficult *) -change (ballS X (e + e1) (approximate x e) -(approximate x ((1 # 2) * e1)%Qpos)). -simpl. -apply ball_weak_le with (Qpos_plus e ((1 # 2) * e1)%Qpos). -2: apply (regFun_prf_ex x e ((1 # 2) * e1)%Qpos). -rewrite Qle_minus_iff. -replace RHS with (e1 - (1#2)*e1). -replace RHS with ((1#2)*e1) by ring. -Qauto_nonneg. replace LHS with ((e + e1)+ - (e + (1 # 2) * e1)). -ring. reflexivity. Qed. + intros X x. simpl. + unfold StFReturn_uc. + intros e e1. simpl. unfold dist_raw. simpl. + unfold StepFSupBall. + (* From here onwards the proof is too difficult *) + change (ballS X (e + e1) (approximate x e) (approximate x ((1 # 2) * e1)%Qpos)). + simpl. + apply ball_weak_le with (Qpos_plus e ((1 # 2) * e1)%Qpos). + 2: apply (regFun_prf_ex x e ((1 # 2) * e1)%Qpos). + rewrite Qle_minus_iff. + replace RHS with (e1 - (1#2)*e1). + replace RHS with ((1#2)*e1) by ring. + Qauto_nonneg. replace LHS with ((e + e1)+ - (e + (1 # 2) * e1)). + ring. reflexivity. Qed. (*dist . mapN returnM≍returnM*) Lemma distmapret: forall X, (ucEq (uc_compose dist -(@Map_uc _ _ (@Cunit X))) +(@Map_uc _ _ (@Cunit X))) (@Cunit (StepFSup X))). -intros X x e1 e2. simpl. -unfold dist_raw. -unfold StepFSupBall. -setoid_replace ( -Map (fun z : RegularFunction X => approximate z e1) - (Map (Cunit_fun X) x)) -with (Map (fun z => (approximate ((Cunit_fun X) z) e1)) x). -simpl. -setoid_replace (Map (fun z : X => z) x) with x. -set (b:=(@ballS X (e1+e2))). -set (f:=(@join _ _) ^@> (constStepF b)). -cut (StepFfoldProp (f <@> x )). - unfold f; evalStepF; tauto. -apply: StepFfoldPropForall_Map. -simpl. -auto with *. -apply: Map_identity. -(* Is there a general solution to avoid StepF_Qeq_eq??*) -apply StepF_Qeq_eq; rewrite <- Map_compose_Map; reflexivity. +Proof. + intros X x e1 e2. simpl. + unfold dist_raw. + unfold StepFSupBall. + setoid_replace ( Map (fun z : RegularFunction X => approximate z e1) (Map (Cunit_fun X) x)) + with (Map (fun z => (approximate ((Cunit_fun X) z) e1)) x). + simpl. + setoid_replace (Map (fun z : X => z) x) with x. + set (b:=(@ballS X (e1+e2))). + set (f:=(@join _ _) ^@> (constStepF b)). + cut (StepFfoldProp (f <@> x )). + unfold f; evalStepF; tauto. + apply: StepFfoldPropForall_Map. + simpl. + auto with *. + apply: Map_identity. + (* Is there a general solution to avoid StepF_Qeq_eq??*) + apply StepF_Qeq_eq; rewrite <- Map_compose_Map; reflexivity. Qed. (* We skip the proof of the following lemma since the obvious induction -proof does not work since glue does not work well with join +proof does not work since glue does not work well with join In our current setting it would be more natural to check the distributive laws using a (unit, bind) presentation. Unfortunately, we have been unable to find one in the literature. @@ -321,4 +297,4 @@ Lemma prodmadorp:(ucEq (uc_compose (dorp _) (@prod (Complete X))) ). *) -End DistributionLaws. \ No newline at end of file +End DistributionLaws. diff --git a/model/metric2/LinfMetric.v b/model/metric2/LinfMetric.v index f7f288f26..a89f2dc1f 100644 --- a/model/metric2/LinfMetric.v +++ b/model/metric2/LinfMetric.v @@ -47,84 +47,82 @@ Definition StepQSup : (StepQ)->Q := StepFfold (fun x => x) (fun b (x y:QS) => Qm (** The Sup of the glue of two step functions. *) Lemma StepQSup_glue : forall o s t, (StepQSup (glue o s t) = Qmax (StepQSup s) (StepQSup t))%Q. Proof. -reflexivity. + reflexivity. Qed. (** The sup of the split of a step function. *) -Lemma StepQSupSplit : forall (o:OpenUnit) x, +Lemma StepQSupSplit : forall (o:OpenUnit) x, (StepQSup x == Qmax (StepQSup (SplitL x o)) (StepQSup (SplitR x o)))%Q. Proof. -intros o x. -revert o. -induction x using StepF_ind. - intros o. - change (x == Qmax x x)%Q. - rewrite Qmax_idem. - reflexivity. -intros s. -apply SplitLR_glue_ind; intros H. - change (Qmax (StepQSup x1) (StepQSup x2) == Qmax (StepQSup (SplitL x1 (OpenUnitDiv s o H))) - (Qmax (StepQSup (SplitR x1 (OpenUnitDiv s o H))) (StepQSup x2)))%Q. - rewrite Qmax_assoc. - rewrite <- IHx1. + intros o x. + revert o. + induction x using StepF_ind. + intros o. + change (x == Qmax x x)%Q. + rewrite Qmax_idem. + reflexivity. + intros s. + apply SplitLR_glue_ind; intros H. + change (Qmax (StepQSup x1) (StepQSup x2) == Qmax (StepQSup (SplitL x1 (OpenUnitDiv s o H))) + (Qmax (StepQSup (SplitR x1 (OpenUnitDiv s o H))) (StepQSup x2)))%Q. + rewrite Qmax_assoc. + rewrite <- IHx1. + reflexivity. + change (Qmax (StepQSup x1) (StepQSup x2) == Qmax (Qmax (StepQSup x1) (StepQSup (SplitL x2 (OpenUnitDualDiv s o H)))) + (StepQSup (SplitR x2 (OpenUnitDualDiv s o H))))%Q. + rewrite <- Qmax_assoc. + rewrite <- IHx2. reflexivity. - change (Qmax (StepQSup x1) (StepQSup x2) == Qmax (Qmax (StepQSup x1) (StepQSup (SplitL x2 (OpenUnitDualDiv s o H)))) - (StepQSup (SplitR x2 (OpenUnitDualDiv s o H))))%Q. - rewrite <- Qmax_assoc. - rewrite <- IHx2. reflexivity. -reflexivity. -Qed. +Qed. (* begin hide *) -Add Morphism StepQSup +Add Morphism StepQSup with signature (@StepF_eq _) ==> Qeq as StepQSup_wd. -unfold IntegralQ. -induction x using StepF_ind. -intros x2 H. simpl. induction x2 using StepF_ind. +Proof. + unfold IntegralQ. + induction x using StepF_ind. + intros x2 H. simpl. induction x2 using StepF_ind. simpl. auto with *. - change (StepQSup (glue o x2_1 x2_2))%Q with - (Qmax (StepQSup x2_1) (StepQSup x2_2)). - destruct H as [H0 H1] using (eq_glue_ind x2_1). - rewrite <- IHx2_1; auto with *. - rewrite <- IHx2_2; auto with *. -intros y H. -destruct H as [H0 H1] using (glue_eq_ind x1). -change (StepQSup (glue o x1 x2))%Q with - (Qmax (StepQSup x1) (StepQSup x2)). -rewrite (IHx1 _ H0). -rewrite (IHx2 _ H1). -symmetry. -apply StepQSupSplit. + change (StepQSup (glue o x2_1 x2_2))%Q with (Qmax (StepQSup x2_1) (StepQSup x2_2)). + destruct H as [H0 H1] using (eq_glue_ind x2_1). + rewrite <- IHx2_1; auto with *. + rewrite <- IHx2_2; auto with *. + intros y H. + destruct H as [H0 H1] using (glue_eq_ind x1). + change (StepQSup (glue o x1 x2))%Q with (Qmax (StepQSup x1) (StepQSup x2)). + rewrite (IHx1 _ H0). + rewrite (IHx2 _ H1). + symmetry. + apply StepQSupSplit. Qed. (* end hide *) (** How the sup interacts with various arithmetic operations on step functions. *) Lemma StepQSup_resp_le : forall x y, x <= y -> (StepQSup x <= StepQSup y)%Q. Proof. -apply: StepF_ind2; auto. - intros s s0 t t0 Hs Ht. - rewrite Hs Ht; auto. -intros o s s0 t t0 H0 H1. -unfold StepQ_le. -rewriteStepF. -intros [Hl Hr]. -repeat rewrite StepQSup_glue. -apply Qmax_le_compat; auto. + apply: StepF_ind2; auto. + intros s s0 t t0 Hs Ht. + rewrite Hs Ht; auto. + intros o s s0 t t0 H0 H1. + unfold StepQ_le. + rewriteStepF. + intros [Hl Hr]. + repeat rewrite StepQSup_glue. + apply Qmax_le_compat; auto. Qed. Lemma StepQSup_plus : forall x y, (StepQSup (x + y) <= StepQSup x + StepQSup y )%Q. Proof. -apply StepF_ind2; auto with *. - intros s s0 t t0 Hs Ht. - rewrite Hs Ht; auto. -intros o s s0 t t0 H0 H1. -unfold StepQplus. -rewriteStepF. -repeat rewrite StepQSup_glue. -eapply Qle_trans;[apply Qmax_le_compat;[apply H0|apply H1]|]. -rewrite Qmax_plus_distr_l. -apply Qmax_le_compat; - apply: plus_resp_leEq_lft; simpl; auto with *. + apply StepF_ind2; auto with *. + intros s s0 t t0 Hs Ht. + rewrite Hs Ht; auto. + intros o s s0 t t0 H0 H1. + unfold StepQplus. + rewriteStepF. + repeat rewrite StepQSup_glue. + eapply Qle_trans;[apply Qmax_le_compat;[apply H0|apply H1]|]. + rewrite Qmax_plus_distr_l. + apply Qmax_le_compat; apply: plus_resp_leEq_lft; simpl; auto with *. Qed. (** The Linf metric on step function over Q. *) @@ -135,36 +133,31 @@ Definition LinfStepQPrelengthSpace := StepFSupPrelengthSpace QPrelengthSpace. (** Sup is uniformly continuous. *) Lemma sup_uc_prf : is_UniformlyContinuousFunction (StepQSup:LinfStepQ -> Q) Qpos2QposInf. Proof. -intros e x y. -simpl. -rewrite Qball_Qabs. -revert x y. -apply: StepF_ind2. - intros s s0 t t0 Hs Ht. - simpl. - rewrite Hs Ht. + intros e x y. + simpl. + rewrite Qball_Qabs. + revert x y. + apply: StepF_ind2. + intros s s0 t t0 Hs Ht. + simpl. + rewrite Hs Ht. + auto. + intros x y. + rewrite <- Qball_Qabs. auto. - intros x y. - rewrite <- Qball_Qabs. - auto. -intros o s s0 t t0 H0 H1 H2. -simpl in *. -repeat rewrite StepQSup_glue. -assert (X:forall a b, (-(a-b)==b-a)%Q). - intros; ring. -unfold StepFSupBall in H2. -revert H2. -rewriteStepF. -intros [H2a H2b]. -apply Qabs_case; intros H; -[|rewrite <- Qabs_opp in H0, H1; rewrite -> X in *]; - (rewrite Qmax_minus_distr_l; - unfold Qminus; - apply Qmax_lub;[|clear H0; rename H1 into H0]; - (eapply Qle_trans;[|apply H0; auto]); - (eapply Qle_trans;[|apply Qle_Qabs]); - unfold Qminus; - apply: plus_resp_leEq_lft; simpl; auto with *). + intros o s s0 t t0 H0 H1 H2. + simpl in *. + repeat rewrite StepQSup_glue. + assert (X:forall a b, (-(a-b)==b-a)%Q). + intros; ring. + unfold StepFSupBall in H2. + revert H2. + rewriteStepF. + intros [H2a H2b]. + apply Qabs_case; intros H; [|rewrite <- Qabs_opp in H0, H1; rewrite -> X in *]; + (rewrite Qmax_minus_distr_l; unfold Qminus; apply Qmax_lub;[|clear H0; rename H1 into H0]; + (eapply Qle_trans;[|apply H0; auto]); (eapply Qle_trans;[|apply Qle_Qabs]); unfold Qminus; + apply: plus_resp_leEq_lft; simpl; auto with *). Qed. Open Local Scope uc_scope. @@ -175,44 +168,44 @@ Definition StepQSup_uc : LinfStepQ --> Q_as_MetricSpace (** There is an injection from Linf to L1. *) Lemma LinfAsL1_uc_prf : is_UniformlyContinuousFunction (fun (x:LinfStepQ) => (x:L1StepQ)) Qpos2QposInf. Proof. -intros e. -apply: StepF_ind2. - simpl. - intros s s0 t t0 Hs Ht H. - rewrite <- Hs , <- Ht. + intros e. + apply: StepF_ind2. + simpl. + intros s s0 t t0 Hs Ht H. + rewrite <- Hs , <- Ht. + assumption. + intros x y Hxy. + change (Qball e x y) in Hxy. + rewrite -> Qball_Qabs in Hxy. + apply Hxy. + intros o s s0 t t0 Hst Hst0 H. + simpl. + unfold L1Ball. + unfold L1Distance. + unfold L1Norm. + unfold StepQminus. + rewrite MapGlue. + rewrite ApGlueGlue. + unfold StepQabs. + rewrite MapGlue. + rewrite Integral_glue. + setoid_replace (e:Q) with (o*e + (1-o)*e)%Q by ring. + simpl in H. + unfold StepFSupBall, StepFfoldProp in H. + simpl in H. + rewrite MapGlue in H. + rewrite ApGlueGlue in H. + destruct H as [H0 H1]. + apply Qplus_le_compat. + repeat rewrite (Qmult_comm o). + apply Qmult_le_compat_r; auto with *. + apply Hst. assumption. - intros x y Hxy. - change (Qball e x y) in Hxy. - rewrite -> Qball_Qabs in Hxy. - apply Hxy. -intros o s s0 t t0 Hst Hst0 H. -simpl. -unfold L1Ball. -unfold L1Distance. -unfold L1Norm. -unfold StepQminus. -rewrite MapGlue. -rewrite ApGlueGlue. -unfold StepQabs. -rewrite MapGlue. -rewrite Integral_glue. -setoid_replace (e:Q) with (o*e + (1-o)*e)%Q by ring. -simpl in H. -unfold StepFSupBall, StepFfoldProp in H. -simpl in H. -rewrite MapGlue in H. -rewrite ApGlueGlue in H. -destruct H as [H0 H1]. -apply Qplus_le_compat. - repeat rewrite (Qmult_comm o). + repeat rewrite (Qmult_comm (1-o)). apply Qmult_le_compat_r; auto with *. - apply Hst. + apply Hst0. assumption. -repeat rewrite (Qmult_comm (1-o)). -apply Qmult_le_compat_r; auto with *. -apply Hst0. -assumption. Qed. Definition LinfAsL1 : LinfStepQ --> L1StepQ -:= Build_UniformlyContinuousFunction LinfAsL1_uc_prf. \ No newline at end of file +:= Build_UniformlyContinuousFunction LinfAsL1_uc_prf. diff --git a/model/metric2/LinfMetricMonad.v b/model/metric2/LinfMetricMonad.v index 68d394031..6b8bbd511 100644 --- a/model/metric2/LinfMetricMonad.v +++ b/model/metric2/LinfMetricMonad.v @@ -1,5 +1,5 @@ (* -Copyright © 2007-2008 +Copyright © 2007-2008 Russell O’Connor Bas Spitters @@ -50,30 +50,32 @@ Variable X:MetricSpace. (** A setoid verion of the ball predicate *) Definition ballS0 (m : MetricSpace): Qpos -> m -> m --> iffSetoid. -intros m e x. -exists (ball e x). -intros. apply ball_wd;auto with *. +Proof. + intros m e x. + exists (ball e x). + intros. apply ball_wd;auto with *. Defined. Definition ballS (m : MetricSpace): Qpos -> m --> m --> iffSetoid. -intros m e. -exists (ballS0 m e). -intros. simpl. split; rewrite H; auto with *. +Proof. + intros m e. + exists (ballS0 m e). + intros. simpl. split; rewrite H; auto with *. Defined. (** The definition of the usp metric *) Definition StepFSupBall(e:Qpos)(f:StepF X)(g:StepF X):= StepFfoldProp ((@ballS X e)^@> f <@> g). -Lemma StepFSupBallGlueGlue : forall e o fl fr gl gr, +Lemma StepFSupBallGlueGlue : forall e o fl fr gl gr, StepFSupBall e (glue o fl fr) (glue o gl gr) <-> StepFSupBall e fl gl /\ StepFSupBall e fr gr. Proof. -intros e o fl fr gl gr. -unfold StepFSupBall at 1. -rewrite MapGlue. -rewrite ApGlueGlue. -reflexivity. + intros e o fl fr gl gr. + unfold StepFSupBall at 1. + rewrite MapGlue. + rewrite ApGlueGlue. + reflexivity. Qed. End StepFSupBall. @@ -83,17 +85,18 @@ Implicit Arguments StepFSupBall [X]. Add Parametric Morphism X : (@StepFSupBall X) with signature QposEq ==> (@StepF_eq _) ==> (@StepF_eq _) ==> iff as StepFSupBall_wd. -unfold StepFSupBall. -intros a1 a2 Ha x1 x2 Hx y1 y2 Hy. -apply StepFfoldProp_morphism. -rewrite Hx. -rewrite Hy. -setoid_replace (ballS X a1) with (ballS X a2). -reflexivity. -intros x y. -simpl. -rewrite Ha. -reflexivity. +Proof. + unfold StepFSupBall. + intros a1 a2 Ha x1 x2 Hx y1 y2 Hy. + apply StepFfoldProp_morphism. + rewrite Hx. + rewrite Hy. + setoid_replace (ballS X a1) with (ballS X a2). + reflexivity. + intros x y. + simpl. + rewrite Ha. + reflexivity. Qed. Section SupMetric. @@ -102,109 +105,107 @@ Variable X : MetricSpace. Lemma StepFSupBall_refl : forall e (x:StepF X), (StepFSupBall e x x). Proof. -intros e x. -unfold StepFSupBall. -set (b:=(@ballS X e)). -set (f:=(@join _ _) ^@> (constStepF b)). -cut (StepFfoldProp (f <@> x )). - unfold f. - evalStepF. - auto. -apply: StepFfoldPropForall_Map. -simpl. -auto with *. + intros e x. + unfold StepFSupBall. + set (b:=(@ballS X e)). + set (f:=(@join _ _) ^@> (constStepF b)). + cut (StepFfoldProp (f <@> x )). + unfold f. + evalStepF. + auto. + apply: StepFfoldPropForall_Map. + simpl. + auto with *. Qed. Lemma StepFSupBall_sym : forall e (x y:StepF X), (StepFSupBall e x y) -> (StepFSupBall e y x). Proof. -intros e x y. -unfold StepFSupBall. -set (b:=(@ballS X e)). -apply StepF_imp_imp. -unfold StepF_imp. -set (f:=ap - (compose (@ap _ _ _) (compose (compose imp) b)) - (flip (b))). -cut (StepFfoldProp (f ^@> x <@> y)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map2. -intros a b0. -simpl. unfold compose0. -auto with *. + intros e x y. + unfold StepFSupBall. + set (b:=(@ballS X e)). + apply StepF_imp_imp. + unfold StepF_imp. + set (f:=ap (compose (@ap _ _ _) (compose (compose imp) b)) (flip (b))). + cut (StepFfoldProp (f ^@> x <@> y)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map2. + intros a b0. + simpl. unfold compose0. + auto with *. Qed. -Lemma StepFSupBall_triangle : forall e d (x y z:StepF X), +Lemma StepFSupBall_triangle : forall e d (x y z:StepF X), (StepFSupBall e x y) -> (StepFSupBall d y z) -> (StepFSupBall (e+d) x z). Proof. -intros e d x y z. -unfold StepFSupBall. -set (be:=(@ballS X e)). -set (bd:=(@ballS X d)). -set (bed:=(@ballS X (e+d) )). -intro H. apply StepF_imp_imp. revert H. -apply StepF_imp_imp. -unfold StepF_imp. -pose (f:= ap -(compose (@ap _ _ _) (compose (compose (compose (@compose _ _ _) imp)) be)) -(compose (flip (compose (@ap _ _ _) (compose (compose imp) bd))) bed)). -cut (StepFfoldProp (f ^@> x <@> y <@> z)). - unfold f. - evalStepF. - tauto. -apply StepFfoldPropForall_Map3. -apply: (ball_triangle X e d). + intros e d x y z. + unfold StepFSupBall. + set (be:=(@ballS X e)). + set (bd:=(@ballS X d)). + set (bed:=(@ballS X (e+d) )). + intro H. apply StepF_imp_imp. revert H. + apply StepF_imp_imp. + unfold StepF_imp. + pose (f:= ap (compose (@ap _ _ _) (compose (compose (compose (@compose _ _ _) imp)) be)) + (compose (flip (compose (@ap _ _ _) (compose (compose imp) bd))) bed)). + cut (StepFfoldProp (f ^@> x <@> y <@> z)). + unfold f. + evalStepF. + tauto. + apply StepFfoldPropForall_Map3. + apply: (ball_triangle X e d). Qed. Lemma StepFSupBall_closed : forall e (x y:StepF X), (forall d, (StepFSupBall (e+d) x y)) -> (StepFSupBall e x y). Proof. -intros e. -apply: (StepF_ind2). - intros. rewrite -> H, H0 in H1. apply H1. - intro. rewrite H H0. apply H2. - apply: ball_closed. -intros o s s0 t t0 IH0 IH1 H. -unfold StepFSupBall in *. -rewrite MapGlue. rewrite ApGlue. simpl. -split. - rewrite SplitLGlue. apply IH0. clear IH0. + intros e. + apply: (StepF_ind2). + intros. rewrite -> H, H0 in H1. apply H1. + intro. rewrite H H0. apply H2. + apply: ball_closed. + intros o s s0 t t0 IH0 IH1 H. + unfold StepFSupBall in *. + rewrite MapGlue. rewrite ApGlue. simpl. + split. + rewrite SplitLGlue. apply IH0. clear IH0. + intro d. pose (H2:=H d). + rewrite -> MapGlue in H2. rewrite ApGlue in H2. rewrite SplitRGlue in H2. rewrite SplitLGlue in H2. + destruct H2. auto. + rewrite SplitRGlue. apply IH1. clear IH1. intro d. pose (H2:=H d). - rewrite -> MapGlue in H2. rewrite ApGlue in H2. rewrite SplitRGlue in H2. rewrite SplitLGlue in H2. - destruct H2. auto. -rewrite SplitRGlue. apply IH1. clear IH1. -intro d. pose (H2:=H d). -rewrite -> MapGlue in H2. rewrite ApGlue in H2. rewrite SplitRGlue in H2. rewrite SplitLGlue in H2. -destruct H2. auto. + rewrite -> MapGlue in H2. rewrite ApGlue in H2. rewrite SplitRGlue in H2. rewrite SplitLGlue in H2. + destruct H2. auto. Qed. Lemma StepFSupBall_eq : forall (x y : StepF X), (forall e : Qpos, StepFSupBall e x y) -> StepF_eq x y. Proof. -apply: (StepF_ind2). - intros s s0 t t0 H H0 H1 H2. rewrite -> H, H0 in H1. apply H1. - intro. rewrite H H0. apply H2. - apply ball_eq. -intros o s s0 t t0 H H0 H1. -unfold StepFSupBall in *. apply glue_resp_StepF_eq. -apply H. clear H. - intro e. pose (H2:=H1 e). + apply: (StepF_ind2). + intros s s0 t t0 H H0 H1 H2. rewrite -> H, H0 in H1. apply H1. + intro. rewrite H H0. apply H2. + apply ball_eq. + intros o s s0 t t0 H H0 H1. + unfold StepFSupBall in *. apply glue_resp_StepF_eq. + apply H. clear H. + intro e. pose (H2:=H1 e). + rewrite -> MapGlue in H2. rewrite ApGlue in H2. rewrite SplitRGlue in H2. rewrite SplitLGlue in H2. + destruct H2; auto. + apply H0. clear H0. + intro e. pose (H2:=H1 e). rewrite -> MapGlue in H2. rewrite ApGlue in H2. rewrite SplitRGlue in H2. rewrite SplitLGlue in H2. destruct H2; auto. -apply H0. clear H0. -intro e. pose (H2:=H1 e). -rewrite -> MapGlue in H2. rewrite ApGlue in H2. rewrite SplitRGlue in H2. rewrite SplitLGlue in H2. -destruct H2; auto. Qed. (** *** Example of a Metric Space *) -Lemma StepFSupBall_is_MetricSpace : +Lemma StepFSupBall_is_MetricSpace : (is_MetricSpace (@StepFS X) (@StepFSupBall X)). -split. - apply: StepFSupBall_refl. - apply: StepFSupBall_sym. - apply: StepFSupBall_triangle. - apply: StepFSupBall_closed. -apply: StepFSupBall_eq. +Proof. + split. + apply: StepFSupBall_refl. + apply: StepFSupBall_sym. + apply: StepFSupBall_triangle. + apply: StepFSupBall_closed. + apply: StepFSupBall_eq. Qed. Definition StepFSup : MetricSpace := @@ -213,27 +214,24 @@ Definition StepFSup : MetricSpace := (** The StepFSup is is a prelength space. *) Lemma StepFSupPrelengthSpace : PrelengthSpace X -> PrelengthSpace StepFSup. Proof. -intros pl. -apply: StepF_ind2. - intros s s0 t t0 Hs Ht H e d1 d2 He H0. - rewrite <- Hs, <- Ht in H0. - destruct (H _ _ _ He H0) as [c Hc0 Hc1]. - exists c. - rewrite <- Hs; auto. - rewrite <- Ht; auto. - intros a b e d1 d2 He Hab. - destruct (pl a b e d1 d2 He Hab) as [c Hc0 Hc1]. - exists (constStepF c); auto. -intros o s s0 t t0 IHl IHr e d1 d2 He H. -simpl in H. -rewrite -> StepFSupBallGlueGlue in H. -destruct H as [Hl Hr]. -destruct (IHl _ _ _ He Hl) as [c Hc0 Hc1]. -destruct (IHr _ _ _ He Hr) as [d Hd0 Hd1]. -exists (glue o c d); - simpl; - rewrite StepFSupBallGlueGlue; - auto. + intros pl. + apply: StepF_ind2. + intros s s0 t t0 Hs Ht H e d1 d2 He H0. + rewrite <- Hs, <- Ht in H0. + destruct (H _ _ _ He H0) as [c Hc0 Hc1]. + exists c. + rewrite <- Hs; auto. + rewrite <- Ht; auto. + intros a b e d1 d2 He Hab. + destruct (pl a b e d1 d2 He Hab) as [c Hc0 Hc1]. + exists (constStepF c); auto. + intros o s s0 t t0 IHl IHr e d1 d2 He H. + simpl in H. + rewrite -> StepFSupBallGlueGlue in H. + destruct H as [Hl Hr]. + destruct (IHl _ _ _ He Hl) as [c Hc0 Hc1]. + destruct (IHr _ _ _ He Hr) as [d Hd0 Hd1]. + exists (glue o c d); simpl; rewrite StepFSupBallGlueGlue; auto. Qed. End SupMetric. @@ -243,54 +241,54 @@ Canonical Structure StepFSup. (* end hide *) Lemma StepFSupBallBind(X:MetricSpace): ((forall (e : Qpos) (a b : StepF (StepFS X)) , -forall f:(StepFS X) -->(StepFS X), +forall f:(StepFS X) -->(StepFS X), (forall c d, (StepFSupBall e c d) -> (StepFSupBall e (f c) (f d)))-> StepFSupBall (X:=StepFSup X) e a b -> StepFSupBall (X:=X) e (StFBind00 a f) (StFBind00 b f))). -intros X e a. unfold ball_ex. -induction a using StepF_ind. simpl. induction b using StepF_ind. +Proof. + intros X e a. unfold ball_ex. + induction a using StepF_ind. simpl. induction b using StepF_ind. intros. simpl. apply H. assumption. - intros f Hf H. simpl in H. unfold StepFSupBall in H. rewrite -> GlueAp in H. - rewrite -> StepFfoldPropglue_rew in H. destruct H as [H H1]. - simpl. - unfold StepFSupBall. rewrite GlueAp. - rewrite StepFfoldPropglue_rew. split. - pose (HH:=IHb1 (compose1 (SplitLS X o) f)). simpl in HH. - simpl in HH. unfold StepFSupBall in HH. unfold compose0 in HH. - assert (rew:(ballS X e ^@> SplitLS0 o (f x)) == - (SplitL (ballS X e ^@> f x) o)). unfold SplitLS0. rewrite SplitLMap;reflexivity. - rewrite <-rew. clear rew. apply HH; auto with *. + intros f Hf H. simpl in H. unfold StepFSupBall in H. rewrite -> GlueAp in H. + rewrite -> StepFfoldPropglue_rew in H. destruct H as [H H1]. + simpl. + unfold StepFSupBall. rewrite GlueAp. + rewrite StepFfoldPropglue_rew. split. + pose (HH:=IHb1 (compose1 (SplitLS X o) f)). simpl in HH. + simpl in HH. unfold StepFSupBall in HH. unfold compose0 in HH. + assert (rew:(ballS X e ^@> SplitLS0 o (f x)) == + (SplitL (ballS X e ^@> f x) o)). unfold SplitLS0. rewrite SplitLMap;reflexivity. + rewrite <-rew. clear rew. apply HH; auto with *. intros. unfold SplitLS0. rewrite <- SplitLMap. rewrite <- SplitLAp. apply StepFfoldPropSplitL. apply (Hf c d H0). - (* right *) - pose (HH:=IHb2 (compose1 (SplitRS X o) f)). simpl in HH. - unfold StepFSupBall in HH. unfold compose0 in HH. + (* right *) + pose (HH:=IHb2 (compose1 (SplitRS X o) f)). simpl in HH. + unfold StepFSupBall in HH. unfold compose0 in HH. assert (rew:(ballS X e ^@> SplitRS0 o (f x)) == - (SplitR (ballS X e ^@> f x) o)). unfold SplitRS0. rewrite SplitRMap;reflexivity. - rewrite <-rew. clear rew. apply HH; auto with *. - intros. unfold SplitRS0. rewrite <- SplitRMap. rewrite <- SplitRAp. - apply StepFfoldPropSplitR. apply (Hf c d H0). -intros b f Hf H. -simpl. -unfold StepFSupBall. simpl. rewrite MapGlue. -rewrite ApGlue. rewrite StepFfoldPropglue_rew. split. + (SplitR (ballS X e ^@> f x) o)). unfold SplitRS0. rewrite SplitRMap;reflexivity. + rewrite <-rew. clear rew. apply HH; auto with *. + intros. unfold SplitRS0. rewrite <- SplitRMap. rewrite <- SplitRAp. + apply StepFfoldPropSplitR. apply (Hf c d H0). + intros b f Hf H. + simpl. + unfold StepFSupBall. simpl. rewrite MapGlue. + rewrite ApGlue. rewrite StepFfoldPropglue_rew. split. clear IHa2. pose (HH:=IHa1 (SplitL b o) (compose1 (SplitLS X o) f)). simpl in HH. - unfold compose0 in HH. unfold StepFSupBall in HH. - rewrite SplitLBind. apply HH; clear HH. + unfold compose0 in HH. unfold StepFSupBall in HH. + rewrite SplitLBind. apply HH; clear HH. intros. unfold SplitLS0. rewrite <- SplitLMap. rewrite <- SplitLAp. - apply StepFfoldPropSplitL. apply (Hf c d H0). - pose (HH:=StepFfoldPropSplitL _ o H). rewrite -> SplitLAp in HH. rewrite SplitLMap in HH. - setoid_replace a1 with (SplitL (glue o a1 a2) o ). - assumption. rewrite SplitLGlue;reflexivity. - - clear IHa1. pose (HH:=IHa2 (SplitR b o) (compose1 (SplitRS X o) f)). simpl in HH. - unfold compose0 in HH. unfold StepFSupBall in HH. + apply StepFfoldPropSplitL. apply (Hf c d H0). + pose (HH:=StepFfoldPropSplitL _ o H). rewrite -> SplitLAp in HH. rewrite SplitLMap in HH. + setoid_replace a1 with (SplitL (glue o a1 a2) o ). + assumption. rewrite SplitLGlue;reflexivity. + clear IHa1. pose (HH:=IHa2 (SplitR b o) (compose1 (SplitRS X o) f)). simpl in HH. + unfold compose0 in HH. unfold StepFSupBall in HH. rewrite SplitRBind. apply HH; clear HH. - intros. unfold SplitRS0. rewrite <- SplitRMap. rewrite <- SplitRAp. + intros. unfold SplitRS0. rewrite <- SplitRMap. rewrite <- SplitRAp. apply StepFfoldPropSplitR. apply (Hf c d H0). - pose (HH:=StepFfoldPropSplitR _ o H). rewrite -> SplitRAp in HH. rewrite SplitRMap in HH. + pose (HH:=StepFfoldPropSplitR _ o H). rewrite -> SplitRAp in HH. rewrite SplitRMap in HH. setoid_replace a2 with (SplitR (glue o a1 a2) o ). - assumption. rewrite SplitRGlue;reflexivity. + assumption. rewrite SplitRGlue;reflexivity. Qed. Open Local Scope uc_scope. @@ -301,20 +299,22 @@ Variable X Y : MetricSpace. (** Various functions with step functions are uniformly continuous with this metric. *) Definition StFJoinSup :(StepFSup (StepFSup X)) --> (StepFSup X). -simpl. apply (@Build_UniformlyContinuousFunction -_ _ (@StFJoin X) (fun e:Qpos=>e)). -abstract (unfold is_UniformlyContinuousFunction; simpl; intros; apply -StepFSupBallBind; [auto with * | assumption]). + simpl. apply (@Build_UniformlyContinuousFunction _ _ (@StFJoin X) (fun e:Qpos=>e)). +Proof. + abstract (unfold is_UniformlyContinuousFunction; simpl; intros; apply + StepFSupBallBind; [auto with * | assumption]). Defined. Definition StFReturn_uc : X --> (StepFSup X). -simpl. exists (StFReturn X) (fun x:Qpos=> x:QposInf). -abstract (intros e a b H ; apply H). +Proof. + simpl. exists (StFReturn X) (fun x:Qpos=> x:QposInf). + abstract (intros e a b H ; apply H). Defined. Lemma uc_stdFun(X Y:MetricSpace): (UniformlyContinuousFunction X Y) ->(extSetoid X Y). -intros X0 Y0 f. exists (ucFun f). abstract (intros; apply uc_wd; assumption). +Proof. + intros X0 Y0 f. exists (ucFun f). abstract (intros; apply uc_wd; assumption). Defined. (* Why doesn't this work? @@ -322,59 +322,56 @@ Coercion uc_stdFun: (UniformlyContinuousFunction X Y)>-> (extSetoid X Y). *) Definition Map_uc (f:X-->Y):(StepFSup X)-->(StepFSup Y). -intros. -exists (Map f) (mu f). -intros e a b. -simpl. unfold StepFSupBall. -case_eq (mu f e). -Focus 2. intros. -set (bal:=(ballS Y e)). -unfold ball_ex in H. -cut (StepFfoldProp -((flip (compose (flip (compose bal (uc_stdFun f))) (uc_stdFun f))) ^@> a <@> b)). -evalStepF. auto with *. -apply StepFfoldPropForall_Map2. intros. simpl. -apply uc_prf. -rewrite H. simpl. auto. -intros q eq. apply: StepF_imp_imp. -unfold StepF_imp. -set (bal:=(ballS Y e)). -set (F:=(((flip (compose (flip (compose bal (uc_stdFun f))) (uc_stdFun f)))))). -set (IMP:=(ap - (compose (@ap _ _ _) (compose (compose imp) (ballS X q))) - F)). -cut (StepFfoldProp (IMP ^@> a <@> b)). - unfold IMP, F; evalStepF. tauto. -apply StepFfoldPropForall_Map2. -intros a0 b0. simpl. unfold compose0. -intro. apply uc_prf. rewrite eq. apply H. +Proof. + intros. + exists (Map f) (mu f). + intros e a b. + simpl. unfold StepFSupBall. + case_eq (mu f e). + Focus 2. intros. + set (bal:=(ballS Y e)). + unfold ball_ex in H. + cut (StepFfoldProp ((flip (compose (flip (compose bal (uc_stdFun f))) (uc_stdFun f))) ^@> a <@> b)). + evalStepF. auto with *. + apply StepFfoldPropForall_Map2. intros. simpl. + apply uc_prf. + rewrite H. simpl. auto. + intros q eq. apply: StepF_imp_imp. + unfold StepF_imp. + set (bal:=(ballS Y e)). + set (F:=(((flip (compose (flip (compose bal (uc_stdFun f))) (uc_stdFun f)))))). + set (IMP:=(ap (compose (@ap _ _ _) (compose (compose imp) (ballS X q))) F)). + cut (StepFfoldProp (IMP ^@> a <@> b)). + unfold IMP, F; evalStepF. tauto. + apply StepFfoldPropForall_Map2. + intros a0 b0. simpl. unfold compose0. + intro. apply uc_prf. rewrite eq. apply H. Defined. -Definition glue_uc0 (o:OpenUnit): +Definition glue_uc0 (o:OpenUnit): StepFSup X -> StepFSup X --> StepFSup X. -intros o x. -exists (fun y=>(glue o x y)) (fun x:Qpos=> x). -abstract( -intros e a b; simpl; rewrite StepFSupBallGlueGlue; intuition; -apply StepFSupBall_refl). +Proof. + intros o x. + exists (fun y=>(glue o x y)) (fun x:Qpos=> x). + abstract( intros e a b; simpl; rewrite StepFSupBallGlueGlue; intuition; apply StepFSupBall_refl). Defined. -Definition glue_uc (o:OpenUnit): +Definition glue_uc (o:OpenUnit): StepFSup X --> StepFSup X --> StepFSup X. -intros o. -exists (fun y=>(glue_uc0 o y)) (fun x:Qpos=> x). -abstract (intros e a b; simpl; unfold ucBall; simpl; intros; -rewrite StepFSupBallGlueGlue; intuition; -apply StepFSupBall_refl). +Proof. + intros o. + exists (fun y=>(glue_uc0 o y)) (fun x:Qpos=> x). + abstract (intros e a b; simpl; unfold ucBall; simpl; intros; rewrite StepFSupBallGlueGlue; intuition; + apply StepFSupBall_refl). Defined. (** There is an injection from X to StepFSup X. *) Lemma constStepF_uc_prf : is_UniformlyContinuousFunction (@constStepF X:X -> StepFSup X) Qpos2QposInf. Proof. -intros e x y H. -simpl in *. -assumption. + intros e x y H. + simpl in *. + assumption. Qed. Definition constStepF_uc : X --> StepFSup X @@ -382,4 +379,4 @@ Definition constStepF_uc : X --> StepFSup X End UniformlyContinuousFunctions. -Implicit Arguments constStepF_uc [X]. \ No newline at end of file +Implicit Arguments constStepF_uc [X]. diff --git a/model/metric2/Qmetric.v b/model/metric2/Qmetric.v index b4866fac9..e3107054f 100644 --- a/model/metric2/Qmetric.v +++ b/model/metric2/Qmetric.v @@ -41,101 +41,102 @@ Definition Qball (e : Qpos) (a b : Q) := AbsSmall (e:Q) (a - b). Lemma Qball_Qabs : forall e a b, Qball e a b <-> Qabs (a - b) <= e. Proof. -intros e a b. -unfold Qball, AbsSmall. -simpl. -generalize (a-b). -intros c. -split. - apply Qabs_case. + intros e a b. + unfold Qball, AbsSmall. + simpl. + generalize (a-b). + intros c. + split. + apply Qabs_case. + tauto. + intros. + rewrite <- (Qopp_involutive e). + apply Qopp_le_compat. tauto. intros. - rewrite <- (Qopp_involutive e). - apply Qopp_le_compat. - tauto. -intros. -split. - apply Qle_trans with (-(Qabs (-c))). - rewrite Qabs_opp. - auto with *. - rewrite <- (Qopp_involutive c). - apply Qopp_le_compat. - rewrite Qopp_involutive. + split. + apply Qle_trans with (-(Qabs (-c))). + rewrite Qabs_opp. + auto with *. + rewrite <- (Qopp_involutive c). + apply Qopp_le_compat. + rewrite Qopp_involutive. + apply Qle_Qabs. + apply Qle_trans with (Qabs c); auto with *. apply Qle_Qabs. -apply Qle_trans with (Qabs c); auto with *. -apply Qle_Qabs. Qed. Lemma Qle_closed : (forall e x, (forall d : Qpos, x <= e+d) -> x <= e). Proof. -intros. -apply: shift_zero_leEq_minus'. -apply: inv_cancel_leEq. -apply: approach_zero_weak;simpl. -intros. -replace LHS with (x[-](e:Q)). -apply: shift_minus_leEq;simpl. -replace RHS with (e+e0) by ring. -rewrite <- (QposAsmkQpos H0). -apply (H (mkQpos H0)). -unfold cg_minus; simpl; ring. + intros. + apply: shift_zero_leEq_minus'. + apply: inv_cancel_leEq. + apply: approach_zero_weak;simpl. + intros. + replace LHS with (x[-](e:Q)). + apply: shift_minus_leEq;simpl. + replace RHS with (e+e0) by ring. + rewrite <- (QposAsmkQpos H0). + apply (H (mkQpos H0)). + unfold cg_minus; simpl; ring. Qed. Notation QS := Q_is_Setoid (only parsing). Lemma Q_is_MetricSpace : is_MetricSpace QS Qball. Proof. -split. -intros e x. -unfold Qball. -apply AbsSmall_wdr with 0. -apply (zero_AbsSmall _ (e:Q)). -apply less_leEq. -apply Qpos_prf. -simpl; ring. -intros e x y. -unfold Qball. -apply AbsSmall_minus. -intros [e1 He1] [e2 He2] a b c H1 H2. -unfold Qball. -apply AbsSmall_wdr with ((a-b)+(b-c)). -autorewrite with QposElim. -apply AbsSmall_plus; assumption. -simpl; ring. -intros e a b H. -unfold Qball. -split. -apply inv_cancel_leEq;simpl. -replace RHS with (e:Q) by ring. -apply Qle_closed. -intros. -destruct (H d). -apply: inv_cancel_leEq;simpl. -replace RHS with (a-b) by ring. -destruct e; destruct d; apply H0. -apply Qle_closed. -intros d. -destruct (H d). -destruct e; destruct d; apply H1. -intros. -apply: cg_inv_unique_2. -apply: AbsSmall_approach_zero;simpl. -intros e H0. -rewrite <- (QposAsmkQpos H0). -apply (H (mkQpos H0)). + split. + intros e x. + unfold Qball. + apply AbsSmall_wdr with 0. + apply (zero_AbsSmall _ (e:Q)). + apply less_leEq. + apply Qpos_prf. + simpl; ring. + intros e x y. + unfold Qball. + apply AbsSmall_minus. + intros [e1 He1] [e2 He2] a b c H1 H2. + unfold Qball. + apply AbsSmall_wdr with ((a-b)+(b-c)). + autorewrite with QposElim. + apply AbsSmall_plus; assumption. + simpl; ring. + intros e a b H. + unfold Qball. + split. + apply inv_cancel_leEq;simpl. + replace RHS with (e:Q) by ring. + apply Qle_closed. + intros. + destruct (H d). + apply: inv_cancel_leEq;simpl. + replace RHS with (a-b) by ring. + destruct e; destruct d; apply H0. + apply Qle_closed. + intros d. + destruct (H d). + destruct e; destruct d; apply H1. + intros. + apply: cg_inv_unique_2. + apply: AbsSmall_approach_zero;simpl. + intros e H0. + rewrite <- (QposAsmkQpos H0). + apply (H (mkQpos H0)). Qed. (* begin hide *) Add Morphism Qball with signature QposEq ==> Qeq ==> Qeq ==> iff as Qball_wd. -intros [x1 Hx1] [x2 Hx2] H x3 x4 H0 x5 x6 H1. -unfold Qball. -unfold AbsSmall. -simpl. -rewrite H0. -rewrite H1. -unfold QposEq in H. -simpl in H. -rewrite H. -tauto. +Proof. + intros [x1 Hx1] [x2 Hx2] H x3 x4 H0 x5 x6 H1. + unfold Qball. + unfold AbsSmall. + simpl. + rewrite H0. + rewrite H1. + unfold QposEq in H. + simpl in H. + rewrite H. + tauto. Qed. (* end hide *) Definition Q_as_MetricSpace : MetricSpace := @@ -144,84 +145,78 @@ Definition Q_as_MetricSpace : MetricSpace := Canonical Structure Q_as_MetricSpace. (* end hide *) Lemma QPrelengthSpace_help : forall (e d1 d2:Qpos), e < d1+d2 -> forall (a b c:QS), ball e a b -> (c == (a*d2 + b*d1)/(d1+d2)%Qpos) -> ball d1 a c. -intros e d1 d2 He a b c Hab Hc. -simpl. -unfold Qball. -apply AbsSmall_wdr with ((d1/(d1+d2)%Qpos)*(a - b)). -apply AbsSmall_wdl with ((d1/(d1+d2)%Qpos)*(d1+d2)%Qpos); - [|simpl; field; apply Qpos_nonzero]. -apply mult_resp_AbsSmall. -apply less_leEq. -apply (div_resp_pos _ _ (d1:Q) (@Qpos_nonzero (d1+d2)%Qpos)); apply Qpos_prf. -destruct d1; destruct d2; apply (AbsSmall_trans _ (e:Q)); assumption. -simpl. -rewrite Hc. -pose (@Qpos_nonzero (d1 + d2)%Qpos). -QposField. -assumption. +Proof. + intros e d1 d2 He a b c Hab Hc. + simpl. + unfold Qball. + apply AbsSmall_wdr with ((d1/(d1+d2)%Qpos)*(a - b)). + apply AbsSmall_wdl with ((d1/(d1+d2)%Qpos)*(d1+d2)%Qpos); [|simpl; field; apply Qpos_nonzero]. + apply mult_resp_AbsSmall. + apply less_leEq. + apply (div_resp_pos _ _ (d1:Q) (@Qpos_nonzero (d1+d2)%Qpos)); apply Qpos_prf. + destruct d1; destruct d2; apply (AbsSmall_trans _ (e:Q)); assumption. + simpl. + rewrite Hc. + pose (@Qpos_nonzero (d1 + d2)%Qpos). + QposField. + assumption. Qed. (** Q is a prelength space *) Lemma QPrelengthSpace : PrelengthSpace Q_as_MetricSpace. Proof. -intros a b e d1 d2 He Hab. -pose (c:= (a * d2 + b * d1) / (d1 + d2)%Qpos). -exists c. -apply (@QPrelengthSpace_help e d1 d2 He a b c); try assumption. -reflexivity. -apply ball_sym. -eapply QPrelengthSpace_help. -rewrite Qplus_comm. -apply He. -apply ball_sym. -apply Hab. -unfold c. -unfold Qdiv. -apply Qmult_comp. -ring. -apply Qinv_comp. -QposRing. + intros a b e d1 d2 He Hab. + pose (c:= (a * d2 + b * d1) / (d1 + d2)%Qpos). + exists c. + apply (@QPrelengthSpace_help e d1 d2 He a b c); try assumption. + reflexivity. + apply ball_sym. + eapply QPrelengthSpace_help. + rewrite Qplus_comm. + apply He. + apply ball_sym. + apply Hab. + unfold c. + unfold Qdiv. + apply Qmult_comp. + ring. + apply Qinv_comp. + QposRing. Qed. (** Q is a decideable metric, and hence located and stable. *) Lemma Qmetric_dec : decidableMetric Q_as_MetricSpace. Proof. -intros e a b. -simpl. -unfold Qball, AbsSmall. -simpl. -set (c:=-e). -set (d:=(a-b)). -destruct (Qlt_le_dec_fast d c) as [Hdc|Hdc]. -right. -abstract( -intros [H1 H2]; -apply (Qlt_not_le _ _ Hdc H1) -). -destruct (Qlt_le_dec_fast e d) as [Hed|Hed]. -right. -abstract( -intros [H1 H2]; -apply (Qlt_not_le _ _ Hed H2) -). -left. -abstract auto. + intros e a b. + simpl. + unfold Qball, AbsSmall. + simpl. + set (c:=-e). + set (d:=(a-b)). + destruct (Qlt_le_dec_fast d c) as [Hdc|Hdc]. + right. + abstract( intros [H1 H2]; apply (Qlt_not_le _ _ Hdc H1) ). + destruct (Qlt_le_dec_fast e d) as [Hed|Hed]. + right. + abstract( intros [H1 H2]; apply (Qlt_not_le _ _ Hed H2) ). + left. + abstract auto. Defined. Hint Resolve Qmetric_dec : metricQ. Lemma locatedQ : locatedMetric Q_as_MetricSpace. Proof. -apply decidable_located. -auto with *. + apply decidable_located. + auto with *. Defined. Hint Resolve locatedQ : metricQ. Lemma stableQ : stableMetric Q_as_MetricSpace. Proof. -apply located_stable. -auto with *. + apply located_stable. + auto with *. Qed. -Hint Resolve stableQ : metricQ. \ No newline at end of file +Hint Resolve stableQ : metricQ. diff --git a/model/monoids/CRmonoid.v b/model/monoids/CRmonoid.v index 4651fe989..3837214bc 100644 --- a/model/monoids/CRmonoid.v +++ b/model/monoids/CRmonoid.v @@ -34,22 +34,18 @@ We use the addition [' 0] as the unit of monoid: Lemma CRisCMonoid : is_CMonoid CRasCSemiGroup (' 0)%CR. Proof. -split; -intros x. -change (x+(' 0%Q)==x)%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR (inject_Q 0))) by - apply: CR_plus_as_Cauchy_IR_plus. -stepl ((CRasCauchy_IR x)[+]Zero) by - apply: plus_resp_eq; apply: CR_inject_Q_as_Cauchy_IR_inject_Q. -apply cm_rht_unit. -change ((inject_Q 0%Q)+x==x)%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR (inject_Q 0))[+](CRasCauchy_IR x)) by - apply CR_plus_as_Cauchy_IR_plus. -stepl (Zero[+](CRasCauchy_IR x)) by - apply bin_op_is_wd_un_op_lft; apply: CR_inject_Q_as_Cauchy_IR_inject_Q. -apply cm_lft_unit. + split; intros x. + change (x+(' 0%Q)==x)%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR (inject_Q 0))) by apply: CR_plus_as_Cauchy_IR_plus. + stepl ((CRasCauchy_IR x)[+]Zero) by apply: plus_resp_eq; apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + apply cm_rht_unit. + change ((inject_Q 0%Q)+x==x)%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR (inject_Q 0))[+](CRasCauchy_IR x)) by apply CR_plus_as_Cauchy_IR_plus. + stepl (Zero[+](CRasCauchy_IR x)) by + apply bin_op_is_wd_un_op_lft; apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + apply cm_lft_unit. Qed. Definition CRasCMonoid : CMonoid := diff --git a/model/monoids/Nm_to_cycm.v b/model/monoids/Nm_to_cycm.v index 9580af22e..88bebf0fd 100644 --- a/model/monoids/Nm_to_cycm.v +++ b/model/monoids/Nm_to_cycm.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CMonoids. Require Export Nmonoid. @@ -42,7 +42,7 @@ Section p71E1. (** ** A function from the natural numbers to a cyclic monoid %\begin{convention}% -Let [M:CMonoid], [c:M] and +Let [M:CMonoid], [c:M] and [is_generated_by: forall(m:M),{n:nat | (power_CMonoid c n)[=]m}]. %\end{convention}% *) @@ -51,8 +51,9 @@ Variable M:CMonoid. Variable c:M. Definition power_CMonoid_CSetoid: M-> nat_as_CSetoid -> M. -simpl. -exact (@power_CMonoid M). +Proof. + simpl. + exact (@power_CMonoid M). Defined. Variable is_generated_by: forall(m:M),{n:nat | (power_CMonoid c n)[=]m}. @@ -61,79 +62,75 @@ Let f:= fun (H:forall(m:M),{n:nat | (power_CMonoid c n)[=]m})=> fun (n:nat_as_CMonoid)=> power_CMonoid c n. Lemma f_strext: (fun_strext (f is_generated_by)). -simpl. -unfold fun_strext. -simpl. -double induction x y. -unfold f. -simpl. -intro H. -set (H1:=(ax_ap_irreflexive M (@cs_eq M) (@cs_ap M))). -unfold irreflexive in H1. -unfold Not in H1. -unfold ap_nat. -unfold CNot. -intro H2. -elim H1 with (cm_unit M). -apply CSetoid_is_CSetoid. - -exact H. - -unfold ap_nat. -unfold CNot. -intros n H H0. -set (H1:= (O_S n)). -intuition. - -unfold ap_nat. -unfold CNot. -intros n H H0 H2. -set (H1:= (O_S n)). -cut (0=(S n)). -intuition. - -intuition. - -intros n H n0 H0. -unfold f. -simpl. -elim (@csg_op M). -simpl. -intros op op_strext H1. -unfold bin_fun_strext in op_strext. -set (H2:=(op_strext c c (power_CMonoid c n0) (power_CMonoid c n)H1)). -elim H2. -intros H3. -set (H4:=(ap_irreflexive_unfolded M c H3)). -elim H4. - -intro H3. -unfold f in H0. -set (H4:= (H0 n H3)). -set (H5:= (not_eq_S n0 n)). -unfold ap_nat in H4 |- *. -unfold CNot in H4 |- *. -unfold not in H5. -intro H6. -elim H5. -intro H7. -elim H4. -exact H7. -exact H6. +Proof. + simpl. + unfold fun_strext. + simpl. + double induction x y. + unfold f. + simpl. + intro H. + set (H1:=(ax_ap_irreflexive M (@cs_eq M) (@cs_ap M))). + unfold irreflexive in H1. + unfold Not in H1. + unfold ap_nat. + unfold CNot. + intro H2. + elim H1 with (cm_unit M). + apply CSetoid_is_CSetoid. + exact H. + unfold ap_nat. + unfold CNot. + intros n H H0. + set (H1:= (O_S n)). + intuition. + unfold ap_nat. + unfold CNot. + intros n H H0 H2. + set (H1:= (O_S n)). + cut (0=(S n)). + intuition. + intuition. + intros n H n0 H0. + unfold f. + simpl. + elim (@csg_op M). + simpl. + intros op op_strext H1. + unfold bin_fun_strext in op_strext. + set (H2:=(op_strext c c (power_CMonoid c n0) (power_CMonoid c n)H1)). + elim H2. + intros H3. + set (H4:=(ap_irreflexive_unfolded M c H3)). + elim H4. + intro H3. + unfold f in H0. + set (H4:= (H0 n H3)). + set (H5:= (not_eq_S n0 n)). + unfold ap_nat in H4 |- *. + unfold CNot in H4 |- *. + unfold not in H5. + intro H6. + elim H5. + intro H7. + elim H4. + exact H7. + exact H6. Qed. Definition f_as_CSetoid_fun:= (Build_CSetoid_fun nat_as_CMonoid M (f is_generated_by) f_strext). Lemma surjective_f: (surjective f_as_CSetoid_fun). -unfold surjective. -simpl. -intro b. -elim (is_generated_by b). -intros m H. -exists m. -unfold f. -exact H. +Proof. + unfold surjective. + simpl. + intro b. + elim (is_generated_by b). + intros m H. + exists m. + unfold f. + exact H. Qed. End p71E1. diff --git a/model/monoids/Nm_to_freem.v b/model/monoids/Nm_to_freem.v index a162e9afb..033e8ec5d 100644 --- a/model/monoids/Nm_to_freem.v +++ b/model/monoids/Nm_to_freem.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CMonoids. Require Export Nmonoid. @@ -48,7 +48,8 @@ Let A:= (CSetoid_of_less 1). (* begin hide *) Let ZerolessOne: 0<1. -intuition. +Proof. + intuition. Qed. (* end hide *) @@ -60,126 +61,119 @@ match n with end. Definition to_word_: nat_as_CMonoid -> (free_monoid_as_CMonoid A). -simpl. -unfold Astar. -unfold A. -intro n. -unfold CSetoid_of_less. -simpl. -apply to_word. -exact n. +Proof. + simpl. + unfold Astar. + unfold A. + intro n. + unfold CSetoid_of_less. + simpl. + apply to_word. + exact n. Defined. Lemma to_word_strext: (fun_strext to_word_). -simpl. -unfold fun_strext. -double induction x y. -simpl. -intuition. - -intros n H2. -simpl. -unfold ap_nat. -unfold CNot. -intros T H. -set (H1:= (O_S n H)). -elim H1. - -intros n H3. -simpl. -unfold ap_nat. -unfold CNot. -intros T H. -cut (0= (S n)). -intro H2. -set (H1:= (O_S n H2 )). -elim H1. -intuition. - -intros n H1 n0 H2. -simpl. -cut ( ap_fm A (to_word_ n0) (to_word_ n) -> S n0{#N}S n). -intuition. - -intro H3. -simpl in H2. -set (H4:=(H2 n H3)). -unfold ap_nat in H4 |- *. -unfold CNot in H4 |- *. -intro H5. -apply H4. -apply (eq_add_S n0 n H5). +Proof. + simpl. + unfold fun_strext. + double induction x y. + simpl. + intuition. + intros n H2. + simpl. + unfold ap_nat. + unfold CNot. + intros T H. + set (H1:= (O_S n H)). + elim H1. + intros n H3. + simpl. + unfold ap_nat. + unfold CNot. + intros T H. + cut (0= (S n)). + intro H2. + set (H1:= (O_S n H2 )). + elim H1. + intuition. + intros n H1 n0 H2. + simpl. + cut ( ap_fm A (to_word_ n0) (to_word_ n) -> S n0{#N}S n). + intuition. + intro H3. + simpl in H2. + set (H4:=(H2 n H3)). + unfold ap_nat in H4 |- *. + unfold CNot in H4 |- *. + intro H5. + apply H4. + apply (eq_add_S n0 n H5). Qed. Definition to_word_as_CSetoid_fun:= (Build_CSetoid_fun nat_as_CSetoid (free_csetoid_as_csetoid A) to_word_ to_word_strext). Lemma to_word_bijective: (bijective to_word_as_CSetoid_fun). -unfold bijective. -split. -unfold injective. -simpl. -intros a0. -induction a0. -intro a1. -case a1. -unfold ap_nat. -unfold CNot. -intuition. - -simpl. -intuition. - -intro a1. -case a1. -simpl. -intuition. - -intros n H. -unfold ap_nat in H. -unfold CNot in H. -simpl. -apply Cinright. -apply IHa0. -unfold ap_nat. -unfold CNot. -intro H1. -rewrite H1 in H. -apply H. -reflexivity. - -unfold surjective. -simpl. -unfold Astar. -unfold A. -intro b. -induction b. -exists 0. -simpl. -exact I. - -elim IHb. -intros c H. -exists (S c). -split. -simpl in a. -elim a. -simpl. -intuition. - -exact H. +Proof. + unfold bijective. + split. + unfold injective. + simpl. + intros a0. + induction a0. + intro a1. + case a1. + unfold ap_nat. + unfold CNot. + intuition. + simpl. + intuition. + intro a1. + case a1. + simpl. + intuition. + intros n H. + unfold ap_nat in H. + unfold CNot in H. + simpl. + apply Cinright. + apply IHa0. + unfold ap_nat. + unfold CNot. + intro H1. + rewrite H1 in H. + apply H. + reflexivity. + unfold surjective. + simpl. + unfold Astar. + unfold A. + intro b. + induction b. + exists 0. + simpl. + exact I. + elim IHb. + intros c H. + exists (S c). + split. + simpl in a. + elim a. + simpl. + intuition. + exact H. Qed. -Lemma pres_plus_to_word: +Lemma pres_plus_to_word: forall (n m: nat_as_CMonoid),(to_word_ n)[+](to_word_ m)[=](to_word_ (n[+]m)). -simpl. -intros n m. -induction n. -simpl. -apply eq_fm_reflexive. - -simpl. -intuition. +Proof. + simpl. + intros n m. + induction n. + simpl. + apply eq_fm_reflexive. + simpl. + intuition. Qed. End p70text. diff --git a/model/monoids/Nmonoid.v b/model/monoids/Nmonoid.v index 3b33ab225..87286a8e1 100644 --- a/model/monoids/Nmonoid.v +++ b/model/monoids/Nmonoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Nsemigroup. Require Import CMonoids. @@ -44,19 +44,19 @@ Zero is an unit for the addition. Lemma O_as_rht_unit : is_rht_unit (S:=nat_as_CSetoid) plus_is_bin_fun 0. Proof. -red in |- *. -simpl in |- *. -intro x. -symmetry in |- *. -apply plus_n_O. + red in |- *. + simpl in |- *. + intro x. + symmetry in |- *. + apply plus_n_O. Qed. Lemma O_as_lft_unit : is_lft_unit (S:=nat_as_CSetoid) plus_is_bin_fun 0. Proof. -red in |- *. -simpl in |- *. -intro x. -reflexivity. + red in |- *. + simpl in |- *. + intro x. + reflexivity. Qed. Definition nat_is_CMonoid := Build_is_CMonoid @@ -66,22 +66,22 @@ Definition nat_is_CMonoid := Build_is_CMonoid Whence we can define ##%\emph{%the monoid of natural numbers%}%##: *) -Definition nat_as_CMonoid := Build_CMonoid nat_as_CSemiGroup _ nat_is_CMonoid. +Definition nat_as_CMonoid := Build_CMonoid nat_as_CSemiGroup _ nat_is_CMonoid. Canonical Structure nat_as_CMonoid. Lemma SO_as_rht_unit : is_rht_unit (S:=nat_as_CSetoid) mult_as_bin_fun 1. Proof. -red in |- *. -simpl. -auto with arith. + red in |- *. + simpl. + auto with arith. Qed. Lemma SO_as_lft_unit : is_lft_unit (S:=nat_as_CSetoid) mult_as_bin_fun 1. Proof. -red in |- *. -simpl. -auto with arith. + red in |- *. + simpl. + auto with arith. Qed. Definition Nmult_is_CMonoid := Build_is_CMonoid diff --git a/model/monoids/Nposmonoid.v b/model/monoids/Nposmonoid.v index e369ed6c3..376274000 100644 --- a/model/monoids/Nposmonoid.v +++ b/model/monoids/Nposmonoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Npossemigroup. Require Import CMonoids. @@ -44,23 +44,25 @@ positive natural numbers. *) Lemma rhtunitNpos : is_rht_unit Npos_mult ONEpos. -unfold is_rht_unit in |- *. -unfold Npos_mult in |- *. -intro x. -case x. -simpl in |- *. -intros scs_elem H. -auto with arith. +Proof. + unfold is_rht_unit in |- *. + unfold Npos_mult in |- *. + intro x. + case x. + simpl in |- *. + intros scs_elem H. + auto with arith. Qed. Lemma lftunitNpos : is_lft_unit Npos_mult ONEpos. -unfold is_rht_unit in |- *. -unfold Npos_mult in |- *. -intro x. -case x. -simpl in |- *. -intros scs_elem H. -auto with arith. +Proof. + unfold is_rht_unit in |- *. + unfold Npos_mult in |- *. + intro x. + case x. + simpl in |- *. + intros scs_elem H. + auto with arith. Qed. (** So, the positive natural numbers with multiplication form a CMonoid. diff --git a/model/monoids/QSposmonoid.v b/model/monoids/QSposmonoid.v index 10128a270..47d711411 100644 --- a/model/monoids/QSposmonoid.v +++ b/model/monoids/QSposmonoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export QSpossemigroup. @@ -40,22 +40,24 @@ Require Import CMonoids. (** ** Example of a monoid: $\langle$#⟨#[Qpos],$(x,y) \mapsto xy/2$ #(x,y) ↦ xy/2#$\rangle$#⟩# -Two is the unit of the operation $(x,y) \mapsto xy/2$ #(x,y) +Two is the unit of the operation $(x,y) \mapsto xy/2$ #(x,y) ↦ xy/2# on the positive rationals. So we have another monoid structure on the positive rational numbers. -*) +*) Lemma QTWOpos_is_rht_unit : is_rht_unit multdiv2 (2#1)%Qpos. -intros x. -simpl. -autorewrite with QposElim. -field. +Proof. + intros x. + simpl. + autorewrite with QposElim. + field. Qed. Lemma QTWOpos_is_lft_unit : is_lft_unit multdiv2 (2#1)%Qpos. -intros x. -simpl. -autorewrite with QposElim. -field. +Proof. + intros x. + simpl. + autorewrite with QposElim. + field. Qed. Definition Qpos_multdiv2_is_CMonoid := Build_is_CMonoid diff --git a/model/monoids/Qmonoid.v b/model/monoids/Qmonoid.v index 7b5de1179..9d87edc46 100644 --- a/model/monoids/Qmonoid.v +++ b/model/monoids/Qmonoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qsemigroup. @@ -48,16 +48,16 @@ The rational numbers form with addition a CMonoid. [QZERO] is the unit. Lemma ZEROQ_as_rht_unit3 : is_rht_unit (S:=Q_as_CSetoid) Qplus_is_bin_fun 0. Proof. -red in |- *. -simpl in |- *. -apply ZEROQ_as_rht_unit0. + red in |- *. + simpl in |- *. + apply ZEROQ_as_rht_unit0. Qed. Lemma ZEROQ_as_lft_unit3 : is_lft_unit (S:=Q_as_CSetoid) Qplus_is_bin_fun 0. Proof. -red in |- *. -simpl in |- *. -apply ZEROQ_as_lft_unit0. + red in |- *. + simpl in |- *. + apply ZEROQ_as_lft_unit0. Qed. Definition Q_is_CMonoid := Build_is_CMonoid @@ -74,22 +74,22 @@ Also with multiplication Q forms a CMonoid. Here, the unit is [QONE]. Lemma ONEQ_as_rht_unit : is_rht_unit (S:=Q_as_CSetoid) Qmult_is_bin_fun 1. Proof. -red in |- *. -simpl in |- *. -exact Qmult_n_1. + red in |- *. + simpl in |- *. + exact Qmult_n_1. Qed. Lemma ONEQ_as_lft_unit : is_lft_unit (S:=Q_as_CSetoid) Qmult_is_bin_fun 1. Proof. -red in |- *. -intro. -eapply eq_transitive_unfolded. -apply Qmult_is_commut. -apply ONEQ_as_rht_unit. + red in |- *. + intro. + eapply eq_transitive_unfolded. + apply Qmult_is_commut. + apply ONEQ_as_rht_unit. Qed. Definition Q_mul_is_CMonoid := Build_is_CMonoid - Q_mul_as_CSemiGroup _ ONEQ_as_rht_unit ONEQ_as_lft_unit. + Q_mul_as_CSemiGroup _ ONEQ_as_rht_unit ONEQ_as_lft_unit. Definition Q_mul_as_CMonoid := Build_CMonoid Q_mul_as_CSemiGroup _ Q_mul_is_CMonoid. diff --git a/model/monoids/Qposmonoid.v b/model/monoids/Qposmonoid.v index 8a18856f6..041641b09 100644 --- a/model/monoids/Qposmonoid.v +++ b/model/monoids/Qposmonoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qpossemigroup. @@ -45,16 +45,16 @@ One is the unit for multiplication on positive integers. Therefore the positive Lemma QONEpos_is_rht_unit : is_rht_unit Qpos_mult_is_bin_fun (1#1)%Qpos. Proof. -intros x. -simpl. -QposRing. + intros x. + simpl. + QposRing. Qed. Lemma QONEpos_is_lft_unit : is_lft_unit Qpos_mult_is_bin_fun (1#1)%Qpos. Proof. -intros x. -simpl. -QposRing. + intros x. + simpl. + QposRing. Qed. Definition Qpos_mult_is_CMonoid := Build_is_CMonoid diff --git a/model/monoids/Zmonoid.v b/model/monoids/Zmonoid.v index cedfe7321..5657bdddd 100644 --- a/model/monoids/Zmonoid.v +++ b/model/monoids/Zmonoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Zsemigroup. @@ -48,26 +48,27 @@ unit of monoid: Lemma ZERO_as_rht_unit : is_rht_unit (S:=Z_as_CSetoid) Zplus_is_bin_fun 0%Z. Proof. -red in |- *. -simpl in |- *. -intro x. -apply Zplus_0_r. + red in |- *. + simpl in |- *. + intro x. + apply Zplus_0_r. Qed. Lemma ZERO_as_lft_unit : is_lft_unit (S:=Z_as_CSetoid) Zplus_is_bin_fun 0%Z. Proof. -red in |- *. -simpl in |- *. -reflexivity. + red in |- *. + simpl in |- *. + reflexivity. Qed. Lemma is_unit_Z_0 :(is_unit Z_as_CSemiGroup 0%Z). -unfold is_unit. -intro a. -simpl. -split. -reflexivity. -intuition. +Proof. + unfold is_unit. + intro a. + simpl. + split. + reflexivity. + intuition. Qed. Definition Z_is_CMonoid := Build_is_CMonoid @@ -86,23 +87,23 @@ the representation we have for integers. Lemma ONE_as_rht_unit : is_rht_unit (S:=Z_as_CSetoid) Zmult_is_bin_fun 1%Z. Proof. -red in |- *. -simpl in |- *. -intro. -apply Zmult_1_r. + red in |- *. + simpl in |- *. + intro. + apply Zmult_1_r. Qed. Lemma ONE_as_lft_unit : is_lft_unit (S:=Z_as_CSetoid) Zmult_is_bin_fun 1%Z. Proof. -red in |- *. -intro. -eapply eq_transitive_unfolded. -apply Zmult_is_commut. -apply ONE_as_rht_unit. + red in |- *. + intro. + eapply eq_transitive_unfolded. + apply Zmult_is_commut. + apply ONE_as_rht_unit. Qed. Definition Z_mul_is_CMonoid := Build_is_CMonoid - Z_mul_as_CSemiGroup _ ONE_as_rht_unit ONE_as_lft_unit. + Z_mul_as_CSemiGroup _ ONE_as_rht_unit ONE_as_lft_unit. Definition Z_mul_as_CMonoid := Build_CMonoid Z_mul_as_CSemiGroup _ Z_mul_is_CMonoid. diff --git a/model/monoids/freem_to_Nm.v b/model/monoids/freem_to_Nm.v index 5fc6f1193..63b41bcbf 100644 --- a/model/monoids/freem_to_Nm.v +++ b/model/monoids/freem_to_Nm.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CMonoids. Require Export Nmonoid. @@ -44,65 +44,63 @@ Section p71E2. %\begin{convention}% Let [A:CSetoid]. %\end{convention}% -*) +*) Variable A:CSetoid. Let L: (free_monoid_as_CMonoid A)-> nat_as_CMonoid. -simpl. -unfold Astar. -intros l. -exact (length l). +Proof. + simpl. + unfold Astar. + intros l. + exact (length l). Defined. Lemma L_strext: (fun_strext L). -simpl. -unfold fun_strext. -simpl. -unfold Astar. -intros x. -induction x. -intro y. -case y. -simpl. -unfold ap_nat. -unfold CNot. -intuition. - -simpl. -intuition. - -intro y. -case y. -simpl. -intuition. - -simpl. -intros c l H. -right. -apply IHx. -unfold ap_nat in H |- *. -unfold CNot in H |- *. -intuition. +Proof. + simpl. + unfold fun_strext. + simpl. + unfold Astar. + intros x. + induction x. + intro y. + case y. + simpl. + unfold ap_nat. + unfold CNot. + intuition. + simpl. + intuition. + intro y. + case y. + simpl. + intuition. + simpl. + intros c l H. + right. + apply IHx. + unfold ap_nat in H |- *. + unfold CNot in H |- *. + intuition. Qed. Definition L_as_CSetoid_fun:= (Build_CSetoid_fun _ _ L L_strext). Lemma L_is_morphism: (morphism _ _ L_as_CSetoid_fun). -unfold morphism. -simpl. -split. -reflexivity. - -unfold Astar. -intros a. -induction a. -simpl. -reflexivity. - -simpl. -intuition. +Proof. + unfold morphism. + simpl. + split. + reflexivity. + unfold Astar. + intros a. + induction a. + simpl. + reflexivity. + simpl. + intuition. Qed. End p71E2. diff --git a/model/monoids/twoelemmonoid.v b/model/monoids/twoelemmonoid.v index 015b14eca..686914bfd 100644 --- a/model/monoids/twoelemmonoid.v +++ b/model/monoids/twoelemmonoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CMonoids. Require Export twoelemsemigroup. @@ -59,69 +59,63 @@ Definition M2_as_CMonoid:CMonoid:= Lemma two_element_CMonoids: forall (op :(CSetoid_bin_fun M1_as_CSetoid M1_as_CSetoid M1_as_CSetoid)) (H: (is_CSemiGroup M1_as_CSetoid op)), -(is_unit (Build_CSemiGroup M1_as_CSetoid op H) e1)-> +(is_unit (Build_CSemiGroup M1_as_CSetoid op H) e1)-> (forall (x y:M1_as_CSetoid),(op x y)= (M1_mult_as_bin_fun x y)) or (forall (x y:M1_as_CSetoid), (op x y)= (M2_mult_as_bin_fun x y)). -intros op H unit0. -cut (((op u u)=e1) or ((op u u)= u)). -intro H0. -unfold is_unit in unit0. -simpl in unit0. -elim H0. -clear H0. -intro H0. -left. -simpl. -intros x y. -unfold M1_CS_mult. -case x. -case y. -simpl. -set (unit1:= (unit0 e1)). -unfold M1_eq in unit1. -intuition. - -simpl. -set (unit1:= (unit0 u)). -unfold M1_eq in unit1. -intuition. - -case y. -simpl. -set (unit1:= (unit0 u)). -unfold M1_eq in unit1. -intuition. - -simpl. -exact H0. - -clear H0. -intro H0. -right. -simpl. -intros x y. -unfold M1_CS_mult. -case x. -case y. -simpl. -set (unit1:= (unit0 e1)). -unfold M1_eq in unit1. -intuition. - -simpl. -set (unit1:= (unit0 u)). -unfold M1_eq in unit1. -intuition. - -case y. -simpl. -set (unit1:= (unit0 u)). -unfold M1_eq in unit1. -intuition. - -simpl. -exact H0. -apply (M1_eq_dec (op u u)). +Proof. + intros op H unit0. + cut (((op u u)=e1) or ((op u u)= u)). + intro H0. + unfold is_unit in unit0. + simpl in unit0. + elim H0. + clear H0. + intro H0. + left. + simpl. + intros x y. + unfold M1_CS_mult. + case x. + case y. + simpl. + set (unit1:= (unit0 e1)). + unfold M1_eq in unit1. + intuition. + simpl. + set (unit1:= (unit0 u)). + unfold M1_eq in unit1. + intuition. + case y. + simpl. + set (unit1:= (unit0 u)). + unfold M1_eq in unit1. + intuition. + simpl. + exact H0. + clear H0. + intro H0. + right. + simpl. + intros x y. + unfold M1_CS_mult. + case x. + case y. + simpl. + set (unit1:= (unit0 e1)). + unfold M1_eq in unit1. + intuition. + simpl. + set (unit1:= (unit0 u)). + unfold M1_eq in unit1. + intuition. + case y. + simpl. + set (unit1:= (unit0 u)). + unfold M1_eq in unit1. + intuition. + simpl. + exact H0. + apply (M1_eq_dec (op u u)). Qed. End p68E1b1. @@ -131,19 +125,22 @@ Section p69E1. Let PM1M2:=(direct_product_as_CMonoid M1_as_CMonoid M2_as_CMonoid). Let uu: PM1M2. -simpl. -exact (pairT u u). +Proof. + simpl. + exact (pairT u u). Defined. Let e1u: PM1M2. -simpl. -exact (pairT e1 u). +Proof. + simpl. + exact (pairT e1 u). Defined. Lemma ex_69 : uu [+] uu [=]e1u. -simpl. -unfold M1_eq. -intuition. +Proof. + simpl. + unfold M1_eq. + intuition. Qed. End p69E1. @@ -152,44 +149,43 @@ Section p71E1_. Lemma M1_is_generated_by_u: (forall(m:M1_as_CMonoid), {n:nat | (@power_CMonoid M1_as_CMonoid u n)[=]m}):CProp. -simpl. -intro m. -induction m. -exists 0. -simpl. -set (H:= (eq_reflexive M1_as_CSetoid e1)). -intuition. - -exists 1. -simpl. -set (H:= (eq_reflexive M1_as_CSetoid u)). -intuition. +Proof. + simpl. + intro m. + induction m. + exists 0. + simpl. + set (H:= (eq_reflexive M1_as_CSetoid e1)). + intuition. + exists 1. + simpl. + set (H:= (eq_reflexive M1_as_CSetoid u)). + intuition. Qed. Lemma not_injective_f: Not(injective (f_as_CSetoid_fun M1_as_CMonoid u M1_is_generated_by_u)). -red. -unfold injective. -simpl. -intro H. -set (H3:=(H 0 2)). -cut (0 {#N} 2). -intro H4. -set (H5:= (H3 H4)). -set (H6:=(ap_imp_neq _ (@power_CMonoid M1_as_CMonoid u 0) - (@power_CMonoid M1_as_CMonoid u 2) H5)). -unfold cs_neq in H6. -simpl in H6. -apply H6. -set (H7:= (eq_reflexive_unfolded M1_as_CMonoid e1)). -intuition. - -unfold ap_nat. -unfold CNot. -intro H4. -cut False. -intuition. -intuition. +Proof. + red. + unfold injective. + simpl. + intro H. + set (H3:=(H 0 2)). + cut (0 {#N} 2). + intro H4. + set (H5:= (H3 H4)). + set (H6:=(ap_imp_neq _ (@power_CMonoid M1_as_CMonoid u 0) (@power_CMonoid M1_as_CMonoid u 2) H5)). + unfold cs_neq in H6. + simpl in H6. + apply H6. + set (H7:= (eq_reflexive_unfolded M1_as_CMonoid e1)). + intuition. + unfold ap_nat. + unfold CNot. + intro H4. + cut False. + intuition. + intuition. Qed. End p71E1_. @@ -197,61 +193,60 @@ End p71E1_. Section p71E2b1. Lemma not_isomorphic_M1_M2: Not (isomorphic M1_as_CMonoid M2_as_CMonoid). -unfold Not. -unfold isomorphic. -simpl. -unfold isomorphism. -unfold morphism. -simpl. -intro H. -elim H. -clear H. -intros f H. -elim H. -clear H. -intros H H0. -elim H. -clear H. -intros H H2. -unfold bijective in H0. -elim H0. -clear H0. -intros H0 H3. -unfold surjective in H3. -simpl in H3. -elim (H3 u). -intros x H4. -cut (M1_eq (f u) u). -intros H5. -set (H1:= not_M1_eq_e1_u). -unfold Not in H1. -apply H1. -unfold M1_eq in H, H2, H5 |- *. -set (H6:=(H2 u u)). -simpl in H6. -rewrite -> H in H6. -rewrite -> H5 in H6. -simpl in H6. -exact H6. - -unfold M1_eq in H, H4 |- *. -set (H1:= (M1_eq_dec x)). -unfold M1_eq in H1. -elim H1. -intro H5. -rewrite H5 in H4. -rewrite H4 in H. -set (H6:= not_M1_eq_e1_u). -unfold Not in H6. -unfold M1_eq in H6. -elim H6. -cut (u=e1). -intuition. -exact H. - -intro H5. -rewrite H5 in H4. -exact H4. +Proof. + unfold Not. + unfold isomorphic. + simpl. + unfold isomorphism. + unfold morphism. + simpl. + intro H. + elim H. + clear H. + intros f H. + elim H. + clear H. + intros H H0. + elim H. + clear H. + intros H H2. + unfold bijective in H0. + elim H0. + clear H0. + intros H0 H3. + unfold surjective in H3. + simpl in H3. + elim (H3 u). + intros x H4. + cut (M1_eq (f u) u). + intros H5. + set (H1:= not_M1_eq_e1_u). + unfold Not in H1. + apply H1. + unfold M1_eq in H, H2, H5 |- *. + set (H6:=(H2 u u)). + simpl in H6. + rewrite -> H in H6. + rewrite -> H5 in H6. + simpl in H6. + exact H6. + unfold M1_eq in H, H4 |- *. + set (H1:= (M1_eq_dec x)). + unfold M1_eq in H1. + elim H1. + intro H5. + rewrite H5 in H4. + rewrite H4 in H. + set (H6:= not_M1_eq_e1_u). + unfold Not in H6. + unfold M1_eq in H6. + elim H6. + cut (u=e1). + intuition. + exact H. + intro H5. + rewrite H5 in H4. + exact H4. Qed. End p71E2b1. diff --git a/model/non_examples/N_no_group.v b/model/non_examples/N_no_group.v index 51f1e281c..fc3cb6bc8 100644 --- a/model/non_examples/N_no_group.v +++ b/model/non_examples/N_no_group.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Nmonoid. @@ -45,16 +45,17 @@ There is no inverse function for the natural numbers with addition. Lemma no_inverse_nat_plus : forall inv : CSetoid_un_op nat_as_CSetoid, ~ is_inverse (csg_op (c:=nat_as_CSemiGroup)) 0 2 (inv 2). -simpl in |- *. -unfold plus_is_bin_fun in |- *. -intro inv. -case inv. -unfold is_inverse in |- *. -simpl in |- *. -intros a1 a2. -generalize no_inverse0. -simpl in |- *. -intuition. +Proof. + simpl in |- *. + unfold plus_is_bin_fun in |- *. + intro inv. + case inv. + unfold is_inverse in |- *. + simpl in |- *. + intros a1 a2. + generalize no_inverse0. + simpl in |- *. + intuition. Qed. (** Hence they do not form a CGroup. @@ -62,13 +63,14 @@ Qed. Lemma no_group_nat_plus : forall inv : CSetoid_un_op nat_as_CMonoid, ~ is_CGroup nat_as_CMonoid inv. -simpl in |- *. -intro inv. -red in |- *. -unfold is_CGroup in |- *. -intro H. -set (H0 := H 2) in *. -set (H1 := no_inverse_nat_plus inv) in *. -apply H1. -exact H0. +Proof. + simpl in |- *. + intro inv. + red in |- *. + unfold is_CGroup in |- *. + intro H. + set (H0 := H 2) in *. + set (H1 := no_inverse_nat_plus inv) in *. + apply H1. + exact H0. Qed. diff --git a/model/non_examples/Npos_no_group.v b/model/non_examples/Npos_no_group.v index fca1006bd..c0d3a839d 100644 --- a/model/non_examples/Npos_no_group.v +++ b/model/non_examples/Npos_no_group.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Import CGroups. @@ -45,17 +45,18 @@ There is no inverse for multiplication on the positive natural numbers. Lemma no_inverse_Nposmult : forall inv : CSetoid_un_op Npos, ~ is_inverse Npos_mult ONEpos TWOpos (inv TWOpos). -intro inv. -red in |- *. -unfold is_inverse in |- *. -intro H. -elim H. -clear H. -intros H1 H2. -clear H2. -set (H3 := no_inverse_Nposmult1) in *. -elim (H3 (inv TWOpos)). -exact H1. +Proof. + intro inv. + red in |- *. + unfold is_inverse in |- *. + intro H. + elim H. + clear H. + intros H1 H2. + clear H2. + set (H3 := no_inverse_Nposmult1) in *. + elim (H3 (inv TWOpos)). + exact H1. Qed. (** Hence the natural numbers with multiplication do not form a group. @@ -63,16 +64,14 @@ Qed. Lemma no_group_Nposmult : forall inv : CSetoid_un_op Nposmult_as_CMonoid, ~ is_CGroup Nposmult_as_CMonoid inv. -simpl in |- *. -intro inv. -red in |- *. -unfold is_CGroup in |- *. -intro H. -set - (H0 := - H (Build_subcsetoid_crr nat_as_CSetoid (fun n : nat => n <> 0) 2 (S_O 1))) - in *. -set (H1 := no_inverse_Nposmult inv) in *. -apply H1. -exact H0. +Proof. + simpl in |- *. + intro inv. + red in |- *. + unfold is_CGroup in |- *. + intro H. + set (H0 := H (Build_subcsetoid_crr nat_as_CSetoid (fun n : nat => n <> 0) 2 (S_O 1))) in *. + set (H1 := no_inverse_Nposmult inv) in *. + apply H1. + exact H0. Qed. diff --git a/model/non_examples/Npos_no_monoid.v b/model/non_examples/Npos_no_monoid.v index 0f7125f31..626f71b23 100644 --- a/model/non_examples/Npos_no_monoid.v +++ b/model/non_examples/Npos_no_monoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Npossemigroup. @@ -44,23 +44,25 @@ There is no right unit for the addition on the positive natural numbers. *) Lemma no_rht_unit_Npos : forall y : Npos, ~ is_rht_unit (S:=Npos) Npos_plus y. -unfold is_rht_unit in |- *. -intro y. -case y. -intros scs_elem scs_prf. -apply no_rht_unit_Npos1. +Proof. + unfold is_rht_unit in |- *. + intro y. + case y. + intros scs_elem scs_prf. + apply no_rht_unit_Npos1. Qed. -(** Therefore the set of positive natural numbers doesn't form a group with +(** Therefore the set of positive natural numbers doesn't form a group with addition. *) Lemma no_monoid_Npos : forall y : Npos, ~ is_CMonoid Npos_as_CSemiGroup y. -intro y. -red in |- *. -intro H. -set (H0 := no_rht_unit_Npos y) in *. -apply H0. -apply (runit Npos_as_CSemiGroup). -exact H. +Proof. + intro y. + red in |- *. + intro H. + set (H0 := no_rht_unit_Npos y) in *. + apply H0. + apply (runit Npos_as_CSemiGroup). + exact H. Qed. diff --git a/model/ordfields/CRordfield.v b/model/ordfields/CRordfield.v index 6aa0c3c4c..83e3b30ad 100644 --- a/model/ordfields/CRordfield.v +++ b/model/ordfields/CRordfield.v @@ -29,14 +29,13 @@ Open Local Scope uc_scope. Lemma CRlt_strext : Crel_strext CRasCField CRlt. Proof. -intros x1 x2 y1 y2 H. -destruct (Ccsr_strext _ _ _ (CRasCauchy_IR x2) _ (CRasCauchy_IR y2) (CR_lt_as_Cauchy_IR_lt_1 _ _ H)) as[H0|H0]. -left. -apply CR_lt_as_Cauchy_IR_lt_2. -assumption. -right. -destruct H0;[left|right]; -apply CR_ap_as_Cauchy_IR_ap_2; assumption. + intros x1 x2 y1 y2 H. + destruct (Ccsr_strext _ _ _ (CRasCauchy_IR x2) _ (CRasCauchy_IR y2) (CR_lt_as_Cauchy_IR_lt_1 _ _ H)) as[H0|H0]. + left. + apply CR_lt_as_Cauchy_IR_lt_2. + assumption. + right. + destruct H0;[left|right]; apply CR_ap_as_Cauchy_IR_ap_2; assumption. Qed. Definition CRltasCCsetoidRelation : CCSetoid_relation CRasCField := @@ -46,64 +45,51 @@ Lemma CRisCOrdField : is_COrdField CRasCField CRltasCCsetoidRelation CRle (default_greater _ CRltasCCsetoidRelation) (default_grEq CRasCField CRle). Proof. -split. - -split. -intros x y z H0 H1. -apply CR_lt_as_Cauchy_IR_lt_2. -apply less_transitive_unfolded with (CRasCauchy_IR y); - apply CR_lt_as_Cauchy_IR_lt_1; assumption. -intros x y H0 H1. -apply (less_antisymmetric_unfolded _ (CRasCauchy_IR x) (CRasCauchy_IR y)); - apply CR_lt_as_Cauchy_IR_lt_1; assumption. - -intros x y H z. -change (x+z < y + z)%CR. -apply CR_lt_as_Cauchy_IR_lt_2. -stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR z)) by - apply CR_plus_as_Cauchy_IR_plus. -stepr ((CRasCauchy_IR y)[+](CRasCauchy_IR z)) by - apply CR_plus_as_Cauchy_IR_plus. -apply plus_resp_less_rht. -apply CR_lt_as_Cauchy_IR_lt_1. -assumption. - -intros x y Hx Hy. -change ((' 0%Q) < x*y)%CR. -apply CR_lt_as_Cauchy_IR_lt_2. -stepr ((CRasCauchy_IR x)[*](CRasCauchy_IR y)) by - apply CR_mult_as_Cauchy_IR_mult. -apply: less_wdl;[|apply (CR_inject_Q_as_Cauchy_IR_inject_Q 0)]. -apply mult_resp_pos;( - apply: less_wdl;[|apply eq_symmetric;apply (CR_inject_Q_as_Cauchy_IR_inject_Q 0)]; - apply CR_lt_as_Cauchy_IR_lt_1;assumption). - -intros x y. -split. -intros H. -destruct (ap_imp_less _ _ _ (CR_ap_as_Cauchy_IR_ap_1 _ _ H));[left|right]; - apply CR_lt_as_Cauchy_IR_lt_2; assumption. -intros [H|H]; - apply CR_ap_as_Cauchy_IR_ap_2; - [apply less_imp_ap|apply Greater_imp_ap]; - apply CR_lt_as_Cauchy_IR_lt_1;assumption. - -intros x y. -rewrite <- CR_le_as_Cauchy_IR_le. -split. -intros H0 H1. -apply H0. -apply CR_lt_as_Cauchy_IR_lt_1. -assumption. -intros H0 H1. -apply H0. -apply CR_lt_as_Cauchy_IR_lt_2. -assumption. - -intros x y. -split; intros; assumption. - -reflexivity. + split. + split. + intros x y z H0 H1. + apply CR_lt_as_Cauchy_IR_lt_2. + apply less_transitive_unfolded with (CRasCauchy_IR y); apply CR_lt_as_Cauchy_IR_lt_1; assumption. + intros x y H0 H1. + apply (less_antisymmetric_unfolded _ (CRasCauchy_IR x) (CRasCauchy_IR y)); + apply CR_lt_as_Cauchy_IR_lt_1; assumption. + intros x y H z. + change (x+z < y + z)%CR. + apply CR_lt_as_Cauchy_IR_lt_2. + stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR z)) by apply CR_plus_as_Cauchy_IR_plus. + stepr ((CRasCauchy_IR y)[+](CRasCauchy_IR z)) by apply CR_plus_as_Cauchy_IR_plus. + apply plus_resp_less_rht. + apply CR_lt_as_Cauchy_IR_lt_1. + assumption. + intros x y Hx Hy. + change ((' 0%Q) < x*y)%CR. + apply CR_lt_as_Cauchy_IR_lt_2. + stepr ((CRasCauchy_IR x)[*](CRasCauchy_IR y)) by apply CR_mult_as_Cauchy_IR_mult. + apply: less_wdl;[|apply (CR_inject_Q_as_Cauchy_IR_inject_Q 0)]. + apply mult_resp_pos;( + apply: less_wdl;[|apply eq_symmetric;apply (CR_inject_Q_as_Cauchy_IR_inject_Q 0)]; + apply CR_lt_as_Cauchy_IR_lt_1;assumption). + intros x y. + split. + intros H. + destruct (ap_imp_less _ _ _ (CR_ap_as_Cauchy_IR_ap_1 _ _ H));[left|right]; + apply CR_lt_as_Cauchy_IR_lt_2; assumption. + intros [H|H]; apply CR_ap_as_Cauchy_IR_ap_2; [apply less_imp_ap|apply Greater_imp_ap]; + apply CR_lt_as_Cauchy_IR_lt_1;assumption. + intros x y. + rewrite <- CR_le_as_Cauchy_IR_le. + split. + intros H0 H1. + apply H0. + apply CR_lt_as_Cauchy_IR_lt_1. + assumption. + intros H0 H1. + apply H0. + apply CR_lt_as_Cauchy_IR_lt_2. + assumption. + intros x y. + split; intros; assumption. + reflexivity. Qed. Definition CRasCOrdField : COrdField := diff --git a/model/ordfields/Qordfield.v b/model/ordfields/Qordfield.v index 3932f105f..91ffd0003 100644 --- a/model/ordfields/Qordfield.v +++ b/model/ordfields/Qordfield.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qfield. Require Import COrdFields. @@ -46,7 +46,7 @@ Definition Qlt_is_strict_order := Build_strictorder Qlt_is_transitive_unfolded Qlt_is_antisymmetric_unfolded. Definition Q_is_COrdField := Build_is_COrdField Q_as_CField - Qlt_is_CSetoid_relation Qle (default_greater Q_as_CField Qlt_is_CSetoid_relation) + Qlt_is_CSetoid_relation Qle (default_greater Q_as_CField Qlt_is_CSetoid_relation) (default_grEq Q_as_CField Qle) Qlt_is_strict_order Qplus_resp_Qlt Qmult_resp_pos_Qlt Qlt_gives_apartness Qle_is_not_lt Qgt_is_lt Qge_is_not_gt. @@ -59,35 +59,30 @@ Proof. intros. case x. intros p q. - - exists (S (Zabs_nat p)). + exists (S (Zabs_nat p)). astepr (inject_Z (S (Zabs_nat p))). - - unfold inject_Z in |- *. - unfold zring in |- *. - simpl in |- *. - red in |- *. - unfold Qnum at 1 in |- *. - unfold Qden in |- *. - apply toCProp_Zlt. - simpl in |- *. - rewrite Zmult_1_r. - apply Zlt_le_trans with (P_of_succ_nat (Zabs_nat p) * 1)%Z. - rewrite Zmult_1_r. - case p; simpl in |- *; auto with zarith. - intros; rewrite P_of_succ_nat_o_nat_of_P_eq_succ; rewrite Pplus_one_succ_r. - change (p0 < p0 + 1)%Z in |- *. - auto with zarith. - intros; unfold Zlt in |- *; auto. - change - (P_of_succ_nat (Zabs_nat p) * 1%positive <= P_of_succ_nat (Zabs_nat p) * q)%Z - in |- *. - apply Zmult_le_compat_l. - change (Zsucc 0 <= q)%Z in |- *. - apply Zgt_le_succ. - auto with zarith. - auto with zarith. - - apply eq_symmetric_unfolded. + unfold inject_Z in |- *. + unfold zring in |- *. + simpl in |- *. + red in |- *. + unfold Qnum at 1 in |- *. + unfold Qden in |- *. + apply toCProp_Zlt. + simpl in |- *. + rewrite Zmult_1_r. + apply Zlt_le_trans with (P_of_succ_nat (Zabs_nat p) * 1)%Z. + rewrite Zmult_1_r. + case p; simpl in |- *; auto with zarith. + intros; rewrite P_of_succ_nat_o_nat_of_P_eq_succ; rewrite Pplus_one_succ_r. + change (p0 < p0 + 1)%Z in |- *. + auto with zarith. + intros; unfold Zlt in |- *; auto. + change (P_of_succ_nat (Zabs_nat p) * 1%positive <= P_of_succ_nat (Zabs_nat p) * q)%Z in |- *. + apply Zmult_le_compat_l. + change (Zsucc 0 <= q)%Z in |- *. + apply Zgt_le_succ. + auto with zarith. + auto with zarith. + apply eq_symmetric_unfolded. apply nring_Q. Qed. diff --git a/model/reals/CRreal.v b/model/reals/CRreal.v index 1f59cb762..8949fe53a 100644 --- a/model/reals/CRreal.v +++ b/model/reals/CRreal.v @@ -37,188 +37,171 @@ Open Local Scope uc_scope. Lemma CRAbsSmall_ball : forall (x y:CR) (e:Qpos), AbsSmall (R:=CRasCOrdField) (inject_Q e) ((x:CRasCOrdField)[-]y) <-> ball e x y. Proof. -intros x y e. -split. - -intros [H1 H2]. -rewrite <- (doubleSpeed_Eq x). -rewrite <- (doubleSpeed_Eq (doubleSpeed x)). -rewrite <- (doubleSpeed_Eq y). -rewrite <- (doubleSpeed_Eq (doubleSpeed y)). -apply: regFunBall_e. -intros d. -assert (H1':=H1 d). -assert (H2':=H2 d). -clear H1 H2. -simpl. -set (x':=approximate x ((1#2)*((1#2)*d))%Qpos). -set (y':=approximate y ((1#2)*((1#2)*d))%Qpos). -change (-d <= x' - y' + - - e) in H1'. -change (-d <= e + - (x' - y')) in H2'. -rewrite -> Qle_minus_iff in *. -apply: ball_weak. -split; simpl; autorewrite with QposElim; rewrite Qle_minus_iff. -replace RHS with (x' - y' + - - e + - - d) by ring. -assumption. -replace RHS with (e + - (x' - y') + - - d) by ring. -assumption. - -intros H. -rewrite <- (doubleSpeed_Eq x) in H. -rewrite <- (doubleSpeed_Eq y) in H. -split; intros d; -destruct (H ((1#2)*d)%Qpos ((1#2)*d)%Qpos) as [H1 H2]; -clear H; -set (x':=(approximate (doubleSpeed x) ((1 # 2) * d)%Qpos)) in *; -set (y':=(approximate (doubleSpeed y) ((1 # 2) * d)%Qpos)) in *. - -autorewrite with QposElim in H1. -change (- ((1 # 2) * d + e + (1 # 2) * d)<=x' - y') in H1. -change (-d <= x' - y' + - - e). -rewrite Qle_minus_iff. -rewrite -> Qle_minus_iff in H1. -replace RHS with (x' - y' + - - ((1 # 2) * d + e + (1 # 2) * d)) by ring. -assumption. - -autorewrite with QposElim in H2. -change (x' - y'<=((1 # 2) * d + e + (1 # 2) * d)) in H2. -change (-d <= e + - (x' - y')). -rewrite Qle_minus_iff. -rewrite -> Qle_minus_iff in H2. -replace RHS with ((1 # 2) * d + e + (1 # 2) * d + - (x' - y')) by ring. -assumption. + intros x y e. + split. + intros [H1 H2]. + rewrite <- (doubleSpeed_Eq x). + rewrite <- (doubleSpeed_Eq (doubleSpeed x)). + rewrite <- (doubleSpeed_Eq y). + rewrite <- (doubleSpeed_Eq (doubleSpeed y)). + apply: regFunBall_e. + intros d. + assert (H1':=H1 d). + assert (H2':=H2 d). + clear H1 H2. + simpl. + set (x':=approximate x ((1#2)*((1#2)*d))%Qpos). + set (y':=approximate y ((1#2)*((1#2)*d))%Qpos). + change (-d <= x' - y' + - - e) in H1'. + change (-d <= e + - (x' - y')) in H2'. + rewrite -> Qle_minus_iff in *. + apply: ball_weak. + split; simpl; autorewrite with QposElim; rewrite Qle_minus_iff. + replace RHS with (x' - y' + - - e + - - d) by ring. + assumption. + replace RHS with (e + - (x' - y') + - - d) by ring. + assumption. + intros H. + rewrite <- (doubleSpeed_Eq x) in H. + rewrite <- (doubleSpeed_Eq y) in H. + split; intros d; destruct (H ((1#2)*d)%Qpos ((1#2)*d)%Qpos) as [H1 H2]; clear H; + set (x':=(approximate (doubleSpeed x) ((1 # 2) * d)%Qpos)) in *; + set (y':=(approximate (doubleSpeed y) ((1 # 2) * d)%Qpos)) in *. + autorewrite with QposElim in H1. + change (- ((1 # 2) * d + e + (1 # 2) * d)<=x' - y') in H1. + change (-d <= x' - y' + - - e). + rewrite Qle_minus_iff. + rewrite -> Qle_minus_iff in H1. + replace RHS with (x' - y' + - - ((1 # 2) * d + e + (1 # 2) * d)) by ring. + assumption. + autorewrite with QposElim in H2. + change (x' - y'<=((1 # 2) * d + e + (1 # 2) * d)) in H2. + change (-d <= e + - (x' - y')). + rewrite Qle_minus_iff. + rewrite -> Qle_minus_iff in H2. + replace RHS with ((1 # 2) * d + e + (1 # 2) * d + - (x' - y')) by ring. + assumption. Qed. Lemma CRlt_Qlt : forall a b, (a < b)%Q -> ((' a%Q) < (' b))%CR. Proof. -intros a b H. -destruct (Qpos_lt_plus H) as [c Hc]. -exists c. -intros d. -change (-d <= b + - a + - c). -rewrite Hc. -rewrite Qle_minus_iff. -ring_simplify. -apply Qpos_nonneg. + intros a b H. + destruct (Qpos_lt_plus H) as [c Hc]. + exists c. + intros d. + change (-d <= b + - a + - c). + rewrite Hc. + rewrite Qle_minus_iff. + ring_simplify. + apply Qpos_nonneg. Qed. Definition CRlim (s:CauchySeq CRasCOrdField) : CR. -intros [f Hf]. -apply (ucFun (@Cjoin Q_as_MetricSpace)). -exists (fun e:QposInf => match e with - | QposInfinity => (inject_Q 0) - | Qpos2QposInf e => let (n,_) := Hf (inject_Q e) (CRlt_Qlt _ _ (Qpos_prf e)) in f n - end). -abstract ( -intros e1 e2; -destruct (Hf (inject_Q e1) (CRlt_Qlt _ _ (Qpos_prf e1))) as [n1 Hn1]; -destruct (Hf (inject_Q e2) (CRlt_Qlt _ _ (Qpos_prf e2))) as [n2 Hn2]; -apply: ball_triangle;[apply ball_sym|];rewrite <- CRAbsSmall_ball; -[apply Hn1;apply le_max_l| - apply Hn2;apply le_max_r]) using Rlim_subproof0. +Proof. + intros [f Hf]. + apply (ucFun (@Cjoin Q_as_MetricSpace)). + exists (fun e:QposInf => match e with | QposInfinity => (inject_Q 0) + | Qpos2QposInf e => let (n,_) := Hf (inject_Q e) (CRlt_Qlt _ _ (Qpos_prf e)) in f n end). + abstract ( intros e1 e2; destruct (Hf (inject_Q e1) (CRlt_Qlt _ _ (Qpos_prf e1))) as [n1 Hn1]; + destruct (Hf (inject_Q e2) (CRlt_Qlt _ _ (Qpos_prf e2))) as [n2 Hn2]; + apply: ball_triangle;[apply ball_sym|];rewrite <- CRAbsSmall_ball; [apply Hn1;apply le_max_l| + apply Hn2;apply le_max_r]) using Rlim_subproof0. Defined. Lemma CRisCReals : is_CReals CRasCOrdField CRlim. Proof. -split. - -intros [f Hf] e [d Hed]. -destruct (Hf _ (CRlt_Qlt _ _ (Qpos_prf ((1#2)*d)%Qpos))) as [n Hn]. -exists n. -intros m Hm. -apply AbsSmall_leEq_trans with (inject_Q d);[rstepr (e[-]Zero);assumption|]. -rewrite CRAbsSmall_ball. -change (nat -> Complete Q_as_MetricSpace) in f. -change (ball d (f m) (CRlim (Build_CauchySeq CRasCOrdField f Hf))). -rewrite <- (MonadLaw5 (f m)). -change (ball d (Cjoin (Cunit (f m))) (CRlim (Build_CauchySeq CRasCOrdField f Hf))). -unfold CRlim. -apply uc_prf. -change (ball d (Cunit (f m)) (Build_RegularFunction (Rlim_subproof0 f Hf))). -intros e1 e2. -simpl. -destruct (Hf (' e2)%CR (CRlt_Qlt _ _ (Qpos_prf e2))) as [a Ha]. -change (ball (e1+d+e2) (f m) (f a)). -destruct (le_ge_dec a m). - -rewrite <- CRAbsSmall_ball. -apply: AbsSmall_leEq_trans;[|apply Ha;assumption]. -intros x. -autorewrite with QposElim. -change (-x <= e1 + d + e2 - e2). -rewrite Qle_minus_iff. -ring_simplify. -change (0<=(e1+d+x)%Qpos). -apply Qpos_nonneg. - -apply ball_weak_le with ((1#2)*d+(1#2)*d)%Qpos. -rewrite Qle_minus_iff. -autorewrite with QposElim. -ring_simplify. -change (0<=(e1+e2)%Qpos). -apply Qpos_nonneg. -apply ball_triangle with (f n);[|apply ball_sym]; -rewrite <- CRAbsSmall_ball; apply Hn. -auto. -apply le_trans with m; auto. - - -(*Archimedean*) -intros x. -assert (X:=(CR_b_upperBound (1#1) x)). -destruct (CR_b (1 # 1) x) as [n d]. -rewrite (anti_convert_pred_convert n) in X. -exists (nat_of_P n)%nat. -apply: leEq_transitive. -apply X. -clear X. -intros z. -simpl. -unfold Cap_raw. -simpl. -apply Qle_trans with 0. -rewrite Qle_minus_iff. -ring_simplify. -apply Qpos_nonneg. -destruct (ZL4 n) as [a Ha]. -rewrite Ha. -clear Ha. -simpl. -unfold Cap_raw. -simpl. -rewrite <- Qle_minus_iff. -generalize ((1 # 2) * ((1 # 2) * z))%Qpos. -induction a; intros q. -simpl. -autorewrite with QposElim. -ring_simplify. -unfold Qle. -simpl. -apply Zle_1_POS. - -simpl. -unfold Cap_raw. -simpl. -rewrite Qle_minus_iff. -replace RHS with - ((approximate (nring (R:=CRasCRing) a) ((1 # 2) * q)%Qpos + 1) + - ((Psucc (P_of_succ_nat a) # d)%Qpos- 1%Q))%Q by ring. -rewrite<- Qle_minus_iff. -apply: Qle_trans;[|apply IHa]. -generalize (P_of_succ_nat a). -intros p. -rewrite Qle_minus_iff. -autorewrite with QposElim. -replace RHS with (((p#d) + 1) + - (Psucc p # d)) by ring. -rewrite <- Qle_minus_iff. -unfold Qle. -simpl. -repeat rewrite Pmult_1_r. -rewrite Pplus_one_succ_r. -repeat rewrite Zpos_mult_morphism. -apply Zmult_lt_0_le_compat_r. -auto with *. -repeat rewrite Zpos_plus_distr. -auto with *. + split. + intros [f Hf] e [d Hed]. + destruct (Hf _ (CRlt_Qlt _ _ (Qpos_prf ((1#2)*d)%Qpos))) as [n Hn]. + exists n. + intros m Hm. + apply AbsSmall_leEq_trans with (inject_Q d);[rstepr (e[-]Zero);assumption|]. + rewrite CRAbsSmall_ball. + change (nat -> Complete Q_as_MetricSpace) in f. + change (ball d (f m) (CRlim (Build_CauchySeq CRasCOrdField f Hf))). + rewrite <- (MonadLaw5 (f m)). + change (ball d (Cjoin (Cunit (f m))) (CRlim (Build_CauchySeq CRasCOrdField f Hf))). + unfold CRlim. + apply uc_prf. + change (ball d (Cunit (f m)) (Build_RegularFunction (Rlim_subproof0 f Hf))). + intros e1 e2. + simpl. + destruct (Hf (' e2)%CR (CRlt_Qlt _ _ (Qpos_prf e2))) as [a Ha]. + change (ball (e1+d+e2) (f m) (f a)). + destruct (le_ge_dec a m). + rewrite <- CRAbsSmall_ball. + apply: AbsSmall_leEq_trans;[|apply Ha;assumption]. + intros x. + autorewrite with QposElim. + change (-x <= e1 + d + e2 - e2). + rewrite Qle_minus_iff. + ring_simplify. + change (0<=(e1+d+x)%Qpos). + apply Qpos_nonneg. + apply ball_weak_le with ((1#2)*d+(1#2)*d)%Qpos. + rewrite Qle_minus_iff. + autorewrite with QposElim. + ring_simplify. + change (0<=(e1+e2)%Qpos). + apply Qpos_nonneg. + apply ball_triangle with (f n);[|apply ball_sym]; rewrite <- CRAbsSmall_ball; apply Hn. + auto. + apply le_trans with m; auto. + (*Archimedean*) + intros x. + assert (X:=(CR_b_upperBound (1#1) x)). + destruct (CR_b (1 # 1) x) as [n d]. + rewrite (anti_convert_pred_convert n) in X. + exists (nat_of_P n)%nat. + apply: leEq_transitive. + apply X. + clear X. + intros z. + simpl. + unfold Cap_raw. + simpl. + apply Qle_trans with 0. + rewrite Qle_minus_iff. + ring_simplify. + apply Qpos_nonneg. + destruct (ZL4 n) as [a Ha]. + rewrite Ha. + clear Ha. + simpl. + unfold Cap_raw. + simpl. + rewrite <- Qle_minus_iff. + generalize ((1 # 2) * ((1 # 2) * z))%Qpos. + induction a; intros q. + simpl. + autorewrite with QposElim. + ring_simplify. + unfold Qle. + simpl. + apply Zle_1_POS. + simpl. + unfold Cap_raw. + simpl. + rewrite Qle_minus_iff. + replace RHS with + ((approximate (nring (R:=CRasCRing) a) ((1 # 2) * q)%Qpos + 1) + - ((Psucc (P_of_succ_nat a) # d)%Qpos- 1%Q))%Q by ring. + rewrite<- Qle_minus_iff. + apply: Qle_trans;[|apply IHa]. + generalize (P_of_succ_nat a). + intros p. + rewrite Qle_minus_iff. + autorewrite with QposElim. + replace RHS with (((p#d) + 1) + - (Psucc p # d)) by ring. + rewrite <- Qle_minus_iff. + unfold Qle. + simpl. + repeat rewrite Pmult_1_r. + rewrite Pplus_one_succ_r. + repeat rewrite Zpos_mult_morphism. + apply Zmult_lt_0_le_compat_r. + auto with *. + repeat rewrite Zpos_plus_distr. + auto with *. Qed. Definition CRasCReals : CReals := diff --git a/model/reals/Cauchy_IR.v b/model/reals/Cauchy_IR.v index b2ec70f9a..e8a3cd86c 100644 --- a/model/reals/Cauchy_IR.v +++ b/model/reals/Cauchy_IR.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qordfield. Require Export Cauchy_CReals. diff --git a/model/rings/CRring.v b/model/rings/CRring.v index d1194e27d..86ac1fcd8 100644 --- a/model/rings/CRring.v +++ b/model/rings/CRring.v @@ -34,18 +34,16 @@ Open Local Scope uc_scope. Lemma CRmult_strext : bin_op_strext CRasCSetoid CRmult. Proof. -intros x1 x2 y1 y2 H. -simpl in *. -autorewrite with CRtoCauchy_IR in H. -assert (X:(CRasCauchy_IR x1[*]CRasCauchy_IR y1)[#](CRasCauchy_IR x2[*]CRasCauchy_IR y2)). -stepl (CRasCauchy_IR (x1*y1)%CR) by - apply eq_symmetric; apply CR_mult_as_Cauchy_IR_mult. -stepr (CRasCauchy_IR (x2*y2)%CR) by - apply eq_symmetric; apply CR_mult_as_Cauchy_IR_mult. -apply CR_ap_as_Cauchy_IR_ap_1. -assumption. -destruct (bin_op_strext_unfolded _ _ _ _ _ _ X);[left|right]; -apply CR_ap_as_Cauchy_IR_ap_2; assumption. + intros x1 x2 y1 y2 H. + simpl in *. + autorewrite with CRtoCauchy_IR in H. + assert (X:(CRasCauchy_IR x1[*]CRasCauchy_IR y1)[#](CRasCauchy_IR x2[*]CRasCauchy_IR y2)). + stepl (CRasCauchy_IR (x1*y1)%CR) by apply eq_symmetric; apply CR_mult_as_Cauchy_IR_mult. + stepr (CRasCauchy_IR (x2*y2)%CR) by apply eq_symmetric; apply CR_mult_as_Cauchy_IR_mult. + apply CR_ap_as_Cauchy_IR_ap_1. + assumption. + destruct (bin_op_strext_unfolded _ _ _ _ _ _ X);[left|right]; + apply CR_ap_as_Cauchy_IR_ap_2; assumption. Qed. Definition CRmultasBinOp : CSetoid_bin_op CRasCSetoid := @@ -53,70 +51,58 @@ Build_CSetoid_bin_fun _ _ _ _ CRmult_strext. Lemma CRmultAssoc : associative CRmultasBinOp. Proof. -intros x y z. -change (x*(y*z)==(x*y)*z)%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR (y*z)%CR)) by - apply CR_mult_as_Cauchy_IR_mult. -stepl ((CRasCauchy_IR x)[*]((CRasCauchy_IR y)[*](CRasCauchy_IR z))) by - apply bin_op_is_wd_un_op_rht; apply CR_mult_as_Cauchy_IR_mult. -stepr ((CRasCauchy_IR (x*y)%CR)[*](CRasCauchy_IR z)) by - apply CR_mult_as_Cauchy_IR_mult. -stepr (((CRasCauchy_IR x)[*](CRasCauchy_IR y))[*](CRasCauchy_IR z)) by - apply bin_op_is_wd_un_op_lft; apply CR_mult_as_Cauchy_IR_mult. -apply mult_assoc_unfolded. + intros x y z. + change (x*(y*z)==(x*y)*z)%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR (y*z)%CR)) by apply CR_mult_as_Cauchy_IR_mult. + stepl ((CRasCauchy_IR x)[*]((CRasCauchy_IR y)[*](CRasCauchy_IR z))) by + apply bin_op_is_wd_un_op_rht; apply CR_mult_as_Cauchy_IR_mult. + stepr ((CRasCauchy_IR (x*y)%CR)[*](CRasCauchy_IR z)) by apply CR_mult_as_Cauchy_IR_mult. + stepr (((CRasCauchy_IR x)[*](CRasCauchy_IR y))[*](CRasCauchy_IR z)) by + apply bin_op_is_wd_un_op_lft; apply CR_mult_as_Cauchy_IR_mult. + apply mult_assoc_unfolded. Qed. Lemma CRisCRing : is_CRing CRasCAbGroup (' 1)%CR CRmultasBinOp. Proof. -apply Build_is_CRing with CRmultAssoc. - -split. -intros x. -change (x*(' 1%Q)==x)%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR (inject_Q 1))) by - apply CR_mult_as_Cauchy_IR_mult. -stepl ((CRasCauchy_IR x)[*]One) by - apply bin_op_is_wd_un_op_rht; apply: CR_inject_Q_as_Cauchy_IR_inject_Q. -rational. -intros x. -change ((inject_Q 1%Q)*x==x)%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR (inject_Q 1))[*](CRasCauchy_IR x)) by - apply CR_mult_as_Cauchy_IR_mult. -stepl (One[*](CRasCauchy_IR x)) by - apply bin_op_is_wd_un_op_lft; apply: CR_inject_Q_as_Cauchy_IR_inject_Q. -rational. - -intros x y. -change (x*y==y*x)%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR y)) by - apply CR_mult_as_Cauchy_IR_mult. -stepr ((CRasCauchy_IR y)[*](CRasCauchy_IR x)) by - apply CR_mult_as_Cauchy_IR_mult. -rational. - -intros x y z. -change (x*(y+z)==x*y+x*z)%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR (y+z)%CR)) by - apply CR_mult_as_Cauchy_IR_mult. -stepl ((CRasCauchy_IR x)[*]((CRasCauchy_IR y)[+](CRasCauchy_IR z))) by - apply bin_op_is_wd_un_op_rht; apply CR_plus_as_Cauchy_IR_plus. -stepr ((CRasCauchy_IR (x*y)%CR)[+](CRasCauchy_IR (x*z)%CR)) by - apply CR_plus_as_Cauchy_IR_plus. -stepr (((CRasCauchy_IR x)[*](CRasCauchy_IR y))[+]((CRasCauchy_IR x)[*](CRasCauchy_IR z))). -apply dist. -apply cs_bin_op_wd; apply CR_mult_as_Cauchy_IR_mult. - -change (CRapart (inject_Q 1) (inject_Q 0)). -apply CR_ap_as_Cauchy_IR_ap_2. -apply: ap_wd. -apply one_ap_zero. -apply: CR_inject_Q_as_Cauchy_IR_inject_Q. -apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + apply Build_is_CRing with CRmultAssoc. + split. + intros x. + change (x*(' 1%Q)==x)%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR (inject_Q 1))) by apply CR_mult_as_Cauchy_IR_mult. + stepl ((CRasCauchy_IR x)[*]One) by + apply bin_op_is_wd_un_op_rht; apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + rational. + intros x. + change ((inject_Q 1%Q)*x==x)%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR (inject_Q 1))[*](CRasCauchy_IR x)) by apply CR_mult_as_Cauchy_IR_mult. + stepl (One[*](CRasCauchy_IR x)) by + apply bin_op_is_wd_un_op_lft; apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + rational. + intros x y. + change (x*y==y*x)%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR y)) by apply CR_mult_as_Cauchy_IR_mult. + stepr ((CRasCauchy_IR y)[*](CRasCauchy_IR x)) by apply CR_mult_as_Cauchy_IR_mult. + rational. + intros x y z. + change (x*(y+z)==x*y+x*z)%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR x)[*](CRasCauchy_IR (y+z)%CR)) by apply CR_mult_as_Cauchy_IR_mult. + stepl ((CRasCauchy_IR x)[*]((CRasCauchy_IR y)[+](CRasCauchy_IR z))) by + apply bin_op_is_wd_un_op_rht; apply CR_plus_as_Cauchy_IR_plus. + stepr ((CRasCauchy_IR (x*y)%CR)[+](CRasCauchy_IR (x*z)%CR)) by apply CR_plus_as_Cauchy_IR_plus. + stepr (((CRasCauchy_IR x)[*](CRasCauchy_IR y))[+]((CRasCauchy_IR x)[*](CRasCauchy_IR z))). + apply dist. + apply cs_bin_op_wd; apply CR_mult_as_Cauchy_IR_mult. + change (CRapart (inject_Q 1) (inject_Q 0)). + apply CR_ap_as_Cauchy_IR_ap_2. + apply: ap_wd. + apply one_ap_zero. + apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + apply: CR_inject_Q_as_Cauchy_IR_inject_Q. Qed. Definition CRasCRing : CRing := diff --git a/model/rings/Qring.v b/model/rings/Qring.v index af10ed3bf..45ac5c924 100644 --- a/model/rings/Qring.v +++ b/model/rings/Qring.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qabgroup. Require Import CRings. @@ -42,27 +42,28 @@ Open Local Scope Q_scope. (** ** Example of a ring: $\langle$#⟨#[Q],[[+]],[[*]]$\rangle$#⟩# -Because [Q] forms an abelian group with addition, a monoid with +Because [Q] forms an abelian group with addition, a monoid with multiplication and it satisfies the distributive law, it is a ring. *) Lemma Q_mult_plus_is_dist : distributive Qmult_is_bin_fun Qplus_is_bin_fun. Proof. -red in |- *. -simpl in |- *. -exact Qmult_plus_distr_r. + red in |- *. + simpl in |- *. + exact Qmult_plus_distr_r. Qed. Definition Q_is_CRing : is_CRing Q_as_CAbGroup QONE Qmult_is_bin_fun. -apply Build_is_CRing with Qmult_is_assoc. -apply Q_mul_is_CMonoid. -apply Qmult_is_commut. -apply Q_mult_plus_is_dist. -red in |- *. -simpl in |- *. -intro. -elim ONEQ_neq_ZEROQ. -auto. +Proof. + apply Build_is_CRing with Qmult_is_assoc. + apply Q_mul_is_CMonoid. + apply Qmult_is_commut. + apply Q_mult_plus_is_dist. + red in |- *. + simpl in |- *. + intro. + elim ONEQ_neq_ZEROQ. + auto. Defined. Definition Q_as_CRing := Build_CRing _ _ _ Q_is_CRing. @@ -77,15 +78,11 @@ Lemma injz_Nring : forall n, Proof. intro n. induction n as [| n Hrecn]. - change ((Zero:Q_as_CRing)[=]Zero) in |- *. - apply eq_reflexive_unfolded. - change - (nring (R:=Q_as_CRing) n[+]One[=]inject_Z (nring (R:=Z_as_CRing) n[+]One)) - in |- *. + change ((Zero:Q_as_CRing)[=]Zero) in |- *. + apply eq_reflexive_unfolded. + change (nring (R:=Q_as_CRing) n[+]One[=]inject_Z (nring (R:=Z_as_CRing) n[+]One)) in |- *. Step_final ((inject_Z (nring (R:=Z_as_CRing) n):Q_as_CRing)[+]One). - astepl - ((inject_Z (nring (R:=Z_as_CRing) n):Q_as_CRing)[+] - inject_Z (One:Z_as_CRing)). + astepl ((inject_Z (nring (R:=Z_as_CRing) n):Q_as_CRing)[+] inject_Z (One:Z_as_CRing)). apply eq_symmetric_unfolded. apply injz_plus. Qed. @@ -94,7 +91,7 @@ Lemma injZ_eq : forall x y : Z, x = y -> (inject_Z x:Q_as_CRing)[=]inject_Z y. Proof. intros. unfold inject_Z in |- *. - simpl in |- *. + simpl in |- *. red in |- *. simpl in |- *. rewrite H; trivial. @@ -104,12 +101,11 @@ Lemma nring_Q : forall n : nat, nring (R:=Q_as_CRing) n[=]inject_Z n. Proof. intro n. induction n as [| n Hrecn]. - change (Qmake 0%Z 1%positive==Qmake 0%Z 1%positive) in |- *. - change (Zero[=](Zero:Q_as_CRing)) in |- *. - apply eq_reflexive_unfolded. - + change (Qmake 0%Z 1%positive==Qmake 0%Z 1%positive) in |- *. + change (Zero[=](Zero:Q_as_CRing)) in |- *. + apply eq_reflexive_unfolded. change (nring (R:=Q_as_CRing) n[+]One[=]inject_Z (S n)) in |- *. - Step_final ((inject_Z n:Q_as_CRing)[+]One). + Step_final ((inject_Z n:Q_as_CRing)[+]One). astepl ((inject_Z n:Q_as_CRing)[+]inject_Z 1). simpl in |- *. red in |- *. @@ -122,18 +118,18 @@ Qed. Lemma zring_Q : forall z, zring (R:=Q_as_CRing) z[=]inject_Z z. Proof. -destruct z; simpl. + destruct z; simpl. + reflexivity. + rewrite pring_convert. + rewrite nring_Q. + rewrite convert_is_POS. reflexivity. rewrite pring_convert. rewrite nring_Q. - rewrite convert_is_POS. + unfold Qeq. + simpl. + ring_simplify. + rewrite min_convert_is_NEG. + rewrite Pmult_comm. reflexivity. -rewrite pring_convert. -rewrite nring_Q. -unfold Qeq. -simpl. -ring_simplify. -rewrite min_convert_is_NEG. -rewrite Pmult_comm. -reflexivity. -Qed. \ No newline at end of file +Qed. diff --git a/model/rings/Zring.v b/model/rings/Zring.v index ee88f3865..01a4a1482 100644 --- a/model/rings/Zring.v +++ b/model/rings/Zring.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Zabgroup. Require Import CRings. @@ -43,12 +43,12 @@ Require Import CRings. The multiplication and the addition are distributive. *) -Lemma Z_mult_plus_is_dist : distributive Zmult_is_bin_fun Zplus_is_bin_fun. +Lemma Z_mult_plus_is_dist : distributive Zmult_is_bin_fun Zplus_is_bin_fun. Proof. -red in |- *. -simpl in |- *. -intros x y z. -apply Zmult_plus_distr_r. + red in |- *. + simpl in |- *. + intros x y z. + apply Zmult_plus_distr_r. Qed. Definition Z_is_CRing := Build_is_CRing Z_as_CAbGroup _ _ Zmult_is_assoc diff --git a/model/semigroups/CRsemigroup.v b/model/semigroups/CRsemigroup.v index fc6d21946..484f409a6 100644 --- a/model/semigroups/CRsemigroup.v +++ b/model/semigroups/CRsemigroup.v @@ -34,17 +34,15 @@ Open Local Scope uc_scope. Lemma CRplus_strext : bin_op_strext CRasCSetoid (ucFun2 CRplus). Proof. -intros x1 x2 y1 y2 H. -simpl in *. -assert (X:(CRasCauchy_IR x1[+]CRasCauchy_IR y1)[#](CRasCauchy_IR x2[+]CRasCauchy_IR y2)). -stepl (CRasCauchy_IR (x1+y1)%CR) by - apply eq_symmetric; apply CR_plus_as_Cauchy_IR_plus. -stepr (CRasCauchy_IR (x2+y2)%CR) by - apply eq_symmetric; apply CR_plus_as_Cauchy_IR_plus. -apply CR_ap_as_Cauchy_IR_ap_1. -assumption. -destruct (bin_op_strext_unfolded _ _ _ _ _ _ X);[left|right]; -apply CR_ap_as_Cauchy_IR_ap_2; assumption. + intros x1 x2 y1 y2 H. + simpl in *. + assert (X:(CRasCauchy_IR x1[+]CRasCauchy_IR y1)[#](CRasCauchy_IR x2[+]CRasCauchy_IR y2)). + stepl (CRasCauchy_IR (x1+y1)%CR) by apply eq_symmetric; apply CR_plus_as_Cauchy_IR_plus. + stepr (CRasCauchy_IR (x2+y2)%CR) by apply eq_symmetric; apply CR_plus_as_Cauchy_IR_plus. + apply CR_ap_as_Cauchy_IR_ap_1. + assumption. + destruct (bin_op_strext_unfolded _ _ _ _ _ _ X);[left|right]; + apply CR_ap_as_Cauchy_IR_ap_2; assumption. Qed. Definition CRplusasBinOp : CSetoid_bin_op CRasCSetoid := @@ -52,18 +50,16 @@ Build_CSetoid_bin_fun _ _ _ _ CRplus_strext. Lemma CRisCSemiGroup : is_CSemiGroup _ CRplusasBinOp. Proof. -intros x y z. -change (x + (y+z)==(x+y)+z)%CR. -rewrite <- CR_eq_as_Cauchy_IR_eq. -stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR (y+z)%CR)) by - apply CR_plus_as_Cauchy_IR_plus. -stepl ((CRasCauchy_IR x)[+]((CRasCauchy_IR y)[+](CRasCauchy_IR z))) by - apply plus_resp_eq; apply CR_plus_as_Cauchy_IR_plus. -stepr ((CRasCauchy_IR (x+y)%CR)[+](CRasCauchy_IR z)) by - apply CR_plus_as_Cauchy_IR_plus. -stepr (((CRasCauchy_IR x)[+](CRasCauchy_IR y))[+](CRasCauchy_IR z)) by - apply bin_op_is_wd_un_op_lft; apply CR_plus_as_Cauchy_IR_plus. -apply plus_assoc_unfolded. + intros x y z. + change (x + (y+z)==(x+y)+z)%CR. + rewrite <- CR_eq_as_Cauchy_IR_eq. + stepl ((CRasCauchy_IR x)[+](CRasCauchy_IR (y+z)%CR)) by apply CR_plus_as_Cauchy_IR_plus. + stepl ((CRasCauchy_IR x)[+]((CRasCauchy_IR y)[+](CRasCauchy_IR z))) by + apply plus_resp_eq; apply CR_plus_as_Cauchy_IR_plus. + stepr ((CRasCauchy_IR (x+y)%CR)[+](CRasCauchy_IR z)) by apply CR_plus_as_Cauchy_IR_plus. + stepr (((CRasCauchy_IR x)[+](CRasCauchy_IR y))[+](CRasCauchy_IR z)) by + apply bin_op_is_wd_un_op_lft; apply CR_plus_as_Cauchy_IR_plus. + apply plus_assoc_unfolded. Qed. Definition CRasCSemiGroup : CSemiGroup := diff --git a/model/semigroups/Npossemigroup.v b/model/semigroups/Npossemigroup.v index d5d9e1014..3da6eb60e 100644 --- a/model/semigroups/Npossemigroup.v +++ b/model/semigroups/Npossemigroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CSemiGroups. Require Import Nsemigroup. @@ -41,7 +41,7 @@ Require Export Npossetoid. (** ** Examples of semi-groups: $\langle$#⟨#[Npos],[[+]]$\rangle$#⟩# and $\langle$#⟨#[Npos],[[*]]$\rangle$#⟩# *** $\langle$#⟨#[Npos],[[+]]$\rangle$#⟩# -The positive natural numbers form together with addition a subsemigroup +The positive natural numbers form together with addition a subsemigroup of the semigroup of the natural numbers with addition. *) @@ -54,17 +54,18 @@ Also together with multiplication, the positive numbers form a semigroup. *) Lemma Nposmult_is_CSemiGroup : is_CSemiGroup Npos Npos_mult. -unfold is_CSemiGroup in |- *. -unfold associative in |- *. -unfold Npos_mult in |- *. -simpl in |- *. -intros x y z. -case x. -case y. -case z. -simpl in |- *. -intros a pa b pb c pc. -auto with arith. +Proof. + unfold is_CSemiGroup in |- *. + unfold associative in |- *. + unfold Npos_mult in |- *. + simpl in |- *. + intros x y z. + case x. + case y. + case z. + simpl in |- *. + intros a pa b pb c pc. + auto with arith. Qed. Definition Nposmult_as_CSemiGroup := Build_CSemiGroup diff --git a/model/semigroups/Nsemigroup.v b/model/semigroups/Nsemigroup.v index 3020b63b2..c0d7fac2c 100644 --- a/model/semigroups/Nsemigroup.v +++ b/model/semigroups/Nsemigroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Nsetoid. Require Import CSemiGroups. @@ -49,11 +49,12 @@ Definition nat_as_CSemiGroup := Build_CSemiGroup _ plus_is_bin_fun plus_is_assoc Canonical Structure nat_as_CSemiGroup. Lemma Nmult_is_CSemiGroup : is_CSemiGroup nat_as_CSetoid mult_as_bin_fun. -unfold is_CSemiGroup in |- *. -unfold associative in |- *. -unfold mult_as_bin_fun in |- *. -simpl in |- *. -auto with arith. +Proof. + unfold is_CSemiGroup in |- *. + unfold associative in |- *. + unfold mult_as_bin_fun in |- *. + simpl in |- *. + auto with arith. Qed. Definition Nmult_as_CSemiGroup := Build_CSemiGroup diff --git a/model/semigroups/QSpossemigroup.v b/model/semigroups/QSpossemigroup.v index ddb681954..a419da38c 100644 --- a/model/semigroups/QSpossemigroup.v +++ b/model/semigroups/QSpossemigroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qpossetoid. Require Import CSemiGroups. diff --git a/model/semigroups/Qpossemigroup.v b/model/semigroups/Qpossemigroup.v index ed6efb441..d22ea80b2 100644 --- a/model/semigroups/Qpossemigroup.v +++ b/model/semigroups/Qpossemigroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qpossetoid. Require Export CSemiGroups. diff --git a/model/semigroups/Qsemigroup.v b/model/semigroups/Qsemigroup.v index 0939a7470..b5d6c590e 100644 --- a/model/semigroups/Qsemigroup.v +++ b/model/semigroups/Qsemigroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qsetoid. Require Import CSemiGroups. diff --git a/model/semigroups/Zsemigroup.v b/model/semigroups/Zsemigroup.v index 07ba50a6b..57bf81ba9 100644 --- a/model/semigroups/Zsemigroup.v +++ b/model/semigroups/Zsemigroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Zsetoid. Require Export CSemiGroups. @@ -43,8 +43,9 @@ Require Export CSemiGroups. *) Lemma Zplus_is_CSemiGroup: (is_CSemiGroup Z_as_CSetoid Zplus_is_bin_fun). -unfold is_CSemiGroup. -exact Zplus_is_assoc. +Proof. + unfold is_CSemiGroup. + exact Zplus_is_assoc. Qed. Definition Z_as_CSemiGroup := Build_CSemiGroup _ Zplus_is_bin_fun Zplus_is_assoc. @@ -58,8 +59,9 @@ Canonical Structure Z_as_CSemiGroup. *) Lemma Zmult_is_CSemiGroup: (is_CSemiGroup Z_as_CSetoid Zmult_is_bin_fun). -unfold is_CSemiGroup. -exact Zmult_is_assoc. +Proof. + unfold is_CSemiGroup. + exact Zmult_is_assoc. Qed. Definition Z_mul_as_CSemiGroup := Build_CSemiGroup _ Zmult_is_bin_fun Zmult_is_assoc. diff --git a/model/semigroups/twoelemsemigroup.v b/model/semigroups/twoelemsemigroup.v index 50ebb561f..ccdfb0c8e 100644 --- a/model/semigroups/twoelemsemigroup.v +++ b/model/semigroups/twoelemsemigroup.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CSemiGroups. Require Export twoelemsetoid. @@ -44,137 +44,128 @@ Section p68E1b1. *) Lemma M1_is_CSemiGroup:(is_CSemiGroup M1_as_CSetoid M1_mult_as_bin_fun). -unfold is_CSemiGroup. -unfold associative. -simpl. -unfold M1_CS_mult. -intros x y z. -case x. -case y. -case z. -simpl. -unfold M1_eq. -reflexivity. - -simpl. -unfold M1_eq. -reflexivity. - -case z. -simpl. -unfold M1_eq. -reflexivity. - -simpl. -unfold M1_eq. -reflexivity. - -case y. -case z. -simpl. -unfold M1_eq. -reflexivity. - -simpl. -unfold M1_eq. -reflexivity. - -case z. -simpl. -unfold M1_eq. -reflexivity. - -simpl. -unfold M1_eq. -reflexivity. +Proof. + unfold is_CSemiGroup. + unfold associative. + simpl. + unfold M1_CS_mult. + intros x y z. + case x. + case y. + case z. + simpl. + unfold M1_eq. + reflexivity. + simpl. + unfold M1_eq. + reflexivity. + case z. + simpl. + unfold M1_eq. + reflexivity. + simpl. + unfold M1_eq. + reflexivity. + case y. + case z. + simpl. + unfold M1_eq. + reflexivity. + simpl. + unfold M1_eq. + reflexivity. + case z. + simpl. + unfold M1_eq. + reflexivity. + simpl. + unfold M1_eq. + reflexivity. Qed. Lemma e1_is_lft_unit: (is_lft_unit M1_mult_as_bin_fun e1). -unfold is_lft_unit. -simpl. -unfold M1_eq. -reflexivity. +Proof. + unfold is_lft_unit. + simpl. + unfold M1_eq. + reflexivity. Qed. Lemma e1_is_rht_unit:(is_rht_unit M1_mult_as_bin_fun e1). -unfold is_rht_unit. -simpl. -unfold M1_eq. -unfold M1_CS_mult. -intro x. -case x. -simpl. -reflexivity. - -simpl. -reflexivity. +Proof. + unfold is_rht_unit. + simpl. + unfold M1_eq. + unfold M1_CS_mult. + intro x. + case x. + simpl. + reflexivity. + simpl. + reflexivity. Qed. Definition M1_as_CSemiGroup:CSemiGroup:= (Build_CSemiGroup M1_as_CSetoid M1_mult_as_bin_fun M1_is_CSemiGroup). Lemma M2_is_CSemiGroup:(is_CSemiGroup M1_as_CSetoid M2_mult_as_bin_fun). -unfold is_CSemiGroup. -unfold associative. -simpl. -intros x y z. -case x. -case y. -case z. -simpl. -unfold M1_eq. -reflexivity. - -simpl. -unfold M1_eq. -reflexivity. - -case z. -simpl. -unfold M1_eq. -reflexivity. - -simpl. -unfold M1_eq. -reflexivity. - -case y. -case z. -simpl. -unfold M1_eq. -reflexivity. - -simpl. -unfold M1_eq. -reflexivity. - -simpl. -unfold M1_eq. -reflexivity. +Proof. + unfold is_CSemiGroup. + unfold associative. + simpl. + intros x y z. + case x. + case y. + case z. + simpl. + unfold M1_eq. + reflexivity. + simpl. + unfold M1_eq. + reflexivity. + case z. + simpl. + unfold M1_eq. + reflexivity. + simpl. + unfold M1_eq. + reflexivity. + case y. + case z. + simpl. + unfold M1_eq. + reflexivity. + simpl. + unfold M1_eq. + reflexivity. + simpl. + unfold M1_eq. + reflexivity. Qed. - + Definition M2_as_CSemiGroup:= (Build_CSemiGroup M1_as_CSetoid M2_mult_as_bin_fun M2_is_CSemiGroup). -Lemma e1_is_lft_unit_M2: (is_lft_unit M2_mult_as_bin_fun e1). -unfold is_lft_unit. -simpl. -unfold M1_eq. -reflexivity. +Lemma e1_is_lft_unit_M2: (is_lft_unit M2_mult_as_bin_fun e1). +Proof. + unfold is_lft_unit. + simpl. + unfold M1_eq. + reflexivity. Qed. Lemma e1_is_rht_unit_M2: (is_rht_unit M2_mult_as_bin_fun e1). -unfold is_rht_unit. -simpl. -intro x. -case x. -simpl. -unfold M1_eq. -reflexivity. - -simpl. -unfold M1_eq. -reflexivity. +Proof. + unfold is_rht_unit. + simpl. + intro x. + case x. + simpl. + unfold M1_eq. + reflexivity. + simpl. + unfold M1_eq. + reflexivity. Qed. End p68E1b1. diff --git a/model/setoids/CRsetoid.v b/model/setoids/CRsetoid.v index b496ae17f..f18fd7aea 100644 --- a/model/setoids/CRsetoid.v +++ b/model/setoids/CRsetoid.v @@ -31,39 +31,34 @@ Require Import CornTac. Lemma CRisCSetoid : is_CSetoid CR (@st_eq CR) CRapart. Proof. -split;simpl. - -intros x H. -eapply ap_irreflexive. -apply CR_ap_as_Cauchy_IR_ap_1. -apply H. - -intros x y H. -apply CR_ap_as_Cauchy_IR_ap_2. -eapply ap_symmetric. -apply CR_ap_as_Cauchy_IR_ap_1. -apply H. - -intros x y H1 z. -destruct (ap_cotransitive _ _ _ (CR_ap_as_Cauchy_IR_ap_1 _ _ H1) (CRasCauchy_IR z));[left|right]; - apply CR_ap_as_Cauchy_IR_ap_2; assumption. - -intros x y. -change (Not (CRapart x y)<->(x==y)%CR). -rewrite <- CR_eq_as_Cauchy_IR_eq. -destruct (ap_tight _ (CRasCauchy_IR x) (CRasCauchy_IR y)) as [A B]. -split. -intros H. -apply A. -intros X. -apply H. -apply CR_ap_as_Cauchy_IR_ap_2. -assumption. - -intros H X. -apply (B H). -apply CR_ap_as_Cauchy_IR_ap_1. -apply X. + split;simpl. + intros x H. + eapply ap_irreflexive. + apply CR_ap_as_Cauchy_IR_ap_1. + apply H. + intros x y H. + apply CR_ap_as_Cauchy_IR_ap_2. + eapply ap_symmetric. + apply CR_ap_as_Cauchy_IR_ap_1. + apply H. + intros x y H1 z. + destruct (ap_cotransitive _ _ _ (CR_ap_as_Cauchy_IR_ap_1 _ _ H1) (CRasCauchy_IR z));[left|right]; + apply CR_ap_as_Cauchy_IR_ap_2; assumption. + intros x y. + change (Not (CRapart x y)<->(x==y)%CR). + rewrite <- CR_eq_as_Cauchy_IR_eq. + destruct (ap_tight _ (CRasCauchy_IR x) (CRasCauchy_IR y)) as [A B]. + split. + intros H. + apply A. + intros X. + apply H. + apply CR_ap_as_Cauchy_IR_ap_2. + assumption. + intros H X. + apply (B H). + apply CR_ap_as_Cauchy_IR_ap_1. + apply X. Qed. Definition CRasCSetoid : CSetoid := makeCSetoid CR _ CRisCSetoid. diff --git a/model/setoids/Nfinsetoid.v b/model/setoids/Nfinsetoid.v index ffdbefa8f..169c388b7 100644 --- a/model/setoids/Nfinsetoid.v +++ b/model/setoids/Nfinsetoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Import CSetoids. @@ -46,77 +46,82 @@ F_prf: F_crr F n -> Prop. -intros n a b. -case a. -case b. -intros x H x0 H0. -exact (x = x0). +Proof. + intros n a b. + case a. + case b. + intros x H x0 H0. + exact (x = x0). Defined. Definition Fap (n : nat) : F n -> F n -> CProp. -intros n a b. -case a. -case b. -intros x H x0 H0. -exact (x <> x0). +Proof. + intros n a b. + case a. + case b. + intros x H x0 H0. + exact (x <> x0). Defined. Lemma Fap_irreflexive : forall n : nat, irreflexive (Fap n). -unfold irreflexive in |- *. -unfold Fap in |- *. -intros n x. -case x. -intuition. -red in |- *. -intuition. +Proof. + unfold irreflexive in |- *. + unfold Fap in |- *. + intros n x. + case x. + intuition. + red in |- *. + intuition. Qed. Lemma Fap_symmetric : forall n : nat, Csymmetric (Fap n). -intro n. -unfold Csymmetric in |- *. -unfold Fap in |- *. -intros x y. -case x. -case y. -intuition. +Proof. + intro n. + unfold Csymmetric in |- *. + unfold Fap in |- *. + intros x y. + case x. + case y. + intuition. Qed. Lemma Fap_cotransitive : forall n : nat, cotransitive (Fap n). -intro n. -unfold cotransitive in |- *. -unfold Fap in |- *. -intros x y. -case x. -case y. -intros x0 H0 x1 H1 H2 z. -case z. -intros x2 H. -set (H5 := eq_nat_dec x2 x1) in *. -elim H5. -clear H5. -intro H5. -right. -rewrite H5. -exact H2. - -clear H5. -intro H5. -left. -exact H5. +Proof. + intro n. + unfold cotransitive in |- *. + unfold Fap in |- *. + intros x y. + case x. + case y. + intros x0 H0 x1 H1 H2 z. + case z. + intros x2 H. + set (H5 := eq_nat_dec x2 x1) in *. + elim H5. + clear H5. + intro H5. + right. + rewrite H5. + exact H2. + clear H5. + intro H5. + left. + exact H5. Qed. Lemma Fap_tight : forall n : nat, tight_apart (Feq n) (Fap n). -unfold tight_apart in |- *. -unfold Fap in |- *. -unfold Feq in |- *. -intros n x y. -case x. -case y. -intros x0 H0 x1 H1. -red in |- *. -unfold not in |- *. -unfold Not in |- *. -intuition. +Proof. + unfold tight_apart in |- *. + unfold Fap in |- *. + unfold Feq in |- *. + intros n x y. + case x. + case y. + intros x0 H0 x1 H1. + red in |- *. + unfold not in |- *. + unfold Not in |- *. + intuition. Qed. Definition less (n : nat) := diff --git a/model/setoids/Npossetoid.v b/model/setoids/Npossetoid.v index 5542a665f..de3a0ea5c 100644 --- a/model/setoids/Npossetoid.v +++ b/model/setoids/Npossetoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Nsetoid. Require Export Npossec. @@ -61,23 +61,25 @@ Definition TWOpos := Build_subcsetoid_crr _ NposP 2 (S_O 1). (** *** Addition and multiplication -Because addition and multiplication preserve positivity, we can define +Because addition and multiplication preserve positivity, we can define them on this subsetoid. *) Lemma plus_resp_Npos : bin_op_pres_pred _ NposP plus_is_bin_fun. -unfold bin_op_pres_pred in |- *. -simpl in |- *. -apply plus_resp_Npos0. +Proof. + unfold bin_op_pres_pred in |- *. + simpl in |- *. + apply plus_resp_Npos0. Qed. Definition Npos_plus := Build_SubCSetoid_bin_op _ _ plus_is_bin_fun plus_resp_Npos. Lemma mult_resp_Npos : bin_op_pres_pred _ NposP mult_as_bin_fun. -intros x y H H0. -unfold mult_as_bin_fun, NposP in |- *. -apply mult_resp_Npos0; auto. +Proof. + intros x y H H0. + unfold mult_as_bin_fun, NposP in |- *. + apply mult_resp_Npos0; auto. Qed. Definition Npos_mult := Build_SubCSetoid_bin_op _ _ mult_as_bin_fun mult_resp_Npos. @@ -86,20 +88,20 @@ Definition Npos_mult := Build_SubCSetoid_bin_op _ _ mult_as_bin_fun mult_resp_Np *) Lemma no_rht_unit_Npos1 : forall y : Npos, ~ (forall x : Npos, Npos_plus x y[=]x). -intro y. -case y. -intros scs_elem scs_prf. -cut ((1+scs_elem) <> 1). -intros H. -red in |- *. -intros H0. -apply H. -unfold not in H. -generalize - (H0 (Build_subcsetoid_crr nat_as_CSetoid NposP 1 (S_O 0))). -simpl in |- *. -intuition. -auto. +Proof. + intro y. + case y. + intros scs_elem scs_prf. + cut ((1+scs_elem) <> 1). + intros H. + red in |- *. + intros H0. + apply H. + unfold not in H. + generalize (H0 (Build_subcsetoid_crr nat_as_CSetoid NposP 1 (S_O 0))). + simpl in |- *. + intuition. + auto. Qed. (** And the multiplication doesn't have an inverse, because there can't be an @@ -107,9 +109,10 @@ inverse for 2. *) Lemma no_inverse_Nposmult1 : forall n : Npos, ~ (Npos_mult TWOpos n[=]ONEpos). -intro n. -case n. -simpl in |- *. -intros. -omega. +Proof. + intro n. + case n. + simpl in |- *. + intros. + omega. Qed. diff --git a/model/setoids/Nsetoid.v b/model/setoids/Nsetoid.v index 39116d822..2a4455d18 100644 --- a/model/setoids/Nsetoid.v +++ b/model/setoids/Nsetoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Nsec. Require Import CSetoidFun. @@ -40,31 +40,32 @@ Require Import CSetoidFun. (** ** Example of a setoid: [nat] -We will show that the natural numbers form a CSetoid. +We will show that the natural numbers form a CSetoid. *) Lemma ap_nat_irreflexive : irreflexive (A:=nat) ap_nat. Proof. -red in |- *. -apply ap_nat_irreflexive0. + red in |- *. + apply ap_nat_irreflexive0. Qed. Lemma ap_nat_symmetric : Csymmetric ap_nat. Proof. -red in |- *. -apply ap_nat_symmetric0. + red in |- *. + apply ap_nat_symmetric0. Qed. Lemma ap_nat_cotransitive : cotransitive (A:=nat) ap_nat. Proof. -red in |- *. -apply ap_nat_cotransitive0. + red in |- *. + apply ap_nat_cotransitive0. Qed. Lemma ap_nat_tight : tight_apart (A:=nat) (eq (A:=nat)) ap_nat. -red in |- *. -apply ap_nat_tight0. +Proof. + red in |- *. + apply ap_nat_tight0. Qed. Definition ap_nat_is_apartness := Build_is_CSetoid nat (eq (A:=nat)) ap_nat @@ -80,16 +81,16 @@ Canonical Structure nat_as_CSetoid. Lemma plus_wd : bin_fun_wd nat_as_CSetoid nat_as_CSetoid nat_as_CSetoid plus. Proof. -red in |- *. -simpl in |- *. -auto. + red in |- *. + simpl in |- *. + auto. Qed. Lemma plus_strext : bin_fun_strext nat_as_CSetoid nat_as_CSetoid nat_as_CSetoid plus. Proof. -red in |- *. -simpl in |- *. -apply plus_strext0. + red in |- *. + simpl in |- *. + apply plus_strext0. Qed. Definition plus_is_bin_fun := Build_CSetoid_bin_fun _ _ _ _ plus_strext. @@ -100,18 +101,18 @@ Canonical Structure plus_is_bin_fun. Lemma plus_is_assoc : associative plus_is_bin_fun. Proof. -red in |- *. -intros x y z. -simpl in |- *. -apply plus_assoc. + red in |- *. + intros x y z. + simpl in |- *. + apply plus_assoc. Qed. -Lemma plus_is_commut : commutes plus_is_bin_fun. +Lemma plus_is_commut : commutes plus_is_bin_fun. Proof. -red in |- *. -simpl in |- *. -intros x y. -exact (plus_comm x y). + red in |- *. + simpl in |- *. + intros x y. + exact (plus_comm x y). Qed. (** @@ -119,13 +120,14 @@ Qed. *) Lemma mult_strext : bin_fun_strext - nat_as_CSetoid nat_as_CSetoid nat_as_CSetoid mult. -red in |- *. -simpl in |- *. -apply mult_strext0. + nat_as_CSetoid nat_as_CSetoid nat_as_CSetoid mult. +Proof. + red in |- *. + simpl in |- *. + apply mult_strext0. Qed. -Definition mult_as_bin_fun := Build_CSetoid_bin_fun _ _ _ _ mult_strext. +Definition mult_as_bin_fun := Build_CSetoid_bin_fun _ _ _ _ mult_strext. Canonical Structure mult_as_bin_fun. (** @@ -133,58 +135,57 @@ Canonical Structure mult_as_bin_fun. *) Definition plus1 (n:nat)(m:nat): (n_ary_operation 1 nat_as_CSetoid). -simpl. -intros n m. -apply (projected_bin_fun _ _ _ plus_is_bin_fun (plus_is_bin_fun n m)). +Proof. + simpl. + intros n m. + apply (projected_bin_fun _ _ _ plus_is_bin_fun (plus_is_bin_fun n m)). Defined. Lemma to_plus1_strext:forall (n:nat), fun_strext (S1:=nat_as_CSetoid) (S2:=FS_as_CSetoid nat_as_CSetoid nat_as_CSetoid) (fun m : nat => plus1 n m). -intro n. -unfold plus1. -unfold fun_strext. -simpl. -intros x y H. -unfold ap_fun in H. -simpl in H. -elim H. -clear H. -intros a H. -set (H1:= plus_strext). -unfold bin_fun_strext in H1. -cut ((n+x{#N}n + y) or (a{#N}a)). -intro H2. -elim H2. -intro H3. -cut ((n{#N}n) or (x{#N}y)). -intro H4. -elim H4. -set (H5:=(ap_nat_irreflexive n)). -intro H6. -set (H7:= (H5 H6)). -contradiction. - -intro H5. -exact H5. - -apply H1. -exact H3. - -intro H3. -set (H5:=(ap_nat_irreflexive a)). -set (H7:= (H5 H3)). -contradiction. - -apply H1. -exact H. +Proof. + intro n. + unfold plus1. + unfold fun_strext. + simpl. + intros x y H. + unfold ap_fun in H. + simpl in H. + elim H. + clear H. + intros a H. + set (H1:= plus_strext). + unfold bin_fun_strext in H1. + cut ((n+x{#N}n + y) or (a{#N}a)). + intro H2. + elim H2. + intro H3. + cut ((n{#N}n) or (x{#N}y)). + intro H4. + elim H4. + set (H5:=(ap_nat_irreflexive n)). + intro H6. + set (H7:= (H5 H6)). + contradiction. + intro H5. + exact H5. + apply H1. + exact H3. + intro H3. + set (H5:=(ap_nat_irreflexive a)). + set (H7:= (H5 H3)). + contradiction. + apply H1. + exact H. Qed. Definition plus2 (n:nat): (n_ary_operation 2 nat_as_CSetoid). -simpl. -intro n. -apply Build_CSetoid_fun with (fun m => (plus1 n m)). -apply to_plus1_strext. +Proof. + simpl. + intro n. + apply Build_CSetoid_fun with (fun m => (plus1 n m)). + apply to_plus1_strext. Defined. @@ -192,78 +193,80 @@ Lemma to_plus2_strext:fun_strext (S1:=nat_as_CSetoid) (S2:=FS_as_CSetoid nat_as_CSetoid (FS_as_CSetoid nat_as_CSetoid nat_as_CSetoid)) (fun m : nat => plus2 m). -unfold fun_strext. -intros x y. -simpl. -unfold ap_fun. -simpl. -intro H. -elim H. -clear H. -unfold ap_fun. -intros a H. -elim H. -clear H. -intros a0 H. -unfold plus1 in H. -simpl in H. -set (H1:= (plus_strext)). -unfold bin_fun_strext in H1. -cut (((x+a){#N}(y+a)) or (a0 {#N} a0)). -intro H2. -elim H2. -clear H2. -intro H2. -set (H3:=(H1 x y a a H2)). -simpl in H3. -elim H3. -clear H3. -intro H3. -exact H3. -clear H3. -intro H3. -set (H5:=(ap_nat_irreflexive a)). -set (H7:= (H5 H3)). -contradiction. - -set (H5:=(ap_nat_irreflexive a0)). -intro H6. -set (H7:= (H5 H6)). -contradiction. - -apply H1. -exact H. +Proof. + unfold fun_strext. + intros x y. + simpl. + unfold ap_fun. + simpl. + intro H. + elim H. + clear H. + unfold ap_fun. + intros a H. + elim H. + clear H. + intros a0 H. + unfold plus1 in H. + simpl in H. + set (H1:= (plus_strext)). + unfold bin_fun_strext in H1. + cut (((x+a){#N}(y+a)) or (a0 {#N} a0)). + intro H2. + elim H2. + clear H2. + intro H2. + set (H3:=(H1 x y a a H2)). + simpl in H3. + elim H3. + clear H3. + intro H3. + exact H3. + clear H3. + intro H3. + set (H5:=(ap_nat_irreflexive a)). + set (H7:= (H5 H3)). + contradiction. + set (H5:=(ap_nat_irreflexive a0)). + intro H6. + set (H7:= (H5 H6)). + contradiction. + apply H1. + exact H. Qed. Definition plus3 :(n_ary_operation 3 nat_as_CSetoid). -simpl. -apply Build_CSetoid_fun with (fun m => (plus2 m )). -apply to_plus2_strext. +Proof. + simpl. + apply Build_CSetoid_fun with (fun m => (plus2 m )). + apply to_plus2_strext. Defined. Definition on: nat_as_CSetoid -> nat_as_CSetoid -> nat_as_CSetoid -> (n_ary_operation 3 nat_as_CSetoid)-> nat_as_CSetoid. -intros n m k p. -unfold n_ary_operation in p. -simpl in p. -elim p. -clear p. -intros pfun0 prf0. -set (pfun1 := (pfun0 n)). -elim pfun1. -clear pfun1. -intros pfun1 prf1. -set (pfun2:= (pfun1 m)). -elim pfun2. -clear pfun2. -intros pfun2 prf2. -set (pfun3:= (pfun2 k)). -exact pfun3. +Proof. + intros n m k p. + unfold n_ary_operation in p. + simpl in p. + elim p. + clear p. + intros pfun0 prf0. + set (pfun1 := (pfun0 n)). + elim pfun1. + clear pfun1. + intros pfun1 prf1. + set (pfun2:= (pfun1 m)). + elim pfun2. + clear pfun2. + intros pfun2 prf2. + set (pfun3:= (pfun2 k)). + exact pfun3. Defined. Let ex_3_ary: (on 3 5 7 plus3)[=] 3+5+7. -simpl. -reflexivity. +Proof. + simpl. + reflexivity. Qed. diff --git a/model/setoids/Qpossetoid.v b/model/setoids/Qpossetoid.v index ec2af04f8..c6531629e 100644 --- a/model/setoids/Qpossetoid.v +++ b/model/setoids/Qpossetoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qsetoid. Require Import CSetoidFun. @@ -41,29 +41,31 @@ Require Export Qpossec. (** ** Example of a setoid: [Qpos] *** Setoid -We will examine the subsetoid of positive rationals of the setoid of +We will examine the subsetoid of positive rationals of the setoid of rational numbers. *) Lemma ap_Qpos_irreflexive1 : irreflexive (A:=Qpos) Qap. Proof. -red in |- *. -firstorder using ap_Q_irreflexive0. + red in |- *. + firstorder using ap_Q_irreflexive0. Qed. Lemma ap_Qpos_symmetric1 : Csymmetric (A:=Qpos) Qap. -red in |- *. -firstorder using ap_Q_symmetric0. +Proof. + red in |- *. + firstorder using ap_Q_symmetric0. Qed. Lemma ap_Qpos_cotransitive1 : cotransitive (A:=Qpos) Qap. -red in |- *. -intros; -apply ap_Q_cotransitive0; auto. +Proof. + red in |- *. + intros; apply ap_Q_cotransitive0; auto. Qed. Lemma ap_Qpos_tight1 : tight_apart (A:=Qpos) Qeq Qap. -red in |- *. -firstorder using ap_Q_tight0. +Proof. + red in |- *. + firstorder using ap_Q_tight0. Qed. Definition ap_Qpos_is_apartness := Build_is_CSetoid _ _ _ @@ -74,28 +76,30 @@ Canonical Structure Qpos_as_CSetoid. Canonical Structure Qpos_as_Setoid := (cs_crr Qpos_as_CSetoid). Lemma Qpos_plus_strext : bin_fun_strext Qpos_as_CSetoid Qpos_as_CSetoid Qpos_as_CSetoid Qpos_plus. -red in |- *. -simpl in |- *. -intros x1 x2 y1 y2 H. -destruct (Qeq_dec x1 x2)as [A|A];[|tauto]. -right. -autorewrite with QposElim in H. -intros B. -apply H. -rewrite A. -rewrite B. -reflexivity. +Proof. + red in |- *. + simpl in |- *. + intros x1 x2 y1 y2 H. + destruct (Qeq_dec x1 x2)as [A|A];[|tauto]. + right. + autorewrite with QposElim in H. + intros B. + apply H. + rewrite A. + rewrite B. + reflexivity. Qed. Definition Qpos_plus_is_bin_fun := Build_CSetoid_bin_fun _ _ _ _ Qpos_plus_strext. Canonical Structure Qpos_plus_is_bin_fun. Lemma associative_Qpos_plus : associative Qpos_plus. -unfold associative in |- *. -intros x y z. -simpl. -autorewrite with QposElim. -apply Qplus_is_assoc. +Proof. + unfold associative in |- *. + intros x y z. + simpl. + autorewrite with QposElim. + apply Qplus_is_assoc. Qed. (** @@ -103,28 +107,30 @@ Qed. *) Lemma Qpos_mult_strext : bin_op_strext Qpos_as_CSetoid Qpos_mult. -red in |- *. -intros x1 x2 y1 y2 H. -simpl in *. -destruct (Qeq_dec x1 x2)as [A|A];[|tauto]. -right. -autorewrite with QposElim in H. -intros B. -apply H. -rewrite A. -rewrite B. -reflexivity. +Proof. + red in |- *. + intros x1 x2 y1 y2 H. + simpl in *. + destruct (Qeq_dec x1 x2)as [A|A];[|tauto]. + right. + autorewrite with QposElim in H. + intros B. + apply H. + rewrite A. + rewrite B. + reflexivity. Qed. Definition Qpos_mult_is_bin_fun : CSetoid_bin_op Qpos_as_CSetoid := Build_CSetoid_bin_fun _ _ _ _ Qpos_mult_strext. Canonical Structure Qpos_mult_is_bin_fun. Lemma associative_Qpos_mult : associative Qpos_mult. -unfold associative in |- *. -intros x y z. -simpl. -autorewrite with QposElim. -apply Qmult_is_assoc. +Proof. + unfold associative in |- *. + intros x y z. + simpl. + autorewrite with QposElim. + apply Qmult_is_assoc. Qed. (** @@ -133,8 +139,8 @@ Qed. Lemma Qpos_inv_strext : fun_strext Qpos_inv. Proof. -unfold fun_strext in |- *. -firstorder using Qpos_inv_wd. + unfold fun_strext in |- *. + firstorder using Qpos_inv_wd. Qed. Definition Qpos_inv_op := Build_CSetoid_un_op _ _ Qpos_inv_strext. @@ -150,10 +156,11 @@ Definition Qpos_div2 := projected_bin_fun _ _ _ Qpos_mult_is_bin_fun (Qpos_inv_o Definition multdiv2 := compose_CSetoid_un_bin_fun _ _ _ Qpos_mult_is_bin_fun Qpos_div2. Lemma associative_multdiv2 : associative multdiv2. -unfold associative in |- *. -intros x y z. -simpl. -QposRing. +Proof. + unfold associative in |- *. + intros x y z. + simpl. + QposRing. Qed. (** And its inverse [multdiv4]: $x \mapsto 4/x$ #x ↦ 4/x#. diff --git a/model/setoids/Qsetoid.v b/model/setoids/Qsetoid.v index acff6137f..0b9203959 100644 --- a/model/setoids/Qsetoid.v +++ b/model/setoids/Qsetoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Qsec. @@ -43,23 +43,27 @@ Require Import CSetoidFun. *** Setoid *) Lemma ap_Q_irreflexive1 : irreflexive (A:=Q) Qap. -red in |- *. -apply ap_Q_irreflexive0. +Proof. + red in |- *. + apply ap_Q_irreflexive0. Qed. Lemma ap_Q_symmetric1 : Csymmetric Qap. -red in |- *. -apply ap_Q_symmetric0. +Proof. + red in |- *. + apply ap_Q_symmetric0. Qed. Lemma ap_Q_cotransitive1 : cotransitive (A:=Q) Qap. -red in |- *. -apply ap_Q_cotransitive0. +Proof. + red in |- *. + apply ap_Q_cotransitive0. Qed. Lemma ap_Q_tight1 : tight_apart (A:=Q) Qeq Qap. -red in |- *. -apply ap_Q_tight0. +Proof. + red in |- *. + apply ap_Q_tight0. Qed. Definition ap_Q_is_apartness := Build_is_CSetoid Q Qeq Qap @@ -75,16 +79,17 @@ Canonical Structure Q_is_Setoid := (cs_crr Q_as_CSetoid). Lemma Qplus_wd : bin_fun_wd Q_as_CSetoid Q_as_CSetoid Q_as_CSetoid Qplus. Proof. -red in |- *. -simpl in |- *. -intros. -exact (Qplus_simpl x1 x2 y1 y2 H H0). + red in |- *. + simpl in |- *. + intros. + exact (Qplus_simpl x1 x2 y1 y2 H H0). Qed. Lemma Qplus_strext1 : bin_fun_strext Q_as_CSetoid Q_as_CSetoid Q_as_CSetoid Qplus. -red in |- *. -simpl in |- *. -exact Qplus_strext0. +Proof. + red in |- *. + simpl in |- *. + exact Qplus_strext0. Qed. Definition Qplus_is_bin_fun := Build_CSetoid_bin_fun _ _ _ _ Qplus_strext1. @@ -99,9 +104,9 @@ Proof Qplus_assoc. Lemma Qplus_is_commut1 : commutes Qplus_is_bin_fun. Proof. -red in |- *. -simpl in |- *. -exact Qplus_is_commut0. + red in |- *. + simpl in |- *. + exact Qplus_is_commut0. Qed. (** @@ -110,22 +115,22 @@ Qed. Lemma Qopp_wd : fun_wd (S1:=Q_as_CSetoid) (S2:=Q_as_CSetoid) Qopp. Proof. -red in |- *. -simpl in |- *. -intros. -exact (Qopp_simpl x y H). + red in |- *. + simpl in |- *. + intros. + exact (Qopp_simpl x y H). Qed. Lemma Qopp_strext : fun_strext (S1:=Q_as_CSetoid) (S2:=Q_as_CSetoid) Qopp. Proof. -red in |- *. -simpl in |- *. -unfold Qap in |- *. -intros. -red in |- *. -intro H0. -apply H. -exact (Qopp_simpl x y H0). + red in |- *. + simpl in |- *. + unfold Qap in |- *. + intros. + red in |- *. + intro H0. + apply H. + exact (Qopp_simpl x y H0). Qed. Definition Qopp_is_fun := Build_CSetoid_fun _ _ _ Qopp_strext. @@ -137,19 +142,19 @@ Canonical Structure Qopp_is_fun. Lemma Qmult_wd : bin_fun_wd Q_as_CSetoid Q_as_CSetoid Q_as_CSetoid Qmult. Proof. -red in |- *. -simpl in |- *. -intros. -apply Qmult_simpl. -assumption. -assumption. + red in |- *. + simpl in |- *. + intros. + apply Qmult_simpl. + assumption. + assumption. Qed. Lemma Qmult_strext1 : bin_fun_strext Q_as_CSetoid Q_as_CSetoid Q_as_CSetoid Qmult. Proof. -red in |- *. -simpl in |- *. -apply Qmult_strext0. + red in |- *. + simpl in |- *. + apply Qmult_strext0. Qed. Definition Qmult_is_bin_fun := Build_CSetoid_bin_fun _ _ _ _ Qmult_strext1. @@ -160,17 +165,17 @@ Canonical Structure Qmult_is_bin_fun. Lemma Qmult_is_assoc : associative Qmult_is_bin_fun. Proof. -red in |- *. -intros x y z. -simpl in |- *. -apply Qmult_assoc. + red in |- *. + intros x y z. + simpl in |- *. + apply Qmult_assoc. Qed. Lemma Qmult_is_commut : commutes Qmult_is_bin_fun. Proof. -red in |- *. -simpl in |- *. -exact Qmult_sym. + red in |- *. + simpl in |- *. + exact Qmult_sym. Qed. (** @@ -179,8 +184,8 @@ Qed. Lemma Qlt_strext : Crel_strext Q_as_CSetoid Qlt. Proof. -red in |- *. -apply Qlt_strext_unfolded. + red in |- *. + apply Qlt_strext_unfolded. Qed. Definition Qlt_is_CSetoid_relation := Build_CCSetoid_relation _ _ Qlt_strext. diff --git a/model/setoids/Zfinsetoid.v b/model/setoids/Zfinsetoid.v index ba62c605c..d57c25b15 100644 --- a/model/setoids/Zfinsetoid.v +++ b/model/setoids/Zfinsetoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export ZArith. Require Import CSetoids. @@ -47,77 +47,82 @@ ZF_prf1: (Zle 0 ZF_crr) }. Definition ZFeq (n : Z) : ZF n -> ZF n -> Prop. -intros n a b. -case a. -case b. -intros x H H' x0 H0 H0'. -exact (x = x0). +Proof. + intros n a b. + case a. + case b. + intros x H H' x0 H0 H0'. + exact (x = x0). Defined. Definition ZFap (n : Z) : ZF n -> ZF n -> CProp. -intros n a b. -case a. -case b. -intros x H H' x0 H0 H0'. -exact (x <> x0). +Proof. + intros n a b. + case a. + case b. + intros x H H' x0 H0 H0'. + exact (x <> x0). Defined. Lemma ZFap_irreflexive : forall n : Z, irreflexive (ZFap n). -unfold irreflexive in |- *. -unfold ZFap in |- *. -intros n x. -case x. -intuition. -red in |- *. -intuition. +Proof. + unfold irreflexive in |- *. + unfold ZFap in |- *. + intros n x. + case x. + intuition. + red in |- *. + intuition. Qed. Lemma ZFap_symmetric : forall n : Z, Csymmetric (ZFap n). -intro n. -unfold Csymmetric in |- *. -unfold ZFap in |- *. -intros x y. -case x. -case y. -intuition. +Proof. + intro n. + unfold Csymmetric in |- *. + unfold ZFap in |- *. + intros x y. + case x. + case y. + intuition. Qed. Lemma ZFap_cotransitive : forall n : Z, cotransitive (ZFap n). -intro n. -unfold cotransitive in |- *. -unfold ZFap in |- *. -intros x y. -case x. -case y. -intros x0 H0 H0' x1 H1 H1' H2 z. -case z. -intros x2 H H'. -set (H5 := Z_eq_dec x2 x1) in *. -elim H5. -clear H5. -intro H5. -right. -rewrite H5. -exact H2. - -clear H5. -intro H5. -left. -exact H5. +Proof. + intro n. + unfold cotransitive in |- *. + unfold ZFap in |- *. + intros x y. + case x. + case y. + intros x0 H0 H0' x1 H1 H1' H2 z. + case z. + intros x2 H H'. + set (H5 := Z_eq_dec x2 x1) in *. + elim H5. + clear H5. + intro H5. + right. + rewrite H5. + exact H2. + clear H5. + intro H5. + left. + exact H5. Qed. Lemma ZFap_tight : forall n : Z, tight_apart (ZFeq n) (ZFap n). -unfold tight_apart in |- *. -unfold ZFap in |- *. -unfold ZFeq in |- *. -intros n x y. -case x. -case y. -intros x0 H0 H0'x1 H1 H1'. -red in |- *. -unfold not in |- *. -unfold Not in |- *. -intuition. +Proof. + unfold tight_apart in |- *. + unfold ZFap in |- *. + unfold ZFeq in |- *. + intros n x y. + case x. + case y. + intros x0 H0 H0'x1 H1 H1'. + red in |- *. + unfold not in |- *. + unfold Not in |- *. + intuition. Qed. Definition Zless (n : Z) := diff --git a/model/setoids/Zsetoid.v b/model/setoids/Zsetoid.v index da95c9b2a..ffb2aba69 100644 --- a/model/setoids/Zsetoid.v +++ b/model/setoids/Zsetoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Zsec. @@ -45,26 +45,26 @@ Require Export CSetoidFun. Lemma ap_Z_irreflexive : irreflexive (A:=Z) ap_Z. Proof. -red in |- *. -apply ap_Z_irreflexive0. + red in |- *. + apply ap_Z_irreflexive0. Qed. Lemma ap_Z_symmetric : Csymmetric ap_Z. Proof. -red in |- *. -apply ap_Z_symmetric0. + red in |- *. + apply ap_Z_symmetric0. Qed. Lemma ap_Z_cotransitive : cotransitive (A:=Z) ap_Z. Proof. -red in |- *. -apply ap_Z_cotransitive0. + red in |- *. + apply ap_Z_cotransitive0. Qed. Lemma ap_Z_tight : tight_apart (A:=Z) (eq (A:=Z)) ap_Z. Proof. -red in |- *. -apply ap_Z_tight0. + red in |- *. + apply ap_Z_tight0. Qed. Definition ap_Z_is_apartness := Build_is_CSetoid Z (eq (A:=Z)) ap_Z @@ -82,17 +82,17 @@ We will prove now that the addition on the integers is a setoid function. Lemma Zplus_wd : bin_fun_wd Z_as_CSetoid Z_as_CSetoid Z_as_CSetoid Zplus. Proof. -red in |- *. -simpl in |- *. -apply Zplus_wd0. + red in |- *. + simpl in |- *. + apply Zplus_wd0. Qed. Lemma Zplus_strext : bin_fun_strext Z_as_CSetoid Z_as_CSetoid Z_as_CSetoid Zplus. Proof. -red in |- *. -simpl in |- *. -apply Zplus_strext0. + red in |- *. + simpl in |- *. + apply Zplus_strext0. Qed. Definition Zplus_is_bin_fun := Build_CSetoid_bin_fun @@ -100,22 +100,22 @@ Definition Zplus_is_bin_fun := Build_CSetoid_bin_fun Canonical Structure Zplus_is_bin_fun. (** What's more: the addition is also associative and commutative. -*) +*) Lemma Zplus_is_assoc : associative Zplus_is_bin_fun. Proof. -red in |- *. -intros x y z. -simpl in |- *. -apply Zplus_assoc. + red in |- *. + intros x y z. + simpl in |- *. + apply Zplus_assoc. Qed. Lemma Zplus_is_commut : commutes Zplus_is_bin_fun. Proof. -red in |- *. -simpl in |- *. -intros x y. -apply Zplus_comm. + red in |- *. + simpl in |- *. + intros x y. + apply Zplus_comm. Qed. (** @@ -125,22 +125,22 @@ Taking the opposite of an integer is a setoid function. Lemma Zopp_wd : fun_wd (S1:=Z_as_CSetoid) (S2:=Z_as_CSetoid) Zopp. Proof. -red in |- *. -simpl in |- *. -intros x y H. -apply (f_equal Zopp H). + red in |- *. + simpl in |- *. + intros x y H. + apply (f_equal Zopp H). Qed. Lemma Zopp_strext : fun_strext (S1:=Z_as_CSetoid) (S2:=Z_as_CSetoid) Zopp. Proof. -red in |- *. -simpl in |- *. -unfold ap_Z in |- *. -intros x y H. -intro H0. -apply H. -exact (f_equal Zopp H0). + red in |- *. + simpl in |- *. + unfold ap_Z in |- *. + intros x y H. + intro H0. + apply H. + exact (f_equal Zopp H0). Qed. Definition Zopp_is_fun := @@ -155,20 +155,20 @@ Finally the multiplication is a setoid function and is associative and commutati Lemma Zmult_wd : bin_fun_wd Z_as_CSetoid Z_as_CSetoid Z_as_CSetoid Zmult. Proof. -red in |- *. -simpl in |- *. -intros x1 x2 y1 y2 H H0. -apply (f_equal2 Zmult (x1:=x1) (y1:=x2) (x2:=y1) (y2:=y2)). -assumption. -assumption. + red in |- *. + simpl in |- *. + intros x1 x2 y1 y2 H H0. + apply (f_equal2 Zmult (x1:=x1) (y1:=x2) (x2:=y1) (y2:=y2)). + assumption. + assumption. Qed. Lemma Zmult_strext : bin_fun_strext Z_as_CSetoid Z_as_CSetoid Z_as_CSetoid Zmult. Proof. -red in |- *. -simpl in |- *. -apply Zmult_strext0. + red in |- *. + simpl in |- *. + apply Zmult_strext0. Qed. Definition Zmult_is_bin_fun := Build_CSetoid_bin_fun @@ -177,19 +177,19 @@ Canonical Structure Zmult_is_bin_fun. Lemma Zmult_is_assoc : associative Zmult_is_bin_fun. Proof. -red in |- *. -intros x y z. -simpl in |- *. -apply Zmult_assoc. + red in |- *. + intros x y z. + simpl in |- *. + apply Zmult_assoc. Qed. Lemma Zmult_is_commut : commutes Zmult_is_bin_fun. Proof. -red in |- *. -simpl in |- *. -intros x y. -apply Zmult_comm. + red in |- *. + simpl in |- *. + intros x y. + apply Zmult_comm. Qed. (** @@ -197,6 +197,7 @@ Qed. *) Lemma is_nullary_operation_Z_0 : (is_nullary_operation Z_as_CSetoid 0%Z). -unfold is_nullary_operation. -intuition. +Proof. + unfold is_nullary_operation. + intuition. Qed. diff --git a/model/setoids/twoelemsetoid.v b/model/setoids/twoelemsetoid.v index dc7cbb10a..198a83056 100644 --- a/model/setoids/twoelemsetoid.v +++ b/model/setoids/twoelemsetoid.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CSetoidFun. @@ -50,50 +50,50 @@ Definition M1_eq :(Relation M1):= fun a => fun b => (a=b). Definition M1_ap : (Crelation M1):= fun a => fun b => Not (a=b). Lemma M1_ap_irreflexive: (irreflexive M1_ap). -intro x. -unfold M1_ap. -red. -intuition. +Proof. + intro x. + unfold M1_ap. + red. + intuition. Qed. Lemma M1_ap_symmetric: (Csymmetric M1_ap). -unfold Csymmetric. -unfold M1_ap. -red. -intuition. +Proof. + unfold Csymmetric. + unfold M1_ap. + red. + intuition. Qed. Lemma M1_ap_cotransitive: (cotransitive M1_ap). -unfold cotransitive. -unfold M1_ap. -unfold Not. -intros x y H z. -induction x. -induction y. -intuition. - -induction z. -intuition. - -intuition. - -induction y. -induction z. -intuition. -intuition. -intuition. +Proof. + unfold cotransitive. + unfold M1_ap. + unfold Not. + intros x y H z. + induction x. + induction y. + intuition. + induction z. + intuition. + intuition. + induction y. + induction z. + intuition. + intuition. + intuition. Qed. Lemma M1_eq_dec: forall(x:M1),(M1_eq x e1) or (M1_eq x u). -intros x. -induction x. -left. -unfold M1_eq. -reflexivity. - -right. -unfold M1_eq. -reflexivity. +Proof. + intros x. + induction x. + left. + unfold M1_eq. + reflexivity. + right. + unfold M1_eq. + reflexivity. Qed. Definition is_e1 (x:M1):Prop := @@ -103,42 +103,39 @@ match x with end. Lemma not_M1_eq_e1_u:Not (M1_eq e1 u). -red. -intros H. -change (is_e1 u). -unfold M1_eq in H. -rewrite<- H. -exact I. +Proof. + red. + intros H. + change (is_e1 u). + unfold M1_eq in H. + rewrite<- H. + exact I. Qed. Lemma M1_ap_tight: (tight_apart M1_eq M1_ap). -unfold tight_apart. -unfold M1_eq. -unfold M1_ap. -intros x y. -split. -induction x. -induction y. -intuition. - -unfold Not. -intro H. -cut (e1=u -> False). -intuition. - -apply not_M1_eq_e1_u. - -induction y. -2:intuition. -2:unfold Not. -2:intuition. - -unfold Not. -intro H. -cut (e1=u -> False ). -intuition. - -apply not_M1_eq_e1_u. +Proof. + unfold tight_apart. + unfold M1_eq. + unfold M1_ap. + intros x y. + split. + induction x. + induction y. + intuition. + unfold Not. + intro H. + cut (e1=u -> False). + intuition. + apply not_M1_eq_e1_u. + induction y. + 2:intuition. + 2:unfold Not. + 2:intuition. + unfold Not. + intro H. + cut (e1=u -> False ). + intuition. + apply not_M1_eq_e1_u. Qed. Definition M1_is_CSetoid:(is_CSetoid M1 M1_eq M1_ap) := @@ -154,99 +151,87 @@ match x with |e1 => u |u => e1 end -end. +end. Definition M1_CS_mult: M1_as_CSetoid -> M1_as_CSetoid -> M1_as_CSetoid. -simpl. -exact M1_mult. +Proof. + simpl. + exact M1_mult. Defined. Lemma M1_CS_mult_strext:(bin_fun_strext M1_as_CSetoid M1_as_CSetoid M1_as_CSetoid M1_CS_mult). -unfold bin_fun_strext. -intros x1 x2 y1 y2. -case x1. -case x2. -case y1. -case y2. -simpl. -intuition. - -simpl. -intuition. -case y2. -simpl. -intuition. -simpl. - -intuition. - -case y1. -case y2. -simpl. -intuition. - -simpl. -unfold M1_ap. -unfold Not. -intuition. - -case y2. -simpl. -unfold M1_ap. -unfold Not. -intuition. - -simpl. -intro H. -left. -apply M1_ap_symmetric. -exact H. - -case x2. -case y1. -case y2. -simpl. -intuition. - -simpl. -unfold M1_ap. -unfold Not. -intuition. - -case y2. -simpl. -unfold M1_ap. -unfold Not. -intuition. - -simpl. -intro H. -left. -apply M1_ap_symmetric. -exact H. - -case y1. -case y2. -simpl. -intuition. - -simpl. -intro H. -right. -apply M1_ap_symmetric. -exact H. - -case y2. -simpl. -intro H. -right. -apply M1_ap_symmetric. -exact H. - -simpl. -unfold M1_ap. -unfold Not. -intuition. +Proof. + unfold bin_fun_strext. + intros x1 x2 y1 y2. + case x1. + case x2. + case y1. + case y2. + simpl. + intuition. + simpl. + intuition. + case y2. + simpl. + intuition. + simpl. + intuition. + case y1. + case y2. + simpl. + intuition. + simpl. + unfold M1_ap. + unfold Not. + intuition. + case y2. + simpl. + unfold M1_ap. + unfold Not. + intuition. + simpl. + intro H. + left. + apply M1_ap_symmetric. + exact H. + case x2. + case y1. + case y2. + simpl. + intuition. + simpl. + unfold M1_ap. + unfold Not. + intuition. + case y2. + simpl. + unfold M1_ap. + unfold Not. + intuition. + simpl. + intro H. + left. + apply M1_ap_symmetric. + exact H. + case y1. + case y2. + simpl. + intuition. + simpl. + intro H. + right. + apply M1_ap_symmetric. + exact H. + case y2. + simpl. + intro H. + right. + apply M1_ap_symmetric. + exact H. + simpl. + unfold M1_ap. + unfold Not. + intuition. Qed. Definition M1_mult_as_bin_fun:= @@ -259,84 +244,72 @@ match x with end. Definition M2_CS_mult: M1_as_CSetoid -> M1_as_CSetoid -> M1_as_CSetoid. -simpl. -exact M2_mult. +Proof. + simpl. + exact M2_mult. Defined. Lemma M2_CS_mult_strext: (bin_fun_strext M1_as_CSetoid M1_as_CSetoid M1_as_CSetoid M2_CS_mult). -unfold bin_fun_strext. -intros x1 x2 y1 y2. -case x1. -case x2. -case y1. -case y2. -simpl. -intuition. - -simpl. -intuition. - -case y2. -simpl. -intuition. - -simpl. -intuition. - -case y1. -case y2. -simpl. -intuition. - -simpl. -intuition. - -case y2. -simpl. -unfold M1_ap. -unfold Not. -intuition. - -simpl. -intuition. - -case x2. -case y1. -case y2. -simpl. -intuition. -simpl. -unfold M1_ap. -unfold Not. -intuition. - -case y2. -simpl. -intuition. - -simpl. -unfold M1_ap. -unfold Not. -intuition. - -case y1. -case y2. -simpl. -intuition. - -simpl. -intuition. - -case y2. -simpl. -intuition. - -simpl. -intuition. +Proof. + unfold bin_fun_strext. + intros x1 x2 y1 y2. + case x1. + case x2. + case y1. + case y2. + simpl. + intuition. + simpl. + intuition. + case y2. + simpl. + intuition. + simpl. + intuition. + case y1. + case y2. + simpl. + intuition. + simpl. + intuition. + case y2. + simpl. + unfold M1_ap. + unfold Not. + intuition. + simpl. + intuition. + case x2. + case y1. + case y2. + simpl. + intuition. + simpl. + unfold M1_ap. + unfold Not. + intuition. + case y2. + simpl. + intuition. + simpl. + unfold M1_ap. + unfold Not. + intuition. + case y1. + case y2. + simpl. + intuition. + simpl. + intuition. + case y2. + simpl. + intuition. + simpl. + intuition. Qed. -Definition M2_mult_as_bin_fun:= - (Build_CSetoid_bin_fun M1_as_CSetoid M1_as_CSetoid M1_as_CSetoid +Definition M2_mult_as_bin_fun:= + (Build_CSetoid_bin_fun M1_as_CSetoid M1_as_CSetoid M1_as_CSetoid M2_CS_mult M2_CS_mult_strext). End p68E1b1. diff --git a/model/structures/Npossec.v b/model/structures/Npossec.v index 296ccddea..209f1aa20 100644 --- a/model/structures/Npossec.v +++ b/model/structures/Npossec.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Npos $\mathbb{N}^{+}$ #N+# *) @@ -41,61 +41,63 @@ Require Import Arith. (** ** [Npos] -The positive natural numbers have some nice properties. Addition as well +The positive natural numbers have some nice properties. Addition as well as multiplication preserve the feature of being positive. *) Lemma plus_resp_Npos0 : forall x y : nat, x <> 0 -> y <> 0 -> (x+y) <> 0. -intros x y H H0. -unfold not in |- *. -intros H1. -unfold not in H. -apply H. -omega. +Proof. + intros x y H H0. + unfold not in |- *. + intros H1. + unfold not in H. + apply H. + omega. Qed. Lemma Npos_is_suc : forall y : nat, y <> 0 -> exists m : nat, y = S m. -intros y H. -exists (pred y). -unfold pred in |- *. -induction y as [| y Hrecy]. -intuition. -intuition. +Proof. + intros y H. + exists (pred y). + unfold pred in |- *. + induction y as [| y Hrecy]. + intuition. + intuition. Qed. Lemma mult_resp_Npos0 : forall x y : nat, x <> 0 -> y <> 0 -> (x*y) <> 0. -intros x y H H0. -set (H1 := Npos_is_suc y H0) in *. -elim H1. -intros y0 H2. -rewrite H2 in H1. -rewrite H2 in H0. -rewrite H2. -generalize y0. -clear H1 H0 H2 y0 y. -intro y0. -induction y0 as [| y0 Hrecy0]. -rewrite mult_comm. -rewrite mult_1_l. -exact H. - -rewrite <- mult_n_Sm. -cut (0 <> (x*S y0+x) -> (x*S y0+x) <> 0). -intro H3. -apply H3. -apply lt_O_neq. -cut ((x*S y0+x) > 0). -unfold gt in |- *. -intuition. -apply gt_trans with (x*S y0). -apply gt_le_trans with (x*S y0+0). -apply plus_gt_compat_l. -omega. -omega. -unfold gt in |- *. -apply neq_O_lt. -cut ((x*S y0) <> 0). -auto. -apply Hrecy0. -auto. +Proof. + intros x y H H0. + set (H1 := Npos_is_suc y H0) in *. + elim H1. + intros y0 H2. + rewrite H2 in H1. + rewrite H2 in H0. + rewrite H2. + generalize y0. + clear H1 H0 H2 y0 y. + intro y0. + induction y0 as [| y0 Hrecy0]. + rewrite mult_comm. + rewrite mult_1_l. + exact H. + rewrite <- mult_n_Sm. + cut (0 <> (x*S y0+x) -> (x*S y0+x) <> 0). + intro H3. + apply H3. + apply lt_O_neq. + cut ((x*S y0+x) > 0). + unfold gt in |- *. + intuition. + apply gt_trans with (x*S y0). + apply gt_le_trans with (x*S y0+0). + apply plus_gt_compat_l. + omega. + omega. + unfold gt in |- *. + apply neq_O_lt. + cut ((x*S y0) <> 0). + auto. + apply Hrecy0. + auto. Qed. diff --git a/model/structures/Nsec.v b/model/structures/Nsec.v index fad9c729d..c11607238 100644 --- a/model/structures/Nsec.v +++ b/model/structures/Nsec.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing {#N} $\ensuremath{\mathrel\#_{\mathbb N}}$ *) @@ -50,15 +50,16 @@ A variant of [0_S] from the standard library *) Lemma S_O : forall n : nat, S n <> 0. -intro n. -red in |- *. -intro H. -generalize O_S. -intro H0. -red in H0. -apply H0 with n. -apply sym_eq. -exact H. +Proof. + intro n. + red in |- *. + intro H. + generalize O_S. + intro H0. + red in H0. + apply H0 with n. + apply sym_eq. + exact H. Qed. (** @@ -70,14 +71,16 @@ Definition ap_nat (x y : nat) := ~ (x = y :>nat). Infix "{#N}" := ap_nat (no associativity, at level 90). Lemma ap_nat_irreflexive0 : forall x : nat, Not (x{#N}x). -red in |- *. -unfold ap_nat in |- *. -intros x X. -apply X. -auto. +Proof. + red in |- *. + unfold ap_nat in |- *. + intros x X. + apply X. + auto. Qed. Lemma ap_nat_symmetric0 : forall x y : nat, (x{#N}y) -> y{#N}x. +Proof. intros x y. unfold ap_nat in |- *. intros X. @@ -88,13 +91,14 @@ Qed. Lemma ap_nat_cotransitive0 : forall x y : nat, (x{#N}y) -> forall z : nat, (x{#N}z) or (z{#N}y). - intros x y X z. +Proof. + intros x y X z. unfold ap_nat in |- *. case (eq_nat_dec x z). - intro e. - right. - rewrite <- e. - assumption. + intro e. + right. + rewrite <- e. + assumption. intro. left. intro. @@ -103,19 +107,20 @@ Lemma ap_nat_cotransitive0 : forall x y : nat, Qed. Lemma ap_nat_tight0 : forall x y : nat, Not (x{#N}y) <-> x = y. -intros x y. +Proof. + intros x y. red in |- *. split. - unfold ap_nat in |- *. - intro H. - case (eq_nat_dec x y). - intro e. - assumption. - intro n. - elim H. - intro H0. - elim n. - assumption. + unfold ap_nat in |- *. + intro H. + case (eq_nat_dec x y). + intro e. + assumption. + intro n. + elim H. + intro H0. + elim n. + assumption. intro H. unfold ap_nat in |- *. intro H0. @@ -129,39 +134,41 @@ Qed. Lemma plus_strext0 : forall x1 x2 y1 y2 : nat, (x1+y1{#N}x2+y2) -> (x1{#N}x2) or (y1{#N}y2). -intros x1 x2 y1 y2 H. -unfold ap_nat in |- *. -unfold ap_nat in H. -case (eq_nat_dec x1 x2). -intro e. -right. -red in |- *. -intro H0. -apply H. -auto. -intro n. -left. -intro H0. -elim n. -assumption. +Proof. + intros x1 x2 y1 y2 H. + unfold ap_nat in |- *. + unfold ap_nat in H. + case (eq_nat_dec x1 x2). + intro e. + right. + red in |- *. + intro H0. + apply H. + auto. + intro n. + left. + intro H0. + elim n. + assumption. Qed. (** There is no inverse for addition, because every candidate will fail for 2 *) Lemma no_inverse0 : forall f : nat -> nat, ~ ((2+f 2) = 0 /\ (f 2+2) = 0). -intro f. -simpl in |- *. -red in |- *. -intro H. -elim H. -intros H1 H2. -set (H3 := O_S (S (f 2))) in *. -generalize H3. -unfold not in |- *. -intro H4. -apply H4. -omega. +Proof. + intro f. + simpl in |- *. + red in |- *. + intro H. + elim H. + intros H1 H2. + set (H3 := O_S (S (f 2))) in *. + generalize H3. + unfold not in |- *. + intro H4. + apply H4. + omega. Qed. @@ -172,93 +179,94 @@ Qed. Lemma mult_strext0 : forall x1 x2 y1 y2 : nat, (x1*y1{#N}x2*y2) -> (x1{#N}x2) or (y1{#N}y2). -unfold ap_nat in |- *. -intros x1 x2 y1 y2 H. -cut ({x1 = x2} + {x1 <> x2}). -intro H1. -elim H1. -intro e. -right. -red in |- *. -intro H0. -apply H. -exact (f_equal2 mult e H0). -intro X. -auto. -apply eq_nat_dec. +Proof. + unfold ap_nat in |- *. + intros x1 x2 y1 y2 H. + cut ({x1 = x2} + {x1 <> x2}). + intro H1. + elim H1. + intro e. + right. + red in |- *. + intro H0. + apply H. + exact (f_equal2 mult e H0). + intro X. + auto. + apply eq_nat_dec. Qed. (** *** Decidability *) Lemma not_or:(forall (p q:nat), (p<>q)-> p k=0. -intros k i l H. -unfold Not in H. -set (H1:=(lt_eq_lt_dec 0 k)). -elim H1. -clear H1. -intro H1. -elim H1. -clear H1. -intuition. -intuition. -intuition. +Proof. + intros k i l H. + unfold Not in H. + set (H1:=(lt_eq_lt_dec 0 k)). + elim H1. + clear H1. + intro H1. + elim H1. + clear H1. + intuition. + intuition. + intuition. Qed. Lemma lexi_dec:(forall (k i l:nat), Cdecidable (0 Qlt_minus_iff in H1;assumption. +Proof. + intros [a [H0 H1]]. + simpl. + rewrite -> Qlt_minus_iff in H1;assumption. Qed. Lemma OpenUnit_Dual_lt_1 : forall (a:OpenUnit), 1-a < 1. -intros [a [H0 H1]]. -simpl. -rewrite Qlt_minus_iff. -replace RHS with a by ring. -assumption. +Proof. + intros [a [H0 H1]]. + simpl. + rewrite Qlt_minus_iff. + replace RHS with a by ring. + assumption. Qed. (* begin hide *) Hint Resolve OpenUnit_0_lt OpenUnit_lt_1 OpenUnit_0_lt_Dual OpenUnit_Dual_lt_1 : ouarith. (* end hide *) (** Multiplication *) Definition OpenUnitMult (a b:OpenUnit):OpenUnit. -intros a b. -exists (a * b). -abstract(destruct a as [a [Ha0 Ha1]]; destruct b as [b [Hb0 Hb1]]; -split; simpl; - [apply: mult_resp_pos; assumption - |change (1:Q) with (1*1); - apply: mult_resp_less_both;auto with *]). +Proof. + intros a b. + exists (a * b). + abstract(destruct a as [a [Ha0 Ha1]]; destruct b as [b [Hb0 Hb1]]; split; simpl; + [apply: mult_resp_pos; assumption |change (1:Q) with (1*1); + apply: mult_resp_less_both;auto with *]). Defined. Notation "x * y":=(OpenUnitMult x y) : ou_scope. (** Division *) Definition OpenUnitDiv (a b:OpenUnit):(aOpenUnit. -intros a b p. -exists (a/b). -abstract (destruct a as [a [Ha0 Ha1]]; destruct b as [b [Hb0 Hb1]]; -split; simpl;[ - apply Qlt_shift_div_l; auto; ring_simplify; auto| - apply Qlt_shift_div_r; auto; ring_simplify; auto]). +Proof. + intros a b p. + exists (a/b). + abstract (destruct a as [a [Ha0 Ha1]]; destruct b as [b [Hb0 Hb1]]; split; simpl;[ + apply Qlt_shift_div_l; auto; ring_simplify; auto| + apply Qlt_shift_div_r; auto; ring_simplify; auto]). Defined. (** The dual of a is 1-a *) Definition OpenUnitDual (a:OpenUnit):OpenUnit. -intros a. -exists (1-a). -abstract (destruct a as [a [Ha0 Ha1]]; -simpl; split; rewrite -> Qlt_minus_iff in *;[ -(replace RHS with (1+-a) by ring); auto| -(replace RHS with (a+-0) by ring); auto]). +Proof. + intros a. + exists (1-a). + abstract (destruct a as [a [Ha0 Ha1]]; simpl; split; rewrite -> Qlt_minus_iff in *;[ + (replace RHS with (1+-a) by ring); auto| (replace RHS with (a+-0) by ring); auto]). Defined. (** The dual of multipliation: 1 - (1-a)*(1-b) or a + b - a*b *) Definition OpenUnitDualMult (a b:OpenUnit):OpenUnit. -intros a b. -exists (a + b - a * b). -abstract ( -split; -[(replace RHS with (OpenUnitDual ((OpenUnitDual a)*(OpenUnitDual b)):Q) by simpl; ring); - auto with * -|(replace LHS with (OpenUnitDual ((OpenUnitDual a)*(OpenUnitDual b)):Q) by simpl; ring); - auto with *]). +Proof. + intros a b. + exists (a + b - a * b). + abstract ( split; + [(replace RHS with (OpenUnitDual ((OpenUnitDual a)*(OpenUnitDual b)):Q) by simpl; ring); + auto with * + |(replace LHS with (OpenUnitDual ((OpenUnitDual a)*(OpenUnitDual b)):Q) by simpl; ring); + auto with *]). Defined. (** The dual of division: 1 - (1-b)/(1-a) or (b-a)/(1-a) *) Definition OpenUnitDualDiv (b a:OpenUnit):(aOpenUnit. -intros b a p. -exists ((b-a)/(1-a)). -abstract ( -assert (X:OpenUnitDual b < OpenUnitDual a); -[rewrite -> Qlt_minus_iff in *; - simpl; - (replace RHS with (b + - a) by ring); - assumption -|split; - [(replace RHS with (OpenUnitDual (OpenUnitDiv _ _ X):Q) by simpl; field; auto with *); - auto with * - |(replace LHS with (OpenUnitDual (OpenUnitDiv _ _ X):Q) by simpl; field; auto with *); - auto with *]]). +Proof. + intros b a p. + exists ((b-a)/(1-a)). + abstract ( assert (X:OpenUnitDual b < OpenUnitDual a); [rewrite -> Qlt_minus_iff in *; simpl; + (replace RHS with (b + - a) by ring); assumption |split; + [(replace RHS with (OpenUnitDual (OpenUnitDiv _ _ X):Q) by simpl; field; auto with *); + auto with * + |(replace LHS with (OpenUnitDual (OpenUnitDiv _ _ X):Q) by simpl; field; auto with *); + auto with *]]). Defined. (** @@ -137,17 +135,17 @@ Defined. Definition ou_eq (x y:OpenUnit) := Qeq x y. Lemma ou_eq_refl : forall x, ou_eq x x. Proof. -intros; apply Qeq_refl. + intros; apply Qeq_refl. Qed. Lemma ou_eq_sym : forall x y, ou_eq x y -> ou_eq y x. Proof. -intros; apply Qeq_sym; auto. + intros; apply Qeq_sym; auto. Qed. Lemma ou_eq_trans : forall x y z, ou_eq x y -> ou_eq y z -> ou_eq x z. Proof. -intros; apply (Qeq_trans x y); auto. + intros; apply (Qeq_trans x y); auto. Qed. Add Relation OpenUnit ou_eq @@ -161,48 +159,48 @@ Definition affineCombo (o:OpenUnit) (a b:Q) := o*a + (1-o)*b. Add Morphism affineCombo with signature ou_eq ==> Qeq ==> Qeq ==> Qeq as affineCombo_wd. Proof. -intros x1 x2 Hx y1 y2 Hy z1 z2 Hz. -unfold affineCombo. -unfold ou_eq in Hx. -rewrite Hx Hy Hz; reflexivity. + intros x1 x2 Hx y1 y2 Hy z1 z2 Hz. + unfold affineCombo. + unfold ou_eq in Hx. + rewrite Hx Hy Hz; reflexivity. Qed. (** Properties of an affine combination. *) Lemma affineCombo_gt : forall o a b (H:a < b), a < affineCombo o a b. Proof. -intros o a b H. -unfold affineCombo. -rewrite -> Qlt_minus_iff in *. -replace RHS with ((1-o)*(b-a)) by ring. -apply: mult_resp_pos; simpl; auto with *. + intros o a b H. + unfold affineCombo. + rewrite -> Qlt_minus_iff in *. + replace RHS with ((1-o)*(b-a)) by ring. + apply: mult_resp_pos; simpl; auto with *. Qed. Lemma affineCombo_lt : forall o a b (H:a < b), affineCombo o a b < b. Proof. -intros o a b H. -unfold affineCombo. -rewrite -> Qlt_minus_iff in *. -replace RHS with (o*(b-a)) by ring. -apply: mult_resp_pos; simpl; auto with *. + intros o a b H. + unfold affineCombo. + rewrite -> Qlt_minus_iff in *. + replace RHS with (o*(b-a)) by ring. + apply: mult_resp_pos; simpl; auto with *. Qed. (* begin hide *) Hint Resolve affineCombo_lt affineCombo_gt : ouarith. (* end hide *) -Lemma affineAffine_l : forall a b o1 o2, +Lemma affineAffine_l : forall a b o1 o2, (affineCombo o1 a (affineCombo o2 a b)==affineCombo (OpenUnitDualMult o1 o2) a b)%Q. Proof. -intros a b o1 o2. -unfold affineCombo. -simpl. -ring. + intros a b o1 o2. + unfold affineCombo. + simpl. + ring. Qed. -Lemma affineAffine_r : forall a b o1 o2, +Lemma affineAffine_r : forall a b o1 o2, (affineCombo o1 (affineCombo o2 a b) b==affineCombo (o1*o2) a b)%Q. Proof. -intros a b o1 o2. -unfold affineCombo. -simpl. -ring. -Qed. \ No newline at end of file + intros a b o1 o2. + unfold affineCombo. + simpl. + ring. +Qed. diff --git a/model/structures/QposInf.v b/model/structures/QposInf.v index a4fe14e77..b108c5b39 100644 --- a/model/structures/QposInf.v +++ b/model/structures/QposInf.v @@ -57,15 +57,16 @@ Definition QposInf_bind (f : Qpos -> QposInf) (x:QposInf) := end. Lemma QposInf_bind_id : forall x, QposInf_bind (fun e => e) x = x. -intros [x|]; reflexivity. +Proof. + intros [x|]; reflexivity. Qed. (** Addditon *) -Definition QposInf_plus (x y : QposInf) : QposInf := +Definition QposInf_plus (x y : QposInf) : QposInf := QposInf_bind (fun x' => QposInf_bind (fun y' => x'+y') y) x. (** Multiplication *) -Definition QposInf_mult (x y : QposInf) : QposInf := +Definition QposInf_mult (x y : QposInf) : QposInf := QposInf_bind (fun x' => QposInf_bind (fun y' => x'*y') y) x. (** Order *) @@ -73,7 +74,7 @@ Definition QposInf_le (x y: QposInf) : Prop := match y with | QposInfinity => True | Qpos2QposInf y' => - match x with + match x with | QposInfinity => False | Qpos2QposInf x' => x' <= y' end @@ -83,7 +84,7 @@ end. Definition QposInf_min (x y : QposInf) : QposInf := match x with | QposInfinity => y -| Qpos2QposInf x' => +| Qpos2QposInf x' => match y with | QposInfinity => x' | Qpos2QposInf y' => Qpos2QposInf (Qpos_min x' y') @@ -92,16 +93,16 @@ end. Lemma QposInf_min_lb_l : forall x y, QposInf_le (QposInf_min x y) x. Proof. -intros [x|] [y|]; simpl; try auto. -apply Qpos_min_lb_l. -apply Qle_refl. + intros [x|] [y|]; simpl; try auto. + apply Qpos_min_lb_l. + apply Qle_refl. Qed. Lemma QposInf_min_lb_r : forall x y, QposInf_le (QposInf_min x y) y. Proof. -intros [x|] [y|]; simpl; try auto. -apply Qpos_min_lb_r. -apply Qle_refl. + intros [x|] [y|]; simpl; try auto. + apply Qpos_min_lb_r. + apply Qle_refl. Qed. Infix "+" := QposInf_plus : QposInf_scope. diff --git a/model/structures/Qpossec.v b/model/structures/Qpossec.v index 8af896ab3..d88914f2c 100644 --- a/model/structures/Qpossec.v +++ b/model/structures/Qpossec.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Qpos $\mathbb{Q}^{+}$ #Q+# *) @@ -50,7 +50,7 @@ Open Local Scope Q_scope. We define [Qpos] as a pair of positives (n,d) which represents the fraction n/d. *) -Record Qpos : Set := QposMake +Record Qpos : Set := QposMake {QposNumerator : positive ;QposDenominator : positive }. @@ -70,49 +70,50 @@ Coercion QposAsQ : Qpos >-> Q. (** Basic properties about [Qpos] *) Lemma Qpos_prf : forall a:Qpos, 0 < a. Proof. -firstorder. + firstorder. Qed. Lemma Qpos_nonzero : forall x:Qpos, (x:Q)[#]0. Proof. -intros x. -apply: pos_ap_zero. -apply Qpos_prf. + intros x. + apply: pos_ap_zero. + apply Qpos_prf. Qed. Lemma Qpos_nonneg : forall a:Qpos, 0 <= a. Proof. -intros a. -apply Qlt_le_weak. -apply Qpos_prf. + intros a. + apply Qlt_le_weak. + apply Qpos_prf. Qed. (** Any positive rational number can be transformed into a [Qpos]. *) Definition mkQpos (a:Q) (p:0 < a) : Qpos. -intros [an ad] p. -destruct an as [|an|an]. -compute in p. -abstract discriminate p. -exact (QposMake an ad). -compute in p. -abstract discriminate p. +Proof. + intros [an ad] p. + destruct an as [|an|an]. + compute in p. + abstract discriminate p. + exact (QposMake an ad). + compute in p. + abstract discriminate p. Defined. (* begin hide *) Implicit Arguments mkQpos [a]. (* end hide *) Lemma QposAsmkQpos : forall (a:Q) (p:0 Q. Proof. -trivial. + trivial. Qed. Hint Rewrite Q_Qpos_inv : QposElim. @@ -225,16 +231,16 @@ Ltac QposField := (** This is a standard way of decomposing a rational b that is greater than a into a plus a positive value c. *) -Lemma Qpos_lt_plus : forall (a b:Q), +Lemma Qpos_lt_plus : forall (a b:Q), a< b -> {c:Qpos | b==(a+c)}. Proof. -intros. -assert (0 (0 < Qred a). Proof. -intros a Ha. -rewrite Qred_correct. -assumption. + intros a Ha. + rewrite Qred_correct. + assumption. Qed. Definition QposRed (a:Qpos) : Qpos := mkQpos (QposRed_prf a (Qpos_prf a)). Lemma QposRed_complete : forall p q : Qpos, p == q -> QposRed p = QposRed q. Proof. -intros p q H. -unfold QposRed. -generalize (QposRed_prf p (Qpos_prf p)). -generalize (QposRed_prf q (Qpos_prf q)). -rewrite (Qred_complete p q H). -unfold Qlt, Zlt. -intros A B. -assert (X:forall x y : comparison, x = y \/ x <> y). -decide equality. -rewrite (eq_proofs_unicity X A B). -reflexivity. + intros p q H. + unfold QposRed. + generalize (QposRed_prf p (Qpos_prf p)). + generalize (QposRed_prf q (Qpos_prf q)). + rewrite (Qred_complete p q H). + unfold Qlt, Zlt. + intros A B. + assert (X:forall x y : comparison, x = y \/ x <> y). + decide equality. + rewrite (eq_proofs_unicity X A B). + reflexivity. Qed. Lemma QposRed_correct : forall p, QposRed p == p. Proof. -unfold QposRed. -intros p. -autorewrite with QposElim. -apply Qred_correct. + unfold QposRed. + intros p. + autorewrite with QposElim. + apply Qred_correct. Qed. diff --git a/model/structures/Qsec.v b/model/structures/Qsec.v index e4c5a33d8..b6075f357 100644 --- a/model/structures/Qsec.v +++ b/model/structures/Qsec.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Q %\ensuremath{\mathbb{Q}}% *) (** printing QZERO %\ensuremath{0_\mathbb{Q}}% #0Q# *) @@ -65,7 +65,7 @@ inverse an de constants 0 and 1. *) Section Q. Definition Qap (x y : Q) := ~(Qeq x y). -Definition QZERO := Qmake 0 1. +Definition QZERO := Qmake 0 1. Definition QONE := Qmake 1 1. @@ -85,7 +85,7 @@ Definition QFOUR := Qmake 4%positive 1%positive. (** *** Equality -Here we prove that [QONE] is ##%\emph{%not equal%}%## to [QZERO]: +Here we prove that [QONE] is ##%\emph{%not equal%}%## to [QZERO]: *) Theorem ONEQ_neq_ZEROQ : ~ (QONE==QZERO). @@ -103,12 +103,12 @@ Proof. apply refl_equal. Qed. -Theorem sym_Qeq : forall x y : Q, (x==y) -> y==x. +Theorem sym_Qeq : forall x y : Q, (x==y) -> y==x. Proof. intros x y H. unfold Qeq in |- *. unfold Qeq in H. - apply sym_equal. + apply sym_equal. assumption. Qed. @@ -120,42 +120,42 @@ Proof. unfold Qeq in |- *. intros x y z e1 e2. case (dec_eq (Qnum y) 0). - intro H. - cut (Qnum x = 0%Z). - intro H0. - rewrite H0. - cut (Qnum z = 0%Z). - intro H1. - rewrite H1. - simpl in |- *. - trivial. - rewrite H in e2. - cut (Zpos (Qden y) <> 0%Z). - intro H1. - simpl in e2. - exact (Zmult_integral_l (Qden y) (Qnum z) H1 (sym_eq e2)). - apply Zgt_not_eq; auto with zarith. - rewrite H in e1. - simpl in e1. - cut (Zpos (Qden y) <> 0%Z). - intro H0. - exact (Zmult_integral_l (Qden y) (Qnum x) H0 e1). - apply Zgt_not_eq; auto with zarith. + intro H. + cut (Qnum x = 0%Z). + intro H0. + rewrite H0. + cut (Qnum z = 0%Z). + intro H1. + rewrite H1. + simpl in |- *. + trivial. + rewrite H in e2. + cut (Zpos (Qden y) <> 0%Z). + intro H1. + simpl in e2. + exact (Zmult_integral_l (Qden y) (Qnum z) H1 (sym_eq e2)). + apply Zgt_not_eq; auto with zarith. + rewrite H in e1. + simpl in e1. + cut (Zpos (Qden y) <> 0%Z). + intro H0. + exact (Zmult_integral_l (Qden y) (Qnum x) H0 e1). + apply Zgt_not_eq; auto with zarith. intro H. eapply a_very_specific_lemma1; eauto. Qed. (** - The equality is decidable: + The equality is decidable: *) Theorem dec_Qeq : forall x y : Q, {x==y} + {~ (x==y)}. Proof. intros x y. case (Z_eq_dec (Qnum x * Qden y) (Qnum y * Qden x)). - intro e. - auto. + intro e. + auto. intro n. right. intro H. @@ -170,20 +170,20 @@ Qed. Lemma Q_non_zero : forall x : Q, (x/=QZERO) -> Qnum x <> 0%Z. Proof. -intros x H. -red in H. -intro H0. -elim H. -unfold Qeq in |- *. -unfold QZERO in |- *. -unfold Qnum at 2 in |- *. -rewrite H0. -simpl in |- *. -auto. + intros x H. + red in H. + intro H0. + elim H. + unfold Qeq in |- *. + unfold QZERO in |- *. + unfold Qnum at 2 in |- *. + rewrite H0. + simpl in |- *. + auto. Qed. Lemma ap_Q_irreflexive0 : forall x : Q, Not (x/=x). -Proof. +Proof. intros x. unfold Qap in |- *. red in |- *. @@ -212,12 +212,12 @@ Proof. intros x y X z. unfold Qap in |- *. case (dec_Qeq x z). - intro e. - right. - red in |- *. - intro H0. - apply X. - exact (trans_Qeq x z y e H0). + intro e. + right. + red in |- *. + intro H0. + apply X. + exact (trans_Qeq x z y e H0). intros n. left. intro H. @@ -230,16 +230,16 @@ Proof. intros x y. red in |- *. split. - unfold Qap in |- *. - intro. - case (dec_Qeq x y). - intro e. - assumption. - intro n. - elim H. - intro H0. - elim n. - assumption. + unfold Qap in |- *. + intro. + case (dec_Qeq x y). + intro e. + assumption. + intro n. + elim H. + intro H0. + elim n. + assumption. intro H. unfold Qap in |- *. red in |- *. @@ -253,19 +253,19 @@ Qed. *) Theorem Qplus_simpl : forall n m p q : Q, - (n==m) -> (p==q) -> n+p==m+q. + (n==m) -> (p==q) -> n+p==m+q. Proof. red in |- *. simpl in |- *. unfold Qeq in |- *. - intros n m p q. + intros n m p q. intros e1 e2. apply a_very_specific_lemma3. - assumption. + assumption. assumption. Qed. -(** +(** Addition is associative: *) @@ -275,9 +275,7 @@ Proof. red in |- *. unfold Qplus in |- *. simpl in |- *. - exact - (a_very_specific_lemma5 (Qnum x) (Qnum y) (Qnum z) ( - Qden x) (Qden y) (Qden z)). + exact (a_very_specific_lemma5 (Qnum x) (Qnum y) (Qnum z) ( Qden x) (Qden y) (Qden z)). Qed. (** @@ -293,7 +291,7 @@ Proof. simpl in |- *. rewrite Zpos_mult_morphism in |- *. ring. -Qed. +Qed. (** Commutativity of addition: @@ -314,55 +312,57 @@ Qed. Lemma Qplus_strext0 : forall x1 x2 y1 y2 : Q, (x1+y1/=x2+y2) -> (x1/=x2) or (y1/=y2). -unfold Qap in |- *. -intros x1 x2 y1 y2 X. -case (dec_Qeq x1 x2). -intro e. -right. -red in |- *. -intro H0. -apply X. -exact (Qplus_simpl x1 x2 y1 y2 e H0). -intro n. -left. -intro H. -elim n. -auto. +Proof. + unfold Qap in |- *. + intros x1 x2 y1 y2 X. + case (dec_Qeq x1 x2). + intro e. + right. + red in |- *. + intro H0. + apply X. + exact (Qplus_simpl x1 x2 y1 y2 e H0). + intro n. + left. + intro H. + elim n. + auto. Qed. Lemma ZEROQ_as_rht_unit0 : forall x : Q, x+QZERO==x. -intro x. -red in |- *. -unfold Qplus in |- *. -simpl in |- *. -rewrite Zpos_mult_morphism in |- *. -ring. +Proof. + intro x. + red in |- *. + unfold Qplus in |- *. + simpl in |- *. + rewrite Zpos_mult_morphism in |- *. + ring. Qed. Lemma ZEROQ_as_lft_unit0 : forall x : Q, QZERO+x==x. -intro x. -red in |- *. -unfold Qplus in |- *. -simpl in |- *. -ring. +Proof. + intro x. + red in |- *. + unfold Qplus in |- *. + simpl in |- *. + ring. Qed. -Lemma Qplus_is_commut0 : forall x y : Q, x+y==y+x. -intros x y. -unfold Qplus in |- *. -red in |- *. -simpl in |- *. -change - (((Qnum x * Qden y + Qnum y * Qden x) * (Qden y * Qden x))%Z = - ((Qnum y * Qden x + Qnum x * Qden y) * (Qden x * Qden y))%Z) - in |- *. -ring. +Lemma Qplus_is_commut0 : forall x y : Q, x+y==y+x. +Proof. + intros x y. + unfold Qplus in |- *. + red in |- *. + simpl in |- *. + change (((Qnum x * Qden y + Qnum y * Qden x) * (Qden y * Qden x))%Z = + ((Qnum y * Qden x + Qnum x * Qden y) * (Qden x * Qden y))%Z) in |- *. + ring. Qed. (** *** Opposite - [-] is a well defined unary operation: + [-] is a well defined unary operation: *) Lemma Qopp_simpl : forall x y : Q, (x==y) -> - x==- y. @@ -395,15 +395,13 @@ that [*] is well-defined *) Theorem Qmult_simpl : forall n m p q : Q, - (n==m) -> (p==q) -> n*p==m*q. + (n==m) -> (p==q) -> n*p==m*q. Proof. red in |- *. simpl in |- *. unfold Qeq in |- *. intros n m p q e1 e2. - change - ((Qnum n * Qnum p * (Qden m * Qden q))%Z = - (Qnum m * Qnum q * (Qden n * Qden p))%Z) in |- *. + change ((Qnum n * Qnum p * (Qden m * Qden q))%Z = (Qnum m * Qnum q * (Qden n * Qden p))%Z) in |- *. rewrite <- Zmult_assoc. rewrite Zmult_permute with (m := Qden m). rewrite e2. @@ -437,7 +435,7 @@ Proof. simpl in |- *. rewrite Zmult_1_r with (n := Qnum n). rewrite Pmult_comm. - simpl in |- *; trivial. + simpl in |- *; trivial. Qed. @@ -450,23 +448,20 @@ Proof. intros x y. red in |- *. simpl in |- *. - rewrite Pmult_comm. + rewrite Pmult_comm. ring. Qed. Theorem Qmult_plus_distr_r : forall x y z : Q, - x*(y+z)==x*y+x*z. + x*(y+z)==x*y+x*z. Proof. -intros x y z. -red in |- *. -simpl in |- *. -change - ((Qnum x * (Qnum y * Qden z + Qnum z * Qden y) * - (Qden x * Qden y * (Qden x * Qden z)))%Z = - ((Qnum x * Qnum y * (Qden x * Qden z) + - Qnum x * Qnum z * (Qden x * Qden y)) * - (Qden x * (Qden y * Qden z)))%Z) in |- *. -ring. + intros x y z. + red in |- *. + simpl in |- *. + change ((Qnum x * (Qnum y * Qden z + Qnum z * Qden y) * (Qden x * Qden y * (Qden x * Qden z)))%Z = + ((Qnum x * Qnum y * (Qden x * Qden z) + Qnum x * Qnum z * (Qden x * Qden y)) * + (Qden x * (Qden y * Qden z)))%Z) in |- *. + ring. Qed. @@ -486,10 +481,10 @@ Proof. rewrite Zmult_comm with (n := Qnum x) (m := Qnum y). intro H. cut (Qnum x <> 0%Z :>Z). - intros H0 H1. - apply (Zmult_integral_l (Qnum x) (Qnum y)). - assumption. - assumption. + intros H0 H1. + apply (Zmult_integral_l (Qnum x) (Qnum y)). + assumption. + assumption. intro H0. apply H. assumption. @@ -502,46 +497,47 @@ Qed. Lemma Qmult_strext0 : forall x1 x2 y1 y2 : Q, (x1*y1/=x2*y2) -> (x1/=x2) or (y1/=y2). -unfold Qap in |- *. -intros x1 x2 y1 y2 X. -case (dec_Qeq x1 x2). -intro. -right. -red in |- *. -intro H0. -apply X. -exact (Qmult_simpl x1 x2 y1 y2 q H0). -intro n. -left. -intro H. -elim n. -assumption. +Proof. + unfold Qap in |- *. + intros x1 x2 y1 y2 X. + case (dec_Qeq x1 x2). + intro. + right. + red in |- *. + intro H0. + apply X. + exact (Qmult_simpl x1 x2 y1 y2 q H0). + intro n. + left. + intro H. + elim n. + assumption. Qed. Lemma nonZero : forall x : Q, ~(x==QZERO) -> ~(Qmake (Zsgn (Qnum x) * Qden x)%Z (posZ (Qnum x))==QZERO). Proof. -intro x. -unfold Qeq in |- *. -unfold Qnum at 2 6 in |- *. -unfold QZERO in |- *. -repeat rewrite Zmult_0_l. -unfold Qden at 1 3 in |- *. -repeat rewrite Zplus_0_l. -repeat rewrite Zmult_1_r. -simpl in |- *. -intro H. -cut (Zsgn (Qnum x) <> 0%Z). -intro H0. -cut (Zpos (Qden x) <> 0%Z). -intro H1. -intro H2. -elim H0. -exact (Zmult_integral_l (Qden x) (Zsgn (Qnum x)) H1 H2). -apply Zgt_not_eq. -auto with zarith. -apply Zsgn_3. -intro; elim H; auto. + intro x. + unfold Qeq in |- *. + unfold Qnum at 2 6 in |- *. + unfold QZERO in |- *. + repeat rewrite Zmult_0_l. + unfold Qden at 1 3 in |- *. + repeat rewrite Zplus_0_l. + repeat rewrite Zmult_1_r. + simpl in |- *. + intro H. + cut (Zsgn (Qnum x) <> 0%Z). + intro H0. + cut (Zpos (Qden x) <> 0%Z). + intro H1. + intro H2. + elim H0. + exact (Zmult_integral_l (Qden x) (Zsgn (Qnum x)) H1 H2). + apply Zgt_not_eq. + auto with zarith. + apply Zsgn_3. + intro; elim H; auto. Qed. (** @@ -552,18 +548,19 @@ Qed. Lemma Qinv_strext : forall (x y : Q) x_ y_, ~(Qinv x x_==Qinv y y_) -> ~(x==y). Proof. -firstorder using Qinv_comp. + firstorder using Qinv_comp. Qed. Lemma Qinv_is_inv : forall (x : Q) (Hx : x/=QZERO), (x*Qinv x Hx==QONE) /\ (Qinv x Hx*x==QONE). -intros x Hx. -split. -apply (Qmult_inv_r x). -assumption. -rewrite Qmult_comm. -apply (Qmult_inv_r x). -assumption. +Proof. + intros x Hx. + split. + apply (Qmult_inv_r x). + assumption. + rewrite Qmult_comm. + apply (Qmult_inv_r x). + assumption. Qed. @@ -572,65 +569,52 @@ Qed. *) Lemma Qlt_wd_right : forall x y z : Q, (x (y==z) -> x (x==z) -> z (y x 0 *) - -intro H4. -apply Zgt_lt. -apply Zgt_trans with (m := 0%Z). -apply Zlt_gt. -rewrite Zmult_comm. -rewrite <- Zmult_0_r with (n := Qden x). -apply Zlt_reg_mult_l. - -auto with zarith. - -assumption. - -rewrite Zmult_comm. -rewrite <- Zmult_0_r with (n := Qden z). -apply Zlt_gt. -apply Zlt_reg_mult_l. - -auto with zarith. -assumption. - -(* x > 0 *) -intro H2. -apply Zgt_lt. -apply Zgt_mult_reg_absorb_l with (a := Qnum y). -apply Zgt_mult_reg_absorb_l with (a := Qden x). - -auto with zarith. - -apply Zgt_trans with (m := (Qnum x * Qden y)%Z). - -rewrite Zmult_comm. -apply Zlt_gt. -assumption. - -rewrite Zmult_0_r. -rewrite <- Zmult_0_r with (n := Qden y). -rewrite Zmult_comm. -apply Zlt_gt. -apply Zlt_reg_mult_l. - -auto with zarith. - -assumption. - -apply Zgt_trans with (m := (Qnum x * Qnum z * Qden y)%Z). -rewrite Zmult_assoc. -rewrite Zmult_comm with (n := Qnum y). -rewrite Zmult_comm with (n := Qnum x). -rewrite <- Zmult_assoc. -rewrite <- Zmult_assoc. -apply Zlt_gt. -apply Zlt_reg_mult_l. - -apply Zgt_mult_reg_absorb_l with (a := Qden y). - -auto with zarith. - -apply Zgt_trans with (m := (Qnum y * Qden z)%Z). - -rewrite Zmult_comm. -apply Zlt_gt. -assumption. - -rewrite Zmult_0_r. -rewrite <- Zmult_0_r with (n := Qden z). -rewrite Zmult_comm. -apply Zlt_gt. -apply Zlt_reg_mult_l. - -auto with zarith. - -apply Zgt_lt. -apply Zgt_mult_reg_absorb_l with (a := Qden x). - -auto with zarith. - -apply Zgt_trans with (m := (Qnum x * Qden y)%Z). - -rewrite Zmult_comm. -apply Zlt_gt. -assumption. - -rewrite Zmult_0_r. -rewrite <- Zmult_0_r with (n := Qden y). -rewrite Zmult_comm. -apply Zlt_gt. -apply Zlt_reg_mult_l. - -auto with zarith. - -assumption. - -assumption. - -rewrite Zmult_assoc. -rewrite Zmult_comm with (n := Qnum y). -rewrite <- Zmult_assoc. -rewrite <- Zmult_assoc. -apply Zlt_gt. -apply Zlt_reg_mult_l. - -apply Zlt_gt. -assumption. - -assumption. +Proof. + intros x y z e e0. + red in |- *. + apply toCProp_Zlt. + red in e. + generalize (CZlt_to _ _ e). + intro H. + red in e0. + generalize (CZlt_to _ _ e0). + intro H0. + case (dec_eq (Qnum x) 0). + (* x=0 *) + intro H1. + rewrite H1. + simpl in |- *. + rewrite H1 in H. + simpl in H. + rewrite <- Zmult_0_r with (n := Qden x). + rewrite Zmult_comm with (n := Qnum z). + apply Zlt_reg_mult_l. + auto with zarith. + apply Zgt_lt. + apply Zgt_mult_reg_absorb_l with (a := Qden y). + auto with zarith. + rewrite Zmult_comm. + rewrite Zmult_0_r. + apply Zgt_trans with (m := (Qnum y * Qden z)%Z). + apply Zlt_gt. + assumption. + rewrite Zmult_comm. + apply Zlt_gt. + rewrite <- Zmult_0_r with (n := Qden z). + apply Zlt_reg_mult_l. + auto with zarith. + apply Zgt_lt. + apply Zgt_mult_reg_absorb_l with (a := Qden x). + auto with zarith. + rewrite Zmult_0_r. + apply Zlt_gt. + rewrite Zmult_comm. + assumption. + intro H1. + case (not_Zeq (Qnum x) 0 H1). + (* x : 0 *) + intro H2. + case (dec_eq (Qnum z) 0). + (* x : 0 , z = 0 *) + intro H3. + rewrite H3. + simpl in |- *. + rewrite <- Zmult_0_r with (n := Qnum x). + apply Zgt_lt. + apply Zlt_conv_mult_l. + assumption. + apply Zgt_lt. + auto with zarith. + intro H3. + case (not_Zeq (Qnum z) 0 H3). + (* x < 0 , z < 0 *) + intro H4. + apply Zgt_mult_conv_absorb_l with (a := Qnum y). + apply Zgt_lt. + apply Zgt_mult_reg_absorb_l with (a := Qden z). + auto with zarith. + apply Zgt_trans with (m := (Qnum z * Qden y)%Z). + rewrite Zmult_0_r. + apply Zlt_gt. + rewrite <- Zmult_0_r with (n := Qden y). + rewrite Zmult_comm. + apply Zlt_reg_mult_l. + auto with zarith. + assumption. + apply Zlt_gt. + rewrite Zmult_comm. + assumption. + apply Zgt_trans with (m := (Qnum x * Qnum z * Qden y)%Z). + rewrite Zmult_assoc. + rewrite Zmult_comm with (n := Qnum y). + rewrite <- Zmult_assoc. + rewrite <- Zmult_assoc. + apply Zlt_conv_mult_l. + assumption. + assumption. + rewrite Zmult_comm with (n := Qnum x). + rewrite Zmult_assoc. + rewrite Zmult_comm with (n := Qnum y). + rewrite <- Zmult_assoc. + rewrite <- Zmult_assoc. + apply Zlt_conv_mult_l. + assumption. + assumption. + (* x < 0 , z > 0 *) + intro H4. + apply Zgt_lt. + apply Zgt_trans with (m := 0%Z). + apply Zlt_gt. + rewrite Zmult_comm. + rewrite <- Zmult_0_r with (n := Qden x). + apply Zlt_reg_mult_l. + auto with zarith. + assumption. + rewrite Zmult_comm. + rewrite <- Zmult_0_r with (n := Qden z). + apply Zlt_gt. + apply Zlt_reg_mult_l. + auto with zarith. + assumption. + (* x > 0 *) + intro H2. + apply Zgt_lt. + apply Zgt_mult_reg_absorb_l with (a := Qnum y). + apply Zgt_mult_reg_absorb_l with (a := Qden x). + auto with zarith. + apply Zgt_trans with (m := (Qnum x * Qden y)%Z). + rewrite Zmult_comm. + apply Zlt_gt. + assumption. + rewrite Zmult_0_r. + rewrite <- Zmult_0_r with (n := Qden y). + rewrite Zmult_comm. + apply Zlt_gt. + apply Zlt_reg_mult_l. + auto with zarith. + assumption. + apply Zgt_trans with (m := (Qnum x * Qnum z * Qden y)%Z). + rewrite Zmult_assoc. + rewrite Zmult_comm with (n := Qnum y). + rewrite Zmult_comm with (n := Qnum x). + rewrite <- Zmult_assoc. + rewrite <- Zmult_assoc. + apply Zlt_gt. + apply Zlt_reg_mult_l. + apply Zgt_mult_reg_absorb_l with (a := Qden y). + auto with zarith. + apply Zgt_trans with (m := (Qnum y * Qden z)%Z). + rewrite Zmult_comm. + apply Zlt_gt. + assumption. + rewrite Zmult_0_r. + rewrite <- Zmult_0_r with (n := Qden z). + rewrite Zmult_comm. + apply Zlt_gt. + apply Zlt_reg_mult_l. + auto with zarith. + apply Zgt_lt. + apply Zgt_mult_reg_absorb_l with (a := Qden x). + auto with zarith. + apply Zgt_trans with (m := (Qnum x * Qden y)%Z). + rewrite Zmult_comm. + apply Zlt_gt. + assumption. + rewrite Zmult_0_r. + rewrite <- Zmult_0_r with (n := Qden y). + rewrite Zmult_comm. + apply Zlt_gt. + apply Zlt_reg_mult_l. + auto with zarith. + assumption. + assumption. + rewrite Zmult_assoc. + rewrite Zmult_comm with (n := Qnum y). + rewrite <- Zmult_assoc. + rewrite <- Zmult_assoc. + apply Zlt_gt. + apply Zlt_reg_mult_l. + apply Zlt_gt. + assumption. + assumption. Qed. Lemma Qlt_strext_unfolded : forall x1 x2 y1 y2 : Q, (x1 (x2 Qnum x * Qden x)%Z. -apply Zgt_irrefl with (n := (Qnum x * Qden x)%Z). -apply Zlt_gt. -apply CZlt_to. -assumption. +Lemma Qlt_is_irreflexive_unfolded : forall x : Q, Not (x Qnum x * Qden x)%Z. + apply Zgt_irrefl with (n := (Qnum x * Qden x)%Z). + apply Zlt_gt. + apply CZlt_to. + assumption. Qed. Lemma Qlt_is_antisymmetric_unfolded : forall x y : Q, (x Not (y forall z : Q, x+z (QZERO QZERO ~ y < x. Proof. -firstorder using Qle_not_lt Qnot_lt_le. + firstorder using Qle_not_lt Qnot_lt_le. Qed. Lemma Qge_is_not_gt : forall x y : Q, x >= y <-> y <= x. Proof. -firstorder. + firstorder. Qed. Lemma Qgt_is_lt : forall x y : Q, x > y IFF y < x. Proof. -firstorder. + firstorder. Qed. diff --git a/model/structures/StepQsec.v b/model/structures/StepQsec.v index fe1df9c49..70b7d475e 100644 --- a/model/structures/StepQsec.v +++ b/model/structures/StepQsec.v @@ -14,87 +14,67 @@ Open Local Scope sfstscope. Section QS. Definition QabsS : QS-->QS. -exists Qabs. -abstract( -simpl; intros x1 x2 Hx; -rewrite Hx; -reflexivity). +Proof. + exists Qabs. + abstract( simpl; intros x1 x2 Hx; rewrite Hx; reflexivity). Defined. Definition Qplus0 : QS -> QS --> QS. -intros q. -exists (Qplus q). -abstract ( -simpl; intros x1 x2 Hx; -rewrite Hx; -reflexivity). +Proof. + intros q. + exists (Qplus q). + abstract ( simpl; intros x1 x2 Hx; rewrite Hx; reflexivity). Defined. Definition QplusS : QS --> QS --> QS. -exists (Qplus0). -abstract ( -intros x1 x2 Hx y; simpl in *; -rewrite Hx; -reflexivity). +Proof. + exists (Qplus0). + abstract ( intros x1 x2 Hx y; simpl in *; rewrite Hx; reflexivity). Defined. Definition QoppS : QS --> QS. -exists (Qopp). -abstract ( -simpl; intros x1 x2 Hx; simpl in *; -rewrite Hx; -reflexivity). +Proof. + exists (Qopp). + abstract ( simpl; intros x1 x2 Hx; simpl in *; rewrite Hx; reflexivity). Defined. Definition Qminus0 : QS -> QS --> QS. -intros q. -exists (Qminus q). -abstract ( -simpl; intros x1 x2 Hx; -rewrite Hx; -reflexivity). +Proof. + intros q. + exists (Qminus q). + abstract ( simpl; intros x1 x2 Hx; rewrite Hx; reflexivity). Defined. Definition QminusS : QS --> QS --> QS. -exists (Qminus0). -abstract ( -intros x1 x2 Hx y; simpl in *; -rewrite Hx; -reflexivity). +Proof. + exists (Qminus0). + abstract ( intros x1 x2 Hx y; simpl in *; rewrite Hx; reflexivity). Defined. Definition QscaleS : QS -> QS --> QS. -intros q. -exists (Qmult q). -abstract ( -intros x1 x2 Hx; simpl in *; -rewrite Hx; -reflexivity). +Proof. + intros q. + exists (Qmult q). + abstract ( intros x1 x2 Hx; simpl in *; rewrite Hx; reflexivity). Defined. Definition QmultS : QS --> QS --> QS. -exists (QscaleS). -abstract ( -intros x1 x2 Hx y; simpl in *; -rewrite Hx; -reflexivity). +Proof. + exists (QscaleS). + abstract ( intros x1 x2 Hx y; simpl in *; rewrite Hx; reflexivity). Defined. Definition Qle0 : QS -> QS --> iffSetoid. -intros q. -exists (Qle q). -abstract ( -simpl; intros x1 x2 Hx; -rewrite Hx; -reflexivity). +Proof. + intros q. + exists (Qle q). + abstract ( simpl; intros x1 x2 Hx; rewrite Hx; reflexivity). Defined. Definition QleS : QS --> QS --> iffSetoid. -exists (Qle0). -abstract ( -intros x1 x2 Hx y; simpl in *; -rewrite Hx; -reflexivity). +Proof. + exists (Qle0). + abstract ( intros x1 x2 Hx y; simpl in *; rewrite Hx; reflexivity). Defined. End QS. @@ -118,130 +98,114 @@ Notation "x * y" := (StepQmult x y) : StepQ_scope. Add Morphism StepQplus with signature (@StepF_eq QS) ==> (@StepF_eq QS) ==> (@StepF_eq QS) as StepQplus_wd. Proof. -intros. -unfold StepQplus. -rewrite H. -rewrite H0. -reflexivity. + intros. + unfold StepQplus. + rewrite H. + rewrite H0. + reflexivity. Qed. Add Morphism StepQopp with signature (@StepF_eq QS) ==> (@StepF_eq QS) as StepQopp_wd. Proof. -intros. -unfold StepQopp. -rewrite H. -reflexivity. + intros. + unfold StepQopp. + rewrite H. + reflexivity. Qed. Add Morphism StepQminus with signature (@StepF_eq QS) ==> (@StepF_eq QS) ==> (@StepF_eq QS) as StepQminus_wd. Proof. -intros. -unfold StepQminus. -rewrite H. -rewrite H0. -reflexivity. + intros. + unfold StepQminus. + rewrite H. + rewrite H0. + reflexivity. Qed. Add Morphism StepQmult with signature (@StepF_eq QS) ==> (@StepF_eq QS) ==> (@StepF_eq QS) as StepQmult_wd. Proof. -intros. -unfold StepQmult. -rewrite H. -rewrite H0. -reflexivity. + intros. + unfold StepQmult. + rewrite H. + rewrite H0. + reflexivity. Qed. Definition StepQsrt : (@ring_theory (StepQ) (constStepF (0:QS)) (constStepF (1:QS)) StepQplus StepQmult StepQminus StepQopp (@StepF_eq QS)). -constructor; - intros; - unfold StepF_eq, StepQplus, StepQminus, StepQopp, StepQmult; - rewriteStepF; - set (g:=st_eqS QS). - -set (z:=QplusS 0). -set (f:=(join (compose g z))). -cut (StepFfoldProp (f ^@> x)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map. -intros a. -unfold f; simpl; ring. - -set (f:=ap - (compose (@ap _ _ _) (compose (compose g) QplusS)) - (flip (QplusS))). -cut (StepFfoldProp (f ^@> x <@> y)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map2. -intros a b. -change (a + b == b + a)%Q. -ring. - -set (f:=ap - (compose (@ap _ _ _) (compose (compose (compose (compose (@ap _ _ _)) (@compose _ _ _) g)) (compose (flip (@compose _ _ _) QplusS) (compose (@compose _ _ _) QplusS)))) - (compose (compose QplusS) QplusS)). -cut (StepFfoldProp (f ^@> x <@> y <@> z)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map3. -intros a b c. -change (a + (b + c) == a + b + c)%Q. -ring. - -set (z:=(QmultS 1)). -set (f:=(join (compose g z))). -cut (StepFfoldProp (f ^@> x)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map. -intros a. -unfold f; simpl; ring. - -set (f:=ap - (compose (@ap _ _ _) (compose (compose g) QmultS)) - (flip (QmultS))). -cut (StepFfoldProp (f ^@> x <@> y)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map2. -intros a b. -change (a * b == b * a)%Q. -ring. - -set (f:=ap - (compose (@ap _ _ _) (compose (compose (compose (compose (@ap _ _ _)) (@compose _ _ _) g)) (compose (flip (@compose _ _ _) QmultS) (compose (@compose _ _ _) QmultS)))) - (compose (compose QmultS) QmultS)). -cut (StepFfoldProp (f ^@> x <@> y <@> z)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map3. -intros a b c. -change (a * (b * c) == a * b * c)%Q. -ring. - -set (f:= ap - (compose (@ap _ _ _) (compose (compose (compose (@ap _ _ _) (compose (compose g) QmultS))) QplusS)) - (compose (flip (@compose _ _ _) QmultS) (compose (@ap _ _ _) (compose (compose QplusS) QmultS)))). -cut (StepFfoldProp (f ^@> x <@> y <@> z)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map3. -intros a b c. -change ((a + b) * c == a*c + b*c)%Q. -ring. - -set (f:= ap - (compose (@ap _ _ _) (compose (compose g) QminusS)) - (compose (flip (@compose _ _ _) QoppS) QplusS)). -cut (StepFfoldProp (f ^@> x <@> y)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map2. -intros a b. -change (a - b == a + - b)%Q. -ring. - -set (z:=(0:QS)). -set (f:= compose (flip g z) (ap QplusS QoppS)). -cut (StepFfoldProp (f ^@> x)). - unfold f; evalStepF; tauto. -apply StepFfoldPropForall_Map. -intros a. -change (a + - a == 0)%Q. -ring. +Proof. + constructor; intros; unfold StepF_eq, StepQplus, StepQminus, StepQopp, StepQmult; rewriteStepF; + set (g:=st_eqS QS). + set (z:=QplusS 0). + set (f:=(join (compose g z))). + cut (StepFfoldProp (f ^@> x)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map. + intros a. + unfold f; simpl; ring. + set (f:=ap (compose (@ap _ _ _) (compose (compose g) QplusS)) (flip (QplusS))). + cut (StepFfoldProp (f ^@> x <@> y)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map2. + intros a b. + change (a + b == b + a)%Q. + ring. + set (f:=ap + (compose (@ap _ _ _) (compose (compose (compose (compose (@ap _ _ _)) (@compose _ _ _) g)) (compose (flip (@compose _ _ _) QplusS) (compose (@compose _ _ _) QplusS)))) + (compose (compose QplusS) QplusS)). + cut (StepFfoldProp (f ^@> x <@> y <@> z)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map3. + intros a b c. + change (a + (b + c) == a + b + c)%Q. + ring. + set (z:=(QmultS 1)). + set (f:=(join (compose g z))). + cut (StepFfoldProp (f ^@> x)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map. + intros a. + unfold f; simpl; ring. + set (f:=ap (compose (@ap _ _ _) (compose (compose g) QmultS)) (flip (QmultS))). + cut (StepFfoldProp (f ^@> x <@> y)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map2. + intros a b. + change (a * b == b * a)%Q. + ring. + set (f:=ap + (compose (@ap _ _ _) (compose (compose (compose (compose (@ap _ _ _)) (@compose _ _ _) g)) (compose (flip (@compose _ _ _) QmultS) (compose (@compose _ _ _) QmultS)))) + (compose (compose QmultS) QmultS)). + cut (StepFfoldProp (f ^@> x <@> y <@> z)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map3. + intros a b c. + change (a * (b * c) == a * b * c)%Q. + ring. + set (f:= ap + (compose (@ap _ _ _) (compose (compose (compose (@ap _ _ _) (compose (compose g) QmultS))) QplusS)) + (compose (flip (@compose _ _ _) QmultS) (compose (@ap _ _ _) (compose (compose QplusS) QmultS)))). + cut (StepFfoldProp (f ^@> x <@> y <@> z)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map3. + intros a b c. + change ((a + b) * c == a*c + b*c)%Q. + ring. + set (f:= ap (compose (@ap _ _ _) (compose (compose g) QminusS)) + (compose (flip (@compose _ _ _) QoppS) QplusS)). + cut (StepFfoldProp (f ^@> x <@> y)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map2. + intros a b. + change (a - b == a + - b)%Q. + ring. + set (z:=(0:QS)). + set (f:= compose (flip g z) (ap QplusS QoppS)). + cut (StepFfoldProp (f ^@> x)). + unfold f; evalStepF; tauto. + apply StepFfoldPropForall_Map. + intros a. + change (a + - a == 0)%Q. + ring. Qed. Definition StepQisZero:(StepQ)->bool:=(StepFfold (fun (x:QS) => Qeq_bool x 0) (fun _ x y => x && y)). @@ -250,44 +214,45 @@ Definition StepQeq_bool (x y:StepQ) : bool := StepQisZero (x-y). Lemma StepQeq_bool_correct : forall x y, StepQeq_bool x y = true -> x == y. Proof. -intros x y H. -destruct StepQsrt. -rewrite <- (Radd_0_l x). -rewrite <- (Ropp_def y). -transitivity (y + (constStepF (0:QS))). - set (z:=constStepF (X:=QS) 0). - rewrite <- (Radd_assoc). - apply StepQplus_wd. - reflexivity. + intros x y H. + destruct StepQsrt. + rewrite <- (Radd_0_l x). + rewrite <- (Ropp_def y). + transitivity (y + (constStepF (0:QS))). + set (z:=constStepF (X:=QS) 0). + rewrite <- (Radd_assoc). + apply StepQplus_wd. + reflexivity. + rewrite Radd_comm. + rewrite <- Rsub_def. + unfold StepF_eq. + revert H. + unfold StepQeq_bool. + generalize (x-y). + intros s H. + induction s. + apply: Qeq_bool_eq;assumption. + symmetry in H. + destruct (andb_true_eq _ _ H) as [H1 H2]. + split. + apply IHs1; symmetry; assumption. + apply IHs2; symmetry; assumption. rewrite Radd_comm. - rewrite <- Rsub_def. - unfold StepF_eq. - revert H. - unfold StepQeq_bool. - generalize (x-y). - intros s H. - induction s. - apply: Qeq_bool_eq;assumption. - symmetry in H. - destruct (andb_true_eq _ _ H) as [H1 H2]. - split. - apply IHs1; symmetry; assumption. - apply IHs2; symmetry; assumption. -rewrite Radd_comm. -apply Radd_0_l. + apply Radd_0_l. Qed. Lemma StepQRing_Morphism : ring_eq_ext StepQplus StepQmult StepQopp (@StepF_eq QS). -split. - apply StepQplus_wd. - apply StepQmult_wd. -apply StepQopp_wd. +Proof. + split. + apply StepQplus_wd. + apply StepQmult_wd. + apply StepQopp_wd. Qed. Ltac isStepQcst t := match t with | constStepF ?q => isQcst q - | glue ?o ?l ?r => + | glue ?o ?l ?r => match isStepQcst l with |true => match isStepQcst r with |true => isQcst o @@ -313,90 +278,89 @@ Definition StepQabs (s:StepQ) : StepQ := QabsS ^@> s. Add Morphism StepQabs with signature (@StepF_eq QS) ==> (@StepF_eq QS) as StepQabs_wd. Proof. -intros. -unfold StepQabs. -rewrite H. -reflexivity. + intros. + unfold StepQabs. + rewrite H. + reflexivity. Qed. -(** +(** ** A Partial Order on Step Functions. *) Definition StepQ_le x y := (StepFfoldProp (QleS ^@> x <@> y)). (* begin hide *) -Add Morphism StepQ_le +Add Morphism StepQ_le with signature (@StepF_eq QS) ==> (@StepF_eq QS) ==> iff as StepQ_le_wd. -unfold StepQ_le. -intros x1 x2 Hx y1 y2 Hy. -rewrite Hx. -rewrite Hy. -reflexivity. +Proof. + unfold StepQ_le. + intros x1 x2 Hx y1 y2 Hy. + rewrite Hx. + rewrite Hy. + reflexivity. Qed. (* end hide *) Notation "x <= y" := (StepQ_le x y) (at level 70) : sfstscope. Lemma StepQ_le_refl:forall x, (x <= x). -intros x. -unfold StepQ_le. -cut (StepFfoldProp (join QleS ^@> x)). - evalStepF. - tauto. -apply StepFfoldPropForall_Map. -intros. -simpl. -auto with *. +Proof. + intros x. + unfold StepQ_le. + cut (StepFfoldProp (join QleS ^@> x)). + evalStepF. + tauto. + apply StepFfoldPropForall_Map. + intros. + simpl. + auto with *. Qed. -Lemma StepQ_le_trans:forall x y z, +Lemma StepQ_le_trans:forall x y z, (x <= y)-> (y <= z) ->(x <= z). -intros x y z. unfold StepQ_le. -intros H. -apply StepF_imp_imp. -revert H. -apply StepF_imp_imp. -unfold StepF_imp. -pose (f:= ap -(compose (@ap _ _ _) (compose (compose (compose (@compose _ _ _) imp)) QleS)) -(compose (flip (compose (@ap _ _ _) (compose (compose imp) QleS))) QleS)). -cut (StepFfoldProp (f ^@> x <@> y <@> z)). - unfold f. - evalStepF. - tauto. -apply StepFfoldPropForall_Map3. -intros a b c Hab Hbc. -clear f. -simpl in *. -eauto with qarith. +Proof. + intros x y z. unfold StepQ_le. + intros H. + apply StepF_imp_imp. + revert H. + apply StepF_imp_imp. + unfold StepF_imp. + pose (f:= ap (compose (@ap _ _ _) (compose (compose (compose (@compose _ _ _) imp)) QleS)) + (compose (flip (compose (@ap _ _ _) (compose (compose imp) QleS))) QleS)). + cut (StepFfoldProp (f ^@> x <@> y <@> z)). + unfold f. + evalStepF. + tauto. + apply StepFfoldPropForall_Map3. + intros a b c Hab Hbc. + clear f. + simpl in *. + eauto with qarith. Qed. Lemma StepQabsOpp : forall x, StepQabs (-x) == StepQabs (x). Proof. -intros x. -unfold StepF_eq. -set (g:=(st_eqS QS)). -set (f:=(ap -(compose g (compose QabsS QoppS)) -QabsS)). -cut (StepFfoldProp (f ^@> x)). - unfold f. - evalStepF. - tauto. -apply StepFfoldPropForall_Map. -intros a. -apply: Qabs_opp. + intros x. + unfold StepF_eq. + set (g:=(st_eqS QS)). + set (f:=(ap (compose g (compose QabsS QoppS)) QabsS)). + cut (StepFfoldProp (f ^@> x)). + unfold f. + evalStepF. + tauto. + apply StepFfoldPropForall_Map. + intros a. + apply: Qabs_opp. Qed. Lemma StepQabs_triangle : forall x y, StepQabs (x+y) <= StepQabs x + StepQabs y. Proof. -intros x y. -set (f:=(ap -(compose ap (compose (compose (compose QleS QabsS)) QplusS)) -(compose (flip (@compose _ _ _) QabsS) (compose QplusS QabsS)))). -cut (StepFfoldProp (f ^@> x <@> y)). - unfold f. - evalStepF. - tauto. -apply StepFfoldPropForall_Map2. -intros a b. -apply: Qabs_triangle. + intros x y. + set (f:=(ap (compose ap (compose (compose (compose QleS QabsS)) QplusS)) + (compose (flip (@compose _ _ _) QabsS) (compose QplusS QabsS)))). + cut (StepFfoldProp (f ^@> x <@> y)). + unfold f. + evalStepF. + tauto. + apply StepFfoldPropForall_Map2. + intros a b. + apply: Qabs_triangle. Qed. diff --git a/model/structures/Zsec.v b/model/structures/Zsec.v index b358ed037..421314823 100644 --- a/model/structures/Zsec.v +++ b/model/structures/Zsec.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing {#Z} %\ensuremath{\mathrel\#_{\mathbb Z}}% *) @@ -42,7 +42,7 @@ Require Import CLogic. (** * [Z] ** About [Z] -We consider the implementation of integers as signed binary sequences (the +We consider the implementation of integers as signed binary sequences (the datatype [Z] as defined in [ZArith], in the standard library). *** Apartness @@ -57,15 +57,17 @@ Infix "{#Z}" := ap_Z (no associativity, at level 90). *) Lemma ap_Z_irreflexive0 : forall x : Z, Not (x{#Z}x). -intro x. -unfold ap_Z in |- *. -red in |- *. -intro H. -elim H. -reflexivity. +Proof. + intro x. + unfold ap_Z in |- *. + red in |- *. + intro H. + elim H. + reflexivity. Qed. Lemma ap_Z_symmetric0 : forall x y : Z, (x{#Z}y) -> y{#Z}x. +Proof. intros x y H. unfold ap_Z in |- *. red in |- *. @@ -76,67 +78,71 @@ Qed. Lemma ap_Z_cotransitive0 : forall x y : Z, (x{#Z}y) -> forall z : Z, (x{#Z}z) or (z{#Z}y). -intros x y X z. +Proof. + intros x y X z. unfold ap_Z in |- *. case (Z_eq_dec x z). - intro e. - right. - rewrite <- e. - assumption. + intro e. + right. + rewrite <- e. + assumption. intro n. left. assumption. Qed. Lemma ap_Z_tight0 : forall x y : Z, Not (x{#Z}y) <-> x = y. -intros x y. +Proof. + intros x y. red in |- *. split. - unfold ap_Z in |- *. - intro H. - case (Z_eq_dec x y). - intro e. - assumption. - contradiction. + unfold ap_Z in |- *. + intro H. + case (Z_eq_dec x y). + intro e. + assumption. + contradiction. unfold ap_Z, Not. contradiction. Qed. Lemma ONE_neq_O : 1{#Z}0. Proof. -apply ap_Z_symmetric0. -red in |- *. -apply Zorder.Zlt_not_eq. -apply Zgt_lt. -exact (Zorder.Zgt_pos_0 1). + apply ap_Z_symmetric0. + red in |- *. + apply Zorder.Zlt_not_eq. + apply Zgt_lt. + exact (Zorder.Zgt_pos_0 1). Qed. (** *** Addition -Some properties of the addition. [Zplus] is also defined in the standard +Some properties of the addition. [Zplus] is also defined in the standard library. *) Lemma Zplus_wd0 : forall x1 x2 y1 y2 : Z, x1 = x2 -> y1 = y2 -> (x1 + y1)%Z = (x2 + y2)%Z. -intros x1 x2 y1 y2 H H0. -rewrite H. -rewrite H0. -auto. +Proof. + intros x1 x2 y1 y2 H H0. + rewrite H. + rewrite H0. + auto. Qed. Lemma Zplus_strext0 : forall x1 x2 y1 y2 : Z, (x1 + y1{#Z}x2 + y2) -> (x1{#Z}x2) or (y1{#Z}y2). -intros x1 x2 y1 y2 H. -unfold ap_Z in |- *. -unfold ap_Z in H. -case (Z_eq_dec x1 x2). -intro e. -right. -red in |- *. -intro H0. -apply H. -exact (f_equal2 Zplus e H0). -auto. +Proof. + intros x1 x2 y1 y2 H. + unfold ap_Z in |- *. + unfold ap_Z in H. + case (Z_eq_dec x1 x2). + intro e. + right. + red in |- *. + intro H0. + apply H. + exact (f_equal2 Zplus e H0). + auto. Qed. (** @@ -146,16 +152,17 @@ The multiplication is extensional: Lemma Zmult_strext0 : forall x1 x2 y1 y2 : Z, (x1 * y1{#Z}x2 * y2) -> (x1{#Z}x2) or (y1{#Z}y2). -unfold ap_Z in |- *. -intros x1 x2 y1 y2 H. -case (Z_eq_dec x1 x2). -intro e. -right. -red in |- *. -intro H0. -apply H. -exact (f_equal2 Zmult e H0). -auto. +Proof. + unfold ap_Z in |- *. + intros x1 x2 y1 y2 H. + case (Z_eq_dec x1 x2). + intro e. + right. + red in |- *. + intro H0. + apply H. + exact (f_equal2 Zmult e H0). + auto. Qed. (** @@ -175,44 +182,44 @@ Lemma a_very_specific_lemma1 : forall a b c d e f : Z, c <> 0%Z -> Proof. intros. cut ((a * (c * e))%Z = (a * (f * b))%Z). - intro. - cut ((f * (a * b))%Z = (f * (c * d))%Z). - intro. - cut ((a * (f * b))%Z = (f * (a * b))%Z). - intro. - cut ((a * (c * e))%Z = (f * (a * b))%Z). - intro. - cut ((a * (c * e))%Z = (f * (c * d))%Z). - intro. - cut ((a * (c * e))%Z = (c * (a * e))%Z). - intro. - cut ((f * (c * d))%Z = (c * (f * d))%Z). - intro. - cut ((c * (a * e))%Z = (a * (c * e))%Z). - intro. - cut ((c * (a * e))%Z = (f * (c * d))%Z). - intro. - cut ((c * (a * e))%Z = (c * (f * d))%Z). - intro. - exact (Zmult_absorb c (a * e) (f * d) H H11). - cut ((f * (c * d))%Z = (c * (f * d))%Z). - intro. - exact (trans_eq H10 H11). - exact (Zmult_permute f c d). - exact (trans_eq H9 H6). - exact (Zmult_permute c a e). - exact (Zmult_permute f c d). - exact (Zmult_permute a c e). - exact (trans_eq H5 H3). - exact (trans_eq H2 H4). - exact (Zmult_permute a f b). - cut (f = f). - intro. - exact (f_equal2 Zmult H3 H0). - trivial. + intro. + cut ((f * (a * b))%Z = (f * (c * d))%Z). + intro. + cut ((a * (f * b))%Z = (f * (a * b))%Z). + intro. + cut ((a * (c * e))%Z = (f * (a * b))%Z). + intro. + cut ((a * (c * e))%Z = (f * (c * d))%Z). + intro. + cut ((a * (c * e))%Z = (c * (a * e))%Z). + intro. + cut ((f * (c * d))%Z = (c * (f * d))%Z). + intro. + cut ((c * (a * e))%Z = (a * (c * e))%Z). + intro. + cut ((c * (a * e))%Z = (f * (c * d))%Z). + intro. + cut ((c * (a * e))%Z = (c * (f * d))%Z). + intro. + exact (Zmult_absorb c (a * e) (f * d) H H11). + cut ((f * (c * d))%Z = (c * (f * d))%Z). + intro. + exact (trans_eq H10 H11). + exact (Zmult_permute f c d). + exact (trans_eq H9 H6). + exact (Zmult_permute c a e). + exact (Zmult_permute f c d). + exact (Zmult_permute a c e). + exact (trans_eq H5 H3). + exact (trans_eq H2 H4). + exact (Zmult_permute a f b). + cut (f = f). + intro. + exact (f_equal2 Zmult H3 H0). + trivial. cut (a = a). - intro. - exact (f_equal2 Zmult H2 H1). + intro. + exact (f_equal2 Zmult H2 H1). trivial. Qed. @@ -221,10 +228,9 @@ Lemma a_very_specific_lemma2 : forall a b c d s r t u : Z, (a * r)%Z = (b * s)%Z -> (c * u)%Z = (d * t)%Z -> ((a * t + c * s) * (r * u))%Z = ((b * u + d * r) * (s * t))%Z. Proof. -intros. -replace ((a * t + c * s) * (r * u))%Z with (a * r * t * u + c * u * s * r)%Z - by ring. -rewrite H in |- *; rewrite H0 in |- *; ring. + intros. + replace ((a * t + c * s) * (r * u))%Z with (a * r * t * u + c * u * s * r)%Z by ring. + rewrite H in |- *; rewrite H0 in |- *; ring. Qed. @@ -234,8 +240,7 @@ Lemma a_very_specific_lemma3 : forall (a b c d : Z) (s r t u : positive), Proof. intros a b c d s r t u. intros. - change (((a * t + c * s) * (r * u))%Z = ((b * u + d * r) * (s * t))%Z) - in |- *. + change (((a * t + c * s) * (r * u))%Z = ((b * u + d * r) * (s * t))%Z) in |- *. apply a_very_specific_lemma2; trivial. Qed. @@ -252,133 +257,119 @@ Lemma a_very_specific_lemma5 : forall (a b c : Z) (m n p : positive), (((a * n + b * m) * p + c * (m * n)%positive) * (m * (n * p))%positive)%Z. Proof. intros. - change - (((a * (n * p) + (b * p + c * n) * m) * (m * n * p))%Z = - (((a * n + b * m) * p + c * (m * n)) * (m * (n * p)))%Z) - in |- *. + change (((a * (n * p) + (b * p + c * n) * m) * (m * n * p))%Z = + (((a * n + b * m) * p + c * (m * n)) * (m * (n * p)))%Z) in |- *. apply a_very_specific_lemma4. Qed. -Lemma posZ_pos : forall x : Z, (x > 0)%Z -> posZ x = x :>Z. +Lemma posZ_pos : forall x : Z, (x > 0)%Z -> posZ x = x :>Z. Proof. -simple induction x; intros; reflexivity || inversion H. + simple induction x; intros; reflexivity || inversion H. Qed. -Lemma posZ_neg : forall x : Z, (x < 0)%Z -> posZ x = (- x)%Z :>Z. +Lemma posZ_neg : forall x : Z, (x < 0)%Z -> posZ x = (- x)%Z :>Z. Proof. -simple induction x; intros; reflexivity || inversion H. + simple induction x; intros; reflexivity || inversion H. Qed. Lemma posZ_Zsgn : forall x : Z, x <> 0%Z -> (Zsgn x * posZ x)%Z = x. Proof. -simple induction x; intros; reflexivity. + simple induction x; intros; reflexivity. Qed. Lemma posZ_Zsgn2 : forall x : Z, x <> 0%Z -> (Zsgn x * x)%Z = posZ x. Proof. -simple induction x; intros; [ elim H | simpl in |- * | simpl in |- * ]; - reflexivity. + simple induction x; intros; [ elim H | simpl in |- * | simpl in |- * ]; reflexivity. Qed. Lemma a_very_specific_lemma5' : forall (m n p : positive) (a b c : Z), (a * n < b * m)%Z -> (b * p)%Z = (c * n)%Z -> (a * p < c * m)%Z. Proof. -intros. -case (dec_eq b 0). -intro. -rewrite H1 in H0. -simpl in H0. -cut (c = 0%Z). -intro. -rewrite H2. -rewrite H1 in H. -simpl in H. -simpl in |- *. -apply Zgt_lt. -cut (a * 0 > a * p)%Z. -intro. -rewrite Zmult_0_r in H3. -assumption. -apply Zlt_conv_mult_l. -apply Zgt_lt. -cut (- (0) > - - a)%Z. -simpl in |- *. -rewrite Zopp_involutive. -trivial. -apply Zlt_opp. -apply Zmult_gt_0_lt_0_reg_r with (n := n). -auto with zarith. -rewrite Zopp_mult_distr_l_reverse. -cut (- (a * n) > - (0))%Z. -simpl in |- *. -intro. -apply Zgt_lt. -trivial. -apply Zlt_opp. -assumption. -apply Zgt_lt. -auto with zarith. -apply Zmult_integral_l with (n := n). -apply Zgt_not_eq. -auto with zarith. -apply sym_eq. -assumption. - -intro. -case (not_Zeq b 0 H1). - -(* y:0 *) -intro. -cut (b * p < 0)%Z. -intro. -cut (b * p * (a * n) > b * p * (b * m))%Z. -intro. -cut (b * p * (a * n) > c * n * (b * m))%Z. -intro. -apply Zgt_lt. -apply Zgt_mult_reg_absorb_l with (a := n). -auto with zarith. -apply Zlt_gt. -apply Zgt_mult_conv_absorb_l with (a := b). -assumption. - -replace (b * (n * (a * p)))%Z with (b * p * (a * n))%Z by ring. -replace (b * (n * (c * m)))%Z with (c * n * (b * m))%Z by ring; auto. - -rewrite <- H0. -auto. - -apply Zlt_conv_mult_l;trivial. - -apply Zgt_lt. -replace 0%Z with (b * 0)%Z by ring. -apply Zlt_conv_mult_l; trivial. -apply Zgt_lt. -auto with zarith. - -(* y>0 *) -intro. -cut (b * p > 0)%Z. -intro. -cut (b * p * (a * n) < b * p * (b * m))%Z. -intro. -cut (b * p * (a * n) < c * n * (b * m))%Z. -intro. -apply Zgt_lt. -apply Zgt_mult_reg_absorb_l with (a := n). -auto with zarith. -apply Zgt_mult_reg_absorb_l with (a := b). -apply Zlt_gt. -assumption. - -apply Zlt_gt. -replace (b * (n * (a * p)))%Z with (b * p * (a * n))%Z by ring. -replace (b * (n * (c * m)))%Z with (c * n * (b * m))%Z by ring; auto. - -rewrite <- H0. -auto. - -apply Zlt_reg_mult_l; auto. - -apply Zmult_gt_0_compat; auto with zarith. + intros. + case (dec_eq b 0). + intro. + rewrite H1 in H0. + simpl in H0. + cut (c = 0%Z). + intro. + rewrite H2. + rewrite H1 in H. + simpl in H. + simpl in |- *. + apply Zgt_lt. + cut (a * 0 > a * p)%Z. + intro. + rewrite Zmult_0_r in H3. + assumption. + apply Zlt_conv_mult_l. + apply Zgt_lt. + cut (- (0) > - - a)%Z. + simpl in |- *. + rewrite Zopp_involutive. + trivial. + apply Zlt_opp. + apply Zmult_gt_0_lt_0_reg_r with (n := n). + auto with zarith. + rewrite Zopp_mult_distr_l_reverse. + cut (- (a * n) > - (0))%Z. + simpl in |- *. + intro. + apply Zgt_lt. + trivial. + apply Zlt_opp. + assumption. + apply Zgt_lt. + auto with zarith. + apply Zmult_integral_l with (n := n). + apply Zgt_not_eq. + auto with zarith. + apply sym_eq. + assumption. + intro. + case (not_Zeq b 0 H1). + (* y:0 *) + intro. + cut (b * p < 0)%Z. + intro. + cut (b * p * (a * n) > b * p * (b * m))%Z. + intro. + cut (b * p * (a * n) > c * n * (b * m))%Z. + intro. + apply Zgt_lt. + apply Zgt_mult_reg_absorb_l with (a := n). + auto with zarith. + apply Zlt_gt. + apply Zgt_mult_conv_absorb_l with (a := b). + assumption. + replace (b * (n * (a * p)))%Z with (b * p * (a * n))%Z by ring. + replace (b * (n * (c * m)))%Z with (c * n * (b * m))%Z by ring; auto. + rewrite <- H0. + auto. + apply Zlt_conv_mult_l;trivial. + apply Zgt_lt. + replace 0%Z with (b * 0)%Z by ring. + apply Zlt_conv_mult_l; trivial. + apply Zgt_lt. + auto with zarith. + (* y>0 *) + intro. + cut (b * p > 0)%Z. + intro. + cut (b * p * (a * n) < b * p * (b * m))%Z. + intro. + cut (b * p * (a * n) < c * n * (b * m))%Z. + intro. + apply Zgt_lt. + apply Zgt_mult_reg_absorb_l with (a := n). + auto with zarith. + apply Zgt_mult_reg_absorb_l with (a := b). + apply Zlt_gt. + assumption. + apply Zlt_gt. + replace (b * (n * (a * p)))%Z with (b * p * (a * n))%Z by ring. + replace (b * (n * (c * m)))%Z with (c * n * (b * m))%Z by ring; auto. + rewrite <- H0. + auto. + apply Zlt_reg_mult_l; auto. + apply Zmult_gt_0_compat; auto with zarith. Qed. diff --git a/model/totalorder/QMinMax.v b/model/totalorder/QMinMax.v index 5f4cdb3b1..70a3e06b1 100644 --- a/model/totalorder/QMinMax.v +++ b/model/totalorder/QMinMax.v @@ -27,13 +27,12 @@ Require Import TotalOrder. *) Definition Qlt_le_dec_fast x y : {x < y} + {y <= x}. -intros x y. -change ({x ?= y = Lt}+{y<=x}). -cut (x ?= y <> Lt -> y <= x). -destruct (x?=y); intros H; - (right; abstract(apply H; discriminate)) || - (left; reflexivity). -refine (Qnot_lt_le _ _). +Proof. + intros x y. + change ({x ?= y = Lt}+{y<=x}). + cut (x ?= y <> Lt -> y <= x). + destruct (x?=y); intros H; (right; abstract(apply H; discriminate)) || (left; reflexivity). + refine (Qnot_lt_le _ _). Defined. Definition Qle_total x y : {x <= y} + {y <= x} := @@ -44,11 +43,11 @@ end. Lemma Qeq_le_def : forall x y, x == y <-> x <= y /\ y <= x. Proof. -intros. -split. -intros H; rewrite H. -firstorder using Qle_refl. -firstorder using Qle_antisym. + intros. + split. + intros H; rewrite H. + firstorder using Qle_refl. + firstorder using Qle_antisym. Qed. Definition Qmonotone : (Q -> Q) -> Prop := Default.monotone Qle. @@ -64,26 +63,28 @@ Definition Qmax_case : Default.max_case Q Qle Qle_total. Definition QTotalOrder : TotalOrder. -apply makeTotalOrder with - Q Qeq Qle Qmonotone Qantitone Qmin Qmax. -apply Qeq_le_def. -apply Qle_refl. -apply Qle_trans. -apply Qle_total. -firstorder using PartialOrder.Default.monotone_def. -firstorder using PartialOrder.Default.antitone_def. -apply (TotalOrder.Default.min_def1 Q Qeq Qle Qeq_le_def Qle_total). -apply (TotalOrder.Default.min_def2 Q Qeq Qle Qeq_le_def Qle_total). -apply (TotalOrder.Default.max_def1 Q Qeq Qle Qeq_le_def Qle_total). -apply (TotalOrder.Default.max_def2 Q Qeq Qle Qeq_le_def Qle_total). + apply makeTotalOrder with Q Qeq Qle Qmonotone Qantitone Qmin Qmax. +Proof. + apply Qeq_le_def. + apply Qle_refl. + apply Qle_trans. + apply Qle_total. + firstorder using PartialOrder.Default.monotone_def. + firstorder using PartialOrder.Default.antitone_def. + apply (TotalOrder.Default.min_def1 Q Qeq Qle Qeq_le_def Qle_total). + apply (TotalOrder.Default.min_def2 Q Qeq Qle Qeq_le_def Qle_total). + apply (TotalOrder.Default.max_def1 Q Qeq Qle Qeq_le_def Qle_total). + apply (TotalOrder.Default.max_def2 Q Qeq Qle Qeq_le_def Qle_total). Defined. (* begin hide *) Add Morphism Qmin : Qmin_compat. -exact (@meet_compat QTotalOrder). +Proof. + exact (@meet_compat QTotalOrder). Qed. Add Morphism Qmax : Qmax_compat. -exact (@join_compat QTotalOrder). +Proof. + exact (@join_compat QTotalOrder). Qed. (* end hide *) Section QTotalOrder. @@ -95,7 +96,7 @@ Definition Qmin_lb_r : forall x y : Q, Qmin x y <= y := @meet_lb_r Qto. Definition Qmin_glb : forall x y z : Q, z <= x -> z <= y -> z <= (Qmin x y) := @meet_glb Qto. Definition Qmin_comm : forall x y : Q, Qmin x y == Qmin y x := @meet_comm Qto. -Definition Qmin_assoc : forall x y z : Q, Qmin x (Qmin y z) == Qmin (Qmin x y) z:= +Definition Qmin_assoc : forall x y z : Q, Qmin x (Qmin y z) == Qmin (Qmin x y) z:= @meet_assoc Qto. Definition Qmin_idem : forall x : Q, Qmin x x == x := @meet_idem Qto. Definition Qle_min_l : forall x y : Q, x <= y <-> Qmin x y == x := @le_meet_l Qto. @@ -105,7 +106,7 @@ Definition Qmin_monotone_r : forall a : Q, Qmonotone (Qmin a) := @meet_monotone_r Qto. Definition Qmin_monotone_l : forall a : Q, Qmonotone (fun x => Qmin x a) := @meet_monotone_l Qto. -Definition Qmin_le_compat : +Definition Qmin_le_compat : forall w x y z : Q, w <= y -> x <= z -> Qmin w x <= Qmin y z := @meet_le_compat Qto. @@ -114,7 +115,7 @@ Definition Qmax_ub_r : forall x y : Q, y <= Qmax x y := @join_ub_r Qto. Definition Qmax_lub : forall x y z : Q, x <= z -> y <= z -> (Qmax x y) <= z := @join_lub Qto. Definition Qmax_comm : forall x y : Q, Qmax x y == Qmax y x := @join_comm Qto. -Definition Qmax_assoc : forall x y z : Q, Qmax x (Qmax y z) == Qmax (Qmax x y) z:= +Definition Qmax_assoc : forall x y z : Q, Qmax x (Qmax y z) == Qmax (Qmax x y) z:= @join_assoc Qto. Definition Qmax_idem : forall x : Q, Qmax x x == x := @join_idem Qto. Definition Qle_max_l : forall x y : Q, y <= x <-> Qmax x y == x := @le_join_l Qto. @@ -149,40 +150,42 @@ Definition Qmin_max_eq : forall x y : Q, Qmin x y == Qmax x y -> x == y := @meet_join_eq Qto. Definition Qmax_min_distr_r : forall x y z : Q, - Qmax x (Qmin y z) == Qmin (Qmax x y) (Qmax x z) := + Qmax x (Qmin y z) == Qmin (Qmax x y) (Qmax x z) := @join_meet_distr_r Qto. Definition Qmax_min_distr_l : forall x y z : Q, - Qmax (Qmin y z) x == Qmin (Qmax y x) (Qmax z x) := + Qmax (Qmin y z) x == Qmin (Qmax y x) (Qmax z x) := @join_meet_distr_l Qto. Definition Qmin_max_distr_r : forall x y z : Q, - Qmin x (Qmax y z) == Qmax (Qmin x y) (Qmin x z) := + Qmin x (Qmax y z) == Qmax (Qmin x y) (Qmin x z) := @meet_join_distr_r Qto. Definition Qmin_max_distr_l : forall x y z : Q, - Qmin (Qmax y z) x == Qmax (Qmin y x) (Qmin z x) := + Qmin (Qmax y z) x == Qmax (Qmin y x) (Qmin z x) := @meet_join_distr_l Qto. (*I don't know who wants modularity laws, but here they are *) Definition Qmax_min_modular_r : forall x y z : Q, - Qmax x (Qmin y (Qmax x z)) == Qmin (Qmax x y) (Qmax x z) := + Qmax x (Qmin y (Qmax x z)) == Qmin (Qmax x y) (Qmax x z) := @join_meet_modular_r Qto. Definition Qmax_min_modular_l : forall x y z : Q, - Qmax (Qmin (Qmax x z) y) z == Qmin (Qmax x z) (Qmax y z) := + Qmax (Qmin (Qmax x z) y) z == Qmin (Qmax x z) (Qmax y z) := @join_meet_modular_l Qto. Definition Qmin_max_modular_r : forall x y z : Q, - Qmin x (Qmax y (Qmin x z)) == Qmax (Qmin x y) (Qmin x z) := + Qmin x (Qmax y (Qmin x z)) == Qmax (Qmin x y) (Qmin x z) := @meet_join_modular_r Qto. Definition Qmin_max_modular_l : forall x y z : Q, - Qmin (Qmax (Qmin x z) y) z == Qmax (Qmin x z) (Qmin y z) := + Qmin (Qmax (Qmin x z) y) z == Qmax (Qmin x z) (Qmin y z) := @meet_join_modular_l Qto. Definition Qmin_max_disassoc : forall x y z : Q, Qmin (Qmax x y) z <= Qmax x (Qmin y z) := @meet_join_disassoc Qto. Lemma Qplus_monotone_r : forall a, Qmonotone (Qplus a). -firstorder using Qle_refl Qplus_le_compat . +Proof. + firstorder using Qle_refl Qplus_le_compat . Qed. Lemma Qplus_monotone_l : forall a, Qmonotone (fun x => Qplus x a). -firstorder using Qle_refl Qplus_le_compat. +Proof. + firstorder using Qle_refl Qplus_le_compat. Qed. Definition Qmin_plus_distr_r : forall x y z : Q, x + Qmin y z == Qmin (x+y) (x+z) := fun a => @monotone_meet_distr Qto _ (Qplus_monotone_r a). @@ -203,10 +206,10 @@ Definition Qmax_min_de_morgan : forall x y : Q, -(Qmax x y) == Qmin (-x) (-y) := @antitone_join_meet_distr Qto _ Qopp_le_compat. Lemma Qminus_antitone : forall a : Q, Qantitone (fun x => a - x). -change (forall a x y : Q, x <= y -> a + - y <= a + - x). -intros. -apply Qplus_le_compat; - firstorder using Qle_refl Qopp_le_compat. +Proof. + change (forall a x y : Q, x <= y -> a + - y <= a + - x). + intros. + apply Qplus_le_compat; firstorder using Qle_refl Qopp_le_compat. Qed. Definition Qminus_min_max_antidistr_r : forall x y z : Q, x - Qmin y z == Qmax (x-y) (x-z) := @@ -215,14 +218,16 @@ Definition Qminus_max_min_antidistr_r : forall x y z : Q, x - Qmax y z == Qmin ( fun a => @antitone_join_meet_distr Qto _ (Qminus_antitone a). Lemma Qmult_pos_monotone_r : forall a, (0 <= a) -> Qmonotone (Qmult a). -intros a Ha b c H. -do 2 rewrite (Qmult_comm a). -apply Qmult_le_compat_r; auto with *. +Proof. + intros a Ha b c H. + do 2 rewrite (Qmult_comm a). + apply Qmult_le_compat_r; auto with *. Qed. Lemma Qmult_pos_monotone_l : forall a, (0 <= a) -> Qmonotone (fun x => x*a). -intros a Ha b c H. -apply Qmult_le_compat_r; auto with *. +Proof. + intros a Ha b c H. + apply Qmult_le_compat_r; auto with *. Qed. Definition Qmin_mult_pos_distr_r : forall x y z : Q, 0 <= x -> x * Qmin y z == Qmin (x*y) (x*z) := @@ -242,4 +247,4 @@ Hint Resolve Qmin_glb: qarith. Hint Resolve Qmax_ub_l: qarith. Hint Resolve Qmax_ub_r: qarith. Hint Resolve Qmax_lub: qarith. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/model/totalorder/QposMinMax.v b/model/totalorder/QposMinMax.v index 7c23b62fe..b245bdbd0 100644 --- a/model/totalorder/QposMinMax.v +++ b/model/totalorder/QposMinMax.v @@ -36,11 +36,11 @@ end. Lemma Qpos_eq_le_def : forall (x y: Qpos), x == y <-> x <= y /\ y <= x. Proof. -intros. -split. -intros H; rewrite H. -firstorder using Qle_refl. -firstorder using Qle_antisym. + intros. + split. + intros H; rewrite H. + firstorder using Qle_refl. + firstorder using Qle_antisym. Qed. Definition Qpos_monotone : (Qpos -> Qpos) -> Prop := Default.monotone (fun (x y:Qpos) => x <= y). @@ -56,26 +56,29 @@ Definition Qpos_max_case : Default.max_case _ _ Qpos_le_total. Definition QposTotalOrder : TotalOrder. -apply makeTotalOrder with - Qpos QposEq (fun (x y:Qpos) => x <= y) Qpos_monotone Qpos_antitone Qpos_min Qpos_max. -apply Qpos_eq_le_def. -firstorder using Qle_refl. -firstorder using Qle_trans. -firstorder using Qpos_le_total. -firstorder using PartialOrder.Default.monotone_def. -firstorder using PartialOrder.Default.antitone_def. -apply (TotalOrder.Default.min_def1 _ _ _ Qpos_eq_le_def Qpos_le_total). -apply (TotalOrder.Default.min_def2 _ _ _ Qpos_eq_le_def Qpos_le_total). -apply (TotalOrder.Default.max_def1 _ _ _ Qpos_eq_le_def Qpos_le_total). -apply (TotalOrder.Default.max_def2 _ _ _ Qpos_eq_le_def Qpos_le_total). +Proof. + apply makeTotalOrder with + Qpos QposEq (fun (x y:Qpos) => x <= y) Qpos_monotone Qpos_antitone Qpos_min Qpos_max. + apply Qpos_eq_le_def. + firstorder using Qle_refl. + firstorder using Qle_trans. + firstorder using Qpos_le_total. + firstorder using PartialOrder.Default.monotone_def. + firstorder using PartialOrder.Default.antitone_def. + apply (TotalOrder.Default.min_def1 _ _ _ Qpos_eq_le_def Qpos_le_total). + apply (TotalOrder.Default.min_def2 _ _ _ Qpos_eq_le_def Qpos_le_total). + apply (TotalOrder.Default.max_def1 _ _ _ Qpos_eq_le_def Qpos_le_total). + apply (TotalOrder.Default.max_def2 _ _ _ Qpos_eq_le_def Qpos_le_total). Defined. (* begin hide *) Add Morphism Qpos_min : Qpos_min_compat. -exact (@meet_compat QposTotalOrder). +Proof. + exact (@meet_compat QposTotalOrder). Qed. Add Morphism Qpos_max : Qpos_max_compat. -exact (@join_compat QposTotalOrder). +Proof. + exact (@join_compat QposTotalOrder). Qed. (* end hide *) Section QTotalOrder. @@ -87,7 +90,7 @@ Definition Qpos_min_lb_r : forall x y : Qpos, Qpos_min x y <= y := @meet_lb_r Qt Definition Qpos_min_glb : forall x y z : Qpos, z <= x -> z <= y -> z <= (Qpos_min x y) := @meet_glb Qto. Definition Qpos_min_comm : forall x y : Qpos, Qpos_min x y == Qpos_min y x := @meet_comm Qto. -Definition Qpos_min_assoc : forall x y z : Qpos, Qpos_min x (Qpos_min y z) == Qpos_min (Qpos_min x y) z:= +Definition Qpos_min_assoc : forall x y z : Qpos, Qpos_min x (Qpos_min y z) == Qpos_min (Qpos_min x y) z:= @meet_assoc Qto. Definition Qpos_min_idem : forall x : Qpos, Qpos_min x x == x := @meet_idem Qto. Definition Qpos_le_min_l : forall x y : Qpos, x <= y <-> Qpos_min x y == x := @le_meet_l Qto. @@ -97,7 +100,7 @@ Definition Qpos_min_monotone_r : forall a : Qpos, Qpos_monotone (Qpos_min a) := @meet_monotone_r Qto. Definition Qpos_min_monotone_l : forall a : Qpos, Qpos_monotone (fun x => Qpos_min x a) := @meet_monotone_l Qto. -Definition Qpos_min_le_compat : +Definition Qpos_min_le_compat : forall w x y z : Qpos, w <= y -> x <= z -> Qpos_min w x <= Qpos_min y z := @meet_le_compat Qto. @@ -106,7 +109,7 @@ Definition Qpos_max_ub_r : forall x y : Qpos, y <= Qpos_max x y := @join_ub_r Qt Definition Qpos_max_glb : forall x y z : Qpos, x <= z -> y <= z -> (Qpos_max x y) <= z := @join_lub Qto. Definition Qpos_max_comm : forall x y : Qpos, Qpos_max x y == Qpos_max y x := @join_comm Qto. -Definition Qpos_max_assoc : forall x y z : Qpos, Qpos_max x (Qpos_max y z) == Qpos_max (Qpos_max x y) z:= +Definition Qpos_max_assoc : forall x y z : Qpos, Qpos_max x (Qpos_max y z) == Qpos_max (Qpos_max x y) z:= @join_assoc Qto. Definition Qpos_max_idem : forall x : Qpos, Qpos_max x x == x := @join_idem Qto. Definition Qpos_le_max_l : forall x y : Qpos, y <= x <-> Qpos_max x y == x := @le_join_l Qto. @@ -141,44 +144,46 @@ Definition Qpos_min_max_eq : forall x y : Qpos, Qpos_min x y == Qpos_max x y -> @meet_join_eq Qto. Definition Qpos_max_min_distr_r : forall x y z : Qpos, - Qpos_max x (Qpos_min y z) == Qpos_min (Qpos_max x y) (Qpos_max x z) := + Qpos_max x (Qpos_min y z) == Qpos_min (Qpos_max x y) (Qpos_max x z) := @join_meet_distr_r Qto. Definition Qpos_max_min_distr_l : forall x y z : Qpos, - Qpos_max (Qpos_min y z) x == Qpos_min (Qpos_max y x) (Qpos_max z x) := + Qpos_max (Qpos_min y z) x == Qpos_min (Qpos_max y x) (Qpos_max z x) := @join_meet_distr_l Qto. Definition Qpos_min_max_distr_r : forall x y z : Qpos, - Qpos_min x (Qpos_max y z) == Qpos_max (Qpos_min x y) (Qpos_min x z) := + Qpos_min x (Qpos_max y z) == Qpos_max (Qpos_min x y) (Qpos_min x z) := @meet_join_distr_r Qto. Definition Qpos_min_max_distr_l : forall x y z : Qpos, - Qpos_min (Qpos_max y z) x == Qpos_max (Qpos_min y x) (Qpos_min z x) := + Qpos_min (Qpos_max y z) x == Qpos_max (Qpos_min y x) (Qpos_min z x) := @meet_join_distr_l Qto. (*I don't know who wants modularity laws, but here they are *) Definition Qpos_max_min_modular_r : forall x y z : Qpos, - Qpos_max x (Qpos_min y (Qpos_max x z)) == Qpos_min (Qpos_max x y) (Qpos_max x z) := + Qpos_max x (Qpos_min y (Qpos_max x z)) == Qpos_min (Qpos_max x y) (Qpos_max x z) := @join_meet_modular_r Qto. Definition Qpos_max_min_modular_l : forall x y z : Qpos, - Qpos_max (Qpos_min (Qpos_max x z) y) z == Qpos_min (Qpos_max x z) (Qpos_max y z) := + Qpos_max (Qpos_min (Qpos_max x z) y) z == Qpos_min (Qpos_max x z) (Qpos_max y z) := @join_meet_modular_l Qto. Definition Qpos_min_max_modular_r : forall x y z : Qpos, - Qpos_min x (Qpos_max y (Qpos_min x z)) == Qpos_max (Qpos_min x y) (Qpos_min x z) := + Qpos_min x (Qpos_max y (Qpos_min x z)) == Qpos_max (Qpos_min x y) (Qpos_min x z) := @meet_join_modular_r Qto. Definition Qpos_min_max_modular_l : forall x y z : Qpos, - Qpos_min (Qpos_max (Qpos_min x z) y) z == Qpos_max (Qpos_min x z) (Qpos_min y z) := + Qpos_min (Qpos_max (Qpos_min x z) y) z == Qpos_max (Qpos_min x z) (Qpos_min y z) := @meet_join_modular_l Qto. Definition Qpos_min_max_disassoc : forall x y z : Qpos, Qpos_min (Qpos_max x y) z <= Qpos_max x (Qpos_min y z) := @meet_join_disassoc Qto. Lemma Qplus_monotone_r : forall a, Qpos_monotone (Qpos_plus a). -intros a x y Hxy. -repeat rewrite Q_Qpos_plus. -firstorder using Qle_refl Qplus_le_compat . +Proof. + intros a x y Hxy. + repeat rewrite Q_Qpos_plus. + firstorder using Qle_refl Qplus_le_compat . Qed. Lemma Qplus_monotone_l : forall a, Qpos_monotone (fun x => Qpos_plus x a). -intros a x y Hxy. -repeat rewrite Q_Qpos_plus. -firstorder using Qle_refl Qplus_le_compat. +Proof. + intros a x y Hxy. + repeat rewrite Q_Qpos_plus. + firstorder using Qle_refl Qplus_le_compat. Qed. Open Local Scope Qpos_scope. @@ -196,27 +201,25 @@ End QTotalOrder. Lemma Q_Qpos_min : forall (x y:Qpos), ((Qpos_min x y)%Qpos:Q)==Qmin (x:Q) (y:Q). Proof. -intros x y. -unfold Qpos_min. -unfold Qmin. -unfold Default.min. -destruct (Qpos_le_total x y) as [H|H]; -destruct (Qle_total x y) as [H0|H0]; try reflexivity; - apply Qle_antisym; auto. + intros x y. + unfold Qpos_min. + unfold Qmin. + unfold Default.min. + destruct (Qpos_le_total x y) as [H|H]; destruct (Qle_total x y) as [H0|H0]; try reflexivity; + apply Qle_antisym; auto. Qed. (* begin hide *) Hint Rewrite Q_Qpos_min : QposElim. (* end hide *) Lemma Q_Qpos_max : forall (x y:Qpos), ((Qpos_max x y)%Qpos:Q)==Qmax (x:Q) (y:Q). Proof. -intros x y. -unfold Qpos_max. -unfold Qmax. -unfold Default.max. -destruct (Qpos_le_total y x) as [H|H]; -destruct (Qle_total y x) as [H0|H0]; try reflexivity; - apply Qle_antisym; auto. + intros x y. + unfold Qpos_max. + unfold Qmax. + unfold Default.max. + destruct (Qpos_le_total y x) as [H|H]; destruct (Qle_total y x) as [H0|H0]; try reflexivity; + apply Qle_antisym; auto. Qed. (* begin hide *) Hint Rewrite Q_Qpos_max : QposElim. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/model/totalorder/ZMinMax.v b/model/totalorder/ZMinMax.v index 0b225f604..c1802be00 100644 --- a/model/totalorder/ZMinMax.v +++ b/model/totalorder/ZMinMax.v @@ -40,27 +40,26 @@ end. Lemma Zeq_le_def : forall x y, x = y <-> x <= y /\ y <= x. Proof. -intros. -split. -intros H; rewrite H. -firstorder using Zle_refl. -firstorder using Zle_antisym. + intros. + split. + intros H; rewrite H. + firstorder using Zle_refl. + firstorder using Zle_antisym. Qed. Definition Zmonotone : (Z -> Z) -> Prop := Default.monotone Zle. Definition Zantitone : (Z -> Z) -> Prop := Default.antitone Zle. Definition ZTotalOrder : TotalOrder. -apply makeTotalOrder with - Z (@eq Z) Zle Zmonotone Zantitone Zmin Zmax; try solve - [auto with *]. -apply Zle_total. -firstorder using PartialOrder.Default.monotone_def. -firstorder using PartialOrder.Default.antitone_def. -intros. apply Zmin_case_strong; auto with *. -intros. apply Zmin_case_strong; auto with *. -intros. apply Zmax_case_strong; auto with *. -intros. apply Zmax_case_strong; auto with *. + apply makeTotalOrder with Z (@eq Z) Zle Zmonotone Zantitone Zmin Zmax; try solve [auto with *]. +Proof. + apply Zle_total. + firstorder using PartialOrder.Default.monotone_def. + firstorder using PartialOrder.Default.antitone_def. + intros. apply Zmin_case_strong; auto with *. + intros. apply Zmin_case_strong; auto with *. + intros. apply Zmax_case_strong; auto with *. + intros. apply Zmax_case_strong; auto with *. Defined. Let Zto := ZTotalOrder. @@ -70,7 +69,7 @@ Definition Zmin_lb_r : forall x y : Z, Zmin x y <= y := @meet_lb_r Zto. Definition Zmin_glb : forall x y z : Z, z <= x -> z <= y -> z <= (Zmin x y) := @meet_glb Zto. Definition Zmin_comm : forall x y : Z, Zmin x y = Zmin y x := @meet_comm Zto. -Definition Zmin_assoc : forall x y z : Z, Zmin x (Zmin y z) = Zmin (Zmin x y) z:= +Definition Zmin_assoc : forall x y z : Z, Zmin x (Zmin y z) = Zmin (Zmin x y) z:= @meet_assoc Zto. Definition Zmin_idem : forall x : Z, Zmin x x = x := @meet_idem Zto. Definition Zle_min_l : forall x y : Z, x <= y <-> Zmin x y = x := @le_meet_l Zto. @@ -88,7 +87,7 @@ Definition Zmax_ub_r : forall x y : Z, y <= Zmax x y := @join_ub_r Zto. Definition Zmax_glb : forall x y z : Z, x <= z -> y <= z -> (Zmax x y) <= z := @join_lub Zto. Definition Zmax_comm : forall x y : Z, Zmax x y = Zmax y x := @join_comm Zto. -Definition Zmax_assoc : forall x y z : Z, Zmax x (Zmax y z) = Zmax (Zmax x y) z:= +Definition Zmax_assoc : forall x y z : Z, Zmax x (Zmax y z) = Zmax (Zmax x y) z:= @join_assoc Zto. Definition Zmax_idem : forall x : Z, Zmax x x = x := @join_idem Zto. Definition Zle_max_l : forall x y : Z, y <= x <-> Zmax x y = x := @le_join_l Zto. @@ -119,66 +118,70 @@ Definition Zmax_min_absorb_r_r : forall x y : Z, Zmax (Zmin y x) x = x := @join_meet_absorb_r_r Zto. Definition Zmax_min_distr_r : forall x y z : Z, - Zmax x (Zmin y z) = Zmin (Zmax x y) (Zmax x z) := + Zmax x (Zmin y z) = Zmin (Zmax x y) (Zmax x z) := @join_meet_distr_r Zto. Definition Zmax_min_distr_l : forall x y z : Z, - Zmax (Zmin y z) x = Zmin (Zmax y x) (Zmax z x) := + Zmax (Zmin y z) x = Zmin (Zmax y x) (Zmax z x) := @join_meet_distr_l Zto. Definition Zmin_max_distr_r : forall x y z : Z, - Zmin x (Zmax y z) = Zmax (Zmin x y) (Zmin x z) := + Zmin x (Zmax y z) = Zmax (Zmin x y) (Zmin x z) := @meet_join_distr_r Zto. Definition Zmin_max_distr_l : forall x y z : Z, - Zmin (Zmax y z) x = Zmax (Zmin y x) (Zmin z x) := + Zmin (Zmax y z) x = Zmax (Zmin y x) (Zmin z x) := @meet_join_distr_l Zto. (*I don't know who wants modularity laws, but here they are *) Definition Zmax_min_modular_r : forall x y z : Z, - Zmax x (Zmin y (Zmax x z)) = Zmin (Zmax x y) (Zmax x z) := + Zmax x (Zmin y (Zmax x z)) = Zmin (Zmax x y) (Zmax x z) := @join_meet_modular_r Zto. Definition Zmax_min_modular_l : forall x y z : Z, - Zmax (Zmin (Zmax x z) y) z = Zmin (Zmax x z) (Zmax y z) := + Zmax (Zmin (Zmax x z) y) z = Zmin (Zmax x z) (Zmax y z) := @join_meet_modular_l Zto. Definition Zmin_max_modular_r : forall x y z : Z, - Zmin x (Zmax y (Zmin x z)) = Zmax (Zmin x y) (Zmin x z) := + Zmin x (Zmax y (Zmin x z)) = Zmax (Zmin x y) (Zmin x z) := @meet_join_modular_r Zto. Definition Zmin_max_modular_l : forall x y z : Z, - Zmin (Zmax (Zmin x z) y) z = Zmax (Zmin x z) (Zmin y z) := + Zmin (Zmax (Zmin x z) y) z = Zmax (Zmin x z) (Zmin y z) := @meet_join_modular_l Zto. Definition Zmin_max_disassoc : forall x y z : Z, Zmin (Zmax x y) z <= Zmax x (Zmin y z) := @meet_join_disassoc Zto. Lemma Zsucc_monotone : Zmonotone Zsucc. -unfold Zmonotone, Default.monotone. -auto with *. +Proof. + unfold Zmonotone, Default.monotone. + auto with *. Qed. -Definition Zsucc_min_distr : forall x y : Z, +Definition Zsucc_min_distr : forall x y : Z, Zsucc (Zmin x y) = Zmin (Zsucc x ) (Zsucc y) := @monotone_meet_distr Zto _ Zsucc_monotone. -Definition Zsucc_max_distr : forall x y : Z, +Definition Zsucc_max_distr : forall x y : Z, Zsucc (Zmax x y) = Zmax (Zsucc x ) (Zsucc y) := @monotone_join_distr Zto _ Zsucc_monotone. Lemma Zpred_monotone : Zmonotone Zpred. -unfold Zmonotone, Default.monotone. -intros x y H. -rewrite (Zsucc_pred x) in H. -rewrite (Zsucc_pred y) in H. -firstorder using Zsucc_monotone. +Proof. + unfold Zmonotone, Default.monotone. + intros x y H. + rewrite (Zsucc_pred x) in H. + rewrite (Zsucc_pred y) in H. + firstorder using Zsucc_monotone. Qed. -Definition Zpred_min_distr : forall x y : Z, +Definition Zpred_min_distr : forall x y : Z, Zpred (Zmin x y) = Zmin (Zpred x ) (Zpred y) := @monotone_meet_distr Zto _ Zpred_monotone. -Definition Zpred_max_distr : forall x y : Z, +Definition Zpred_max_distr : forall x y : Z, Zpred (Zmax x y) = Zmax (Zpred x ) (Zpred y) := @monotone_join_distr Zto _ Zpred_monotone. Lemma Zplus_monotone_r : forall a, Zmonotone (Zplus a). -firstorder using Zle_refl Zplus_le_compat . +Proof. + firstorder using Zle_refl Zplus_le_compat . Qed. Lemma Zplus_monotone_l : forall a, Zmonotone (fun x => Zplus x a). -unfold Zmonotone, Default.monotone. -auto with *. +Proof. + unfold Zmonotone, Default.monotone. + auto with *. Qed. Definition Zmin_plus_distr_r : forall x y z : Z, x + Zmin y z = Zmin (x+y) (x+z) := fun a => @monotone_meet_distr Zto _ (Zplus_monotone_r a). @@ -194,7 +197,8 @@ Definition Zmax_minus_distr_l : forall x y z : Z, Zmax y z - x = Zmax (y-x) (z-x (fun x => Zmax_plus_distr_l (-x)). Lemma Zopp_le_compat : forall x y : Z, x <= y -> -y <= -x. -auto with *. +Proof. + auto with *. Qed. Definition Zmin_max_de_morgan : forall x y : Z, -(Zmin x y) = Zmax (-x) (-y) := @antitone_meet_join_distr Zto _ Zopp_le_compat. @@ -202,10 +206,10 @@ Definition Zmax_min_de_morgan : forall x y : Z, -(Zmax x y) = Zmin (-x) (-y) := @antitone_join_meet_distr Zto _ Zopp_le_compat. Lemma Zminus_antitone : forall a : Z, Zantitone (fun x => a - x). -change (forall a x y : Z, x <= y -> a + - y <= a + - x). -intros. -apply Zplus_le_compat; - firstorder using Zle_refl Zopp_le_compat. +Proof. + change (forall a x y : Z, x <= y -> a + - y <= a + - x). + intros. + apply Zplus_le_compat; firstorder using Zle_refl Zopp_le_compat. Qed. Definition Zminus_min_max_antidistr_r : forall x y z : Z, x - Zmin y z = Zmax (x-y) (x-z) := diff --git a/order/Lattice.v b/order/Lattice.v index f9bcf448b..d4c7c0904 100644 --- a/order/Lattice.v +++ b/order/Lattice.v @@ -96,7 +96,7 @@ End Join. (* begin hide *) Add Parametric Morphism X : (@join X) with signature (@st_eq (sl X)) ==> (@st_eq X) ==> (@st_eq X) as join_compat. Proof. -exact (meet_compat (Dual X)). + exact (meet_compat (Dual X)). Qed. (* end hide *) Section MeetJoin. @@ -105,51 +105,51 @@ Variable X : Lattice. (** Lemma about how meet and join interact. *) Lemma meet_join_absorb_l_l : forall x y:X, meet x (join x y) == x. Proof. -intros. -apply le_antisym. -apply meet_lb_l. -apply meet_glb. -apply le_refl. -apply join_ub_l. + intros. + apply le_antisym. + apply meet_lb_l. + apply meet_glb. + apply le_refl. + apply join_ub_l. Qed. Lemma meet_join_absorb_l_r : forall x y:X, meet x (join y x) == x. Proof. -intros. -rewrite (join_comm X). -apply meet_join_absorb_l_l. + intros. + rewrite (join_comm X). + apply meet_join_absorb_l_l. Qed. Lemma meet_join_absorb_r_l : forall x y:X, meet (join x y) x == x. Proof. -intros. -rewrite (meet_comm X). -apply meet_join_absorb_l_l. + intros. + rewrite (meet_comm X). + apply meet_join_absorb_l_l. Qed. Lemma meet_join_absorb_r_r : forall x y:X, meet (join y x) x == x. Proof. -intros. -rewrite (join_comm X). -apply meet_join_absorb_r_l. + intros. + rewrite (join_comm X). + apply meet_join_absorb_r_l. Qed. Lemma meet_join_eq : forall x y : X, meet x y == join x y -> x == y. Proof. -intros. -rewrite <- (meet_join_absorb_l_l y x). -rewrite (join_comm X y x). -rewrite <- H. -rewrite (meet_comm X x y). -rewrite (meet_assoc X). -rewrite (meet_idem X). -set (RHS := meet y x). -rewrite <- (meet_join_absorb_l_l x y). -rewrite <- H. -rewrite (meet_assoc X). -rewrite (meet_idem X). -rewrite (meet_comm X). -reflexivity. + intros. + rewrite <- (meet_join_absorb_l_l y x). + rewrite (join_comm X y x). + rewrite <- H. + rewrite (meet_comm X x y). + rewrite (meet_assoc X). + rewrite (meet_idem X). + set (RHS := meet y x). + rewrite <- (meet_join_absorb_l_l x y). + rewrite <- H. + rewrite (meet_assoc X). + rewrite (meet_idem X). + rewrite (meet_comm X). + reflexivity. Qed. End MeetJoin. @@ -170,4 +170,4 @@ Proof meet_join_absorb_r_l (Dual X). Lemma join_meet_absorb_r_r : forall x y:X, join (meet y x) x == x. Proof meet_join_absorb_r_r (Dual X). -End JoinMeet. \ No newline at end of file +End JoinMeet. diff --git a/order/PartialOrder.v b/order/PartialOrder.v index df7a647ee..c35ff5244 100644 --- a/order/PartialOrder.v +++ b/order/PartialOrder.v @@ -30,7 +30,7 @@ A partial order is a relfexive, transitive, antisymetric ordering relation. *) (* Perhaps adding monotone and antitone to the signature is going too far *) -Record is_PartialOrder +Record is_PartialOrder (car : Type) (eq : car -> car -> Prop) (le : car -> car -> Prop) @@ -59,30 +59,31 @@ Open Local Scope po_scope. Lemma po_st : forall X eq le mnt ant, @is_PartialOrder X eq le mnt ant -> Setoid_Theory X eq. Proof. -intros X eq le0 mnt ant H. -destruct H. -split. -firstorder. -firstorder. -intros x y z. -repeat rewrite po_equiv_le_def0. -firstorder. + intros X eq le0 mnt ant H. + destruct H. + split. + firstorder. + firstorder. + intros x y z. + repeat rewrite po_equiv_le_def0. + firstorder. Qed. (* begin hide *) Add Parametric Morphism (p:PartialOrder) : (le p) with signature (@st_eq p) ==> (@st_eq p) ==> iff as le_compat. -assert (forall x1 x2 : p, x1 == x2 -> forall x3 x4 : p, x3 == x4 -> (x1 <= x3 -> x2 <= x4)). -intros. -rewrite -> (po_equiv_le_def (po_proof p)) in *|-. -destruct (po_proof p). -clear - H H0 H1 po_le_trans0. -firstorder. -intros x y Hxy x0 y0 Hx0y0. -assert (y==x). -symmetry; assumption. -assert (y0==x0). -symmetry; assumption. -firstorder. +Proof. + assert (forall x1 x2 : p, x1 == x2 -> forall x3 x4 : p, x3 == x4 -> (x1 <= x3 -> x2 <= x4)). + intros. + rewrite -> (po_equiv_le_def (po_proof p)) in *|-. + destruct (po_proof p). + clear - H H0 H1 po_le_trans0. + firstorder. + intros x y Hxy x0 y0 Hx0y0. + assert (y==x). + symmetry; assumption. + assert (y0==x0). + symmetry; assumption. + firstorder. Qed. (* end hide *) Section PartialOrder. @@ -111,12 +112,12 @@ Proof (po_antitone_def (po_proof X)). Lemma le_equiv_refl : forall x y:X, x == y -> x <= y. Proof. -firstorder using equiv_le_def. + firstorder using equiv_le_def. Qed. Lemma le_antisym : forall x y:X, x <= y -> y <= x -> x == y. Proof. -firstorder using equiv_le_def. + firstorder using equiv_le_def. Qed. (** @@ -124,16 +125,14 @@ Qed. The dual of a partial order is made by fliping the order relation. *) Definition Dual : PartialOrder. -eapply makePartialOrder with - (eq := @st_eq X) - (le:= (fun x y => le X y x)) - (monotone := @monotone X) - (antitone := @antitone X). -firstorder using equiv_le_def. -firstorder using le_refl. -firstorder using le_trans. -firstorder using monotone_def. (* Notice the use of <-> in monotone_def here *) -firstorder using antitone_def. +Proof. + eapply makePartialOrder with (eq := @st_eq X) (le:= (fun x y => le X y x)) (monotone := @monotone X) + (antitone := @antitone X). + firstorder using equiv_le_def. + firstorder using le_refl. + firstorder using le_trans. + firstorder using monotone_def. (* Notice the use of <-> in monotone_def here *) + firstorder using antitone_def. Defined. End PartialOrder. @@ -152,14 +151,14 @@ Definition monotone (f: A -> A) := forall x y, le x y -> le (f x) (f y). Lemma monotone_def : forall f, monotone f <-> (forall x y, le x y -> le (f x) (f y)). Proof. -firstorder. + firstorder. Qed. Definition antitone (f: A -> A) := forall x y, le x y -> le (f y) (f x). Lemma antitone_def : forall f, antitone f <-> (forall x y, le x y -> le (f y) (f x)). Proof. -firstorder. + firstorder. Qed. End MonotoneAntitone. diff --git a/order/SemiLattice.v b/order/SemiLattice.v index bc56f6ba1..15f9a7983 100644 --- a/order/SemiLattice.v +++ b/order/SemiLattice.v @@ -47,15 +47,16 @@ Record SemiLattice : Type := Implicit Arguments meet [s]. Add Parametric Morphism (X:SemiLattice) : (@meet X) with signature (@st_eq X) ==> (@st_eq X) ==> (@st_eq X) as meet_compat. -assert (forall x1 x2 : X, x1 == x2 -> forall x3 x4 : X, x3 == x4 -> meet x1 x3 <= meet x2 x4). -intros. -move: H H0; do 2 rewrite equiv_le_def; intros. -pose (le_trans X). -destruct (sl_proof X). -apply sl_meet_glb0; firstorder. -intros. -pose (Seq_sym X _ (po_st (po_proof X))). -apply le_antisym; firstorder. +Proof. + assert (forall x1 x2 : X, x1 == x2 -> forall x3 x4 : X, x3 == x4 -> meet x1 x3 <= meet x2 x4). + intros. + move: H H0; do 2 rewrite equiv_le_def; intros. + pose (le_trans X). + destruct (sl_proof X). + apply sl_meet_glb0; firstorder. + intros. + pose (Seq_sym X _ (po_st (po_proof X))). + apply le_antisym; firstorder. Qed. (* end hide *) @@ -80,82 +81,83 @@ Proof (sl_meet_glb _ _ (sl_proof X)). (** commutativity of meet *) Lemma meet_comm : forall x y:X, meet x y == meet y x. Proof. -assert (forall x y : X, meet x y <= meet y x). -intros. -destruct X. -simpl in *. -firstorder. -intros; apply le_antisym; firstorder. + assert (forall x y : X, meet x y <= meet y x). + intros. + destruct X. + simpl in *. + firstorder. + intros; apply le_antisym; firstorder. Qed. (** associativity of meet *) Lemma meet_assoc : forall x y z:X, meet x (meet y z) == meet (meet x y) z. Proof. -assert (forall x y z : X, meet x (meet y z) <= meet (meet x y) z). -intros. -apply meet_glb; [apply meet_glb|]; firstorder using meet_lb_l meet_lb_r le_trans. -intros. -apply le_antisym. -apply H. -rewrite meet_comm. -rewrite (meet_comm x (meet y z)). -rewrite (meet_comm x y). -rewrite (meet_comm y z). -apply H. + assert (forall x y z : X, meet x (meet y z) <= meet (meet x y) z). + intros. + apply meet_glb; [apply meet_glb|]; firstorder using meet_lb_l meet_lb_r le_trans. + intros. + apply le_antisym. + apply H. + rewrite meet_comm. + rewrite (meet_comm x (meet y z)). + rewrite (meet_comm x y). + rewrite (meet_comm y z). + apply H. Qed. (** idempotency of meet *) Lemma meet_idem : forall x:X, meet x x == x. -intros. -apply le_antisym; firstorder using meet_lb_l meet_glb le_refl. +Proof. + intros. + apply le_antisym; firstorder using meet_lb_l meet_glb le_refl. Qed. Lemma le_meet_l : forall x y : X, x <= y <-> meet x y == x. Proof. -intros. -split; intros. -apply le_antisym. -apply meet_lb_l. -apply meet_glb. -apply le_refl. -assumption. -rewrite <- H. -apply meet_lb_r. + intros. + split; intros. + apply le_antisym. + apply meet_lb_l. + apply meet_glb. + apply le_refl. + assumption. + rewrite <- H. + apply meet_lb_r. Qed. Lemma le_meet_r : forall x y : X, y <= x <-> meet x y == y. Proof. -intros. -rewrite meet_comm. -apply le_meet_l. + intros. + rewrite meet_comm. + apply le_meet_l. Qed. (** monotonicity of meet *) Lemma meet_monotone_r : forall a : X, monotone X (meet a). Proof. -intros. -rewrite monotone_def. -intros. -move: H;rewrite le_meet_l meet_comm; intro. -rewrite <- H. -rewrite meet_assoc. -apply meet_lb_l. + intros. + rewrite monotone_def. + intros. + move: H;rewrite le_meet_l meet_comm; intro. + rewrite <- H. + rewrite meet_assoc. + apply meet_lb_l. Qed. Lemma meet_monotone_l : forall a : X, monotone X (fun x => meet x a). Proof. -intros. -assert (A:=meet_monotone_r a). -move: A; do 2 rewrite monotone_def;intros. -rewrite (meet_comm x) (meet_comm y);auto. + intros. + assert (A:=meet_monotone_r a). + move: A; do 2 rewrite monotone_def;intros. + rewrite (meet_comm x) (meet_comm y);auto. Qed. Lemma meet_le_compat : forall w x y z : X, w<=y -> x<=z -> meet w x <= meet y z. Proof. -intros. -apply le_trans with (y:=meet y x). -firstorder using meet_monotone_l monotone_def. -firstorder using meet_monotone_r monotone_def. + intros. + apply le_trans with (y:=meet y x). + firstorder using meet_monotone_l monotone_def. + firstorder using meet_monotone_r monotone_def. Qed. End Meet. diff --git a/order/TotalOrder.v b/order/TotalOrder.v index 77e90b332..319a6d53b 100644 --- a/order/TotalOrder.v +++ b/order/TotalOrder.v @@ -28,7 +28,7 @@ Open Local Scope po_scope. * Total Order A total order is a lattice were x <= y or y <= x. *) -Record TotalOrder : Type := +Record TotalOrder : Type := { L :> Lattice ; le_total : forall x y:L, {x <= y}+{y <= x} }. @@ -38,12 +38,13 @@ Section MinMax. Variable X : TotalOrder. (** meet x y is either x or y. *) Definition meet_irred : forall x y : X, {meet x y == x} + {meet x y == y}. -intros. -destruct (le_total _ x y) as [H|H]. -left. -firstorder using le_meet_l. -right. -firstorder using le_meet_r. +Proof. + intros. + destruct (le_total _ x y) as [H|H]. + left. + firstorder using le_meet_l. + right. + firstorder using le_meet_r. Defined. Section Monotone. @@ -52,29 +53,30 @@ Variable f : X -> X. Hypothesis Hf : monotone X f. Add Morphism f with signature (@st_eq X) ==> (@st_eq X) as monotone_compat. -move:Hf;rewrite monotone_def;intros. -move: H0; do 2 rewrite equiv_le_def. -firstorder. +Proof. + move:Hf;rewrite monotone_def;intros. + move: H0; do 2 rewrite equiv_le_def. + firstorder. Qed. (** meet distributes over any monotone function. *) Lemma monotone_meet_distr : forall x y : X, f (meet x y) == meet (f x) (f y). Proof. -move: Hf; rewrite monotone_def. clear Hf. intro Hf. -assert (forall x y : X, x <= y -> f (meet x y) == meet (f x) (f y)). -intros x y Hxy. -assert (Hfxfy:=Hf _ _ Hxy). -rewrite -> le_meet_l in Hxy. -rewrite Hxy. -rewrite -> le_meet_l in Hfxfy. -rewrite Hfxfy. -reflexivity. -intros. -destruct (le_total _ x y). -auto. -rewrite (meet_comm X). -rewrite (meet_comm _ (f x)). -auto. + move: Hf; rewrite monotone_def. clear Hf. intro Hf. + assert (forall x y : X, x <= y -> f (meet x y) == meet (f x) (f y)). + intros x y Hxy. + assert (Hfxfy:=Hf _ _ Hxy). + rewrite -> le_meet_l in Hxy. + rewrite Hxy. + rewrite -> le_meet_l in Hfxfy. + rewrite Hfxfy. + reflexivity. + intros. + destruct (le_total _ x y). + auto. + rewrite (meet_comm X). + rewrite (meet_comm _ (f x)). + auto. Qed. End Monotone. @@ -92,31 +94,32 @@ Variable f : X -> X. Hypothesis Hf : antitone X f. (* begin hide *) -Add Morphism f with signature (@st_eq X) ==> (@st_eq X) as antitone_compat. -move: Hf; rewrite antitone_def; clear Hf;intros. -rewrite -> equiv_le_def in *. -firstorder. +Add Morphism f with signature (@st_eq X) ==> (@st_eq X) as antitone_compat. +Proof. + move: Hf; rewrite antitone_def; clear Hf;intros. + rewrite -> equiv_le_def in *. + firstorder. Qed. (* end hide *) (* meet transforms into join for antitone functions *) Lemma antitone_meet_join_distr : forall x y : X, f (meet x y) == join (f x) (f y). Proof. -move: Hf;rewrite antitone_def; clear Hf; intro Hf. -assert (forall x y : X, x <= y -> f (meet x y) == join (f x) (f y)). -intros x y Hxy. -assert (Hfxfy:=Hf _ _ Hxy). -rewrite -> le_meet_l in Hxy. -rewrite Hxy. -rewrite -> le_join_l in Hfxfy. -rewrite Hfxfy. -reflexivity. -intros. -destruct (le_total _ x y). -auto. -rewrite (meet_comm X). -rewrite (join_comm X). -auto. + move: Hf;rewrite antitone_def; clear Hf; intro Hf. + assert (forall x y : X, x <= y -> f (meet x y) == join (f x) (f y)). + intros x y Hxy. + assert (Hfxfy:=Hf _ _ Hxy). + rewrite -> le_meet_l in Hxy. + rewrite Hxy. + rewrite -> le_join_l in Hfxfy. + rewrite Hfxfy. + reflexivity. + intros. + destruct (le_total _ x y). + auto. + rewrite (meet_comm X). + rewrite (join_comm X). + auto. Qed. End Antitone. @@ -124,31 +127,31 @@ End Antitone. (** Lemmas of distributive lattices *) Lemma join_meet_modular_r : forall x y z : X, join x (meet y (join x z)) == meet (join x y) (join x z). Proof. -intros. -rewrite join_meet_distr_r. -rewrite (join_assoc X). -rewrite (join_idem X). -reflexivity. + intros. + rewrite join_meet_distr_r. + rewrite (join_assoc X). + rewrite (join_idem X). + reflexivity. Qed. Lemma join_meet_modular_l : forall x y z : X, join (meet (join x z) y) z == meet (join x z) (join y z). Proof. -intros. -rewrite (join_comm X (meet (join x z) y) z). -rewrite (meet_comm X (join x z) y). -rewrite (meet_comm X (join x z) (join y z)). -rewrite (join_comm X x z). -rewrite (join_comm X y z). -apply join_meet_modular_r. + intros. + rewrite (join_comm X (meet (join x z) y) z). + rewrite (meet_comm X (join x z) y). + rewrite (meet_comm X (join x z) (join y z)). + rewrite (join_comm X x z). + rewrite (join_comm X y z). + apply join_meet_modular_r. Qed. Lemma meet_join_disassoc : forall x y z : X, meet (join x y) z <= join x (meet y z). Proof. -intros. -rewrite join_meet_distr_r. -apply meet_le_compat. -apply le_refl. -apply join_ub_r. + intros. + rewrite join_meet_distr_r. + apply meet_le_compat. + apply le_refl. + apply join_ub_r. Qed. End MinMax. @@ -161,10 +164,10 @@ Variable X : TotalOrder. The dual of a total order is a total order. *) Definition Dual : TotalOrder. -eapply Build_TotalOrder with - (L:= Dual X). -intros. -destruct (le_total _ x y); auto. + eapply Build_TotalOrder with (L:= Dual X). +Proof. + intros. + destruct (le_total _ x y); auto. Defined. (** The duals of the previous lemmas hold. *) Definition join_irred : forall x y : X, {join x y == x} + {join x y == y} := @@ -202,35 +205,35 @@ Hypothesis min_def2 : forall x y:X, y <= x -> min x y == y. Lemma min_lb_l : forall x y:X, min x y <= x. Proof. -intros. -destruct (le_total x y). -rewrite min_def1; auto. -apply le_refl. -rewrite min_def2; auto. + intros. + destruct (le_total x y). + rewrite min_def1; auto. + apply le_refl. + rewrite min_def2; auto. Qed. Lemma min_lb_r : forall x y:X, min x y <= y. Proof. -intros. -destruct (le_total x y). -rewrite min_def1; auto. -rewrite min_def2; auto. -apply le_refl. + intros. + destruct (le_total x y). + rewrite min_def1; auto. + rewrite min_def2; auto. + apply le_refl. Qed. Lemma min_glb : forall x y z, z <= x -> z <= y -> z <= min x y. Proof. -intros. -destruct (le_total x y). -rewrite min_def1; assumption. -rewrite min_def2; assumption. + intros. + destruct (le_total x y). + rewrite min_def1; assumption. + rewrite min_def2; assumption. Qed. End TotalOrderMinDef. (** With a total order has a new characterization. *) Definition makeTotalOrder : - forall (A : Type) (equiv : A -> A -> Prop) (le : A -> A -> Prop) + forall (A : Type) (equiv : A -> A -> Prop) (le : A -> A -> Prop) (monotone antitone : (A -> A) -> Prop) (meet join : A -> A -> A), (forall x y : A, equiv x y <-> (le x y /\ le y x)) -> @@ -244,18 +247,16 @@ Definition makeTotalOrder : (forall x y : A, le y x -> equiv (join x y) x) -> (forall x y : A, le x y -> equiv (join x y) y) -> TotalOrder. -intros A0 eq0 le0 monotone0 antitone0 min max eq0_def refl trans total monotone0_def antitone0_def min_def1 min_def2 max_def1 max_def2. -pose (PO:=makePartialOrder eq0 le0 monotone0 antitone0 eq0_def refl trans monotone0_def antitone0_def). -pose (DPO := (PartialOrder.Dual PO)). -pose (flip_total := fun x y => total y x). -pose (L0:=makeLattice PO min max - (min_lb_l PO min total min_def1 min_def2) - (min_lb_r PO min total min_def1 min_def2) - (min_glb PO min total min_def1 min_def2) - (min_lb_l DPO max flip_total max_def1 max_def2) - (min_lb_r DPO max flip_total max_def1 max_def2) - (min_glb DPO max flip_total max_def1 max_def2)). -exact (Build_TotalOrder L0 total). +Proof. + intros A0 eq0 le0 monotone0 antitone0 min max eq0_def refl trans total monotone0_def antitone0_def min_def1 min_def2 max_def1 max_def2. + pose (PO:=makePartialOrder eq0 le0 monotone0 antitone0 eq0_def refl trans monotone0_def antitone0_def). + pose (DPO := (PartialOrder.Dual PO)). + pose (flip_total := fun x y => total y x). + pose (L0:=makeLattice PO min max (min_lb_l PO min total min_def1 min_def2) + (min_lb_r PO min total min_def1 min_def2) (min_glb PO min total min_def1 min_def2) + (min_lb_l DPO max flip_total max_def1 max_def2) (min_lb_r DPO max flip_total max_def1 max_def2) + (min_glb DPO max flip_total max_def1 max_def2)). + exact (Build_TotalOrder L0 total). Defined. Module Default. @@ -281,14 +282,14 @@ end. Lemma min_def1 : forall x y, le x y -> equiv (min x y) x. Proof. -intros. -apply min_case; firstorder. + intros. + apply min_case; firstorder. Qed. Lemma min_def2 : forall x y, le y x -> equiv (min x y) y. Proof. -intros. -apply min_case; firstorder. + intros. + apply min_case; firstorder. Qed. End MinDefault. @@ -312,14 +313,14 @@ Definition max_case : Lemma max_def1 : forall x y, le y x -> equiv (max x y) x. Proof. -refine (min_def1 A equiv flip_le _ flip_le_total). -firstorder. + refine (min_def1 A equiv flip_le _ flip_le_total). + firstorder. Qed. Lemma max_def2 : forall x y, le x y -> equiv (max x y) y. Proof. -refine (min_def2 A equiv flip_le _ flip_le_total). -firstorder. + refine (min_def2 A equiv flip_le _ flip_le_total). + firstorder. Qed. End MaxDefault. diff --git a/raster/Raster.v b/raster/Raster.v index 141037ded..cf7870ca8 100644 --- a/raster/Raster.v +++ b/raster/Raster.v @@ -12,9 +12,9 @@ Definition raster n m := vector (vector bool n) m. (** A series of notation allows rasters to be rendered (and to a certain extent parsed) in Coq *) -Notation "'⎥' a b" := (Vcons (vector bool _) a _ b) +Notation "'⎥' a b" := (Vcons (vector bool _) a _ b) (format "'[v' '⎥' a '/' b ']'", at level 0, a, b at level 0) : raster. -Notation "'⎥' a" := (Vcons (vector bool _) a _ (Vnil _)) +Notation "'⎥' a" := (Vcons (vector bool _) a _ (Vnil _)) (format "'⎥' a", at level 0, a, b at level 0) : raster. (* Notation "☙" := (Vnil (vector bool _)) (at level 0, right associativity) : raster. @@ -39,10 +39,10 @@ Coercion vectorAsList : vector>->list. Lemma length_vectorAsList : forall A n (v:vector A n), (length v) = n. Proof. -induction v. - reflexivity. -simpl. -auto with *. + induction v. + reflexivity. + simpl. + auto with *. Qed. (** Indexing into a raster *) @@ -53,28 +53,27 @@ Definition RasterIndex n m (r:raster n m) i j := Lemma emptyRasterEmpty : forall n m i j, RasterIndex (emptyRaster n m) i j = false. Proof. -intros n m. -induction m. - intros [|i] [|j]; - constructor. -intros i j. -simpl. -destruct i. - unfold RasterIndex. + intros n m. + induction m. + intros [|i] [|j]; constructor. + intros i j. simpl. - clear IHm. - revert j. - induction n. + destruct i. + unfold RasterIndex. + simpl. + clear IHm. + revert j. + induction n. + destruct j; auto. destruct j; auto. - destruct j; auto. + simpl. + apply IHn. + unfold RasterIndex in *. simpl. - apply IHn. -unfold RasterIndex in *. -simpl. -apply IHm. -Qed. + apply IHm. +Qed. -(** [setRaster] transforms a raster by setting (or reseting) the (i,j)th +(** [setRaster] transforms a raster by setting (or reseting) the (i,j)th pixel. *) Definition updateVector A n (v:vector A n) (f:A->A) : nat -> vector A n := vector_rect A (fun (n0 : nat) (_ : vector A n0) => nat -> vector A n0) @@ -92,127 +91,125 @@ updateVector r (fun row => updateVector row (fun _ => x) j) i. Lemma updateVector_correct1 : forall A n (v:vector A n) f i d1 d2, i < n -> nth i (updateVector v f i) d1 = f (nth i v d2). Proof. -induction v. - intros. - absurd (i < 0); auto with *. -intros f [|i] d1 d2 H. - reflexivity. -simpl. -apply IHv. -auto with *. + induction v. + intros. + absurd (i < 0); auto with *. + intros f [|i] d1 d2 H. + reflexivity. + simpl. + apply IHv. + auto with *. Qed. Lemma updateVector_correct2 : forall A n (v:vector A n) f d1 i j, i <> j -> nth i (updateVector v f j) d1 = nth i v d1. Proof. -induction v. - reflexivity. -intros f d1 i [|j] H; - destruct i as [|i]; try reflexivity. - elim H; auto. -simpl. -apply IHv. -auto. + induction v. + reflexivity. + intros f d1 i [|j] H; destruct i as [|i]; try reflexivity. + elim H; auto. + simpl. + apply IHv. + auto. Qed. Lemma setRaster_correct1 : forall n m (r:raster n m) x i j, (i < m) -> (j < n) -> RasterIndex (setRaster r x i j) i j = x. Proof. -intros n m r x i j Hi Hj. -unfold RasterIndex. -replace (nth i (map (@vectorAsList _ _) (setRaster r x i j)) nil) - with (nth i (map (@vectorAsList _ _) (setRaster r x i j)) (Vconst bool false n)). - rewrite map_nth. - unfold setRaster. - rewrite (updateVector_correct1 r (fun row => updateVector row (fun _ : bool => x) j) (Vconst bool false n) (Vconst bool false n) Hi). - rewrite updateVector_correct1; auto. -apply nth_indep. -rewrite map_length. -rewrite length_vectorAsList. -auto. + intros n m r x i j Hi Hj. + unfold RasterIndex. + replace (nth i (map (@vectorAsList _ _) (setRaster r x i j)) nil) + with (nth i (map (@vectorAsList _ _) (setRaster r x i j)) (Vconst bool false n)). + rewrite map_nth. + unfold setRaster. + rewrite (updateVector_correct1 r (fun row => updateVector row (fun _ : bool => x) j) (Vconst bool false n) (Vconst bool false n) Hi). + rewrite updateVector_correct1; auto. + apply nth_indep. + rewrite map_length. + rewrite length_vectorAsList. + auto. Qed. Lemma setRaster_overflow : forall n m (r:raster n m) x i j, (m <= i) \/ (n <= j) -> (setRaster r x i j) = r. Proof. -intros n m r x i j [Hi | Hj]. - revert i Hi. + intros n m r x i j [Hi | Hj]. + revert i Hi. + induction r. + reflexivity. + intros [|i] Hi. + absurd (S n0 <= 0); auto with *. + simpl. + rewrite IHr; auto with *. + revert i j Hj. induction r. reflexivity. - intros [|i] Hi. - absurd (S n0 <= 0); auto with *. + intros [|i] j Hj. + simpl. + replace (updateVector a (fun _ : bool => x) j) with a. + auto. + clear n0 IHr r. + revert j Hj. + induction a. + reflexivity. + intros [|j] Hj. + absurd (S n <= 0); auto with *. + simpl. + rewrite <- IHa; auto with *. simpl. rewrite IHr; auto with *. -revert i j Hj. -induction r. - reflexivity. -intros [|i] j Hj. - simpl. - replace (updateVector a (fun _ : bool => x) j) with a. - auto. - clear n0 IHr r. - revert j Hj. - induction a. - reflexivity. - intros [|j] Hj. - absurd (S n <= 0); auto with *. - simpl. - rewrite <- IHa; auto with *. -simpl. -rewrite IHr; auto with *. Qed. Lemma setRaster_correct2 : forall n m (r:raster n m) x i j i0 j0, (i <> i0) \/ (j <> j0) -> RasterIndex (setRaster r x i0 j0) i j = RasterIndex r i j. Proof. -intros n m r x i j i0 j0 H. -destruct (le_lt_dec m i0) as [Hm | Hm]. - rewrite setRaster_overflow; auto with *. -destruct (le_lt_dec n j0) as [Hn | Hn]. - rewrite setRaster_overflow; auto with *. -unfold RasterIndex. -assert (L:forall v : vector (Bvector n) m, - nth j (nth i (map (@vectorAsList _ _) v) nil) false = - nth j (nth i (map (@vectorAsList _ _) v) (Vconst bool false n)) false). - intros v. - destruct (le_lt_dec m i) as [Hi | Hi]. - transitivity false. - rewrite (nth_overflow (map (@vectorAsList _ _) v)). - destruct j; reflexivity. - rewrite map_length. + intros n m r x i j i0 j0 H. + destruct (le_lt_dec m i0) as [Hm | Hm]. + rewrite setRaster_overflow; auto with *. + destruct (le_lt_dec n j0) as [Hn | Hn]. + rewrite setRaster_overflow; auto with *. + unfold RasterIndex. + assert (L:forall v : vector (Bvector n) m, nth j (nth i (map (@vectorAsList _ _) v) nil) false = + nth j (nth i (map (@vectorAsList _ _) v) (Vconst bool false n)) false). + intros v. + destruct (le_lt_dec m i) as [Hi | Hi]. + transitivity false. + rewrite (nth_overflow (map (@vectorAsList _ _) v)). + destruct j; reflexivity. + rewrite map_length. + rewrite length_vectorAsList. + auto. + rewrite map_nth. + rewrite (nth_overflow v). + clear - j. + revert j. + induction n. + destruct j; reflexivity. + intros [|j]. + reflexivity. + simpl. + apply IHn. rewrite length_vectorAsList. auto. - rewrite map_nth. - rewrite (nth_overflow v). - clear - j. - revert j. - induction n. - destruct j; reflexivity. - intros [|j]. - reflexivity. - simpl. - apply IHn. - rewrite length_vectorAsList. + f_equal. + apply nth_indep. + rewrite map_length, length_vectorAsList. auto. - f_equal. - apply nth_indep. - rewrite map_length, length_vectorAsList. - auto. -transitivity (nth j (nth i (map (@vectorAsList _ _) (setRaster r x i0 j0)) (Vconst bool false n)) false). - apply L. -transitivity (nth j (nth i (map (@vectorAsList _ _) r) (Vconst bool false n)) false);[|symmetry;apply L]. -do 2 rewrite map_nth. -destruct (eq_nat_dec i i0). - destruct H as [Hi | Hj]. - elim Hi; auto. - rewrite <- e in *; clear e. + transitivity (nth j (nth i (map (@vectorAsList _ _) (setRaster r x i0 j0)) (Vconst bool false n)) false). + apply L. + transitivity (nth j (nth i (map (@vectorAsList _ _) r) (Vconst bool false n)) false);[|symmetry;apply L]. + do 2 rewrite map_nth. + destruct (eq_nat_dec i i0). + destruct H as [Hi | Hj]. + elim Hi; auto. + rewrite <- e in *; clear e. + unfold setRaster. + rewrite (updateVector_correct1 r (fun row => updateVector row (fun _ : bool => x) j0) (Vconst bool false n) (Vconst bool false n) Hm). + rewrite updateVector_correct2; auto. unfold setRaster. - rewrite (updateVector_correct1 r (fun row => updateVector row (fun _ : bool => x) j0) (Vconst bool false n) (Vconst bool false n) Hm). rewrite updateVector_correct2; auto. -unfold setRaster. -rewrite updateVector_correct2; auto. -Qed. \ No newline at end of file +Qed. diff --git a/reals/Bridges_LUB.v b/reals/Bridges_LUB.v index c2567d8f0..2bd9175d9 100644 --- a/reals/Bridges_LUB.v +++ b/reals/Bridges_LUB.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) (* file : least_upper_bound_principle.v *) (* version : 1.50 - 03/05/2001 *) @@ -40,19 +40,19 @@ (* author : Milad Niqui *) (* language : coq 7.0beta26feb *) (* dependency : iso_CReals.v , Expon.v *) -(* description : proof of the Bridges' least upper bound principle *) +(* description : proof of the Bridges' least upper bound principle *) Require Export iso_CReals. -Require Import Expon. +Require Import Expon. Section LUBP. Variable R1 : CReals. (* SUBSECTION ON GENRAL DEFINITIONS *) -Section lub_definitions. +Section lub_definitions. Variable OF : COrdField. Variable SS : OF -> CProp. @@ -91,7 +91,7 @@ Section upper_bound_sequence. Variable A : R1 -> CProp. Hypothesis is_inhabitted : {x : R1 | A x}. -Hypothesis bounded_above : {b : R1 | is_upper_bound R1 A b}. +Hypothesis bounded_above : {b : R1 | is_upper_bound R1 A b}. Hypothesis located : forall x y : R1, x[<]y -> is_upper_bound R1 A y or {s : R1 | A s | x[<]s}. @@ -118,20 +118,20 @@ Let dstart_r := b0[+]One. Lemma dl_less_dr : dstart_l[<]dstart_r. Proof. apply less_transitive_unfolded with (y := b0). - unfold is_upper_bound in bounded_above. - cut (forall x : R1, A x -> forall z : R1, z[<]x -> z[<]b0). - intro H. - cut (forall z : R1, z[<]s -> z[<]b0). - intro H0. - apply H0. - unfold dstart_l in |- *. - apply shift_minus_less. - apply less_plusOne. - intros. - apply H with (z := z) (x := s). - apply Ps. - assumption. - exact Pb0. + unfold is_upper_bound in bounded_above. + cut (forall x : R1, A x -> forall z : R1, z[<]x -> z[<]b0). + intro H. + cut (forall z : R1, z[<]s -> z[<]b0). + intro H0. + apply H0. + unfold dstart_l in |- *. + apply shift_minus_less. + apply less_plusOne. + intros. + apply H with (z := z) (x := s). + apply Ps. + assumption. + exact Pb0. unfold dstart_r in |- *. apply less_plusOne. Qed. @@ -149,7 +149,7 @@ Proof. rstepl ([--]((r2[-]r1) [/]ThreeNZ)). apply inv_resp_less. apply mult_cancel_less with (z := Three:R1). - apply pos_nring_S. + apply pos_nring_S. rstepl (Zero:R1). rstepr (r2[-]r1). apply shift_zero_less_minus. @@ -162,12 +162,12 @@ Lemma shrink13d : Proof. intros. apply less_transitive_unfolded with (y := r1[+](r2[-]r1) [/]ThreeNZ). - astepl (r1[+]Zero). - apply plus_resp_less_lft. - apply div_resp_pos. - apply pos_three. - apply shift_zero_less_minus. - assumption. + astepl (r1[+]Zero). + apply plus_resp_less_lft. + apply div_resp_pos. + apply pos_three. + apply shift_zero_less_minus. + assumption. apply shrink23d. assumption. Qed. @@ -177,8 +177,8 @@ Lemma shrink24d : Proof. intros. apply less_transitive_unfolded with (y := r2[-](r2[-]r1) [/]ThreeNZ). - apply shrink23d. - assumption. + apply shrink23d. + assumption. astepl (r2[+][--]((r2[-]r1) [/]ThreeNZ)). astepr (r2[+]Zero). apply plus_resp_less_lft. @@ -186,7 +186,7 @@ Proof. rstepl (Zero:R1). rstepr ((r2[-]r1) [/]ThreeNZ). apply div_resp_pos. - apply pos_three. + apply pos_three. apply shift_zero_less_minus. assumption. Qed. @@ -194,14 +194,15 @@ Qed. Definition Real_Interval := Interval R1. Definition dcotrans_analyze : forall r1 r2 : R1, r1[<]r2 -> R1. -intros. -case (located (r1[+](r2[-]r1) [/]ThreeNZ) (r2[-](r2[-]r1) [/]ThreeNZ)). -apply shrink23d. -assumption. -intro. -exact (r2[-](r2[-]r1) [/]ThreeNZ). -intro. -exact (r1[+](r2[-]r1) [/]ThreeNZ). +Proof. + intros. + case (located (r1[+](r2[-]r1) [/]ThreeNZ) (r2[-](r2[-]r1) [/]ThreeNZ)). + apply shrink23d. + assumption. + intro. + exact (r2[-](r2[-]r1) [/]ThreeNZ). + intro. + exact (r1[+](r2[-]r1) [/]ThreeNZ). Defined. Lemma dcotrans_analyze_strong : @@ -213,36 +214,33 @@ Lemma dcotrans_analyze_strong : Proof. intros. unfold dcotrans_analyze in |- *. - elim - (located (r1[+](r2[-]r1) [/]ThreeNZ) (r2[-](r2[-]r1) [/]ThreeNZ) - (shrink23d _ _ H)). - intro. - right. - split. - assumption. - apply eq_reflexive_unfolded. + elim (located (r1[+](r2[-]r1) [/]ThreeNZ) (r2[-](r2[-]r1) [/]ThreeNZ) (shrink23d _ _ H)). + intro. + right. + split. + assumption. + apply eq_reflexive_unfolded. intro. left. split. - assumption. + assumption. apply eq_reflexive_unfolded. Qed. Notation "( p , q )" := (pairT p q). Definition dif_cotrans : forall I1 : Real_Interval, Real_Interval. -intros. -case I1. -intros i pi. -elim (dcotrans_analyze_strong (fstT i) (sndT i) pi). -intro. -exact - (Build_Interval _ (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ, sndT i) +Proof. + intros. + case I1. + intros i pi. + elim (dcotrans_analyze_strong (fstT i) (sndT i) pi). + intro. + exact (Build_Interval _ (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ, sndT i) (shrink24d (fstT i) (sndT i) pi)). -intro. -exact - (Build_Interval _ (fstT i, sndT i[-](sndT i[-]fstT i) [/]ThreeNZ) - (shrink13d (fstT i) (sndT i) pi)). + intro. + exact (Build_Interval _ (fstT i, sndT i[-](sndT i[-]fstT i) [/]ThreeNZ) + (shrink13d (fstT i) (sndT i) pi)). Defined. @@ -260,54 +258,43 @@ Proof. intros. case I1. intros i pi. - elim (dcotrans_analyze_strong _ _ pi). + elim (dcotrans_analyze_strong _ _ pi). + intro y. + left. + elim y. + intros H H0. + split. + exact H. + cut (dif_cotrans (Build_Interval _ i pi) = + Build_Interval _ (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ, sndT i) (shrink24d (fstT i) (sndT i) pi)). + intro H1. + rewrite H1. + simpl in |- *. + apply refl_equal. + unfold dif_cotrans in |- *. + apply not_r_cor_rect. + apply or_not_and. + right. + apply ap_imp_neq. + astepl (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ). + apply less_imp_ap. + apply shrink23d. + assumption. intro y. - left. elim y. intros H H0. - split. - exact H. - cut - (dif_cotrans (Build_Interval _ i pi) = - Build_Interval _ (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ, sndT i) - (shrink24d (fstT i) (sndT i) pi)). - - intro H1. - - rewrite H1. - simpl in |- *. - apply refl_equal. - - unfold dif_cotrans in |- *. - apply not_r_cor_rect. - - apply or_not_and. right. - apply ap_imp_neq. - astepl (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ). - apply less_imp_ap. - apply shrink23d. - assumption. - - intro y. - elim y. - intros H H0. - right. split. - exact H. - cut - (dif_cotrans (Build_Interval R1 i pi) = + exact H. + cut (dif_cotrans (Build_Interval R1 i pi) = Build_Interval R1 (fstT i, sndT i[-](sndT i[-]fstT i) [/]ThreeNZ) (shrink13d (fstT i) (sndT i) pi)). - intro. - - rewrite H1. - simpl in |- *. - reflexivity. - + intro. + rewrite H1. + simpl in |- *. + reflexivity. unfold dif_cotrans in |- *. apply not_l_cor_rect. - apply or_not_and. right. apply ap_imp_neq. @@ -342,15 +329,14 @@ Proof. unfold Length in |- *. simpl in |- *. rational. - - intro a. - elim a. - intros H H0. - simpl in |- *. - rewrite H0. - unfold Length in |- *. - simpl in |- *. - rational. + intro a. + elim a. + intros H H0. + simpl in |- *. + rewrite H0. + unfold Length in |- *. + simpl in |- *. + rational. Qed. Lemma Length_dIntrvl : @@ -359,16 +345,14 @@ Lemma Length_dIntrvl : Proof. intros. induction n as [| n Hrecn]. - - (* n=0 *) - unfold Length in |- *. - simpl in |- *. - rational. - + (* n=0 *) + unfold Length in |- *. + simpl in |- *. + rational. (* n=(S n0) & induction hypothesis *) astepr (Two [/]ThreeNZ[*]((Two [/]ThreeNZ)[^]n[*](dstart_r[-]dstart_l))). - astepr (Two [/]ThreeNZ[*]Length _ (dIntrvl n)). - apply delta_dIntrvl. + astepr (Two [/]ThreeNZ[*]Length _ (dIntrvl n)). + apply delta_dIntrvl. astepr ((Two [/]ThreeNZ)[^]n[*]Two [/]ThreeNZ[*](dstart_r[-]dstart_l)). rational. Qed. @@ -379,61 +363,56 @@ Lemma dIntrvl_inside_l_n : Proof. intros. induction n as [| n Hrecn]. - - (* n=0 *) - cut (m = 0). - intro. - rewrite H0. - simpl in |- *. - apply leEq_reflexive. - symmetry in |- *. - apply le_n_O_eq. - assumption. - + (* n=0 *) + cut (m = 0). + intro. + rewrite H0. + simpl in |- *. + apply leEq_reflexive. + symmetry in |- *. + apply le_n_O_eq. + assumption. (* n=(S n0) *) - cut ({m = S n} + {m <= n}). + cut ({m = S n} + {m <= n}). intro H0. case H0. - intro H1. - rewrite H1. - apply leEq_reflexive. - intro H2. + intro H1. + rewrite H1. + apply leEq_reflexive. + intro H2. apply leEq_transitive with (y := fstT (dIntrvl n)). - apply Hrecn. - assumption. + apply Hrecn. + assumption. case (dif_cotrans_strong (dIntrvl n)). + intro a. + elim a. + intros H3 H4. + change (fstT (dIntrvl n)[<=]fstT (dif_cotrans (dIntrvl n))) in |- *. + rewrite H4. + simpl in |- *. + astepl (fstT (dIntrvl n)[+]Zero). + apply plus_resp_leEq_both with (b := (sndT (dIntrvl n)[-]fstT (dIntrvl n)) [/]ThreeNZ). + apply leEq_reflexive. + apply less_leEq. + apply div_resp_pos. + apply pos_three. + apply shift_zero_less_minus. + apply is_interval. intro a. elim a. intros H3 H4. change (fstT (dIntrvl n)[<=]fstT (dif_cotrans (dIntrvl n))) in |- *. rewrite H4. simpl in |- *. - astepl (fstT (dIntrvl n)[+]Zero). - apply - plus_resp_leEq_both - with (b := (sndT (dIntrvl n)[-]fstT (dIntrvl n)) [/]ThreeNZ). apply leEq_reflexive. - apply less_leEq. - apply div_resp_pos. - apply pos_three. - apply shift_zero_less_minus. - apply is_interval. - - intro a. - elim a. - intros H3 H4. - change (fstT (dIntrvl n)[<=]fstT (dif_cotrans (dIntrvl n))) in |- *. - rewrite H4. - simpl in |- *. - apply leEq_reflexive. - case (le_lt_eq_dec m (S n) H). + case (le_lt_eq_dec m (S n) H). intro. right. apply lt_n_Sm_le. assumption. - intro. - left. - assumption. + intro. + left. + assumption. Qed. Lemma dIntrvl_inside_r_n : @@ -441,69 +420,62 @@ Lemma dIntrvl_inside_r_n : Proof. intros. induction n as [| n Hrecn]. - - (* n=0 *) - cut (m = 0). - intro H0. - rewrite H0. - simpl in |- *. - apply leEq_reflexive. - symmetry in |- *. - apply le_n_O_eq. - assumption. - + (* n=0 *) + cut (m = 0). + intro H0. + rewrite H0. + simpl in |- *. + apply leEq_reflexive. + symmetry in |- *. + apply le_n_O_eq. + assumption. (* n=(S n0) *) - cut ({m = S n} + {m <= n}). + cut ({m = S n} + {m <= n}). intro H0. case H0. - intro H1. - rewrite H1. - apply leEq_reflexive. - intro H2. + intro H1. + rewrite H1. + apply leEq_reflexive. + intro H2. apply leEq_transitive with (y := sndT (dIntrvl n)). - case (dif_cotrans_strong (dIntrvl n)). - intro a. - elim a. - intros H3 H4. - change (sndT (dif_cotrans (dIntrvl n))[<=]sndT (dIntrvl n)) in |- *. - rewrite H4. - simpl in |- *. - apply leEq_reflexive. - intro a. - elim a. - intros H3 H4. - change (sndT (dif_cotrans (dIntrvl n))[<=]sndT (dIntrvl n)) in |- *. - rewrite H4. - simpl in |- *. - astepr (sndT (dIntrvl n)[+]Zero). - astepl - (sndT (dIntrvl n)[+][--]((sndT (dIntrvl n)[-]fstT (dIntrvl n)) [/]ThreeNZ)). - apply plus_resp_leEq_both. - apply leEq_reflexive. - - apply inv_cancel_leEq. - astepl (Zero:R1). - astepr ((sndT (dIntrvl n)[-]fstT (dIntrvl n)) [/]ThreeNZ). - apply less_leEq. - apply div_resp_pos. - apply pos_three. - apply shift_zero_less_minus. - - apply is_interval. - + case (dif_cotrans_strong (dIntrvl n)). + intro a. + elim a. + intros H3 H4. + change (sndT (dif_cotrans (dIntrvl n))[<=]sndT (dIntrvl n)) in |- *. + rewrite H4. + simpl in |- *. + apply leEq_reflexive. + intro a. + elim a. + intros H3 H4. + change (sndT (dif_cotrans (dIntrvl n))[<=]sndT (dIntrvl n)) in |- *. + rewrite H4. + simpl in |- *. + astepr (sndT (dIntrvl n)[+]Zero). + astepl (sndT (dIntrvl n)[+][--]((sndT (dIntrvl n)[-]fstT (dIntrvl n)) [/]ThreeNZ)). + apply plus_resp_leEq_both. + apply leEq_reflexive. + apply inv_cancel_leEq. + astepl (Zero:R1). + astepr ((sndT (dIntrvl n)[-]fstT (dIntrvl n)) [/]ThreeNZ). + apply less_leEq. + apply div_resp_pos. + apply pos_three. + apply shift_zero_less_minus. + apply is_interval. apply Hrecn. - assumption. - - case (le_lt_eq_dec m (S n) H). + assumption. + case (le_lt_eq_dec m (S n) H). intro. right. apply lt_n_Sm_le. assumption. - intro. - left. - assumption. + intro. + left. + assumption. Qed. - + Lemma V_increase : forall m n : nat, m <= n -> V m[<=]V n. Proof. intros. @@ -512,7 +484,7 @@ Proof. assumption. Qed. -Lemma W_decrease : forall m n : nat, m <= n -> W n[<=]W m. +Lemma W_decrease : forall m n : nat, m <= n -> W n[<=]W m. Proof. intros. unfold W in |- *. @@ -526,8 +498,8 @@ Proof. intros. unfold U in |- *. apply leEq_less_trans with (y := V n). - apply V_increase. - assumption. + apply V_increase. + assumption. unfold V in |- *. apply Smallest_less_Average. apply is_interval. @@ -538,12 +510,12 @@ Proof. intros. unfold U in |- *. apply less_leEq_trans with (y := W n). - unfold W in |- *. - apply Average_less_Greatest. - apply is_interval. + unfold W in |- *. + apply Average_less_Greatest. + apply is_interval. apply W_decrease. assumption. -Qed. +Qed. (* These lemma are *very* similar to those in *) (* Cauchy_rationals_approach_reals.v *) @@ -554,72 +526,66 @@ Lemma a_familiar_simple_inequality : Proof. intros. induction m as [| m Hrecm]. - apply False_rect. - generalize H. - change (~ 4 <= 0) in |- *. - apply le_Sn_O. + apply False_rect. + generalize H. + change (~ 4 <= 0) in |- *. + apply le_Sn_O. case (le_lt_eq_dec 4 (S m) H). intro. - apply - less_transitive_unfolded - with - (y := Two [/]ThreeNZ[*]((One:R1)[/] nring (S m)[//]nringS_ap_zero _ m)). - astepl (((Two:R1) [/]ThreeNZ)[^]m[*]Two [/]ThreeNZ). - astepl ((Two:R1) [/]ThreeNZ[*](Two [/]ThreeNZ)[^]m). - apply mult_resp_less_lft. - apply Hrecm. - apply lt_n_Sm_le. - assumption. - apply div_resp_pos. - apply pos_three. - apply pos_two. - - apply - mult_cancel_less with (z := (Three:R1)[*]nring (S m)[*]nring (S (S m))). - apply mult_resp_pos. - apply mult_resp_pos. - apply pos_three. - apply pos_nring_S. - apply pos_nring_S. + apply less_transitive_unfolded with + (y := Two [/]ThreeNZ[*]((One:R1)[/] nring (S m)[//]nringS_ap_zero _ m)). + astepl (((Two:R1) [/]ThreeNZ)[^]m[*]Two [/]ThreeNZ). + astepl ((Two:R1) [/]ThreeNZ[*](Two [/]ThreeNZ)[^]m). + apply mult_resp_less_lft. + apply Hrecm. + apply lt_n_Sm_le. + assumption. + apply div_resp_pos. + apply pos_three. + apply pos_two. + apply mult_cancel_less with (z := (Three:R1)[*]nring (S m)[*]nring (S (S m))). + apply mult_resp_pos. + apply mult_resp_pos. + apply pos_three. + apply pos_nring_S. + apply pos_nring_S. rstepl ((Two:R1)[*]nring (S (S m))). rstepr ((Three:R1)[*]nring (S m)). astepl ((Two:R1)[*](nring m[+]Two)). - astepr ((Three:R1)[*](nring m[+]One)). - apply plus_cancel_less with (z := [--]((Two:R1)[*]nring m[+]Three)). - rstepl (One:R1). - rstepr (nring (R:=R1) m). - astepl (nring (R:=R1) 1). - apply nring_less. - apply lt_trans with (m := 3). - constructor. - constructor. - apply lt_S_n. - assumption. - simpl in |- *. - algebra. + astepr ((Three:R1)[*](nring m[+]One)). + apply plus_cancel_less with (z := [--]((Two:R1)[*]nring m[+]Three)). + rstepl (One:R1). + rstepr (nring (R:=R1) m). + astepl (nring (R:=R1) 1). + apply nring_less. + apply lt_trans with (m := 3). + constructor. + constructor. + apply lt_S_n. + assumption. + simpl in |- *. + algebra. apply bin_op_wd_unfolded. - apply eq_reflexive_unfolded. + apply eq_reflexive_unfolded. simpl in |- *. rational. - - intro H0. - rewrite <- H0. - - apply mult_cancel_less with (z := nring (R:=R1) 5[*]Three[^]4). + intro H0. + rewrite <- H0. + apply mult_cancel_less with (z := nring (R:=R1) 5[*]Three[^]4). apply mult_resp_pos. - apply pos_nring_S. + apply pos_nring_S. rstepr (Three[^]2[*](Three[^]2:R1)). apply mult_resp_pos. + apply pos_square. + apply nringS_ap_zero. apply pos_square. apply nringS_ap_zero. - apply pos_square. - apply nringS_ap_zero. - rstepl (Two[^]4[*]nring (R:=R1) 5). - rstepr (Three[^]4:R1). - rstepl (nring (R:=R1) 80). - rstepr (nring (R:=R1) 81). - apply nring_less. - constructor. + rstepl (Two[^]4[*]nring (R:=R1) 5). + rstepr (Three[^]4:R1). + rstepl (nring (R:=R1) 80). + rstepr (nring (R:=R1) 81). + apply nring_less. + constructor. Qed. Lemma U_conversion_rate2 : @@ -631,27 +597,27 @@ Lemma U_conversion_rate2 : Proof. intros. apply AbsSmall_leEq_trans with (e1 := Length _ (dIntrvl m)). - apply less_leEq. - astepl ((Two [/]ThreeNZ)[^]m[*](dstart_r[-]dstart_l)). - rstepr ((One[/] nring (S m)[//]nringS_ap_zero _ m)[*](dstart_r[-]dstart_l)). - apply mult_resp_less. - apply a_familiar_simple_inequality. - assumption. - apply shift_zero_less_minus. - apply dl_less_dr. - apply eq_symmetric_unfolded. - apply Length_dIntrvl. + apply less_leEq. + astepl ((Two [/]ThreeNZ)[^]m[*](dstart_r[-]dstart_l)). + rstepr ((One[/] nring (S m)[//]nringS_ap_zero _ m)[*](dstart_r[-]dstart_l)). + apply mult_resp_less. + apply a_familiar_simple_inequality. + assumption. + apply shift_zero_less_minus. + apply dl_less_dr. + apply eq_symmetric_unfolded. + apply Length_dIntrvl. unfold Length in |- *. apply AbsSmall_subinterval; apply less_leEq. - change (V m[<]U m) in |- *. - apply U_m_n_V. - constructor. - change (V m[<]U n) in |- *. - apply U_m_n_V. - assumption. - change (U m[<]W m) in |- *. - apply U_m_n_W. - constructor. + change (V m[<]U m) in |- *. + apply U_m_n_V. + constructor. + change (V m[<]U n) in |- *. + apply U_m_n_V. + assumption. + change (U m[<]W m) in |- *. + apply U_m_n_W. + constructor. change (U n[<]W m) in |- *. apply U_m_n_W. assumption. @@ -663,36 +629,30 @@ Proof. intros. unfold Cauchy_prop in |- *. intros e H. - cut - {n : nat | - (dstart_r[-]dstart_l[/] e[//]Greater_imp_ap _ e Zero H)[<]nring n}. - intro H0. - case H0. - intro N. - intro. - exists (S (N + 3)). - intros. - apply AbsSmall_minus. - apply - AbsSmall_leEq_trans - with - (e1 := dstart_r[-]dstart_l[/] nring (S (S (N + 3)))[//] - nringS_ap_zero R1 (S (N + 3))). - apply less_leEq. - apply swap_div with (z_ := Greater_imp_ap _ e Zero H). - apply pos_nring_S. - assumption. - apply less_transitive_unfolded with (y := nring (R:=R1) N). - assumption. - apply nring_less. - apply le_lt_n_Sm. - constructor. - apply le_plus_l. - - apply U_conversion_rate2 with (m := S (N + 3)). - apply le_n_S. - apply le_plus_r. - assumption. + cut {n : nat | (dstart_r[-]dstart_l[/] e[//]Greater_imp_ap _ e Zero H)[<]nring n}. + intro H0. + case H0. + intro N. + intro. + exists (S (N + 3)). + intros. + apply AbsSmall_minus. + apply AbsSmall_leEq_trans with (e1 := dstart_r[-]dstart_l[/] nring (S (S (N + 3)))[//] + nringS_ap_zero R1 (S (N + 3))). + apply less_leEq. + apply swap_div with (z_ := Greater_imp_ap _ e Zero H). + apply pos_nring_S. + assumption. + apply less_transitive_unfolded with (y := nring (R:=R1) N). + assumption. + apply nring_less. + apply le_lt_n_Sm. + constructor. + apply le_plus_l. + apply U_conversion_rate2 with (m := S (N + 3)). + apply le_n_S. + apply le_plus_r. + assumption. apply Archimedes'. (* Note the use of Archimedean Property of R1 *) Qed. @@ -711,7 +671,7 @@ Qed. Lemma U_minus_W : forall n : nat, W n[-]U n[=]Length _ (dIntrvl n) [/]TwoNZ. Proof. -intros. + intros. unfold U in |- *. unfold W in |- *. unfold Length in |- *. @@ -723,16 +683,16 @@ Lemma U_V_upper : Proof. intro. apply less_wdr with (y := Length _ (dIntrvl n)). - apply less_wdl with (x := Length _ (dIntrvl n) [/]TwoNZ). - apply plus_cancel_less with (z := [--](Length R1 (dIntrvl n) [/]TwoNZ)). - rstepl (Zero:R1). - rstepr (Length R1 (dIntrvl n) [/]TwoNZ). - apply pos_div_two. - unfold Length in |- *. - apply shift_zero_less_minus. - apply is_interval. - apply eq_symmetric_unfolded. - apply U_minus_V. + apply less_wdl with (x := Length _ (dIntrvl n) [/]TwoNZ). + apply plus_cancel_less with (z := [--](Length R1 (dIntrvl n) [/]TwoNZ)). + rstepl (Zero:R1). + rstepr (Length R1 (dIntrvl n) [/]TwoNZ). + apply pos_div_two. + unfold Length in |- *. + apply shift_zero_less_minus. + apply is_interval. + apply eq_symmetric_unfolded. + apply U_minus_V. apply Length_dIntrvl. Qed. @@ -741,43 +701,43 @@ Lemma U_W_lower : Proof. intro. apply less_wdr with (y := Length _ (dIntrvl n)). - apply less_wdl with (x := Length _ (dIntrvl n) [/]TwoNZ). - apply plus_cancel_less with (z := [--](Length R1 (dIntrvl n) [/]TwoNZ)). - rstepl (Zero:R1). - rstepr (Length R1 (dIntrvl n) [/]TwoNZ). - apply pos_div_two. - unfold Length in |- *. - apply shift_zero_less_minus. - apply is_interval. - apply eq_symmetric_unfolded. - apply U_minus_W. + apply less_wdl with (x := Length _ (dIntrvl n) [/]TwoNZ). + apply plus_cancel_less with (z := [--](Length R1 (dIntrvl n) [/]TwoNZ)). + rstepl (Zero:R1). + rstepr (Length R1 (dIntrvl n) [/]TwoNZ). + apply pos_div_two. + unfold Length in |- *. + apply shift_zero_less_minus. + apply is_interval. + apply eq_symmetric_unfolded. + apply U_minus_W. apply Length_dIntrvl. Qed. - + Lemma AbsSmall_U_V : forall n : nat, AbsSmall ((Two [/]ThreeNZ)[^]n[*](dstart_r[-]dstart_l)) (U n[-]V n). Proof. intros. split; apply less_leEq. - apply less_wdr with (y := Length R1 (dIntrvl n) [/]TwoNZ). - apply less_wdl with (x := [--](Length R1 (dIntrvl n))). - apply plus_cancel_less with (z := Length R1 (dIntrvl n)). - rstepl (Zero:R1). - apply plus_resp_pos. - apply pos_div_two. - unfold Length in |- *. - apply shift_zero_less_minus. - apply is_interval. - unfold Length in |- *. - apply shift_zero_less_minus. - apply is_interval. - apply un_op_wd_unfolded. - apply Length_dIntrvl. - apply eq_symmetric_unfolded. - apply U_minus_V. + apply less_wdr with (y := Length R1 (dIntrvl n) [/]TwoNZ). + apply less_wdl with (x := [--](Length R1 (dIntrvl n))). + apply plus_cancel_less with (z := Length R1 (dIntrvl n)). + rstepl (Zero:R1). + apply plus_resp_pos. + apply pos_div_two. + unfold Length in |- *. + apply shift_zero_less_minus. + apply is_interval. + unfold Length in |- *. + apply shift_zero_less_minus. + apply is_interval. + apply un_op_wd_unfolded. + apply Length_dIntrvl. + apply eq_symmetric_unfolded. + apply U_minus_V. apply U_V_upper. -Qed. +Qed. Lemma AbsSmall_U_W : forall n : nat, @@ -785,26 +745,26 @@ Lemma AbsSmall_U_W : Proof. intro. split; apply less_leEq. - apply less_wdr with (y := Length R1 (dIntrvl n) [/]TwoNZ). - apply less_wdl with (x := [--](Length R1 (dIntrvl n))). - apply plus_cancel_less with (z := Length R1 (dIntrvl n)). - rstepl (Zero:R1). - apply plus_resp_pos. - apply pos_div_two. - unfold Length in |- *. - apply shift_zero_less_minus. - apply is_interval. - unfold Length in |- *. - apply shift_zero_less_minus. - apply is_interval. - apply un_op_wd_unfolded. - apply Length_dIntrvl. - apply eq_symmetric_unfolded. - apply U_minus_W. + apply less_wdr with (y := Length R1 (dIntrvl n) [/]TwoNZ). + apply less_wdl with (x := [--](Length R1 (dIntrvl n))). + apply plus_cancel_less with (z := Length R1 (dIntrvl n)). + rstepl (Zero:R1). + apply plus_resp_pos. + apply pos_div_two. + unfold Length in |- *. + apply shift_zero_less_minus. + apply is_interval. + unfold Length in |- *. + apply shift_zero_less_minus. + apply is_interval. + apply un_op_wd_unfolded. + apply Length_dIntrvl. + apply eq_symmetric_unfolded. + apply U_minus_W. apply U_W_lower. -Qed. +Qed. -(* Two properties of exponentiation in COrdFields *) +(* Two properties of exponentiation in COrdFields *) Lemma nexp_resp_great_One : forall (OF : COrdField) (x : OF), One[<]x -> forall n : nat, One[<=]x[^]n. @@ -812,7 +772,7 @@ Proof. intros. change (x[^]0[<=]x[^]n) in |- *. apply great_nexp_resp_le. - apply less_leEq; assumption. + apply less_leEq; assumption. apply le_O_n. Qed. @@ -823,58 +783,51 @@ Lemma very_weak_binomial : Proof. do 3 intro. intros H H0. induction n as [| n Hrecn]. - apply False_rect. - apply (lt_n_O 0). - apply lt_trans with (m := 1). - apply lt_O_Sn. - assumption. - - case (le_lt_eq_dec 2 (S n) (lt_le_S 1 (S n) H0)). - intro. - cut (One[+]nring n[*]x[<](x[+]One)[^]n). - intro. - apply less_wdr with (y := (x[+]One)[^]n[*](x[+]One)). - - apply - less_transitive_unfolded - with (y := One[+]nring (S n)[*]x[+]nring n[*]x[^]2). - apply plus_cancel_less with (z := [--](One[+]nring (S n)[*]x)). - rstepl (Zero:OF). - rstepr (nring n[*]x[^]2). - apply mult_resp_pos. - change (nring (R:=OF) 0[<]nring n) in |- *. - apply nring_less. - apply lt_S_n. - assumption. - apply pos_square. - apply Greater_imp_ap. - assumption. - - apply less_wdl with (x := (One[+]nring n[*]x)[*](x[+]One)). - apply mult_resp_less. - assumption. - apply less_transitive_unfolded with (y := x). - assumption. - apply less_plusOne. - simpl in |- *. - rational. - simpl in |- *. - apply eq_reflexive_unfolded. - apply Hrecn. - apply lt_S_n. - assumption. - + apply False_rect. + apply (lt_n_O 0). + apply lt_trans with (m := 1). + apply lt_O_Sn. + assumption. + case (le_lt_eq_dec 2 (S n) (lt_le_S 1 (S n) H0)). + intro. + cut (One[+]nring n[*]x[<](x[+]One)[^]n). + intro. + apply less_wdr with (y := (x[+]One)[^]n[*](x[+]One)). + apply less_transitive_unfolded with (y := One[+]nring (S n)[*]x[+]nring n[*]x[^]2). + apply plus_cancel_less with (z := [--](One[+]nring (S n)[*]x)). + rstepl (Zero:OF). + rstepr (nring n[*]x[^]2). + apply mult_resp_pos. + change (nring (R:=OF) 0[<]nring n) in |- *. + apply nring_less. + apply lt_S_n. + assumption. + apply pos_square. + apply Greater_imp_ap. + assumption. + apply less_wdl with (x := (One[+]nring n[*]x)[*](x[+]One)). + apply mult_resp_less. + assumption. + apply less_transitive_unfolded with (y := x). + assumption. + apply less_plusOne. + simpl in |- *. + rational. + simpl in |- *. + apply eq_reflexive_unfolded. + apply Hrecn. + apply lt_S_n. + assumption. intro H1. rewrite <- H1. apply less_wdr with (y := One[+]Two[*]x[+]x[^]2). - apply plus_cancel_less with (z := [--](One[+]Two[*]x)). - astepl (Zero:OF). - apply less_wdr with (y := x[^]2). - apply pos_square. - apply Greater_imp_ap. - assumption. - - rational. + apply plus_cancel_less with (z := [--](One[+]Two[*]x)). + astepl (Zero:OF). + apply less_wdr with (y := x[^]2). + apply pos_square. + apply Greater_imp_ap. + assumption. + rational. simpl in |- *. rational. Qed. @@ -886,57 +839,51 @@ Lemma nexp_resp_Two : forall x : R1, One[<]x -> {M : nat | Two[<]x[^]M}. Proof. intros. cut (x[-]One[#]Zero). - intro H0. - cut {N : nat | (One[/] x[-]One[//]H0)[<]nring N}. - intro H1. - case H1. - intro N. - intro. - exists (S N). - apply - less_transitive_unfolded - with (y := ((One[/] nring (S N)[//]nringS_ap_zero _ N)[+](One:R1))[^]S N). - apply - less_wdl - with - (x := (One:R1)[+] - nring (S N)[*](One[/] nring (S N)[//]nringS_ap_zero _ N)). - apply very_weak_binomial. - apply recip_resp_pos. - apply pos_nring_S. - apply lt_n_S. - apply neq_O_lt. - apply (nring_ap_zero_imp R1). - apply Greater_imp_ap. - apply less_transitive_unfolded with (y := One[/] x[-]One[//]H0). - apply recip_resp_pos. - apply shift_zero_less_minus. - assumption. - assumption. - - rational. - apply nexp_resp_less. - apply le_n_S. - apply le_O_n. - apply less_leEq. - apply less_transitive_unfolded with (y := One:R1). - apply pos_one. - apply plus_cancel_less with (z := [--](One:R1)). - astepl (Zero:R1). - rstepr ((One:R1)[/] nring (S N)[//]nringS_ap_zero R1 N). - apply recip_resp_pos. - apply pos_nring_S. - apply plus_cancel_less with (z := [--](One:R1)). - rstepl (One[/] nring (S N)[//]nringS_ap_zero R1 N). - astepr (x[-]One). - apply swap_div with (z_ := H0). - apply pos_nring_S. - apply shift_zero_less_minus. - assumption. - apply less_transitive_unfolded with (y := nring (R:=R1) N). - assumption. - apply nring_less_succ. - apply Archimedes'. (* Note the use of Archimedean property *) + intro H0. + cut {N : nat | (One[/] x[-]One[//]H0)[<]nring N}. + intro H1. + case H1. + intro N. + intro. + exists (S N). + apply less_transitive_unfolded + with (y := ((One[/] nring (S N)[//]nringS_ap_zero _ N)[+](One:R1))[^]S N). + apply less_wdl with (x := (One:R1)[+] nring (S N)[*](One[/] nring (S N)[//]nringS_ap_zero _ N)). + apply very_weak_binomial. + apply recip_resp_pos. + apply pos_nring_S. + apply lt_n_S. + apply neq_O_lt. + apply (nring_ap_zero_imp R1). + apply Greater_imp_ap. + apply less_transitive_unfolded with (y := One[/] x[-]One[//]H0). + apply recip_resp_pos. + apply shift_zero_less_minus. + assumption. + assumption. + rational. + apply nexp_resp_less. + apply le_n_S. + apply le_O_n. + apply less_leEq. + apply less_transitive_unfolded with (y := One:R1). + apply pos_one. + apply plus_cancel_less with (z := [--](One:R1)). + astepl (Zero:R1). + rstepr ((One:R1)[/] nring (S N)[//]nringS_ap_zero R1 N). + apply recip_resp_pos. + apply pos_nring_S. + apply plus_cancel_less with (z := [--](One:R1)). + rstepl (One[/] nring (S N)[//]nringS_ap_zero R1 N). + astepr (x[-]One). + apply swap_div with (z_ := H0). + apply pos_nring_S. + apply shift_zero_less_minus. + assumption. + apply less_transitive_unfolded with (y := nring (R:=R1) N). + assumption. + apply nring_less_succ. + apply Archimedes'. (* Note the use of Archimedean property *) apply Greater_imp_ap. apply shift_zero_less_minus. assumption. @@ -947,10 +894,9 @@ Lemma twisted_archimedean : Proof. intros n x H. induction n as [| n Hrecn]. - exists 0. - simpl in |- *. - apply pos_one. - + exists 0. + simpl in |- *. + apply pos_one. case Hrecn. intro M1. intros. @@ -959,30 +905,29 @@ Proof. intros. exists (M1 + M2). apply less_transitive_unfolded with (y := x[^]M1[+]One). - simpl in |- *. - apply plus_resp_less_leEq. - assumption. - apply leEq_reflexive. - + simpl in |- *. + apply plus_resp_less_leEq. + assumption. + apply leEq_reflexive. apply less_wdr with (y := x[^]M1[*]x[^]M2). - apply plus_cancel_less with (z := [--](x[^]M1)). - apply less_wdl with (x := One:R1). - apply less_wdr with (y := x[^]M1[*](x[^]M2[-]One)). - apply leEq_less_trans with (y := x[^]M1[*]One). - astepr (x[^]M1). - apply nexp_resp_great_One. - assumption. - apply mult_resp_less_lft. - apply shift_less_minus. - rstepl (Two:R1). - assumption. - apply leEq_less_trans with (y := nring (R:=R1) n). - change (nring (R:=R1) 0[<=]nring n) in |- *. - apply nring_leEq. - apply le_O_n. - assumption. - rational. - rational. + apply plus_cancel_less with (z := [--](x[^]M1)). + apply less_wdl with (x := One:R1). + apply less_wdr with (y := x[^]M1[*](x[^]M2[-]One)). + apply leEq_less_trans with (y := x[^]M1[*]One). + astepr (x[^]M1). + apply nexp_resp_great_One. + assumption. + apply mult_resp_less_lft. + apply shift_less_minus. + rstepl (Two:R1). + assumption. + apply leEq_less_trans with (y := nring (R:=R1) n). + change (nring (R:=R1) 0[<=]nring n) in |- *. + apply nring_leEq. + apply le_O_n. + assumption. + rational. + rational. apply nexp_plus. Qed. @@ -992,114 +937,97 @@ Lemma B_limit_V : Proof. intros e H. cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (V m[-]U m)}. - intro H0. - cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (U m[-]B)}. - intro H1. - case H0. - intro N1. - intro H2. - case H1. - intro N2. - intro H3. - exists (N1 + N2). - intros. - rstepr (V m[-]U m[+](U m[-]B)). - rstepl (e [/]TwoNZ[+]e [/]TwoNZ). - apply AbsSmall_plus. - apply H2. - apply le_trans with (m := N1 + N2). - apply le_plus_l. - assumption. - apply H3. - apply le_trans with (m := N1 + N2). - apply le_plus_r. - assumption. - unfold B in |- *. - cut (SeqLimit U_as_CauchySeq (Lim U_as_CauchySeq)). - intro H1. - red in H1. - apply H1. - apply pos_div_two. - assumption. - apply Lim_Cauchy. - + intro H0. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (U m[-]B)}. + intro H1. + case H0. + intro N1. + intro H2. + case H1. + intro N2. + intro H3. + exists (N1 + N2). + intros. + rstepr (V m[-]U m[+](U m[-]B)). + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_plus. + apply H2. + apply le_trans with (m := N1 + N2). + apply le_plus_l. + assumption. + apply H3. + apply le_trans with (m := N1 + N2). + apply le_plus_r. + assumption. + unfold B in |- *. + cut (SeqLimit U_as_CauchySeq (Lim U_as_CauchySeq)). + intro H1. + red in H1. + apply H1. + apply pos_div_two. + assumption. + apply Lim_Cauchy. (* The Core of the Proof *) - - cut - {n : nat | - (Two[*](dstart_r[-]dstart_l)[/] e[//]Greater_imp_ap _ e Zero H)[<]nring n}. - intro H0. - case H0. - intro N. - intros. - case (twisted_archimedean N (Three [/]TwoNZ)). - apply mult_cancel_less with (z := Two:R1). - apply pos_two. - astepl (Two:R1). - rstepr (Three:R1). - apply two_less_three. - intro M. - intros. - exists M. - intros. - apply - AbsSmall_leEq_trans - with (e1 := (Two [/]ThreeNZ)[^]m[*](dstart_r[-]dstart_l)). - apply less_leEq. - - apply mult_cancel_less with (z := ((Three:R1) [/]TwoNZ)[^]m). - apply less_leEq_trans with (y := ((Three:R1) [/]TwoNZ)[^]0). - simpl in |- *. - apply pos_one. - apply great_nexp_resp_le. - apply less_leEq. - apply mult_cancel_less with (z := Two:R1). - apply pos_two. - rstepl (Two:R1). - rstepr (Three:R1). - apply two_less_three. - apply le_O_n. - apply - less_wdl - with - (x := (Two[^]m[/] Three[^]m[//]nexp_resp_ap_zero m (three_ap_zero R1))[*] - (dstart_r[-]dstart_l)[*] - (Three[^]m[/] Two[^]m[//]nexp_resp_ap_zero m (two_ap_zero R1))). - rstepl (dstart_r[-]dstart_l). - apply mult_cancel_less with (z := Two[/] e[//]Greater_imp_ap _ e Zero H). - apply div_resp_pos. - assumption. - apply pos_two. - apply - less_wdl - with (x := Two[*](dstart_r[-]dstart_l)[/] e[//]Greater_imp_ap _ e Zero H). - rstepr (((Three:R1) [/]TwoNZ)[^]m). - apply less_transitive_unfolded with (y := nring (R:=R1) N). - assumption. - apply less_leEq_trans with (y := ((Three:R1) [/]TwoNZ)[^]M). - assumption. - apply great_nexp_resp_le. - apply less_leEq. - apply mult_cancel_less with (z := Two:R1). - apply pos_two. - rstepl (Two:R1). - astepr (Three:R1). - apply two_less_three. - assumption. - - rational. - - apply bin_op_wd_unfolded. - apply bin_op_wd_unfolded. - apply eq_symmetric_unfolded. - apply nexp_distr_div'. - apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. - apply nexp_distr_div'. - - apply AbsSmall_minus. - apply AbsSmall_U_V. - + cut {n : nat | (Two[*](dstart_r[-]dstart_l)[/] e[//]Greater_imp_ap _ e Zero H)[<]nring n}. + intro H0. + case H0. + intro N. + intros. + case (twisted_archimedean N (Three [/]TwoNZ)). + apply mult_cancel_less with (z := Two:R1). + apply pos_two. + astepl (Two:R1). + rstepr (Three:R1). + apply two_less_three. + intro M. + intros. + exists M. + intros. + apply AbsSmall_leEq_trans with (e1 := (Two [/]ThreeNZ)[^]m[*](dstart_r[-]dstart_l)). + apply less_leEq. + apply mult_cancel_less with (z := ((Three:R1) [/]TwoNZ)[^]m). + apply less_leEq_trans with (y := ((Three:R1) [/]TwoNZ)[^]0). + simpl in |- *. + apply pos_one. + apply great_nexp_resp_le. + apply less_leEq. + apply mult_cancel_less with (z := Two:R1). + apply pos_two. + rstepl (Two:R1). + rstepr (Three:R1). + apply two_less_three. + apply le_O_n. + apply less_wdl with (x := (Two[^]m[/] Three[^]m[//]nexp_resp_ap_zero m (three_ap_zero R1))[*] + (dstart_r[-]dstart_l)[*] (Three[^]m[/] Two[^]m[//]nexp_resp_ap_zero m (two_ap_zero R1))). + rstepl (dstart_r[-]dstart_l). + apply mult_cancel_less with (z := Two[/] e[//]Greater_imp_ap _ e Zero H). + apply div_resp_pos. + assumption. + apply pos_two. + apply less_wdl with (x := Two[*](dstart_r[-]dstart_l)[/] e[//]Greater_imp_ap _ e Zero H). + rstepr (((Three:R1) [/]TwoNZ)[^]m). + apply less_transitive_unfolded with (y := nring (R:=R1) N). + assumption. + apply less_leEq_trans with (y := ((Three:R1) [/]TwoNZ)[^]M). + assumption. + apply great_nexp_resp_le. + apply less_leEq. + apply mult_cancel_less with (z := Two:R1). + apply pos_two. + rstepl (Two:R1). + astepr (Three:R1). + apply two_less_three. + assumption. + rational. + apply bin_op_wd_unfolded. + apply bin_op_wd_unfolded. + apply eq_symmetric_unfolded. + apply nexp_distr_div'. + apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded. + apply nexp_distr_div'. + apply AbsSmall_minus. + apply AbsSmall_U_V. apply Archimedes'. Qed. @@ -1110,113 +1038,96 @@ Lemma B_limit_W : Proof. intros e H. cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (W m[-]U m)}. - intro H0. - cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (U m[-]B)}. - intro H1. - case H0. - intro N1. - intros. - case H1. - intro N2. - intros. - exists (N1 + N2). - intros. - rstepr (W m[-]U m[+](U m[-]B)). - rstepl (e [/]TwoNZ[+]e [/]TwoNZ). - apply AbsSmall_plus. - apply a. - apply le_trans with (m := N1 + N2). - apply le_plus_l. - assumption. - apply a0. - apply le_trans with (m := N1 + N2). - apply le_plus_r. - assumption. - unfold B in |- *. - cut (SeqLimit U_as_CauchySeq (Lim U_as_CauchySeq)). - intro H1. - red in H1. - apply H1. - apply pos_div_two. - assumption. - apply Lim_Cauchy. - + intro H0. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (U m[-]B)}. + intro H1. + case H0. + intro N1. + intros. + case H1. + intro N2. + intros. + exists (N1 + N2). + intros. + rstepr (W m[-]U m[+](U m[-]B)). + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_plus. + apply a. + apply le_trans with (m := N1 + N2). + apply le_plus_l. + assumption. + apply a0. + apply le_trans with (m := N1 + N2). + apply le_plus_r. + assumption. + unfold B in |- *. + cut (SeqLimit U_as_CauchySeq (Lim U_as_CauchySeq)). + intro H1. + red in H1. + apply H1. + apply pos_div_two. + assumption. + apply Lim_Cauchy. (* The Core of the Proof *) - - cut - {n : nat | - (Two[*](dstart_r[-]dstart_l)[/] e[//]Greater_imp_ap _ e Zero H)[<]nring n}. - intro H0. - case H0. - intro N. - intros. - case (twisted_archimedean N (Three [/]TwoNZ)). - apply mult_cancel_less with (z := Two:R1). - apply pos_two. - astepl (Two:R1). - rstepr (Three:R1). - apply two_less_three. - intro M. - intros. - exists M. - intros. - apply - AbsSmall_leEq_trans - with (e1 := (Two [/]ThreeNZ)[^]m[*](dstart_r[-]dstart_l)). - apply less_leEq. - - apply mult_cancel_less with (z := ((Three:R1) [/]TwoNZ)[^]m). - apply less_leEq_trans with (y := ((Three:R1) [/]TwoNZ)[^]0). - simpl in |- *. - apply pos_one. - apply great_nexp_resp_le. - apply less_leEq. - apply mult_cancel_less with (z := Two:R1). - apply pos_two. - rstepl (Two:R1). - rstepr (Three:R1). - apply two_less_three. - apply le_O_n. - apply - less_wdl - with - (x := (Two[^]m[/] Three[^]m[//]nexp_resp_ap_zero m (three_ap_zero R1))[*] - (dstart_r[-]dstart_l)[*] - (Three[^]m[/] Two[^]m[//]nexp_resp_ap_zero m (two_ap_zero R1))). - rstepl (dstart_r[-]dstart_l). - apply mult_cancel_less with (z := Two[/] e[//]Greater_imp_ap _ e Zero H). - apply div_resp_pos. - assumption. - apply pos_two. - apply - less_wdl - with (x := Two[*](dstart_r[-]dstart_l)[/] e[//]Greater_imp_ap _ e Zero H). - rstepr (((Three:R1) [/]TwoNZ)[^]m). - apply less_transitive_unfolded with (y := nring (R:=R1) N). - assumption. - apply less_leEq_trans with (y := ((Three:R1) [/]TwoNZ)[^]M). - assumption. - apply great_nexp_resp_le. - apply less_leEq. - apply mult_cancel_less with (z := Two:R1). - apply pos_two. - rstepl (Two:R1). - astepr (Three:R1). - apply two_less_three. - assumption. - - rational. - - apply bin_op_wd_unfolded. - apply bin_op_wd_unfolded. - apply eq_symmetric_unfolded. - apply nexp_distr_div'. - apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. - apply nexp_distr_div'. - - apply AbsSmall_U_W. - + cut {n : nat | (Two[*](dstart_r[-]dstart_l)[/] e[//]Greater_imp_ap _ e Zero H)[<]nring n}. + intro H0. + case H0. + intro N. + intros. + case (twisted_archimedean N (Three [/]TwoNZ)). + apply mult_cancel_less with (z := Two:R1). + apply pos_two. + astepl (Two:R1). + rstepr (Three:R1). + apply two_less_three. + intro M. + intros. + exists M. + intros. + apply AbsSmall_leEq_trans with (e1 := (Two [/]ThreeNZ)[^]m[*](dstart_r[-]dstart_l)). + apply less_leEq. + apply mult_cancel_less with (z := ((Three:R1) [/]TwoNZ)[^]m). + apply less_leEq_trans with (y := ((Three:R1) [/]TwoNZ)[^]0). + simpl in |- *. + apply pos_one. + apply great_nexp_resp_le. + apply less_leEq. + apply mult_cancel_less with (z := Two:R1). + apply pos_two. + rstepl (Two:R1). + rstepr (Three:R1). + apply two_less_three. + apply le_O_n. + apply less_wdl with (x := (Two[^]m[/] Three[^]m[//]nexp_resp_ap_zero m (three_ap_zero R1))[*] + (dstart_r[-]dstart_l)[*] (Three[^]m[/] Two[^]m[//]nexp_resp_ap_zero m (two_ap_zero R1))). + rstepl (dstart_r[-]dstart_l). + apply mult_cancel_less with (z := Two[/] e[//]Greater_imp_ap _ e Zero H). + apply div_resp_pos. + assumption. + apply pos_two. + apply less_wdl with (x := Two[*](dstart_r[-]dstart_l)[/] e[//]Greater_imp_ap _ e Zero H). + rstepr (((Three:R1) [/]TwoNZ)[^]m). + apply less_transitive_unfolded with (y := nring (R:=R1) N). + assumption. + apply less_leEq_trans with (y := ((Three:R1) [/]TwoNZ)[^]M). + assumption. + apply great_nexp_resp_le. + apply less_leEq. + apply mult_cancel_less with (z := Two:R1). + apply pos_two. + rstepl (Two:R1). + astepr (Three:R1). + apply two_less_three. + assumption. + rational. + apply bin_op_wd_unfolded. + apply bin_op_wd_unfolded. + apply eq_symmetric_unfolded. + apply nexp_distr_div'. + apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded. + apply nexp_distr_div'. + apply AbsSmall_U_W. apply Archimedes'. Qed. @@ -1224,30 +1135,30 @@ Lemma W_n_is_upper : forall n : nat, is_upper_bound R1 A (W n). Proof. intros. induction n as [| n Hrecn]. - (* n=O *) - unfold W in |- *. - simpl in |- *. - unfold dstart_r in |- *. - red in |- *. - intros x H z H0. - cut (is_upper_bound R1 A b0). - intros H1. - red in H1. - apply less_transitive_unfolded with (y := b0). - apply (H1 x H z). - assumption. - apply less_plusOne. - exact Pb0. + (* n=O *) + unfold W in |- *. + simpl in |- *. + unfold dstart_r in |- *. + red in |- *. + intros x H z H0. + cut (is_upper_bound R1 A b0). + intros H1. + red in H1. + apply less_transitive_unfolded with (y := b0). + apply (H1 x H z). + assumption. + apply less_plusOne. + exact Pb0. (* n=(S n0) *) case (dif_cotrans_strong (dIntrvl n)). - intro a. - elim a. - intros H H0. - unfold W in |- *. - simpl in |- *. - rewrite H0. - simpl in |- *. - exact Hrecn. + intro a. + elim a. + intros H H0. + unfold W in |- *. + simpl in |- *. + rewrite H0. + simpl in |- *. + exact Hrecn. intro a. elim a. intros. @@ -1262,24 +1173,24 @@ Lemma A_bounds_V_n : forall n : nat, {s' : R1 | A s' | V n[<]s'}. Proof. intro. induction n as [| n Hrecn]. - (* n=0 *) - unfold V in |- *. - simpl in |- *. - exists s. - apply s_inhabits_A. - unfold dstart_l in |- *. - apply shift_minus_less. - apply less_plusOne. + (* n=0 *) + unfold V in |- *. + simpl in |- *. + exists s. + apply s_inhabits_A. + unfold dstart_l in |- *. + apply shift_minus_less. + apply less_plusOne. (* n=(S n0) *) case (dif_cotrans_strong (dIntrvl n)). - intro a. - elim a. - intros H H0. - unfold V in |- *. - simpl in |- *. - rewrite H0. - simpl in |- *. - exact H. + intro a. + elim a. + intros H H0. + unfold V in |- *. + simpl in |- *. + rewrite H0. + simpl in |- *. + exact H. intro a. elim a. intros H H0. @@ -1295,80 +1206,73 @@ Proof. intros. unfold l_u_b in |- *. exists B. - split. - (* to prove the first condition of l.u.b *) - red in |- *. - intros t At. - intros. - - case (B_limit_W ((t[-]z) [/]TwoNZ)). - - apply pos_div_two. - apply shift_zero_less_minus. - assumption. - intro N. - intro H0. - cut (AbsSmall ((t[-]z) [/]TwoNZ) (W N[-]B)). - intro H1. - apply plus_cancel_less with (z := (t[-]z) [/]TwoNZ). - apply less_leEq_trans with (y := W N). - rstepl (t[-](t[-]z) [/]TwoNZ). - cut (is_upper_bound R1 A (W N)). - intro H2. - red in H2. - apply (H2 t At). - apply plus_cancel_less with (z := (t[-]z) [/]TwoNZ[-]t). - rstepl (Zero:R1). - rstepr ((t[-]z) [/]TwoNZ). - apply pos_div_two. - apply shift_zero_less_minus. - assumption. - apply W_n_is_upper. - apply plus_cancel_leEq_rht with (z := [--]B). - astepl (W N[-]B). - rstepr ((t[-]z) [/]TwoNZ). - elim H1. - intros H2 H3. - assumption. - - apply H0. - constructor. - + (* to prove the first condition of l.u.b *) + red in |- *. + intros t At. + intros. + case (B_limit_W ((t[-]z) [/]TwoNZ)). + apply pos_div_two. + apply shift_zero_less_minus. + assumption. + intro N. + intro H0. + cut (AbsSmall ((t[-]z) [/]TwoNZ) (W N[-]B)). + intro H1. + apply plus_cancel_less with (z := (t[-]z) [/]TwoNZ). + apply less_leEq_trans with (y := W N). + rstepl (t[-](t[-]z) [/]TwoNZ). + cut (is_upper_bound R1 A (W N)). + intro H2. + red in H2. + apply (H2 t At). + apply plus_cancel_less with (z := (t[-]z) [/]TwoNZ[-]t). + rstepl (Zero:R1). + rstepr ((t[-]z) [/]TwoNZ). + apply pos_div_two. + apply shift_zero_less_minus. + assumption. + apply W_n_is_upper. + apply plus_cancel_leEq_rht with (z := [--]B). + astepl (W N[-]B). + rstepr ((t[-]z) [/]TwoNZ). + elim H1. + intros H2 H3. + assumption. + apply H0. + constructor. (* to prove the second condition of a l.u.b. *) intros b' H. case (B_limit_V ((B[-]b') [/]TwoNZ)). - - apply pos_div_two. - apply shift_zero_less_minus. - assumption. - + apply pos_div_two. + apply shift_zero_less_minus. + assumption. intro N. intro H0. cut (AbsSmall ((B[-]b') [/]TwoNZ) (V N[-]B)). - intros. - case (A_bounds_V_n N). - intro s'. - set (H2 := True) in *. (* dummy *) - intros. - exists s'. - split. - assumption. - apply less_transitive_unfolded with (y := V N). - apply less_leEq_trans with (y := B[-](B[-]b') [/]TwoNZ). - apply plus_cancel_less with (z := [--]b'). - astepl (Zero:R1). - rstepr ((B[-]b') [/]TwoNZ). - apply pos_div_two. - apply shift_zero_less_minus. - assumption. - apply plus_cancel_leEq_rht with (z := [--]B). - astepr (V N[-]B). - rstepl ([--]((B[-]b') [/]TwoNZ)). - elim H1. - intros. - assumption. - assumption. + intros. + case (A_bounds_V_n N). + intro s'. + set (H2 := True) in *. (* dummy *) + intros. + exists s'. + split. + assumption. + apply less_transitive_unfolded with (y := V N). + apply less_leEq_trans with (y := B[-](B[-]b') [/]TwoNZ). + apply plus_cancel_less with (z := [--]b'). + astepl (Zero:R1). + rstepr ((B[-]b') [/]TwoNZ). + apply pos_div_two. + apply shift_zero_less_minus. + assumption. + apply plus_cancel_leEq_rht with (z := [--]B). + astepr (V N[-]B). + rstepl ([--]((B[-]b') [/]TwoNZ)). + elim H1. + intros. + assumption. + assumption. apply H0. constructor. Qed. diff --git a/reals/Bridges_iso.v b/reals/Bridges_iso.v index f6d98b895..d11bb27db 100644 --- a/reals/Bridges_iso.v +++ b/reals/Bridges_iso.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) (* file : bridges_gives_our.v *) (* version : 1.50 - 09/05/2001 *) @@ -40,7 +40,7 @@ (* author : Milad Niqui *) (* language : coq7.0bet26feb *) (* dependency : least_upper_bound_principle *) -(* description : Bridges' proof of Cauchy completeness in TCS-219 *) +(* description : Bridges' proof of Cauchy completeness in TCS-219 *) Require Import Bridges_LUB. @@ -51,24 +51,24 @@ Lemma le_witness_informative : forall m n : nat, m <= n -> {k : nat | n = m + k}. Proof. intros. - induction n as [| n Hrecn]. - exists 0. - rewrite <- (plus_n_O m). - apply le_n_O_eq. - assumption. + induction n as [| n Hrecn]. + exists 0. + rewrite <- (plus_n_O m). + apply le_n_O_eq. + assumption. case (le_lt_eq_dec m (S n)). - assumption. - intro. - case Hrecn. - apply lt_n_Sm_le. - assumption. - intro k. - intros. - exists (S k). - rewrite <- (plus_Snm_nSm m k). - simpl in |- *. - apply eq_S. - assumption. + assumption. + intro. + case Hrecn. + apply lt_n_Sm_le. + assumption. + intro k. + intros. + exists (S k). + rewrite <- (plus_Snm_nSm m k). + simpl in |- *. + apply eq_S. + assumption. intro. exists 0. rewrite <- (plus_n_O m). @@ -85,18 +85,19 @@ Hypothesis {x : OF | X x} -> {b : OF | is_upper_bound OF X b} -> (forall x y : OF, - x[<]y -> is_upper_bound OF X y or {s : OF | X s | x[<]s}) -> + x[<]y -> is_upper_bound OF X y or {s : OF | X s | x[<]s}) -> l_u_b OF X. Hypothesis is_Archimedes : forall x : OF, {n : nat | x[<=]nring n}. Lemma is_Archimedes' : forall x : OF, {n : nat | x[<]nring n}. -intro x. -elim (is_Archimedes (x[+]One)); intros n Hn. -exists n. -apply less_leEq_trans with (x[+]One). -apply less_plusOne. -auto. +Proof. + intro x. + elim (is_Archimedes (x[+]One)); intros n Hn. + exists n. + apply less_leEq_trans with (x[+]One). + apply less_plusOne. + auto. Qed. Section proofs_in_TCS. @@ -129,107 +130,104 @@ Proof. intros X H H0 strong_extensionality_of_X. intros. red in |- *. - cut (l_u_b OF (fun x : OF => X [--]x)). - intro H2. - red in H2. - case H2. - intro b. - intros a. - exists ([--]b). - elim a. - intros H3 H4. - split. - red in |- *. - intros x H5 z H6. - red in H3. - case (less_cotransitive_unfolded OF z [--]b H6 x). - trivial. - intro. - elimtype False. - apply (less_irreflexive_unfolded _ b). - apply H3 with (x := [--]x) (z := b). - apply (strong_extensionality_of_X x [--][--]x). - algebra. - assumption. - apply inv_cancel_less. - astepl x. - assumption. - intros. - case (H4 [--]c'). - apply inv_cancel_less. - astepr c'. - assumption. - intro s. - intros H6. - elim H6. - intros. - exists ([--]s). - split. - assumption. - apply inv_cancel_less. - astepr s. - assumption. -(* * * * * * * *) - apply (lubp (fun x : OF => X [--]x)). - case H. - intro x. - intro. - exists ([--]x). - apply (strong_extensionality_of_X x [--][--]x). - algebra. - assumption. - - case H0. - intro l. - intros. - exists ([--]l). - red in |- *. - red in i. - intros. - apply inv_cancel_less. - astepl l. - apply (leEq_geEq l [--]x). - intros. - apply i with (x := [--]x). - assumption. - assumption. - apply inv_resp_less. - assumption. - + cut (l_u_b OF (fun x : OF => X [--]x)). + intro H2. + red in H2. + case H2. + intro b. + intros a. + exists ([--]b). + elim a. + intros H3 H4. + split. + red in |- *. + intros x H5 z H6. + red in H3. + case (less_cotransitive_unfolded OF z [--]b H6 x). + trivial. + intro. + elimtype False. + apply (less_irreflexive_unfolded _ b). + apply H3 with (x := [--]x) (z := b). + apply (strong_extensionality_of_X x [--][--]x). + algebra. + assumption. + apply inv_cancel_less. + astepl x. + assumption. + intros. + case (H4 [--]c'). + apply inv_cancel_less. + astepr c'. + assumption. + intro s. + intros H6. + elim H6. + intros. + exists ([--]s). + split. + assumption. + apply inv_cancel_less. + astepr s. + assumption. + (* * * * * * * *) + apply (lubp (fun x : OF => X [--]x)). + case H. + intro x. + intro. + exists ([--]x). + apply (strong_extensionality_of_X x [--][--]x). + algebra. + assumption. + case H0. + intro l. + intros. + exists ([--]l). + red in |- *. + red in i. + intros. + apply inv_cancel_less. + astepl l. + apply (leEq_geEq l [--]x). + intros. + apply i with (x := [--]x). + assumption. + assumption. + apply inv_resp_less. + assumption. rename X0 into H1. intros x y H2. case (H1 [--]y [--]x). - apply inv_resp_less. - assumption. - intro. - left. - red in |- *. - red in i. - intros. - apply inv_cancel_less. - apply (leEq_geEq [--]y [--]x0). - intros. - apply i with (x := [--]x0). - assumption. - assumption. - apply inv_resp_less. - assumption. - + apply inv_resp_less. + assumption. + intro. + left. + red in |- *. + red in i. + intros. + apply inv_cancel_less. + apply (leEq_geEq [--]y [--]x0). + intros. + apply i with (x := [--]x0). + assumption. + assumption. + apply inv_resp_less. + assumption. intro e. right. case e. intro s. intros. exists ([--]s). - apply (strong_extensionality_of_X s [--][--]s). - algebra. - assumption. + apply (strong_extensionality_of_X s [--][--]s). + algebra. + assumption. apply inv_cancel_less. rstepl s. assumption. Qed. - - + + Section supremum. Variable P : OF -> CProp. @@ -244,30 +242,30 @@ Proof. simpl in |- *. rstepr ((x[-]One)[*](x[-]One)[+]One). apply less_wdr with (y := (x[-]One)[^]2[+](One:OF)). - apply less_leEq_trans with (y := One:OF). - apply pos_one. - apply plus_cancel_leEq_rht with (z := [--](One:OF)). - astepl (Zero:OF). - rstepr ((x[-](One:OF))[^]2). - apply sqr_nonneg. + apply less_leEq_trans with (y := One:OF). + apply pos_one. + apply plus_cancel_leEq_rht with (z := [--](One:OF)). + astepl (Zero:OF). + rstepr ((x[-](One:OF))[^]2). + apply sqr_nonneg. simpl in |- *. rational. Qed. -Lemma inequality2 : forall x : OF, (Zero:OF)[<]x[^]2[-]x[+]Two. +Lemma inequality2 : forall x : OF, (Zero:OF)[<]x[^]2[-]x[+]Two. Proof. intros. apply less_wdr with (y := (x[-]One [/]TwoNZ)[^]2[+](Three [/]FourNZ[+]One)). - apply less_leEq_trans with (y := Three [/]FourNZ[+](One:OF)). - apply plus_resp_pos. - apply div_resp_pos. - apply pos_four. - apply pos_three. - apply pos_one. - apply plus_cancel_leEq_rht with (z := [--](Three [/]FourNZ[+](One:OF))). - astepl (Zero:OF). - rstepr ((x[-](One:OF) [/]TwoNZ)[^]2). - apply sqr_nonneg. + apply less_leEq_trans with (y := Three [/]FourNZ[+](One:OF)). + apply plus_resp_pos. + apply div_resp_pos. + apply pos_four. + apply pos_three. + apply pos_one. + apply plus_cancel_leEq_rht with (z := [--](Three [/]FourNZ[+](One:OF))). + astepl (Zero:OF). + rstepr ((x[-](One:OF) [/]TwoNZ)[^]2). + apply sqr_nonneg. simpl in |- *. rational. Qed. @@ -275,18 +273,18 @@ Qed. Lemma inequality3 : forall x : OF, [--](x[^]2)[-]x[-]Two[<]x. Proof. intros. - apply inv_cancel_less. + apply inv_cancel_less. apply plus_cancel_less with (z := x). simpl in |- *. rstepr ((x[+]One)[*](x[+]One)[+]One). astepl (Zero:OF). apply less_wdr with (y := (x[+]One)[^]2[+](One:OF)). - apply less_leEq_trans with (y := One:OF). - apply pos_one. - apply plus_cancel_leEq_rht with (z := [--](One:OF)). - astepl (Zero:OF). - rstepr ((x[+](One:OF))[^]2). - apply sqr_nonneg. + apply less_leEq_trans with (y := One:OF). + apply pos_one. + apply plus_cancel_leEq_rht with (z := [--](One:OF)). + astepl (Zero:OF). + rstepr ((x[+](One:OF))[^]2). + apply sqr_nonneg. simpl in |- *. rational. Qed. @@ -297,16 +295,16 @@ Proof. apply inv_cancel_less. astepl (Zero:OF). apply less_wdr with (y := (x[+]One [/]TwoNZ)[^]2[+](Three [/]FourNZ[+]One)). - apply less_leEq_trans with (y := Three [/]FourNZ[+](One:OF)). - apply plus_resp_pos. - apply div_resp_pos. - apply pos_four. - apply pos_three. - apply pos_one. - apply plus_cancel_leEq_rht with (z := [--](Three [/]FourNZ[+](One:OF))). - astepl (Zero:OF). - rstepr ((x[+](One:OF) [/]TwoNZ)[^]2). - apply sqr_nonneg. + apply less_leEq_trans with (y := Three [/]FourNZ[+](One:OF)). + apply plus_resp_pos. + apply div_resp_pos. + apply pos_four. + apply pos_three. + apply pos_one. + apply plus_cancel_leEq_rht with (z := [--](Three [/]FourNZ[+](One:OF))). + astepl (Zero:OF). + rstepr ((x[+](One:OF) [/]TwoNZ)[^]2). + apply sqr_nonneg. simpl in |- *. rational. Qed. @@ -324,46 +322,46 @@ Lemma bound_tk1 : Proof. intros n g H. induction n as [| n Hrecn]. - simpl in |- *. - apply H. - constructor. + simpl in |- *. + apply H. + constructor. (* n=(S n0) *) simpl in |- *. apply plus_resp_pos. - apply H. - apply le_n. + apply H. + apply le_n. apply Hrecn. intros. apply H. apply le_trans with (m := n). - assumption. + assumption. apply le_n_Sn. Qed. - + Lemma bound_tk2 : forall (n : nat) (g : nat -> OF), (forall m : nat, m <= n -> g m[<](Zero:OF)) -> Hum g n[<]Zero. Proof. intros n g H. induction n as [| n Hrecn]. - simpl in |- *. - apply H. - constructor. + simpl in |- *. + apply H. + constructor. (* n=(S n0) *) simpl in |- *. astepr (Zero[+](Zero:OF)). apply plus_resp_less_both. - apply H. - apply le_n. + apply H. + apply le_n. apply Hrecn. intros. apply H. apply le_trans with (m := n). - assumption. + assumption. apply le_n_Sn. Qed. - - + + Lemma trick : forall (n : nat) (r g : nat -> OF), (forall m : nat, m <= n -> (Zero:OF)[<]g m) -> @@ -372,47 +370,47 @@ Lemma trick : Proof. intros n r g H H0 m H1. induction n as [| n Hrecn]. - (* n=O *) - simpl in |- *. - rewrite <- (le_n_O_eq m H1). - apply H0. - constructor. + (* n=O *) + simpl in |- *. + rewrite <- (le_n_O_eq m H1). + apply H0. + constructor. (* n=(S n0) *) simpl in |- *. case (le_lt_eq_dec m (S n)). - assumption. - intro. - cut (m <= n). - intro. - astepl ((Zero:OF)[+]r m). - apply plus_resp_less_both. - apply H. - apply le_n. - apply Hrecn. - intros. - apply H. - apply le_trans with (m := n). - assumption. - apply le_n_Sn. - intros. - apply H0. - apply le_trans with (m := n). - assumption. - apply le_n_Sn. - assumption. - apply lt_n_Sm_le. - assumption. + assumption. + intro. + cut (m <= n). + intro. + astepl ((Zero:OF)[+]r m). + apply plus_resp_less_both. + apply H. + apply le_n. + apply Hrecn. + intros. + apply H. + apply le_trans with (m := n). + assumption. + apply le_n_Sn. + intros. + apply H0. + apply le_trans with (m := n). + assumption. + apply le_n_Sn. + assumption. + apply lt_n_Sm_le. + assumption. intros. rewrite e. astepl (r (S n)[+](Zero:OF)). apply plus_resp_less_both. - apply H0. - apply le_n. + apply H0. + apply le_n. apply bound_tk1. intros. apply H. apply le_trans with (m := n). - assumption. + assumption. apply le_n_Sn. Qed. @@ -425,47 +423,47 @@ Lemma trick' : Proof. intros n r g H H0 m H1. induction n as [| n Hrecn]. - (* n=O *) - simpl in |- *. - rewrite <- (le_n_O_eq m H1). - apply H0. - constructor. + (* n=O *) + simpl in |- *. + rewrite <- (le_n_O_eq m H1). + apply H0. + constructor. (* n=(S n0) *) simpl in |- *. case (le_lt_eq_dec m (S n)). - assumption. - intro. - cut (m <= n). - intro. - astepr ((Zero:OF)[+]r m). - apply plus_resp_less_both. - apply H. - apply le_n. - apply Hrecn. - intros. - apply H. - apply le_trans with (m := n). - assumption. - apply le_n_Sn. - intros. - apply H0. - apply le_trans with (m := n). - assumption. - apply le_n_Sn. - assumption. - apply lt_n_Sm_le. - assumption. + assumption. + intro. + cut (m <= n). + intro. + astepr ((Zero:OF)[+]r m). + apply plus_resp_less_both. + apply H. + apply le_n. + apply Hrecn. + intros. + apply H. + apply le_trans with (m := n). + assumption. + apply le_n_Sn. + intros. + apply H0. + apply le_trans with (m := n). + assumption. + apply le_n_Sn. + assumption. + apply lt_n_Sm_le. + assumption. intro H2. rewrite H2. astepr (r (S n)[+](Zero:OF)). apply plus_resp_less_both. - apply H0. - apply le_n. + apply H0. + apply le_n. apply bound_tk2. intros. apply H. apply le_trans with (m := n). - assumption. + assumption. apply le_n_Sn. Qed. @@ -474,13 +472,13 @@ Theorem up_bound_for_n_element : {b : OF | forall m : nat, m <= n -> r m[<]b}. Proof. intros. - exists (Hum (fun p : nat => r p[^]2[-]r p[+]Two) n). + exists (Hum (fun p : nat => r p[^]2[-]r p[+]Two) n). intros. apply trick. - intros. - apply inequality2. - intros. - apply inequality1. + intros. + apply inequality2. + intros. + apply inequality1. assumption. Qed. @@ -489,13 +487,13 @@ Lemma low_bound_for_n_element : {l : OF | forall m : nat, m <= n -> l[<]r m}. Proof. intros. - exists (Hum (fun p : nat => [--](r p[^]2)[-]r p[-]Two) n). + exists (Hum (fun p : nat => [--](r p[^]2)[-]r p[-]Two) n). intros. apply trick'. - intros. - apply inequality4. - intros. - apply inequality3. + intros. + apply inequality4. + intros. + apply inequality3. assumption. Qed. @@ -537,7 +535,7 @@ Defined. Definition seq := let (N, _) := Pcard1 in N. -Definition Pseq1 := projT2 Pcard1. +Definition Pseq1 := projT2 Pcard1. Lemma Pseq1_unfolded : forall y : OF, P y -> {m : nat | m <= card | seq m[=]y}. @@ -629,7 +627,7 @@ Proof. Assumption. Apply le_n_Sn. Assumption. -Qed. +Qed. *) Lemma bounded_quantifier_informative : @@ -639,146 +637,139 @@ Lemma bounded_quantifier_informative : Proof. do 3 intro. intro H. induction N as [| N HrecN]. - cut (phi 0 or psi 0). - intro H0. - case H0. - intros. - left. - intros. - rewrite <- (le_n_O_eq m H1). - assumption. - intro. - right. - exists 0. - constructor. - assumption. - apply H. - constructor. + cut (phi 0 or psi 0). + intro H0. + case H0. + intros. + left. + intros. + rewrite <- (le_n_O_eq m H1). + assumption. + intro. + right. + exists 0. + constructor. + assumption. + apply H. + constructor. (* n=(S n0) *) case HrecN. - intros. - apply H. - apply le_trans with (m := N). - assumption. - apply le_n_Sn. - intro. - case (H (S N)). - apply le_n. - intros. - left. - intros. - case (le_lt_eq_dec m (S N)). - assumption. - intros. - apply p. - apply (lt_n_Sm_le m N). - assumption. - intro. - rewrite e. - assumption. - intro. - right. - exists (S N). - apply toCle. - apply le_n. - assumption. + intros. + apply H. + apply le_trans with (m := N). + assumption. + apply le_n_Sn. + intro. + case (H (S N)). + apply le_n. + intros. + left. + intros. + case (le_lt_eq_dec m (S N)). + assumption. + intros. + apply p. + apply (lt_n_Sm_le m N). + assumption. + intro. + rewrite e. + assumption. + intro. + right. + exists (S N). + apply toCle. + apply le_n. + assumption. intro. right. case s. intro j. intros. exists j. - apply toCle. - apply le_trans with (m := N). - apply Cle_to. - assumption. - apply le_n_Sn. + apply toCle. + apply le_trans with (m := N). + apply Cle_to. + assumption. + apply le_n_Sn. assumption. Qed. Lemma bridges_lemma1a : l_u_b OF P. Proof. - apply (lubp P P_is_inhabited). - case is_finite_P. - intro N. - intros. - case s. - intro r. - intro. - exists (saghf r N). - red in |- *. - intros x H z H0. - apply less_transitive_unfolded with (y := x). - assumption. - case (s0 x H). - intro m. - intros H1 H2. - apply less_wdl with (x := r m). - apply Psaghf. - assumption. - assumption. - + apply (lubp P P_is_inhabited). + case is_finite_P. + intro N. + intros. + case s. + intro r. + intro. + exists (saghf r N). + red in |- *. + intros x H z H0. + apply less_transitive_unfolded with (y := x). + assumption. + case (s0 x H). + intro m. + intros H1 H2. + apply less_wdl with (x := r m). + apply Psaghf. + assumption. + assumption. (* Start of Bridges' 3-line proof *) - intros. - cut - ((forall k : nat, k <= card -> seq k[<]y) - or {j : nat | P (seq j) | x[<]seq j}). - intro H0. - case H0. + intros. + cut ((forall k : nat, k <= card -> seq k[<]y) or {j : nat | P (seq j) | x[<]seq j}). + intro H0. + case H0. intro c. left. red in |- *. intros x0 H1 z H2. apply less_transitive_unfolded with (y := x0). - assumption. + assumption. elim (Pindeks x0 H1). intros. apply less_wdl with (x := seq (indeks x0 H1)). - apply c. - assumption. - assumption. - - intro e. - right. - case e. - intro j. - intros H2 H3. - exists (seq j). + apply c. + assumption. assumption. + intro e. + right. + case e. + intro j. + intros H2 H3. + exists (seq j). assumption. - - (* proof of the claim that we cut above *) - case - (bounded_quantifier_informative card) - with (phi := fun k : nat => seq k[<]y) (psi := fun k : nat => x[<]seq k). + assumption. + (* proof of the claim that we cut above *) + case (bounded_quantifier_informative card) + with (phi := fun k : nat => seq k[<]y) (psi := fun k : nat => x[<]seq k). intros. cut (x[<]seq m or seq m[<]y). - intro H1. - case H1. - intro. - right. - assumption. - intro. - left. - assumption. - apply less_cotransitive_unfolded. - - assumption. - intros. - left. - assumption. - intro e. - right. - case e. - intro j. - intros. - exists j. - apply is_onto_seq_P. - apply Cle_to. - assumption. + intro H1. + case H1. + intro. + right. + assumption. + intro. + left. + assumption. + apply less_cotransitive_unfolded. assumption. -Qed. - + intros. + left. + assumption. + intro e. + right. + case e. + intro j. + intros. + exists j. + apply is_onto_seq_P. + apply Cle_to. + assumption. + assumption. +Qed. + Hypothesis P_is_strongly_extensional : forall x y : OF, x[=]y -> P x -> P y. @@ -787,146 +778,134 @@ Proof. intros. red in |- *. cut (l_u_b OF (fun x : OF => P [--]x)). - intro H. - red in H. - case H. - intro b. - intros p. - elim p. - intros H0 H1. - exists ([--]b). - split. - red in |- *. - red in H0. - intros x H2 z H3. - case (less_cotransitive_unfolded OF z [--]b H3 x). - trivial. - intro. - elim (less_irreflexive_unfolded _ b). - apply H0 with (x := [--]x) (z := b). - apply (P_is_strongly_extensional x [--][--]x). - algebra. - assumption. - apply inv_cancel_less. - astepl x. - assumption. - intros. - case (H1 [--]c'). - apply inv_cancel_less. - astepr c'. - assumption. - intro s. - intros H3. - elim H3. - intros. - exists ([--]s). - split. - assumption. - apply inv_cancel_less. - astepr s. - assumption. - + intro H. + red in H. + case H. + intro b. + intros p. + elim p. + intros H0 H1. + exists ([--]b). + split. + red in |- *. + red in H0. + intros x H2 z H3. + case (less_cotransitive_unfolded OF z [--]b H3 x). + trivial. + intro. + elim (less_irreflexive_unfolded _ b). + apply H0 with (x := [--]x) (z := b). + apply (P_is_strongly_extensional x [--][--]x). + algebra. + assumption. + apply inv_cancel_less. + astepl x. + assumption. + intros. + case (H1 [--]c'). + apply inv_cancel_less. + astepr c'. + assumption. + intro s. + intros H3. + elim H3. + intros. + exists ([--]s). + split. + assumption. + apply inv_cancel_less. + astepr s. + assumption. (* * * * * * * * *) - - apply (lubp (fun x : OF => P [--]x)). - case P_is_inhabited. - intro x. - intro. - exists ([--]x). - apply (P_is_strongly_extensional x [--][--]x). - algebra. - assumption. - - case is_finite_P. - intro N. - intros. - case s. - intro r. - intro. - exists (saghf (fun n : nat => [--](r n)) N). - red in |- *. - intros x H z H0. - apply less_transitive_unfolded with (y := x). - assumption. - case (s0 [--]x H). - intro m. - intros H1 H2. - apply less_wdl with (x := [--](r m)). - apply (Psaghf (fun m : nat => [--](r m))). - assumption. - rstepl ((Zero:OF)[-]r m). - rstepr ((Zero:OF)[-][--]x). - apply cg_minus_wd. - apply eq_reflexive_unfolded. - assumption. - + apply (lubp (fun x : OF => P [--]x)). + case P_is_inhabited. + intro x. + intro. + exists ([--]x). + apply (P_is_strongly_extensional x [--][--]x). + algebra. + assumption. + case is_finite_P. + intro N. + intros. + case s. + intro r. + intro. + exists (saghf (fun n : nat => [--](r n)) N). + red in |- *. + intros x H z H0. + apply less_transitive_unfolded with (y := x). + assumption. + case (s0 [--]x H). + intro m. + intros H1 H2. + apply less_wdl with (x := [--](r m)). + apply (Psaghf (fun m : nat => [--](r m))). + assumption. + rstepl ((Zero:OF)[-]r m). + rstepr ((Zero:OF)[-][--]x). + apply cg_minus_wd. + apply eq_reflexive_unfolded. + assumption. (* Start of Bridges' 3-line proof *) intros x y H. - cut - ((forall k : nat, k <= card -> [--](seq k)[<]y) - or {j : nat | P (seq j) | x[<][--](seq j)}). - intro H0. - case H0. + cut ((forall k : nat, k <= card -> [--](seq k)[<]y) or {j : nat | P (seq j) | x[<][--](seq j)}). + intro H0. + case H0. intro c. left. red in |- *. intros x0 H1 z H2. apply less_transitive_unfolded with (y := x0). - assumption. + assumption. elim (Pindeks [--]x0 H1). intros. apply less_wdl with (x := [--](seq (indeks [--]x0 H1))). - apply c. - assumption. + apply c. + assumption. rstepl ((Zero:OF)[-]seq (indeks [--]x0 H1)). rstepr ((Zero:OF)[-][--]x0). apply cg_minus_wd. - apply eq_reflexive_unfolded. + apply eq_reflexive_unfolded. assumption. - - intro e. - right. - case e. - intro j. - intros H2 H3. - exists ([--](seq j)). + intro e. + right. + case e. + intro j. + intros H2 H3. + exists ([--](seq j)). apply (P_is_strongly_extensional (seq j) [--][--](seq j)). - algebra. - assumption. + algebra. assumption. - - (* proof of the claim that we cut above *) - case - (bounded_quantifier_informative card) - with - (phi := fun k : nat => [--](seq k)[<]y) - (psi := fun k : nat => x[<][--](seq k)). + assumption. + (* proof of the claim that we cut above *) + case (bounded_quantifier_informative card) with (phi := fun k : nat => [--](seq k)[<]y) + (psi := fun k : nat => x[<][--](seq k)). intros. cut (x[<][--](seq m) or [--](seq m)[<]y). - intro H1. - case H1. - intro. - right. - assumption. - intro. - left. - assumption. - apply less_cotransitive_unfolded. - - assumption. - intros. - left. - assumption. - intro e. - right. - case e. - intro j. - intros. - exists j. - apply is_onto_seq_P. - apply Cle_to. - assumption. + intro H1. + case H1. + intro. + right. + assumption. + intro. + left. + assumption. + apply less_cotransitive_unfolded. assumption. + intros. + left. + assumption. + intro e. + right. + case e. + intro j. + intros. + exists j. + apply is_onto_seq_P. + apply Cle_to. + assumption. + assumption. Qed. @@ -964,7 +943,7 @@ Proof. intro n. intros. exists n. - assumption. + assumption. apply eq_symmetric_unfolded. assumption. Defined. @@ -993,167 +972,160 @@ Lemma bridges_lemma2a : l_u_b OF (seq2set g). Proof. intros. apply (lubp (seq2set g)). - (* it is inhabited *) - exists (g_ 0). - red in |- *. - exists 0. - apply eq_reflexive_unfolded. - (* it is bounded above *) - cut {N : nat | forall m : nat, N <= m -> AbsSmall One (g_ m[-]g_ N)}. - intro H. - case H. - intro N. - intro. - exists (saghf g_ N[+]One). - red in |- *. - intros x H0 y H1. - red in H0. - case H0. - intro n. - intro c. - apply less_transitive_unfolded with (y := x). - assumption. - apply less_wdl with (x := g_ n). - case (le_ge_dec N n). - intro H2. - apply leEq_less_trans with (y := g_ N[+]One). - apply shift_leEq_plus'. - cut (AbsSmall One (g_ n[-]g_ N)). - intro. - elim H3. - intros H4 H5. - assumption. - apply a. - assumption. - apply plus_resp_less_rht. - apply Psaghf. - apply le_n. - intro H2. - apply less_transitive_unfolded with (y := saghf g_ N). - apply Psaghf. - assumption. - apply less_plusOne. - apply eq_symmetric_unfolded. - exact c. - apply (pg One). - apply pos_one. - + (* it is inhabited *) + exists (g_ 0). + red in |- *. + exists 0. + apply eq_reflexive_unfolded. + (* it is bounded above *) + cut {N : nat | forall m : nat, N <= m -> AbsSmall One (g_ m[-]g_ N)}. + intro H. + case H. + intro N. + intro. + exists (saghf g_ N[+]One). + red in |- *. + intros x H0 y H1. + red in H0. + case H0. + intro n. + intro c. + apply less_transitive_unfolded with (y := x). + assumption. + apply less_wdl with (x := g_ n). + case (le_ge_dec N n). + intro H2. + apply leEq_less_trans with (y := g_ N[+]One). + apply shift_leEq_plus'. + cut (AbsSmall One (g_ n[-]g_ N)). + intro. + elim H3. + intros H4 H5. + assumption. + apply a. + assumption. + apply plus_resp_less_rht. + apply Psaghf. + apply le_n. + intro H2. + apply less_transitive_unfolded with (y := saghf g_ N). + apply Psaghf. + assumption. + apply less_plusOne. + apply eq_symmetric_unfolded. + exact c. + apply (pg One). + apply pos_one. (* This is the proof of Proposition 1 of Bridges *) intros a b. intro. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall ((b[-]a) [/]TwoNZ) (g_ m[-]g_ N)}. - intro H0. - case H0. - intro N. - intros. - cut (l_u_b OF (fun x : OF => {n : nat | n <= N | x[=]g_ n})). - intro H1. - red in H1. - case H1. - intro sigma. - intros p. - elim p. - intros. - cut (a[<](a[+]b) [/]TwoNZ). - intro H2. - case (less_cotransitive_unfolded _ a ((a[+]b) [/]TwoNZ) H2 sigma). - intro c. - right. - case (b0 a c). - intro xj. - intro H5. - exists xj. - elim H5. - intros H6 H7. - case H6. - intro j. - intros H9 H10. - red in |- *. - exists j. - simpl in |- *. - assumption. - elim H5. - intros. - assumption. - - intro. - left. - red in |- *. - intros x H3 z H4. - red in H3. - case H3. - intro n. + cut {N : nat | forall m : nat, N <= m -> AbsSmall ((b[-]a) [/]TwoNZ) (g_ m[-]g_ N)}. + intro H0. + case H0. + intro N. intros. - case (le_ge_dec N n). - intro H7. - rstepr (a[+](b[-]a)). - apply less_transitive_unfolded with (y := sigma[+](b[-]a) [/]TwoNZ). - apply shift_less_plus. - apply (a1 (g_ N)). - exists N. - apply le_n. - apply eq_reflexive_unfolded. - apply shift_minus_less. - apply less_leEq_trans with (y := x). - assumption. - apply leEq_wdl with (x := g_ n). - apply shift_leEq_plus'. - cut (AbsSmall ((b[-]a) [/]TwoNZ) (g_ n[-]g_ N)). - intro H8. - elim H8. - intros H9 H10. - assumption. - apply a0. - assumption. - apply eq_symmetric_unfolded. - assumption. - apply shift_plus_less. - rstepr ((a[+]b) [/]TwoNZ). - assumption. - - intro. - rstepr (a[+](b[-]a)). - apply less_transitive_unfolded with (y := sigma[+](b[-]a) [/]TwoNZ). - apply shift_less_plus. - apply (a1 x). - exists n. - assumption. - assumption. - apply shift_minus_less. - apply less_transitive_unfolded with (y := x). - assumption. - apply shift_less_plus'. - astepl (Zero:OF). - apply pos_div_two. - apply shift_zero_less_minus. - assumption. - apply shift_plus_less. - rstepr ((a[+]b) [/]TwoNZ). - assumption. + cut (l_u_b OF (fun x : OF => {n : nat | n <= N | x[=]g_ n})). + intro H1. + red in H1. + case H1. + intro sigma. + intros p. + elim p. + intros. + cut (a[<](a[+]b) [/]TwoNZ). + intro H2. + case (less_cotransitive_unfolded _ a ((a[+]b) [/]TwoNZ) H2 sigma). + intro c. + right. + case (b0 a c). + intro xj. + intro H5. + exists xj. + elim H5. + intros H6 H7. + case H6. + intro j. + intros H9 H10. + red in |- *. + exists j. + simpl in |- *. + assumption. + elim H5. + intros. + assumption. + intro. + left. + red in |- *. + intros x H3 z H4. + red in H3. + case H3. + intro n. + intros. + case (le_ge_dec N n). + intro H7. + rstepr (a[+](b[-]a)). + apply less_transitive_unfolded with (y := sigma[+](b[-]a) [/]TwoNZ). + apply shift_less_plus. + apply (a1 (g_ N)). + exists N. + apply le_n. + apply eq_reflexive_unfolded. + apply shift_minus_less. + apply less_leEq_trans with (y := x). + assumption. + apply leEq_wdl with (x := g_ n). + apply shift_leEq_plus'. + cut (AbsSmall ((b[-]a) [/]TwoNZ) (g_ n[-]g_ N)). + intro H8. + elim H8. + intros H9 H10. + assumption. + apply a0. + assumption. + apply eq_symmetric_unfolded. + assumption. + apply shift_plus_less. + rstepr ((a[+]b) [/]TwoNZ). + assumption. + intro. + rstepr (a[+](b[-]a)). + apply less_transitive_unfolded with (y := sigma[+](b[-]a) [/]TwoNZ). + apply shift_less_plus. + apply (a1 x). + exists n. + assumption. + assumption. + apply shift_minus_less. + apply less_transitive_unfolded with (y := x). + assumption. + apply shift_less_plus'. + astepl (Zero:OF). + apply pos_div_two. + apply shift_zero_less_minus. + assumption. + apply shift_plus_less. + rstepr ((a[+]b) [/]TwoNZ). + assumption. apply plus_cancel_less with (z := [--]a). rstepl (Zero:OF). rstepr ((b[-]a) [/]TwoNZ). apply pos_div_two. apply shift_zero_less_minus. assumption. - - - apply bridges_lemma1a with (P := P N) (is_finite_P := fin_is_fin N). - intros. - unfold P in |- *. - exists t. - rewrite <- (card_fin N). - assumption. - apply (finite_seq N). + apply bridges_lemma1a with (P := P N) (is_finite_P := fin_is_fin N). + intros. + unfold P in |- *. + exists t. + rewrite <- (card_fin N). + assumption. + apply (finite_seq N). apply (pg ((b[-]a) [/]TwoNZ)). apply pos_div_two. apply shift_zero_less_minus. assumption. Qed. -Definition sup := let (N, _) := bridges_lemma2a in N. +Definition sup := let (N, _) := bridges_lemma2a in N. Definition Psup := projT2 bridges_lemma2a. @@ -1171,7 +1143,7 @@ Proof. change (is_upper_bound OF (seq2set g) sup) in |- *. exact Psup_proj1. Qed. - + Lemma Psup_unfolded2 : forall b' : OF, b'[<]sup -> {s : OF | seq2set g s | b'[<]s}. Proof. @@ -1181,196 +1153,189 @@ Proof. intros. rename X into H. elim (b b' H); intros x p; elim p; exists x; auto. Qed. - + Lemma bridges_lemma2b : g_l_b OF (seq2set g). -Proof. +Proof. intros. apply (glbp (seq2set g)). - (* it is inhabited *) - exists (g_ 0). - red in |- *. - exists 0. - apply eq_reflexive_unfolded. - (* it is bounded below *) - cut {N : nat | forall m : nat, N <= m -> AbsSmall One (g_ m[-]g_ N)}. - intro H. - case H. - intro N. - intros. - exists (kaf g_ N[-]One). - red in |- *. - intros x H0 z H1. - case H0. - intro n. - intros c. - apply less_wdr with (y := g_ n). - case (le_ge_dec N n). - intro. - apply less_leEq_trans with (y := g_ N[-]One). - apply less_transitive_unfolded with (y := kaf g_ N[-]One). - assumption. - apply minus_resp_less. - apply Pkaf. - apply le_n. - apply plus_cancel_leEq_rht with (z := [--](g_ N)). - rstepl ([--](One:OF)). - astepr (g_ n[-]g_ N). - cut (AbsSmall One (g_ n[-]g_ N)). - intro. - elim H2. - intros. - assumption. - apply a. - assumption. - intro. - apply less_transitive_unfolded with (y := kaf g_ N[-]One). - assumption. - apply less_transitive_unfolded with (y := kaf g_ N). - apply plus_cancel_less with (z := One:OF). - astepl (kaf g_ N). - apply less_plusOne. - apply Pkaf. - assumption. - apply eq_symmetric_unfolded. - exact c. - (* Here we are using ex_informative *) - apply (pg One). - apply pos_one. - (* it is strongly extensional *) - intros x y H H0. - red in |- *. - red in H0. - case H0. - intro n. - intros. - exists n. - apply eq_transitive_unfolded with (y := x). - apply eq_symmetric_unfolded. - assumption. - assumption. - (* This is the proof of Proposition 1 of Bridges for infimum *) - intros a b. - intro. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall ((b[-]a) [/]TwoNZ) (g_ m[-]g_ N)}. - intro H0. - case H0. - intro N. - intros. - cut (g_l_b OF (fun x : OF => {n : nat | n <= N | x[=]g_ n})). - intro H1. - red in H1. - case H1. - intro tau. - intros p. - elim p. - intros. - cut ((a[+]b) [/]TwoNZ[<]b). - intro H2. - case (less_cotransitive_unfolded _ ((a[+]b) [/]TwoNZ) b H2 tau). - intro. - left. + (* it is inhabited *) + exists (g_ 0). + red in |- *. + exists 0. + apply eq_reflexive_unfolded. + (* it is bounded below *) + cut {N : nat | forall m : nat, N <= m -> AbsSmall One (g_ m[-]g_ N)}. + intro H. + case H. + intro N. + intros. + exists (kaf g_ N[-]One). + red in |- *. + intros x H0 z H1. + case H0. + intro n. + intros c. + apply less_wdr with (y := g_ n). + case (le_ge_dec N n). + intro. + apply less_leEq_trans with (y := g_ N[-]One). + apply less_transitive_unfolded with (y := kaf g_ N[-]One). + assumption. + apply minus_resp_less. + apply Pkaf. + apply le_n. + apply plus_cancel_leEq_rht with (z := [--](g_ N)). + rstepl ([--](One:OF)). + astepr (g_ n[-]g_ N). + cut (AbsSmall One (g_ n[-]g_ N)). + intro. + elim H2. + intros. + assumption. + apply a. + assumption. + intro. + apply less_transitive_unfolded with (y := kaf g_ N[-]One). + assumption. + apply less_transitive_unfolded with (y := kaf g_ N). + apply plus_cancel_less with (z := One:OF). + astepl (kaf g_ N). + apply less_plusOne. + apply Pkaf. + assumption. + apply eq_symmetric_unfolded. + exact c. + (* Here we are using ex_informative *) + apply (pg One). + apply pos_one. + (* it is strongly extensional *) + intros x y H H0. red in |- *. - intros x H3 z H4. - red in H3. - case H3. + red in H0. + case H0. intro n. - intros H7. - case (le_ge_dec N n). - intro. - red in a1. - apply less_wdr with (y := g_ n). - apply less_leEq_trans with (y := g_ N[-](b[-]a) [/]TwoNZ). - apply shift_less_minus. - apply (a1 (g_ N)). - exists N. - apply le_n. - apply eq_reflexive_unfolded. - apply less_transitive_unfolded with (y := (a[+]b) [/]TwoNZ). - apply shift_plus_less. - rstepr a. - assumption. - assumption. - cut (AbsSmall ((b[-]a) [/]TwoNZ) (g_ n[-]g_ N)). - intro H8. - elim H8. - intros H9 H10. - apply shift_minus_leEq. - apply shift_leEq_plus'. - apply inv_cancel_leEq. - rstepr (g_ n[-]g_ N). - assumption. - apply a0. - assumption. + intros. + exists n. + apply eq_transitive_unfolded with (y := x). apply eq_symmetric_unfolded. assumption. - - intro. - apply less_transitive_unfolded with (y := z[+](b[-]a) [/]TwoNZ). - apply plus_cancel_less with (z := [--]z). + assumption. + (* This is the proof of Proposition 1 of Bridges for infimum *) + intros a b. + intro. + cut {N : nat | forall m : nat, N <= m -> AbsSmall ((b[-]a) [/]TwoNZ) (g_ m[-]g_ N)}. + intro H0. + case H0. + intro N. + intros. + cut (g_l_b OF (fun x : OF => {n : nat | n <= N | x[=]g_ n})). + intro H1. + red in H1. + case H1. + intro tau. + intros p. + elim p. + intros. + cut ((a[+]b) [/]TwoNZ[<]b). + intro H2. + case (less_cotransitive_unfolded _ ((a[+]b) [/]TwoNZ) b H2 tau). + intro. + left. + red in |- *. + intros x H3 z H4. + red in H3. + case H3. + intro n. + intros H7. + case (le_ge_dec N n). + intro. + red in a1. + apply less_wdr with (y := g_ n). + apply less_leEq_trans with (y := g_ N[-](b[-]a) [/]TwoNZ). + apply shift_less_minus. + apply (a1 (g_ N)). + exists N. + apply le_n. + apply eq_reflexive_unfolded. + apply less_transitive_unfolded with (y := (a[+]b) [/]TwoNZ). + apply shift_plus_less. + rstepr a. + assumption. + assumption. + cut (AbsSmall ((b[-]a) [/]TwoNZ) (g_ n[-]g_ N)). + intro H8. + elim H8. + intros H9 H10. + apply shift_minus_leEq. + apply shift_leEq_plus'. + apply inv_cancel_leEq. + rstepr (g_ n[-]g_ N). + assumption. + apply a0. + assumption. + apply eq_symmetric_unfolded. + assumption. + intro. + apply less_transitive_unfolded with (y := z[+](b[-]a) [/]TwoNZ). + apply plus_cancel_less with (z := [--]z). + rstepl (Zero:OF). + rstepr ((b[-]a) [/]TwoNZ). + apply pos_div_two. + apply shift_zero_less_minus. + assumption. + apply (a1 x). + exists n. + assumption. + assumption. + apply less_transitive_unfolded with (y := (a[+]b) [/]TwoNZ). + apply shift_plus_less. + rstepr a. + assumption. + assumption. + right. + case (b0 b c). + intro xj. + intro p0. + exists xj. + elim p0. + intros H6 H7. + case H6. + intro j. + intros H9 H10. + red in |- *. + exists j. + simpl in |- *. + assumption. + elim p0. + intros. + assumption. + apply plus_cancel_less with (z := [--]((a[+]b) [/]TwoNZ)). rstepl (Zero:OF). rstepr ((b[-]a) [/]TwoNZ). - apply pos_div_two. + apply pos_div_two. apply shift_zero_less_minus. assumption. - apply (a1 x). - exists n. - assumption. - assumption. - apply less_transitive_unfolded with (y := (a[+]b) [/]TwoNZ). - apply shift_plus_less. - rstepr a. + apply bridges_lemma1b with (P := P N) (is_finite_P := fin_is_fin N). + intros. + unfold P in |- *. + exists t. + rewrite <- (card_fin N). + assumption. + apply (finite_seq N). + unfold P in |- *. + intros x H1 z H2. + case H2. + intro n. + intros. + exists n. + intros. assumption. + apply eq_transitive_unfolded with (y := x). + apply eq_symmetric_unfolded. assumption. - - right. - case (b0 b c). - intro xj. - intro p0. - exists xj. - elim p0. - intros H6 H7. - case H6. - intro j. - intros H9 H10. - red in |- *. - exists j. - simpl in |- *. assumption. - elim p0. - intros. - assumption. - - apply plus_cancel_less with (z := [--]((a[+]b) [/]TwoNZ)). - rstepl (Zero:OF). - rstepr ((b[-]a) [/]TwoNZ). - apply pos_div_two. - apply shift_zero_less_minus. - assumption. - - - apply bridges_lemma1b with (P := P N) (is_finite_P := fin_is_fin N). - intros. - unfold P in |- *. - exists t. - rewrite <- (card_fin N). - assumption. - apply (finite_seq N). - unfold P in |- *. - intros x H1 z H2. - case H2. - intro n. - intros. - exists n. - intros. - assumption. - apply eq_transitive_unfolded with (y := x). - apply eq_symmetric_unfolded. - assumption. - assumption. apply (pg ((b[-]a) [/]TwoNZ)). apply pos_div_two. apply shift_zero_less_minus. @@ -1379,7 +1344,7 @@ Qed. -Definition inf := let (N, _) := bridges_lemma2b in N. +Definition inf := let (N, _) := bridges_lemma2b in N. Definition Pinf := ProjT2 bridges_lemma2b. @@ -1416,21 +1381,21 @@ Proof. rewrite leEq_def; intro. apply (less_irreflexive_unfolded _ sup). apply (Psup_unfolded1 (g_ n)). - red in |- *. - exists n. - apply eq_reflexive_unfolded. + red in |- *. + exists n. + apply eq_reflexive_unfolded. assumption. Qed. Lemma inf_geEq : forall n : nat, inf[<=]g_ n. Proof. intros. - rewrite leEq_def; intro. + rewrite leEq_def; intro. apply (less_irreflexive_unfolded _ (g_ n)). apply (Pinf_unfolded1 (g_ n)). - red in |- *. - exists n. - apply eq_reflexive_unfolded. + red in |- *. + exists n. + apply eq_reflexive_unfolded. assumption. Qed. @@ -1441,8 +1406,8 @@ Proof. red in |- *. intros. case (pg (e [/]TwoNZ)). - apply pos_div_two. - assumption. + apply pos_div_two. + assumption. intro N. intros. exists N. @@ -1450,10 +1415,10 @@ Proof. rstepr (g_ (n + m)[-]g_ N[+](g_ N[-]g_ (n + N))). rstepl (e [/]TwoNZ[+]e [/]TwoNZ). apply AbsSmall_plus. - apply a. - apply le_trans with (m := m). - assumption. - apply le_plus_r. + apply a. + apply le_trans with (m := m). + assumption. + apply le_plus_r. apply AbsSmall_minus. apply a. apply le_plus_r. @@ -1485,7 +1450,7 @@ Proof. intro k. intro. apply leEq_wdl with (x := tail_seq g N k). - apply sup_leEq. + apply sup_leEq. simpl in |- *. rewrite e. apply eq_reflexive_unfolded. @@ -1496,91 +1461,90 @@ Lemma sup_tail_is_Cauchy : Cauchy_prop (fun m : nat => sup_tail m). Proof. red in |- *. intros. - cut - {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (g_ m[-]g_ N)}. - intros H0. - case H0. - intro N. - intros. - exists N. - intros. - split. - (* I *) - apply inv_cancel_leEq. - rstepl (sup_tail N[-]sup_tail m). - rstepr e. - rewrite leEq_def; intro. - apply (less_irreflexive_unfolded _ e). - case (Psup_unfolded2 (tail_seq g N) (sup_tail m[+]e)). - change (sup_tail m[+]e[<]sup_tail N) in |- *. - apply shift_plus_less'. - assumption. - intro xj. - intros H4 H5. - red in H4. - case H4. - intro j. - intros. - apply less_leEq_trans with (y := g_ (N + j)[-]g_ m). - apply shift_less_minus. - apply shift_plus_less'. - apply leEq_less_trans with (y := sup_tail m). - apply sup_tail_leEq. - apply le_n. - apply shift_less_minus. - apply less_wdr with (y := xj). - assumption. - assumption. - cut (AbsSmall e (g_ (N + j)[-]g_ m)). - intro H7. - elim H7. - intros H8 H9. - assumption. - rstepr (g_ (N + j)[-]g_ N[+](g_ N[-]g_ m)). - rstepl (e [/]TwoNZ[+]e [/]TwoNZ). - apply AbsSmall_plus. - apply a. - apply le_plus_l. - apply AbsSmall_minus. - apply a. - assumption. - (* II *) - apply less_leEq. - apply leEq_less_trans with (y := e [/]TwoNZ). - rewrite leEq_def. - intro. - apply (less_irreflexive_unfolded _ (e [/]TwoNZ)). - case (Psup_unfolded2 (tail_seq g m) (sup_tail N[+]e [/]TwoNZ)). - change (sup_tail N[+]e [/]TwoNZ[<]sup_tail m) in |- *. - apply shift_plus_less'. - assumption. - intro xj. - intros H4 H5. - red in H4. - case H4. - intro j. - intros. - apply less_leEq_trans with (y := g_ (m + j)[-]g_ N). - apply shift_less_minus. - apply shift_plus_less'. - apply leEq_less_trans with (y := sup_tail N). - apply sup_tail_leEq. - apply le_n. - apply shift_less_minus. - apply less_wdr with (y := xj). - assumption. - assumption. - cut (AbsSmall (e [/]TwoNZ) (g_ (m + j)[-]g_ N)). - intro H7. - elim H7. - intros. - assumption. - apply a. - apply le_trans with (m := m). - assumption. - apply le_plus_l. - apply pos_div_two'. - assumption. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (g_ m[-]g_ N)}. + intros H0. + case H0. + intro N. + intros. + exists N. + intros. + split. + (* I *) + apply inv_cancel_leEq. + rstepl (sup_tail N[-]sup_tail m). + rstepr e. + rewrite leEq_def; intro. + apply (less_irreflexive_unfolded _ e). + case (Psup_unfolded2 (tail_seq g N) (sup_tail m[+]e)). + change (sup_tail m[+]e[<]sup_tail N) in |- *. + apply shift_plus_less'. + assumption. + intro xj. + intros H4 H5. + red in H4. + case H4. + intro j. + intros. + apply less_leEq_trans with (y := g_ (N + j)[-]g_ m). + apply shift_less_minus. + apply shift_plus_less'. + apply leEq_less_trans with (y := sup_tail m). + apply sup_tail_leEq. + apply le_n. + apply shift_less_minus. + apply less_wdr with (y := xj). + assumption. + assumption. + cut (AbsSmall e (g_ (N + j)[-]g_ m)). + intro H7. + elim H7. + intros H8 H9. + assumption. + rstepr (g_ (N + j)[-]g_ N[+](g_ N[-]g_ m)). + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_plus. + apply a. + apply le_plus_l. + apply AbsSmall_minus. + apply a. + assumption. + (* II *) + apply less_leEq. + apply leEq_less_trans with (y := e [/]TwoNZ). + rewrite leEq_def. + intro. + apply (less_irreflexive_unfolded _ (e [/]TwoNZ)). + case (Psup_unfolded2 (tail_seq g m) (sup_tail N[+]e [/]TwoNZ)). + change (sup_tail N[+]e [/]TwoNZ[<]sup_tail m) in |- *. + apply shift_plus_less'. + assumption. + intro xj. + intros H4 H5. + red in H4. + case H4. + intro j. + intros. + apply less_leEq_trans with (y := g_ (m + j)[-]g_ N). + apply shift_less_minus. + apply shift_plus_less'. + apply leEq_less_trans with (y := sup_tail N). + apply sup_tail_leEq. + apply le_n. + apply shift_less_minus. + apply less_wdr with (y := xj). + assumption. + assumption. + cut (AbsSmall (e [/]TwoNZ) (g_ (m + j)[-]g_ N)). + intro H7. + elim H7. + intros. + assumption. + apply a. + apply le_trans with (m := m). + assumption. + apply le_plus_l. + apply pos_div_two'. + assumption. apply pg. apply pos_div_two. assumption. @@ -1596,9 +1560,9 @@ Lemma sup_tail_decrease : forall m n : nat, m <= n -> sup_tail n[<=]sup_tail m. Proof. intros. - rewrite leEq_def; intro. + rewrite leEq_def; intro. case (Psup_unfolded2 (tail_seq g n) (sup_tail m)). - assumption. + assumption. intro xj. intros H2 H3. red in H2. @@ -1607,14 +1571,14 @@ Proof. intros. apply (less_irreflexive_unfolded _ xj). apply leEq_less_trans with (y := sup_tail m). - apply leEq_wdl with (x := CS_seq OF (tail_seq g n) j). - simpl in |- *. - apply sup_tail_leEq. - apply le_trans with (m := n). - assumption. - apply le_plus_l. - apply eq_symmetric_unfolded. - assumption. + apply leEq_wdl with (x := CS_seq OF (tail_seq g n) j). + simpl in |- *. + apply sup_tail_leEq. + apply le_trans with (m := n). + assumption. + apply le_plus_l. + apply eq_symmetric_unfolded. + assumption. assumption. Qed. @@ -1652,10 +1616,10 @@ Lemma convergent_subseq : Proof. intros. case (Pinf_unfolded2_informative sup_tail_as_Cauchy (L[+]one_div_succ k)). - change (L[<]L[+]one_div_succ k) in |- *. - apply shift_less_plus'. - rstepl (Zero:OF). - apply one_div_succ_pos. + change (L[<]L[+]one_div_succ k) in |- *. + apply shift_less_plus'. + rstepl (Zero:OF). + apply one_div_succ_pos. intro sN. intros. red in s. @@ -1663,39 +1627,39 @@ Proof. intro N. intros c0. case (Psup_unfolded2_informative (tail_seq g (k + N)) (L[-]one_div_succ k)). - apply less_leEq_trans with (y := L). - apply shift_minus_less. - apply shift_less_plus'. - rstepl (Zero:OF). - apply one_div_succ_pos. - change (L[<=]sup_tail (k + N)) in |- *. - apply L_less_sup_n. + apply less_leEq_trans with (y := L). + apply shift_minus_less. + apply shift_less_plus'. + rstepl (Zero:OF). + apply one_div_succ_pos. + change (L[<=]sup_tail (k + N)) in |- *. + apply L_less_sup_n. intro xj. intros. case s0. intro j. intros. exists (k + N + j). - apply le_trans with (m := k + N). - apply le_plus_l. - apply le_plus_l. + apply le_trans with (m := k + N). + apply le_plus_l. + apply le_plus_l. split. - apply shift_leEq_minus. - rstepl (L[-]one_div_succ k). - apply leEq_wdr with (y := xj). - apply less_leEq; assumption. - assumption. + apply shift_leEq_minus. + rstepl (L[-]one_div_succ k). + apply leEq_wdr with (y := xj). + apply less_leEq; assumption. + assumption. apply shift_minus_leEq. apply leEq_transitive with (y := sN). - change (CS_seq OF (tail_seq g (k + N)) j[<=]sN) in |- *. - apply leEq_transitive with (y := sup (tail_seq g (k + N))). - apply sup_leEq. - apply leEq_wdr with (y := sup (tail_seq g N)). - change (sup_tail (k + N)[<=]sup_tail N) in |- *. - apply sup_tail_decrease. - apply le_plus_r. - apply eq_symmetric_unfolded. - assumption. + change (CS_seq OF (tail_seq g (k + N)) j[<=]sN) in |- *. + apply leEq_transitive with (y := sup (tail_seq g (k + N))). + apply sup_leEq. + apply leEq_wdr with (y := sup (tail_seq g N)). + change (sup_tail (k + N)[<=]sup_tail N) in |- *. + apply sup_tail_decrease. + apply le_plus_r. + apply eq_symmetric_unfolded. + assumption. apply less_leEq. astepr (L[+]one_div_succ k); auto. Qed. @@ -1704,7 +1668,7 @@ Qed. -(* very elegant proof almost as short as text version! *) +(* very elegant proof almost as short as text version! *) Theorem lubp_gives_Cauchy : SeqLimit g L. Proof. red in |- *. @@ -1713,11 +1677,11 @@ Proof. intro k. intros. case (pg (e [/]FourNZ)). - apply div_resp_pos. - apply pos_four. - assumption. + apply div_resp_pos. + apply pos_four. + assumption. intro N1. - intros. + intros. case (convergent_subseq (N1 + k)). intro Nk. intros. @@ -1725,45 +1689,44 @@ Proof. intros. exists Nk. intros. - change (AbsSmall e (g_ m[-]L)) in |- *. + change (AbsSmall e (g_ m[-]L)) in |- *. rstepl (e [/]TwoNZ[+]e [/]TwoNZ). rstepr (g_ m[-]g_ Nk[+](g_ Nk[-]L)). apply AbsSmall_plus. - rstepl (e [/]FourNZ[+]e [/]FourNZ). - rstepr (g_ m[-]g_ N1[+](g_ N1[-]g_ Nk)). - apply AbsSmall_plus. - apply a. - apply le_trans with (m := Nk). - apply le_trans with (m := N1 + k). - apply le_plus_l. - assumption. - assumption. - apply AbsSmall_minus. - apply a. - apply le_trans with (m := N1 + k). - apply le_plus_l. - assumption. + rstepl (e [/]FourNZ[+]e [/]FourNZ). + rstepr (g_ m[-]g_ N1[+](g_ N1[-]g_ Nk)). + apply AbsSmall_plus. + apply a. + apply le_trans with (m := Nk). + apply le_trans with (m := N1 + k). + apply le_plus_l. + assumption. + assumption. + apply AbsSmall_minus. + apply a. + apply le_trans with (m := N1 + k). + apply le_plus_l. + assumption. apply AbsSmall_leEq_trans with (e1 := one_div_succ (R:=OF) (N1 + k)). - unfold one_div_succ in |- *. - unfold Snring in |- *. - apply shift_div_leEq. - apply pos_nring_S. - cut (e [/]TwoNZ[#]Zero). - intro H3. - apply shift_leEq_mult' with H3. - apply pos_div_two. - assumption. - rstepl (Two[/] e[//]Greater_imp_ap _ e Zero H). - change ((Two[/] e[//]Greater_imp_ap OF e Zero H)[<=]nring (N1 + k)[+]One) - in |- *. - apply shift_leEq_plus. - apply leEq_transitive with (y := nring (R:=OF) k). - apply less_leEq; assumption. - apply nring_leEq. - apply le_plus_r. - apply Greater_imp_ap. - apply pos_div_two. - assumption. + unfold one_div_succ in |- *. + unfold Snring in |- *. + apply shift_div_leEq. + apply pos_nring_S. + cut (e [/]TwoNZ[#]Zero). + intro H3. + apply shift_leEq_mult' with H3. + apply pos_div_two. + assumption. + rstepl (Two[/] e[//]Greater_imp_ap _ e Zero H). + change ((Two[/] e[//]Greater_imp_ap OF e Zero H)[<=]nring (N1 + k)[+]One) in |- *. + apply shift_leEq_plus. + apply leEq_transitive with (y := nring (R:=OF) k). + apply less_leEq; assumption. + apply nring_leEq. + apply le_plus_r. + apply Greater_imp_ap. + apply pos_div_two. + assumption. assumption. Qed. diff --git a/reals/CMetricFields.v b/reals/CMetricFields.v index 0fa7b4707..fd92ad1fc 100644 --- a/reals/CMetricFields.v +++ b/reals/CMetricFields.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CReals1. @@ -41,12 +41,12 @@ Section CMetric_Fields. (** * Metric Fields *) -Record is_CMetricField (F : CField) (abs : CSetoid_fun F IR) : Prop := +Record is_CMetricField (F : CField) (abs : CSetoid_fun F IR) : Prop := {ax_abs_gt_zero : forall x : F, Zero [<=] abs x; ax_abs_resp_mult : forall x y : F, abs (x[*]y) [=] abs x[*]abs y; ax_abs_triangle : forall x y : F, abs (x[+]y) [<=] abs x[+]abs y}. -Record CMetricField : Type := +Record CMetricField : Type := {cmf_crr :> CField; cmf_abs : CSetoid_fun cmf_crr IR; cmf_proof : is_CMetricField cmf_crr cmf_abs}. @@ -58,103 +58,90 @@ Section basics. Lemma MAbs_one : forall F : CMetricField, {MAbs (One:F) [=] Zero} + {MAbs (One:F) [=] One}. -intro F. -apply square_id. -astepl (cmf_abs F One[*]cmf_abs F One). -astepl (cmf_abs F (One[*]One)). -astepl (cmf_abs F One). -apply eq_reflexive. -apply ax_abs_resp_mult. -apply cmf_proof. +Proof. + intro F. + apply square_id. + astepl (cmf_abs F One[*]cmf_abs F One). + astepl (cmf_abs F (One[*]One)). + astepl (cmf_abs F One). + apply eq_reflexive. + apply ax_abs_resp_mult. + apply cmf_proof. Qed. Lemma MAbs_one_recip_one : forall F : CMetricField, MAbs (One:F) [=] MAbs ( [--]One:F). -intro F. -cut ({cmf_abs F (One:F) [=] Zero} + {cmf_abs F (One:F) [=] One}). -intro H. -elim H. -intro H2. -astepl ZeroR. -astepr (cmf_abs F ( [--]One[*]One)). -astepr (cmf_abs F [--]One[*]cmf_abs F One). -astepr (cmf_abs F [--]One[*]Zero). -astepr ZeroR. -apply eq_reflexive_unfolded. - -apply eq_symmetric_unfolded. -apply ax_abs_resp_mult. - -apply cmf_proof. - -intro H1. -cut - (cmf_abs F [--]One [=] cmf_abs F One - or cmf_abs F [--]One [=] [--] (cmf_abs F One)). -intro H2. -elim H2. -intro H3. -apply eq_symmetric_unfolded. -exact H3. - -intro H3. - -(* begin hide *) -Lemma Hulp : - forall F : CMetricField, - cmf_abs F One [=] One -> cmf_abs F [--]One [=] [--] (cmf_abs F One) -> False. -intros F G H. -set (H0 := ax_abs_gt_zero) in *. -generalize H0. -intro H1. -set (H2 := H1 F (cmf_abs F) (cmf_proof F) [--] (One:F)) in *. -rewrite -> leEq_def in H2. -apply H2. -astepl ( [--] (cmf_abs F One)). -astepl ( [--]OneR). -apply plus_cancel_less with OneR. -astepl ZeroR. -astepr OneR. -apply pos_one. +Proof. + intro F. + cut ({cmf_abs F (One:F) [=] Zero} + {cmf_abs F (One:F) [=] One}). + intro H. + elim H. + intro H2. + astepl ZeroR. + astepr (cmf_abs F ( [--]One[*]One)). + astepr (cmf_abs F [--]One[*]cmf_abs F One). + astepr (cmf_abs F [--]One[*]Zero). + astepr ZeroR. + apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded. + apply ax_abs_resp_mult. + apply cmf_proof. + intro H1. + cut (cmf_abs F [--]One [=] cmf_abs F One or cmf_abs F [--]One [=] [--] (cmf_abs F One)). + intro H2. + elim H2. + intro H3. + apply eq_symmetric_unfolded. + exact H3. + intro H3. + (* begin hide *) + Lemma Hulp : forall F : CMetricField, + cmf_abs F One [=] One -> cmf_abs F [--]One [=] [--] (cmf_abs F One) -> False. + intros F G H. + set (H0 := ax_abs_gt_zero) in *. + generalize H0. + intro H1. + set (H2 := H1 F (cmf_abs F) (cmf_proof F) [--] (One:F)) in *. + rewrite -> leEq_def in H2. + apply H2. + astepl ( [--] (cmf_abs F One)). + astepl ( [--]OneR). + apply plus_cancel_less with OneR. + astepl ZeroR. + astepr OneR. + apply pos_one. Qed. (* begin hide *) simpl in |- *. -set (H4 := Hulp F H1 H3) in *. -intuition. - -apply cond_square_eq. -apply ap_symmetric_unfolded. -apply less_imp_ap. -apply pos_two. - -astepl OneR. -algebra. - -astepl (cmf_abs F [--]One[*]cmf_abs F [--]One). -astepl (cmf_abs F ( [--]One[*][--]One)). -2: apply ax_abs_resp_mult. -2: apply cmf_proof. - -astepl (cmf_abs F One). -2: apply csf_wd. -2: astepl ( [--] ((One:F) [*][--]One)). -2: astepl ( [--] ( [--] (One:F) [*]One)). -2: astepl ( [--][--] ((One:F) [*]One)). -2: astepl ((One:F) [*]One). -2: algebra. - -astepl (cmf_abs F (One[*]One)). -astepl (cmf_abs F One[*]cmf_abs F One). -2: apply eq_symmetric_unfolded. -2: apply ax_abs_resp_mult. -2: apply cmf_proof. - -astepr (cmf_abs F One[*]cmf_abs F One). -apply eq_reflexive_unfolded. - -rational. - -apply MAbs_one. +Proof. + set (H4 := Hulp F H1 H3) in *. + intuition. + apply cond_square_eq. + apply ap_symmetric_unfolded. + apply less_imp_ap. + apply pos_two. + astepl OneR. + algebra. + astepl (cmf_abs F [--]One[*]cmf_abs F [--]One). + astepl (cmf_abs F ( [--]One[*][--]One)). + 2: apply ax_abs_resp_mult. + 2: apply cmf_proof. + astepl (cmf_abs F One). + 2: apply csf_wd. + 2: astepl ( [--] ((One:F) [*][--]One)). + 2: astepl ( [--] ( [--] (One:F) [*]One)). + 2: astepl ( [--][--] ((One:F) [*]One)). + 2: astepl ((One:F) [*]One). + 2: algebra. + astepl (cmf_abs F (One[*]One)). + astepl (cmf_abs F One[*]cmf_abs F One). + 2: apply eq_symmetric_unfolded. + 2: apply ax_abs_resp_mult. + 2: apply cmf_proof. + astepr (cmf_abs F One[*]cmf_abs F One). + apply eq_reflexive_unfolded. + rational. + apply MAbs_one. Qed. (* end hide *) @@ -170,7 +157,7 @@ Variable F : CMetricField. Definition MCauchy_prop (g : nat -> F) : CProp := forall e : IR, Zero [<] e -> {N : nat | forall m, N <= m -> MAbs (g m[-]g N) [<=] e}. -Record MCauchySeq : Type := +Record MCauchySeq : Type := {MCS_seq :> nat -> F; MCS_proof : MCauchy_prop MCS_seq}. diff --git a/reals/CPoly_Contin.v b/reals/CPoly_Contin.v index 905f51bf7..54bbed46d 100644 --- a/reals/CPoly_Contin.v +++ b/reals/CPoly_Contin.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** * Continuity of polynomials *) @@ -41,85 +41,89 @@ Require Export RealFuncts. Lemma plus_op_contin : forall f g h : CSetoid_un_op IR, contin f -> contin g -> (forall x, f x[+]g x [=] h x) -> contin h. -intros f g h f_contin g_contin f_g_h. -unfold contin in f_contin. -unfold continAt in f_contin. -unfold funLim in f_contin. -unfold contin in g_contin. -unfold continAt in g_contin. -unfold funLim in g_contin. -unfold contin in |- *. unfold continAt in |- *. unfold funLim in |- *. -intros x e H. -elim (plus_contin _ (f x) (g x) e H). intro b. intros H0 H1. -elim H1. clear H1. intro c. intros H1 H2. -elim (f_contin x b H0). clear f_contin. intro d'. intros H3 H4. -elim (g_contin x c H1). clear g_contin. intro d''. intros H5 H6. -exists (Min d' d''). -apply less_Min; auto. intro x'. intros H10. -astepr (f x[+]g x[-](f x'[+]g x')). -apply H2. -apply H4. apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_lft. -apply H6. apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_rht. +Proof. + intros f g h f_contin g_contin f_g_h. + unfold contin in f_contin. + unfold continAt in f_contin. + unfold funLim in f_contin. + unfold contin in g_contin. + unfold continAt in g_contin. + unfold funLim in g_contin. + unfold contin in |- *. unfold continAt in |- *. unfold funLim in |- *. + intros x e H. + elim (plus_contin _ (f x) (g x) e H). intro b. intros H0 H1. + elim H1. clear H1. intro c. intros H1 H2. + elim (f_contin x b H0). clear f_contin. intro d'. intros H3 H4. + elim (g_contin x c H1). clear g_contin. intro d''. intros H5 H6. + exists (Min d' d''). + apply less_Min; auto. intro x'. intros H10. + astepr (f x[+]g x[-](f x'[+]g x')). + apply H2. + apply H4. apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_lft. + apply H6. apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_rht. Qed. Lemma mult_op_contin : forall f g h : CSetoid_un_op IR, contin f -> contin g -> (forall x, f x[*]g x [=] h x) -> contin h. -intros f g h f_contin g_contin f_g_h. -unfold contin in f_contin. -unfold continAt in f_contin. -unfold funLim in f_contin. -unfold contin in g_contin. -unfold continAt in g_contin. -unfold funLim in g_contin. -unfold contin in |- *. unfold continAt in |- *. unfold funLim in |- *. -intros x e H. -elim (mult_contin _ (f x) (g x) e H). intro b. intros H0 H1. -elim H1. clear H1. intro c. intros H1 H2. -elim (f_contin x b H0). clear f_contin. intro d'. intros H3 H4. -elim (g_contin x c H1). clear g_contin. intro d''. intros H5 H6. -exists (Min d' d''). -apply less_Min; auto. intro x'. intros. -astepr (f x[*]g x[-]f x'[*]g x'). -apply H2. -apply H4. apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_lft. -apply H6. apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_rht. +Proof. + intros f g h f_contin g_contin f_g_h. + unfold contin in f_contin. + unfold continAt in f_contin. + unfold funLim in f_contin. + unfold contin in g_contin. + unfold continAt in g_contin. + unfold funLim in g_contin. + unfold contin in |- *. unfold continAt in |- *. unfold funLim in |- *. + intros x e H. + elim (mult_contin _ (f x) (g x) e H). intro b. intros H0 H1. + elim H1. clear H1. intro c. intros H1 H2. + elim (f_contin x b H0). clear f_contin. intro d'. intros H3 H4. + elim (g_contin x c H1). clear g_contin. intro d''. intros H5 H6. + exists (Min d' d''). + apply less_Min; auto. intro x'. intros. + astepr (f x[*]g x[-]f x'[*]g x'). + apply H2. + apply H4. apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_lft. + apply H6. apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_rht. Qed. Lemma linear_op_contin : forall (f g : CSetoid_un_op IR) a, contin f -> (forall x, x[*]f x[+]a [=] g x) -> contin g. -intros f g a f_contin f_g. -unfold contin in f_contin. -unfold continAt in f_contin. -unfold funLim in f_contin. -unfold contin in |- *. unfold continAt in |- *. unfold funLim in |- *. -intros. -elim (mult_contin _ x (f x) e). intro d'. intros H0 H1. -elim H1. clear H1. intro c. intros H1 H2. -elim (f_contin x c). clear f_contin. intro d''. intros H3 H4. -exists (Min d' d''). -apply less_Min; auto. intro x'. intros H8. -astepr (x[*]f x[+]a[-](x'[*]f x'[+]a)). -rstepr (x[*]f x[-]x'[*]f x'). -apply H2. clear H2. -apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_lft. -apply H4. clear H4. -apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_rht. -auto. auto. +Proof. + intros f g a f_contin f_g. + unfold contin in f_contin. + unfold continAt in f_contin. + unfold funLim in f_contin. + unfold contin in |- *. unfold continAt in |- *. unfold funLim in |- *. + intros. + elim (mult_contin _ x (f x) e). intro d'. intros H0 H1. + elim H1. clear H1. intro c. intros H1 H2. + elim (f_contin x c). clear f_contin. intro d''. intros H3 H4. + exists (Min d' d''). + apply less_Min; auto. intro x'. intros H8. + astepr (x[*]f x[+]a[-](x'[*]f x'[+]a)). + rstepr (x[*]f x[-]x'[*]f x'). + apply H2. clear H2. + apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_lft. + apply H4. clear H4. + apply AbsSmall_leEq_trans with (Min d' d''); auto. apply Min_leEq_rht. + auto. auto. Qed. Lemma cpoly_op_contin : forall g : cpoly IR, contin (cpoly_csetoid_op _ g). -intro g. -elim g. -unfold contin in |- *. unfold continAt in |- *. unfold funLim in |- *. -intros. -exists OneR. apply pos_one. -intros. -simpl in |- *. -unfold AbsSmall in |- *. -split; apply less_leEq. -rstepr ([--]ZeroR). apply inv_resp_less. auto. -astepl ZeroR. auto. -intros a f. intros. -apply linear_op_contin with (cpoly_csetoid_op _ f) a. auto. -intros. simpl in |- *. rational. +Proof. + intro g. + elim g. + unfold contin in |- *. unfold continAt in |- *. unfold funLim in |- *. + intros. + exists OneR. apply pos_one. + intros. + simpl in |- *. + unfold AbsSmall in |- *. + split; apply less_leEq. + rstepr ([--]ZeroR). apply inv_resp_less. auto. + astepl ZeroR. auto. + intros a f. intros. + apply linear_op_contin with (cpoly_csetoid_op _ f) a. auto. + intros. simpl in |- *. rational. Qed. diff --git a/reals/CReals.v b/reals/CReals.v index 351319e27..6805573db 100644 --- a/reals/CReals.v +++ b/reals/CReals.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Lim %\ensuremath{\lim}% *) @@ -40,21 +40,21 @@ Require Export COrdCauchy. (** * Definition of the notion of reals -The reals are defined as a Cauchy-closed Archimedean constructive +The reals are defined as a Cauchy-closed Archimedean constructive ordered field in which we have a maximum function. The maximum function is definable, using countable choice, but in a rather tricky way. Cauchy completeness is stated by assuming a function [lim] that returns a real number for every Cauchy sequence together with a -proof that this number is the limit. +proof that this number is the limit. *) (* Begin_SpecReals *) -Record is_CReals (R : COrdField) (lim : CauchySeq R -> R) : CProp := +Record is_CReals (R : COrdField) (lim : CauchySeq R -> R) : CProp := {ax_Lim : forall s : CauchySeq R, SeqLimit s (lim s); ax_Arch : forall x : R, {n : nat | x [<=] nring n}}. -Record CReals : Type := +Record CReals : Type := {crl_crr :> COrdField; crl_lim : CauchySeq crl_crr -> crl_crr; crl_proof : is_CReals crl_crr crl_lim}. diff --git a/reals/CReals1.v b/reals/CReals1.v index 4e674e54d..5d72430f8 100644 --- a/reals/CReals1.v +++ b/reals/CReals1.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Max_AbsIR. Require Export Expon. @@ -43,153 +43,154 @@ Section More_Cauchy_Props. (** ** Miscellaneous *** More properties of Cauchy sequences -We will now define some special Cauchy sequences and prove some +We will now define some special Cauchy sequences and prove some more useful properties about them. The sequence defined by $x_n=\frac2{n+1}$#x(n)=2/(n+1)#. *) Lemma twice_inv_seq_Lim : SeqLimit (R:=IR) (fun n => Two[*]one_div_succ n) Zero. -red in |- *; - fold (Cauchy_Lim_prop2 (fun n : nat => Two[*]one_div_succ n) Zero) in |- *. -apply Cauchy_Lim_prop3_prop2. -red in |- *; intro. -exists (2 * S k); intros. -astepr ((Two:IR) [*]one_div_succ m). -apply AbsIR_imp_AbsSmall. -apply leEq_wdl with ((Two:IR) [*]one_div_succ m). -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -astepl (one_div_succ (R:=IR) m[*]Two). -unfold one_div_succ in |- *; simpl in |- *; fold (Two:IR) in |- *. -apply shift_mult_leEq with (two_ap_zero IR). -apply pos_two. -unfold Snring in |- *. -rstepr - (One[/] nring (S k) [*]Two[//] - mult_resp_ap_zero _ _ _ (nring_ap_zero _ (S k) (sym_not_eq (O_S k))) - (two_ap_zero IR)). -apply recip_resp_leEq. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. -apply pos_nring_S. -apply pos_two. -astepl ((Two:IR) [*]nring (S k)). -apply leEq_transitive with (nring (R:=IR) m). -apply leEq_wdl with (nring (R:=IR) (2 * S k)). -apply nring_leEq. -assumption. -apply nring_comm_mult. -simpl in |- *; astepl (nring (R:=IR) m[+]Zero); apply plus_resp_leEq_lft; - apply less_leEq; apply pos_one. -astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. -apply less_leEq; apply pos_two. -apply less_leEq; apply one_div_succ_pos. + red in |- *; fold (Cauchy_Lim_prop2 (fun n : nat => Two[*]one_div_succ n) Zero) in |- *. +Proof. + apply Cauchy_Lim_prop3_prop2. + red in |- *; intro. + exists (2 * S k); intros. + astepr ((Two:IR) [*]one_div_succ m). + apply AbsIR_imp_AbsSmall. + apply leEq_wdl with ((Two:IR) [*]one_div_succ m). + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + astepl (one_div_succ (R:=IR) m[*]Two). + unfold one_div_succ in |- *; simpl in |- *; fold (Two:IR) in |- *. + apply shift_mult_leEq with (two_ap_zero IR). + apply pos_two. + unfold Snring in |- *. + rstepr (One[/] nring (S k) [*]Two[//] + mult_resp_ap_zero _ _ _ (nring_ap_zero _ (S k) (sym_not_eq (O_S k))) (two_ap_zero IR)). + apply recip_resp_leEq. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. + apply pos_nring_S. + apply pos_two. + astepl ((Two:IR) [*]nring (S k)). + apply leEq_transitive with (nring (R:=IR) m). + apply leEq_wdl with (nring (R:=IR) (2 * S k)). + apply nring_leEq. + assumption. + apply nring_comm_mult. + simpl in |- *; astepl (nring (R:=IR) m[+]Zero); apply plus_resp_leEq_lft; + apply less_leEq; apply pos_one. + astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. + apply less_leEq; apply pos_two. + apply less_leEq; apply one_div_succ_pos. Qed. Definition twice_inv_seq : CauchySeq IR. -apply Build_CauchySeq with (fun n : nat => Two[*]one_div_succ (R:=IR) n). -apply Cauchy_prop2_prop. -red in |- *; exists ZeroR. -red in |- *; - fold (SeqLimit (fun n : nat => Two[*]one_div_succ (R:=IR) n) Zero) in |- *. -apply twice_inv_seq_Lim. +Proof. + apply Build_CauchySeq with (fun n : nat => Two[*]one_div_succ (R:=IR) n). + apply Cauchy_prop2_prop. + red in |- *; exists ZeroR. + red in |- *; fold (SeqLimit (fun n : nat => Two[*]one_div_succ (R:=IR) n) Zero) in |- *. + apply twice_inv_seq_Lim. Defined. -(** -Next, we prove that the sequence of absolute values of a Cauchy +(** +Next, we prove that the sequence of absolute values of a Cauchy sequence is also Cauchy. *) Lemma Cauchy_Lim_abs : forall seq y, Cauchy_Lim_prop2 seq y -> Cauchy_Lim_prop2 (fun n => AbsIR (seq n)) (AbsIR y). -intros seq y H. -red in |- *; red in H. -intros eps He. -elim (H eps He); clear H. -intros N HN. -exists N; intros. -apply AbsIR_imp_AbsSmall. -cut (AbsIR (seq m[-]y) [<=] eps). -intro. -2: apply AbsSmall_imp_AbsIR; apply HN; assumption. -cut (seq m[-]y [<=] eps). -2: eapply leEq_transitive; [ apply leEq_AbsIR | apply H0 ]. -intro. -cut (y[-]seq m [<=] eps). -2: eapply leEq_transitive; - [ apply leEq_AbsIR | eapply leEq_wdl; [ apply H0 | apply AbsIR_minus ] ]. -intro. -simpl in |- *; unfold ABSIR in |- *. -apply Max_leEq. -apply shift_minus_leEq. -apply Max_leEq. -apply shift_leEq_plus'. -apply leEq_transitive with y. -apply shift_minus_leEq; apply shift_leEq_plus'; assumption. -apply lft_leEq_Max. -apply shift_leEq_plus'. -apply leEq_transitive with ( [--]y). -apply shift_minus_leEq; apply shift_leEq_plus'. -rstepl (y[-]seq m). -assumption. -apply rht_leEq_Max. -astepr ( [--][--]eps); apply inv_resp_leEq. -apply shift_leEq_minus; apply shift_plus_leEq'. -apply leEq_wdr with (Max (seq m) [--] (seq m) [+]eps). -apply Max_leEq. -apply leEq_transitive with (seq m[+]eps). -apply shift_leEq_plus'; assumption. -apply plus_resp_leEq. -apply lft_leEq_Max. -apply leEq_transitive with ( [--] (seq m) [+]eps). -apply shift_leEq_plus'; rstepl (seq m[-]y); assumption. -apply plus_resp_leEq. -apply rht_leEq_Max. -unfold cg_minus in |- *. -algebra. +Proof. + intros seq y H. + red in |- *; red in H. + intros eps He. + elim (H eps He); clear H. + intros N HN. + exists N; intros. + apply AbsIR_imp_AbsSmall. + cut (AbsIR (seq m[-]y) [<=] eps). + intro. + 2: apply AbsSmall_imp_AbsIR; apply HN; assumption. + cut (seq m[-]y [<=] eps). + 2: eapply leEq_transitive; [ apply leEq_AbsIR | apply H0 ]. + intro. + cut (y[-]seq m [<=] eps). + 2: eapply leEq_transitive; [ apply leEq_AbsIR | eapply leEq_wdl; [ apply H0 | apply AbsIR_minus ] ]. + intro. + simpl in |- *; unfold ABSIR in |- *. + apply Max_leEq. + apply shift_minus_leEq. + apply Max_leEq. + apply shift_leEq_plus'. + apply leEq_transitive with y. + apply shift_minus_leEq; apply shift_leEq_plus'; assumption. + apply lft_leEq_Max. + apply shift_leEq_plus'. + apply leEq_transitive with ( [--]y). + apply shift_minus_leEq; apply shift_leEq_plus'. + rstepl (y[-]seq m). + assumption. + apply rht_leEq_Max. + astepr ( [--][--]eps); apply inv_resp_leEq. + apply shift_leEq_minus; apply shift_plus_leEq'. + apply leEq_wdr with (Max (seq m) [--] (seq m) [+]eps). + apply Max_leEq. + apply leEq_transitive with (seq m[+]eps). + apply shift_leEq_plus'; assumption. + apply plus_resp_leEq. + apply lft_leEq_Max. + apply leEq_transitive with ( [--] (seq m) [+]eps). + apply shift_leEq_plus'; rstepl (seq m[-]y); assumption. + apply plus_resp_leEq. + apply rht_leEq_Max. + unfold cg_minus in |- *. + algebra. Qed. Lemma Cauchy_abs : forall seq : CauchySeq IR, Cauchy_prop (fun n => AbsIR (seq n)). -intro. -apply Cauchy_prop2_prop. -exists (AbsIR (Lim seq)). -apply Cauchy_Lim_abs. -apply Cauchy_complete. +Proof. + intro. + apply Cauchy_prop2_prop. + exists (AbsIR (Lim seq)). + apply Cauchy_Lim_abs. + apply Cauchy_complete. Qed. Lemma Lim_abs : forall seq : CauchySeq IR, Lim (Build_CauchySeq _ _ (Cauchy_abs seq)) [=] AbsIR (Lim seq). -intros. -apply eq_symmetric_unfolded; apply Limits_unique. -simpl in |- *; apply Cauchy_Lim_abs. -apply Cauchy_complete. +Proof. + intros. + apply eq_symmetric_unfolded; apply Limits_unique. + simpl in |- *; apply Cauchy_Lim_abs. + apply Cauchy_complete. Qed. Lemma CS_seq_bounded' : forall seq : CauchySeqR, {K : IR | Zero [<] K | forall m : nat, AbsSmall K (seq m)}. -unfold CauchySeqR in |- *. -intros. -assert (X0 : {K : IR | Zero [<] K | {N : nat | forall m, N <= m -> AbsSmall K (seq m)}}). -apply CS_seq_bounded; auto. -apply (CS_proof _ seq). -destruct X0 as [K1 K1_pos H1]. -destruct H1 as [N H1]. -exists (Max K1 (SeqBound0 seq N)). -apply less_leEq_trans with K1; auto. -apply lft_leEq_MAX. -intros. -elim (le_or_lt N m). -intros. -assert (AbsSmall (R:=IR) K1 (seq m)). -apply H1. auto. -apply AbsSmall_leEq_trans with K1; auto. -apply lft_leEq_MAX. -intros. -apply AbsSmall_leEq_trans with (SeqBound0 seq N). -apply rht_leEq_MAX. -apply AbsSmall_leEq_trans with (AbsIR (seq m)). -apply SeqBound0_greater; auto. -apply AbsIR_imp_AbsSmall. -apply leEq_reflexive. +Proof. + unfold CauchySeqR in |- *. + intros. + assert (X0 : {K : IR | Zero [<] K | {N : nat | forall m, N <= m -> AbsSmall K (seq m)}}). + apply CS_seq_bounded; auto. + apply (CS_proof _ seq). + destruct X0 as [K1 K1_pos H1]. + destruct H1 as [N H1]. + exists (Max K1 (SeqBound0 seq N)). + apply less_leEq_trans with K1; auto. + apply lft_leEq_MAX. + intros. + elim (le_or_lt N m). + intros. + assert (AbsSmall (R:=IR) K1 (seq m)). + apply H1. auto. + apply AbsSmall_leEq_trans with K1; auto. + apply lft_leEq_MAX. + intros. + apply AbsSmall_leEq_trans with (SeqBound0 seq N). + apply rht_leEq_MAX. + apply AbsSmall_leEq_trans with (AbsIR (seq m)). + apply SeqBound0_greater; auto. + apply AbsIR_imp_AbsSmall. + apply leEq_reflexive. Qed. End More_Cauchy_Props. @@ -198,7 +199,7 @@ Section Subsequences. (** *** Subsequences -We will now examine (although without formalizing it) the concept +We will now examine (although without formalizing it) the concept of subsequence and some of its properties. %\begin{convention}% Let [seq1,seq2:nat->IR]. @@ -209,7 +210,7 @@ increasing function [f] growing to infinity such that [forall (n :nat), (seq1 n) [=] (seq2 (f n))]. We assume [f] to be such a function. -Finally, for some of our results it is important to assume that +Finally, for some of our results it is important to assume that [seq2] is monotonous. *) @@ -224,118 +225,120 @@ Hypothesis mon_seq2 : (forall m n, m <= n -> seq2 m [<=] seq2 n) \/ (forall m n, m <= n -> seq2 n [<=] seq2 m). Lemma unbnd_f : forall m, {n : nat | m < f n}. -simple induction m. -elim (crescF 0). -intros n Hn. -exists n. -inversion_clear Hn. -apply le_lt_trans with (f 0); auto with arith. -intros n H. -elim H; clear H; intros n' Hn'. -elim (crescF n'). -intros i Hi; elim Hi; clear Hi; intros Hi Hi'. -exists i. -apply le_lt_trans with (f n'); auto. +Proof. + simple induction m. + elim (crescF 0). + intros n Hn. + exists n. + inversion_clear Hn. + apply le_lt_trans with (f 0); auto with arith. + intros n H. + elim H; clear H; intros n' Hn'. + elim (crescF n'). + intros i Hi; elim Hi; clear Hi; intros Hi Hi'. + exists i. + apply le_lt_trans with (f n'); auto. Qed. (* begin hide *) Let mon_F' : forall m n : nat, f m < f n -> m < n. -intros. -cut (~ n <= m). -intro; apply not_ge; auto. -intro. -cut (f n <= f m). -apply lt_not_le; auto. -apply monF; assumption. +Proof. + intros. + cut (~ n <= m). + intro; apply not_ge; auto. + intro. + cut (f n <= f m). + apply lt_not_le; auto. + apply monF; assumption. Qed. (* end hide *) Lemma conv_subseq_imp_conv_seq : Cauchy_prop seq1 -> Cauchy_prop seq2. -intro H. -red in |- *; red in H. -intros e H0. -elim (H e H0). -intros N HN. -exists (f N). -intros. -elim (unbnd_f m); intros i Hi. -apply AbsIR_imp_AbsSmall. -apply leEq_transitive with (AbsIR (seq2 (f i) [-]seq2 (f N))). -elim mon_seq2; intro. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (seq2 (f N)); apply H2; assumption. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (seq2 (f N)); apply H2; - apply le_trans with m; auto with arith. -apply minus_resp_leEq. -apply H2; auto with arith. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_inv_x. -2: apply shift_minus_leEq; astepr (seq2 (f N)); auto. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_inv_x. -2: apply shift_minus_leEq; astepr (seq2 (f N)); apply H2; - apply le_trans with m; auto with arith. -apply inv_resp_leEq; apply minus_resp_leEq. -apply H2; auto with arith. -apply leEq_wdl with (AbsIR (seq1 i[-]seq1 N)). -apply AbsSmall_imp_AbsIR; apply HN. -apply lt_le_weak. -apply mon_F'; apply le_lt_trans with m; auto. -apply AbsIR_wd; algebra. +Proof. + intro H. + red in |- *; red in H. + intros e H0. + elim (H e H0). + intros N HN. + exists (f N). + intros. + elim (unbnd_f m); intros i Hi. + apply AbsIR_imp_AbsSmall. + apply leEq_transitive with (AbsIR (seq2 (f i) [-]seq2 (f N))). + elim mon_seq2; intro. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (seq2 (f N)); apply H2; assumption. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (seq2 (f N)); apply H2; apply le_trans with m; auto with arith. + apply minus_resp_leEq. + apply H2; auto with arith. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_inv_x. + 2: apply shift_minus_leEq; astepr (seq2 (f N)); auto. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_inv_x. + 2: apply shift_minus_leEq; astepr (seq2 (f N)); apply H2; apply le_trans with m; auto with arith. + apply inv_resp_leEq; apply minus_resp_leEq. + apply H2; auto with arith. + apply leEq_wdl with (AbsIR (seq1 i[-]seq1 N)). + apply AbsSmall_imp_AbsIR; apply HN. + apply lt_le_weak. + apply mon_F'; apply le_lt_trans with m; auto. + apply AbsIR_wd; algebra. Qed. Lemma Cprop2_seq_imp_Cprop2_subseq : forall a, Cauchy_Lim_prop2 seq2 a -> Cauchy_Lim_prop2 seq1 a. -intros a H. -red in |- *; red in H. -intros eps H0. -elim (H _ H0). -intros N HN. -elim (unbnd_f N); intros i Hi. -exists i. -intros. -astepr (seq2 (f m) [-]a). -apply HN. -cut (f i <= f m). -intros; apply le_trans with (f i); auto with arith. -apply monF; assumption. +Proof. + intros a H. + red in |- *; red in H. + intros eps H0. + elim (H _ H0). + intros N HN. + elim (unbnd_f N); intros i Hi. + exists i. + intros. + astepr (seq2 (f m) [-]a). + apply HN. + cut (f i <= f m). + intros; apply le_trans with (f i); auto with arith. + apply monF; assumption. Qed. Lemma conv_seq_imp_conv_subseq : Cauchy_prop seq2 -> Cauchy_prop seq1. -intro H. -apply Cauchy_prop2_prop. -cut (Cauchy_prop2 (Build_CauchySeq _ _ H)). -intro H0. -elim H0; intros a Ha; exists a. -apply Cprop2_seq_imp_Cprop2_subseq. -assumption. -exists (Lim (Build_CauchySeq _ _ H)). -apply Lim_Cauchy. +Proof. + intro H. + apply Cauchy_prop2_prop. + cut (Cauchy_prop2 (Build_CauchySeq _ _ H)). + intro H0. + elim H0; intros a Ha; exists a. + apply Cprop2_seq_imp_Cprop2_subseq. + assumption. + exists (Lim (Build_CauchySeq _ _ H)). + apply Lim_Cauchy. Qed. Lemma Cprop2_subseq_imp_Cprop2_seq : forall a, Cauchy_Lim_prop2 seq1 a -> Cauchy_Lim_prop2 seq2 a. -intros. -cut (Cauchy_prop seq1); intros. -2: apply Cauchy_prop2_prop. -2: exists a; assumption. -cut (Cauchy_prop seq2); intros H1. -2: apply conv_subseq_imp_conv_seq; assumption. -cut - (Cauchy_Lim_prop2 (Build_CauchySeq _ _ H1) (Lim (Build_CauchySeq _ _ H1))); +Proof. intros. -2: apply Cauchy_complete. -cut (Cauchy_Lim_prop2 seq1 (Lim (Build_CauchySeq _ _ H1))); intros. -2: apply Cprop2_seq_imp_Cprop2_subseq; assumption. -cut (Lim (Build_CauchySeq _ _ H1) [=] a). -intro H4. -eapply Lim_wd. -apply H4. -assumption. -apply Lim_unique with seq1; assumption. + cut (Cauchy_prop seq1); intros. + 2: apply Cauchy_prop2_prop. + 2: exists a; assumption. + cut (Cauchy_prop seq2); intros H1. + 2: apply conv_subseq_imp_conv_seq; assumption. + cut (Cauchy_Lim_prop2 (Build_CauchySeq _ _ H1) (Lim (Build_CauchySeq _ _ H1))); intros. + 2: apply Cauchy_complete. + cut (Cauchy_Lim_prop2 seq1 (Lim (Build_CauchySeq _ _ H1))); intros. + 2: apply Cprop2_seq_imp_Cprop2_subseq; assumption. + cut (Lim (Build_CauchySeq _ _ H1) [=] a). + intro H4. + eapply Lim_wd. + apply H4. + assumption. + apply Lim_unique with seq1; assumption. Qed. End Subsequences. @@ -353,21 +356,21 @@ Hypothesis mon_seq2 : (forall m n, m <= n -> seq2 m [<=] seq2 n) \/ (forall m n, m <= n -> seq2 n [<=] seq2 m). Lemma Lim_seq_eq_Lim_subseq : Lim seq1 [=] Lim seq2. -cut (Cauchy_Lim_prop2 seq1 (Lim seq2)). -2: apply Cprop2_seq_imp_Cprop2_subseq with (CS_seq _ seq2) f; auto; - apply Cauchy_complete. -intro. -apply eq_symmetric_unfolded. -apply Limits_unique; assumption. +Proof. + cut (Cauchy_Lim_prop2 seq1 (Lim seq2)). + 2: apply Cprop2_seq_imp_Cprop2_subseq with (CS_seq _ seq2) f; auto; apply Cauchy_complete. + intro. + apply eq_symmetric_unfolded. + apply Limits_unique; assumption. Qed. Lemma Lim_subseq_eq_Lim_seq : Lim seq1 [=] Lim seq2. -cut (Cauchy_Lim_prop2 seq2 (Lim seq1)). -2: exact - (Cprop2_subseq_imp_Cprop2_seq seq1 seq2 f monF crescF subseq mon_seq2 _ - (Cauchy_complete seq1)). -intro. -apply Limits_unique; assumption. +Proof. + cut (Cauchy_Lim_prop2 seq2 (Lim seq1)). + 2: exact (Cprop2_subseq_imp_Cprop2_seq seq1 seq2 f monF crescF subseq mon_seq2 _ + (Cauchy_complete seq1)). + intro. + apply Limits_unique; assumption. Qed. End Cauchy_Subsequences. @@ -382,101 +385,105 @@ Finally, we prove that [x[^]n] grows to infinity if [x [>] One]. Lemma power_big' : forall (R : COrdField) (x : R) n, Zero [<=] x -> One[+]nring n[*]x [<=] (One[+]x) [^]n. -intros. -induction n as [| n Hrecn]; intros. -rstepl (One:R). -astepr (One:R). -apply leEq_reflexive. -simpl in |- *. -apply leEq_transitive with ((One[+]nring n[*]x) [*] (One[+]x)). -rstepr (One[+] (nring n[+]One) [*]x[+]nring n[*]x[^]2). -astepl (One[+] (nring n[+]One) [*]x[+]Zero). -apply plus_resp_leEq_lft. -apply mult_resp_nonneg. -astepl (nring 0:R). apply nring_leEq. auto with arith. -apply sqr_nonneg. -apply mult_resp_leEq_rht. -auto. -apply less_leEq. astepl ((Zero:R) [+]Zero). -apply plus_resp_less_leEq. apply pos_one. auto. +Proof. + intros. + induction n as [| n Hrecn]; intros. + rstepl (One:R). + astepr (One:R). + apply leEq_reflexive. + simpl in |- *. + apply leEq_transitive with ((One[+]nring n[*]x) [*] (One[+]x)). + rstepr (One[+] (nring n[+]One) [*]x[+]nring n[*]x[^]2). + astepl (One[+] (nring n[+]One) [*]x[+]Zero). + apply plus_resp_leEq_lft. + apply mult_resp_nonneg. + astepl (nring 0:R). apply nring_leEq. auto with arith. + apply sqr_nonneg. + apply mult_resp_leEq_rht. + auto. + apply less_leEq. astepl ((Zero:R) [+]Zero). + apply plus_resp_less_leEq. apply pos_one. auto. Qed. Lemma power_big : forall x y : IR, Zero [<=] x -> One [<] y -> {N : nat | x [<=] y[^]N}. -intros. -cut (Zero [<] y[-]One). intro. -cut (y[-]One [#] Zero). intro H2. -elim (Archimedes (x[-]One[/] y[-]One[//]H2)). intro N. intros. exists N. -apply leEq_transitive with (One[+]nring N[*] (y[-]One)). -apply shift_leEq_plus'. -astepr ((y[-]One) [*]nring N). -apply shift_leEq_mult' with H2. auto. -auto. -apply leEq_wdr with ((One[+] (y[-]One)) [^]N). -apply power_big'. apply less_leEq. auto. -apply un_op_wd_unfolded. rational. -apply Greater_imp_ap. auto. -apply shift_less_minus. astepl OneR. auto. +Proof. + intros. + cut (Zero [<] y[-]One). intro. + cut (y[-]One [#] Zero). intro H2. + elim (Archimedes (x[-]One[/] y[-]One[//]H2)). intro N. intros. exists N. + apply leEq_transitive with (One[+]nring N[*] (y[-]One)). + apply shift_leEq_plus'. + astepr ((y[-]One) [*]nring N). + apply shift_leEq_mult' with H2. auto. + auto. + apply leEq_wdr with ((One[+] (y[-]One)) [^]N). + apply power_big'. apply less_leEq. auto. + apply un_op_wd_unfolded. rational. + apply Greater_imp_ap. auto. + apply shift_less_minus. astepl OneR. auto. Qed. Lemma qi_yields_zero : forall q : IR, Zero [<=] q -> q [<] One -> forall e, Zero [<] e -> {N : nat | q[^]N [<=] e}. -intros. -cut (Zero [<] (One[+]q) [/]TwoNZ). intro Haux. -cut ((One[+]q) [/]TwoNZ [#] Zero). intro H2. -cut (e [#] Zero). intro H3. -elim (power_big (One[/] e[//]H3) (One[/] _[//]H2)). intro N. intros H4. exists N. -cut (Zero [<] ((One[+]q) [/]TwoNZ) [^]N). intro H5. -apply leEq_transitive with (((One[+]q) [/]TwoNZ) [^]N). -apply nexp_resp_leEq. -auto. -apply shift_leEq_div. -apply pos_two. -apply shift_leEq_plus. -rstepl q. apply less_leEq. auto. -astepl (One[*] ((One[+]q) [/]TwoNZ) [^]N). -set (H6 := pos_ap_zero _ _ H5) in *. -apply shift_mult_leEq with H6. auto. -rstepr (e[*] (One[/] _[//]H6)). -apply shift_leEq_mult' with H3. auto. -astepr (One[^]N[/] _[//]H6). -astepr ((One[/] _[//]H2) [^]N). auto. -apply nexp_resp_pos. apply pos_div_two. -astepl (Zero[+]ZeroR). apply plus_resp_less_leEq. -apply pos_one. auto. -apply less_leEq. apply recip_resp_pos. auto. -apply shift_less_div. apply pos_div_two. -astepl (Zero[+]ZeroR). apply plus_resp_less_leEq. -apply pos_one. auto. -astepl ((One[+]q) [/]TwoNZ). apply shift_div_less. -apply pos_two. rstepr (One[+]OneR). -apply plus_resp_less_lft. auto. -apply Greater_imp_ap. auto. -apply Greater_imp_ap. auto. -apply pos_div_two. -astepl (Zero[+]ZeroR). apply plus_resp_less_leEq. -apply pos_one. auto. +Proof. + intros. + cut (Zero [<] (One[+]q) [/]TwoNZ). intro Haux. + cut ((One[+]q) [/]TwoNZ [#] Zero). intro H2. + cut (e [#] Zero). intro H3. + elim (power_big (One[/] e[//]H3) (One[/] _[//]H2)). intro N. intros H4. exists N. + cut (Zero [<] ((One[+]q) [/]TwoNZ) [^]N). intro H5. + apply leEq_transitive with (((One[+]q) [/]TwoNZ) [^]N). + apply nexp_resp_leEq. + auto. + apply shift_leEq_div. + apply pos_two. + apply shift_leEq_plus. + rstepl q. apply less_leEq. auto. + astepl (One[*] ((One[+]q) [/]TwoNZ) [^]N). + set (H6 := pos_ap_zero _ _ H5) in *. + apply shift_mult_leEq with H6. auto. + rstepr (e[*] (One[/] _[//]H6)). + apply shift_leEq_mult' with H3. auto. + astepr (One[^]N[/] _[//]H6). + astepr ((One[/] _[//]H2) [^]N). auto. + apply nexp_resp_pos. apply pos_div_two. + astepl (Zero[+]ZeroR). apply plus_resp_less_leEq. + apply pos_one. auto. + apply less_leEq. apply recip_resp_pos. auto. + apply shift_less_div. apply pos_div_two. + astepl (Zero[+]ZeroR). apply plus_resp_less_leEq. + apply pos_one. auto. + astepl ((One[+]q) [/]TwoNZ). apply shift_div_less. + apply pos_two. rstepr (One[+]OneR). + apply plus_resp_less_lft. auto. + apply Greater_imp_ap. auto. + apply Greater_imp_ap. auto. + apply pos_div_two. + astepl (Zero[+]ZeroR). apply plus_resp_less_leEq. + apply pos_one. auto. Qed. Lemma qi_lim_zero : forall q : IR, Zero [<=] q -> q [<] One -> SeqLimit (fun i => q[^]i) Zero. -intros q H H0. -unfold SeqLimit in |- *. unfold AbsSmall in |- *. intros. -elim (qi_yields_zero q H H0 e); auto. -intro N. intros. exists (S N). intros. split. -apply less_leEq. -apply less_leEq_trans with ZeroR. -astepr ( [--]ZeroR). apply inv_resp_less. auto. -astepr (q[^]m). -apply nexp_resp_nonneg. auto. -astepl (q[^]m). -replace m with (N + (m - N)). -astepl (q[^]N[*]q[^] (m - N)). astepr (e[*]One). -apply mult_resp_leEq_both. -apply nexp_resp_nonneg. auto. -apply nexp_resp_nonneg. auto. -auto. -astepr (OneR[^] (m - N)). -apply nexp_resp_leEq. auto. apply less_leEq. auto. -auto with arith. +Proof. + intros q H H0. + unfold SeqLimit in |- *. unfold AbsSmall in |- *. intros. + elim (qi_yields_zero q H H0 e); auto. + intro N. intros. exists (S N). intros. split. + apply less_leEq. + apply less_leEq_trans with ZeroR. + astepr ( [--]ZeroR). apply inv_resp_less. auto. + astepr (q[^]m). + apply nexp_resp_nonneg. auto. + astepl (q[^]m). + replace m with (N + (m - N)). + astepl (q[^]N[*]q[^] (m - N)). astepr (e[*]One). + apply mult_resp_leEq_both. + apply nexp_resp_nonneg. auto. + apply nexp_resp_nonneg. auto. + auto. + astepr (OneR[^] (m - N)). + apply nexp_resp_leEq. auto. apply less_leEq. auto. + auto with arith. Qed. End Properties_of_Exponentiation. @@ -485,19 +492,22 @@ End Properties_of_Exponentiation. *** [IR] has characteristic zero *) Lemma char0_IR : Char0 IR. -apply char0_OrdField. +Proof. + apply char0_OrdField. Qed. Lemma poly_apzero_IR : forall f : cpoly_cring IR, f [#] Zero -> {c : IR | f ! c [#] Zero}. -intros. -apply poly_apzero. -exact char0_IR. -auto. +Proof. + intros. + apply poly_apzero. + exact char0_IR. + auto. Qed. Lemma poly_IR_extensional : forall p q : cpoly_cring IR, (forall x, p ! x [=] q ! x) -> p [=] q. -intros. -apply poly_extensional. -exact char0_IR. -auto. +Proof. + intros. + apply poly_extensional. + exact char0_IR. + auto. Qed. diff --git a/reals/CSumsReals.v b/reals/CSumsReals.v index 53bf84f0c..436e009cf 100644 --- a/reals/CSumsReals.v +++ b/reals/CSumsReals.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CReals1. @@ -52,25 +52,27 @@ Section Sums_over_Reals. Variable c : IR. Lemma Sum0_c_exp : forall H m, Sum0 m (fun i => c[^]i) [=] (c[^]m[-]One[/] c[-]One[//]H). -intros. -elim m. -simpl in |- *. -rational. -simpl in |- *. -intros. -astepl ((nexp IR n c[-]One[/] c[-]One[//]H) [+]nexp IR n c). -rational. +Proof. + intros. + elim m. + simpl in |- *. + rational. + simpl in |- *. + intros. + astepl ((nexp IR n c[-]One[/] c[-]One[//]H) [+]nexp IR n c). + rational. Qed. Hint Resolve Sum0_c_exp. Lemma Sum_c_exp : forall H m n, Sum m n (fun i => c[^]i) [=] (c[^]S n[-]c[^]m[/] c[-]One[//]H). -intros. -unfold Sum in |- *. -unfold Sum1 in |- *. -astepl ((c[^]S n[-]One[/] c[-]One[//]H) [-] (c[^]m[-]One[/] c[-]One[//]H)). -rational. +Proof. + intros. + unfold Sum in |- *. + unfold Sum1 in |- *. + astepl ((c[^]S n[-]One[/] c[-]One[//]H) [-] (c[^]m[-]One[/] c[-]One[//]H)). + rational. Qed. Hint Resolve Sum_c_exp. @@ -78,14 +80,15 @@ Hint Resolve Sum_c_exp. Lemma Sum_c_exp' : forall H m n, Sum m n (fun i => c[^]i) [=] (c[^]m[-]c[^]S n[/] One[-]c[//]H). -intros. -cut (c[-]One [#] Zero). -intro H0. -astepl (c[^]S n[-]c[^]m[/] c[-]One[//]H0). -rational. -rstepl ( [--] (One[-]c)). -apply inv_resp_ap_zero. -assumption. +Proof. + intros. + cut (c[-]One [#] Zero). + intro H0. + astepl (c[^]S n[-]c[^]m[/] c[-]One[//]H0). + rational. + rstepl ( [--] (One[-]c)). + apply inv_resp_ap_zero. + assumption. Qed. Hint Resolve Sum_c_exp'. @@ -96,123 +99,129 @@ Hint Resolve Sum0_c_exp Sum_c_exp Sum_c_exp': algebra. Lemma diff_is_Sum0 : forall (s : nat -> IR) n, s n[-]s 0 [=] Sum0 n (fun i => s (S i) [-]s i). Proof. -intros s. -simple induction n. -simpl in |- *. algebra. -intros. -simpl in |- *. -apply eq_transitive_unfolded with (s (S n0) [-]s n0[+] (s n0[-]s 0)). -rational. -apply - eq_transitive_unfolded - with (s (S n0) [-]s n0[+]Sum0 n0 (fun i : nat => s (S i) [-]s i)). -exact (plus_resp_eq _ _ _ _ H). -rational. + intros s. + simple induction n. + simpl in |- *. algebra. + intros. + simpl in |- *. + apply eq_transitive_unfolded with (s (S n0) [-]s n0[+] (s n0[-]s 0)). + rational. + apply eq_transitive_unfolded with (s (S n0) [-]s n0[+]Sum0 n0 (fun i : nat => s (S i) [-]s i)). + exact (plus_resp_eq _ _ _ _ H). + rational. Qed. Lemma diff_is_sum : forall (s : nat -> IR) N m, N < m -> s m[-]s N [=] Sum N (pred m) (fun i => s (S i) [-]s i). Proof. -intros s N m ltNm. -unfold Sum in |- *. unfold Sum1 in |- *. -generalize (S_pred m N ltNm). -intro H. -rewrite <- H. -generalize (diff_is_Sum0 s N). -intro HsN. -generalize (diff_is_Sum0 s m). -intro Hsm. -apply eq_transitive_unfolded with (s m[-]s 0[-] (s N[-]s 0)). -rational. -apply (cg_minus_wd IR). -assumption. -assumption. + intros s N m ltNm. + unfold Sum in |- *. unfold Sum1 in |- *. + generalize (S_pred m N ltNm). + intro H. + rewrite <- H. + generalize (diff_is_Sum0 s N). + intro HsN. + generalize (diff_is_Sum0 s m). + intro Hsm. + apply eq_transitive_unfolded with (s m[-]s 0[-] (s N[-]s 0)). + rational. + apply (cg_minus_wd IR). + assumption. + assumption. Qed. Lemma Sum0_pres_less : forall s t : nat -> IR, (forall i, s i [<] t i) -> forall n, Sum0 n s [<=] Sum0 n t. Proof. -intros s t H. -simple induction n. -simpl in |- *. -exact (leEq_reflexive _ _). -intros. -simpl in |- *. -apply leEq_transitive with (Sum0 n0 t[+]s n0). -apply plus_resp_leEq. -assumption. -apply plus_resp_leEq_lft. -apply less_leEq; exact (H _). + intros s t H. + simple induction n. + simpl in |- *. + exact (leEq_reflexive _ _). + intros. + simpl in |- *. + apply leEq_transitive with (Sum0 n0 t[+]s n0). + apply plus_resp_leEq. + assumption. + apply plus_resp_leEq_lft. + apply less_leEq; exact (H _). Qed. Lemma Sum_pres_less : forall s t : nat -> IR, (forall i, s i [<] t i) -> forall N m, N <= m -> Sum N m s [<=] Sum N m t. -intros. -apply less_leEq. -apply Sum_resp_less; auto. +Proof. + intros. + apply less_leEq. + apply Sum_resp_less; auto. Qed. Lemma Sum_pres_leEq : forall s t : nat -> IR, (forall i, s i [<=] t i) -> forall N m, N <= m -> Sum N m s [<=] Sum N m t. -intros. -apply Sum_resp_leEq; auto. +Proof. + intros. + apply Sum_resp_leEq; auto. Qed. Lemma Sum0_comm_scal : forall (s : nat -> IR) a m, Sum0 m (fun i => s i[*]a) [=] Sum0 m s [*]a. -intros. induction m as [| m Hrecm]; intros. -simpl in |- *. algebra. -simpl in |- *. Step_final (Sum0 m s [*]a[+]s m[*]a). +Proof. + intros. induction m as [| m Hrecm]; intros. + simpl in |- *. algebra. + simpl in |- *. Step_final (Sum0 m s [*]a[+]s m[*]a). Qed. Hint Resolve Sum0_comm_scal: algebra. Lemma Sum_comm_scal : forall (s : nat -> IR) a N m, Sum N m (fun i => s i[*]a) [=] Sum N m s [*]a. -unfold Sum in |- *. unfold Sum1 in |- *. intros. -Step_final (Sum0 (S m) s [*]a[-]Sum0 N s [*]a). +Proof. + unfold Sum in |- *. unfold Sum1 in |- *. intros. + Step_final (Sum0 (S m) s [*]a[-]Sum0 N s [*]a). Qed. Lemma Sum0_comm_scal' : forall (s : nat -> IR) a m, Sum0 m (fun i => a[*]s i) [=] a[*]Sum0 m s. -intros. -apply eq_transitive_unfolded with (Sum0 m s[*]a). -2: astepr (Sum0 m s[*]a); apply mult_wdl. -2: apply Sum0_wd; algebra. -eapply eq_transitive_unfolded. -2: apply Sum0_comm_scal. -apply Sum0_wd; algebra. +Proof. + intros. + apply eq_transitive_unfolded with (Sum0 m s[*]a). + 2: astepr (Sum0 m s[*]a); apply mult_wdl. + 2: apply Sum0_wd; algebra. + eapply eq_transitive_unfolded. + 2: apply Sum0_comm_scal. + apply Sum0_wd; algebra. Qed. Lemma Sum_comm_scal' : forall (s : nat -> IR) a m n, Sum m n (fun i => a[*]s i) [=] a[*]Sum m n s. -intros. -unfold Sum, Sum1 in |- *. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply dist_2a. -apply cg_minus_wd; apply Sum0_comm_scal'. +Proof. + intros. + unfold Sum, Sum1 in |- *. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply dist_2a. + apply cg_minus_wd; apply Sum0_comm_scal'. Qed. Lemma Sumx_comm_scal' : forall n (a : IR) (f : forall i, i < n -> IR), Sumx (fun i H => a[*]f i H) [=] a[*]Sumx f. -simple induction n. -intros; simpl in |- *; algebra. -clear n; intros; simpl in |- *. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. -apply bin_op_wd_unfolded. -apply H with (f := fun i l => f i (lt_S _ _ l)). -algebra. +Proof. + simple induction n. + intros; simpl in |- *; algebra. + clear n; intros; simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. + apply bin_op_wd_unfolded. + apply H with (f := fun i l => f i (lt_S _ _ l)). + algebra. Qed. Lemma Sum2_comm_scal' : forall a m n (f: forall i, m <= i -> i <= n -> IR), m <= S n -> Sum2 (fun i Hm Hn => a[*]f i Hm Hn) [=] a[*]Sum2 f. -intros; unfold Sum2 in |- *. -eapply eq_transitive_unfolded. -2: apply Sum_comm_scal'. -apply Sum_wd'. -assumption. -intros. -elim (le_lt_dec m i); intros; simpl in |- *. -elim (le_lt_dec i n); intros; simpl in |- *; algebra. -algebra. +Proof. + intros; unfold Sum2 in |- *. + eapply eq_transitive_unfolded. + 2: apply Sum_comm_scal'. + apply Sum_wd'. + assumption. + intros. + elim (le_lt_dec m i); intros; simpl in |- *. + elim (le_lt_dec i n); intros; simpl in |- *; algebra. + algebra. Qed. diff --git a/reals/CauchySeq.v b/reals/CauchySeq.v index 48ae6fc24..c3a8993c8 100644 --- a/reals/CauchySeq.v +++ b/reals/CauchySeq.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing IR %\ensuremath{\mathbb R}% *) (** printing PartIR %\ensuremath{\mathbb R\!\not\rightarrow\!\mathbb R}% *) @@ -72,60 +72,63 @@ Section CReals_axioms. ** [CReals] axioms *) Lemma CReals_is_CReals : is_CReals IR (Lim (IR:=IR)). -unfold Lim in |- *. -elim IR; intros. -exact crl_proof. +Proof. + unfold Lim in |- *. + elim IR; intros. + exact crl_proof. Qed. (** First properties which follow trivially from the axioms. *) Lemma Lim_Cauchy : forall s : CauchySeq IR, SeqLimit s (Lim s). -elim CReals_is_CReals; auto. +Proof. + elim CReals_is_CReals; auto. Qed. Lemma Archimedes : forall x : IR, {n : nat | x [<=] nring n}. -elim CReals_is_CReals; auto. +Proof. + elim CReals_is_CReals; auto. Qed. Lemma Archimedes' : forall x : IR, {n : nat | x [<] nring n}. -intro x. -elim (Archimedes (x[+]One)); intros n Hn. -exists n. -apply less_leEq_trans with (x[+]One); auto. -apply less_plusOne. +Proof. + intro x. + elim (Archimedes (x[+]One)); intros n Hn. + exists n. + apply less_leEq_trans with (x[+]One); auto. + apply less_plusOne. Qed. (** A stronger version, which often comes in useful. *) Lemma str_Archimedes : forall x : IR, Zero [<=] x -> {n : nat | x [<=] nring n /\ (2 <= n -> nring n[-]Two [<=] x)}. -intros. -elim (Archimedes x); intros n Hn. -induction n as [| n Hrecn]. -exists 0; split; auto. -intro; elimtype False; omega. - -clear Hrecn. -induction n as [| n Hrecn]. -exists 1. -split; intros; [ assumption | eapply leEq_transitive ]. -2: apply H. -simpl in |- *. -rstepl ([--]OneR); astepr ([--]ZeroR); apply less_leEq; apply inv_resp_less; - apply pos_one. -cut (nring (R:=IR) n [<] nring (S n)). -intros H0. -cut (nring n [<] x or x [<] nring (S n)). -intros H1. -elim H1; intros. -exists (S (S n)). -split. -assumption. -intros. -simpl in |- *; rstepl (nring (R:=IR) n); apply less_leEq; assumption. -apply Hrecn; apply less_leEq; assumption. -apply less_cotransitive_unfolded; assumption. -simpl in |- *; apply less_plusOne. +Proof. + intros. + elim (Archimedes x); intros n Hn. + induction n as [| n Hrecn]. + exists 0; split; auto. + intro; elimtype False; omega. + clear Hrecn. + induction n as [| n Hrecn]. + exists 1. + split; intros; [ assumption | eapply leEq_transitive ]. + 2: apply H. + simpl in |- *. + rstepl ([--]OneR); astepr ([--]ZeroR); apply less_leEq; apply inv_resp_less; apply pos_one. + cut (nring (R:=IR) n [<] nring (S n)). + intros H0. + cut (nring n [<] x or x [<] nring (S n)). + intros H1. + elim H1; intros. + exists (S (S n)). + split. + assumption. + intros. + simpl in |- *; rstepl (nring (R:=IR) n); apply less_leEq; assumption. + apply Hrecn; apply less_leEq; assumption. + apply less_cotransitive_unfolded; assumption. + simpl in |- *; apply less_plusOne. Qed. Definition CauchySeqR := CauchySeq IR. @@ -215,288 +218,299 @@ Section Inequalities. The next lemma is equal to lemma [Lim_Cauchy]. *) Lemma Cauchy_complete : forall seq : CauchySeq IR, Cauchy_Lim_prop2 seq (Lim seq). -exact Lim_Cauchy. +Proof. + exact Lim_Cauchy. Qed. Lemma less_Lim_so_less_seq : forall (seq : CauchySeq IR) y, y [<] Lim seq -> {N : nat | forall m, N <= m -> y [<] seq m}. -intros seq y H. -elim (Cauchy_complete seq ((Lim seq[-]y) [/]TwoNZ)). -intro N. -intros H0. -split with N. -intros m H1. -generalize (H0 _ H1). intro H2. -unfold AbsSmall in H2. -elim H2. -intros. - -apply plus_cancel_less with ([--] (Lim seq)). -rstepl ([--] (Lim seq[-]y)). -rstepr (seq m[-]Lim seq). -eapply less_leEq_trans. -2: apply H3. -apply inv_resp_less; apply pos_div_two'. -apply shift_less_minus; astepl y; auto. - -apply pos_div_two. -apply shift_less_minus; astepl y; auto. +Proof. + intros seq y H. + elim (Cauchy_complete seq ((Lim seq[-]y) [/]TwoNZ)). + intro N. + intros H0. + split with N. + intros m H1. + generalize (H0 _ H1). intro H2. + unfold AbsSmall in H2. + elim H2. + intros. + apply plus_cancel_less with ([--] (Lim seq)). + rstepl ([--] (Lim seq[-]y)). + rstepr (seq m[-]Lim seq). + eapply less_leEq_trans. + 2: apply H3. + apply inv_resp_less; apply pos_div_two'. + apply shift_less_minus; astepl y; auto. + apply pos_div_two. + apply shift_less_minus; astepl y; auto. Qed. Lemma Lim_less_so_seq_less : forall (seq : CauchySeq IR) y, Lim seq [<] y -> {N : nat | forall m, N <= m -> seq m [<] y}. -intros. -elim (Cauchy_complete seq ((y[-]Lim seq) [/]TwoNZ)). -intro N. -intros H0. -split with N. -intros m H1. -generalize (H0 _ H1); intro H2. -unfold AbsSmall in H2. -elim H2. -intros H3 H4. - -apply plus_cancel_less with ([--] (Lim seq)). -eapply leEq_less_trans. -apply H4. -apply pos_div_two'. -apply shift_less_plus; rstepl (Lim seq); auto. - -apply pos_div_two. -apply shift_less_minus; astepl (Lim seq); auto. +Proof. + intros. + elim (Cauchy_complete seq ((y[-]Lim seq) [/]TwoNZ)). + intro N. + intros H0. + split with N. + intros m H1. + generalize (H0 _ H1); intro H2. + unfold AbsSmall in H2. + elim H2. + intros H3 H4. + apply plus_cancel_less with ([--] (Lim seq)). + eapply leEq_less_trans. + apply H4. + apply pos_div_two'. + apply shift_less_plus; rstepl (Lim seq); auto. + apply pos_div_two. + apply shift_less_minus; astepl (Lim seq); auto. Qed. Lemma Lim_less_Lim_so_seq_less_seq : forall seq1 seq2 : CauchySeq IR, Lim seq1 [<] Lim seq2 -> {N : nat | forall m, N <= m -> seq1 m [<] seq2 m}. -intros. -set (Av := (Lim seq1[+]Lim seq2) [/]TwoNZ) in |- *. -cut (Lim seq1 [<] Av); try intro H0. -cut (Av [<] Lim seq2); try intro H1. -generalize (Lim_less_so_seq_less _ _ H0); intro H2. -generalize (less_Lim_so_less_seq _ _ H1); intro H3. -elim H2; intro N1; intro H4. -elim H3; intro N2; intro H5. -exists (max N1 N2); intros. -apply less_leEq_trans with Av. -apply H4. -apply le_trans with (max N1 N2). -apply le_max_l. -assumption. -apply less_leEq. -apply H5. -apply le_trans with (max N1 N2). -apply le_max_r. -assumption. -unfold Av in |- *. -apply Average_less_Greatest. -assumption. -unfold Av in |- *. -apply Smallest_less_Average. -assumption. +Proof. + intros. + set (Av := (Lim seq1[+]Lim seq2) [/]TwoNZ) in |- *. + cut (Lim seq1 [<] Av); try intro H0. + cut (Av [<] Lim seq2); try intro H1. + generalize (Lim_less_so_seq_less _ _ H0); intro H2. + generalize (less_Lim_so_less_seq _ _ H1); intro H3. + elim H2; intro N1; intro H4. + elim H3; intro N2; intro H5. + exists (max N1 N2); intros. + apply less_leEq_trans with Av. + apply H4. + apply le_trans with (max N1 N2). + apply le_max_l. + assumption. + apply less_leEq. + apply H5. + apply le_trans with (max N1 N2). + apply le_max_r. + assumption. + unfold Av in |- *. + apply Average_less_Greatest. + assumption. + unfold Av in |- *. + apply Smallest_less_Average. + assumption. Qed. (** The next lemma follows from [less_Lim_so_less_seq] with [y := (y[+] (Lim seq)) [/]TwoNZ]. *) Lemma less_Lim_so : forall (seq : CauchySeq IR) y, y [<] Lim seq -> {eps : IR | Zero [<] eps | {N : nat | forall m, N <= m -> y[+]eps [<] seq m}}. -intros. -elim (less_Lim_so_less_seq seq ((y[+]Lim seq) [/]TwoNZ)). -intros x H0. -exists ((Lim seq[-]y) [/]TwoNZ). -apply pos_div_two. -apply shift_zero_less_minus. -assumption. -exists x. -intros. -rstepl ((y[+]Lim seq) [/]TwoNZ). -apply H0. -assumption. -apply Average_less_Greatest. -assumption. +Proof. + intros. + elim (less_Lim_so_less_seq seq ((y[+]Lim seq) [/]TwoNZ)). + intros x H0. + exists ((Lim seq[-]y) [/]TwoNZ). + apply pos_div_two. + apply shift_zero_less_minus. + assumption. + exists x. + intros. + rstepl ((y[+]Lim seq) [/]TwoNZ). + apply H0. + assumption. + apply Average_less_Greatest. + assumption. Qed. Lemma Lim_less_so : forall (seq : CauchySeq IR) y, Lim seq [<] y -> {eps : IR | Zero [<] eps | {N : nat | forall m, N <= m -> seq m[+]eps [<] y}}. -intros. -elim (Lim_less_so_seq_less seq ((Lim seq[+]y) [/]TwoNZ)). -intros x H0. -exists ((y[-]Lim seq) [/]TwoNZ). -apply pos_div_two. -apply shift_zero_less_minus. -assumption. -exists x. -intros. -apply shift_plus_less. -rstepr ((Lim seq[+]y) [/]TwoNZ). -apply H0. -assumption. -apply Smallest_less_Average. -assumption. +Proof. + intros. + elim (Lim_less_so_seq_less seq ((Lim seq[+]y) [/]TwoNZ)). + intros x H0. + exists ((y[-]Lim seq) [/]TwoNZ). + apply pos_div_two. + apply shift_zero_less_minus. + assumption. + exists x. + intros. + apply shift_plus_less. + rstepr ((Lim seq[+]y) [/]TwoNZ). + apply H0. + assumption. + apply Smallest_less_Average. + assumption. Qed. Lemma leEq_seq_so_leEq_Lim : forall (seq : CauchySeqR) y, (forall i, y [<=] seq i) -> y [<=] Lim seq. -intros. -rewrite leEq_def in |- *. -intro H0. -generalize (Lim_less_so_seq_less _ _ H0); intro H1. -elim H1; intros N H2. -pose (c:=H N). -rewrite -> leEq_def in c. -apply c. -apply H2. -auto with arith. +Proof. + intros. + rewrite leEq_def in |- *. + intro H0. + generalize (Lim_less_so_seq_less _ _ H0); intro H1. + elim H1; intros N H2. + pose (c:=H N). + rewrite -> leEq_def in c. + apply c. + apply H2. + auto with arith. Qed. Lemma str_leEq_seq_so_leEq_Lim : forall (seq : CauchySeq IR) y, (exists N : nat, (forall i, N <= i -> y [<=] seq i)) -> y [<=] Lim seq. -intros. -rewrite leEq_def; intro H0. -generalize (Lim_less_so_seq_less _ _ H0). -elim H; intros N HN. -intro H1. -elim H1; intros M HM. -cut (y [<] y). -apply less_irreflexive_unfolded. -apply leEq_less_trans with (seq (max N M)). -apply HN; apply le_max_l. -apply HM; apply le_max_r. +Proof. + intros. + rewrite leEq_def; intro H0. + generalize (Lim_less_so_seq_less _ _ H0). + elim H; intros N HN. + intro H1. + elim H1; intros M HM. + cut (y [<] y). + apply less_irreflexive_unfolded. + apply leEq_less_trans with (seq (max N M)). + apply HN; apply le_max_l. + apply HM; apply le_max_r. Qed. Lemma Lim_leEq_Lim : forall seq1 seq2 : CauchySeqR, (forall i, seq1 i [<=] seq2 i) -> Lim seq1 [<=] Lim seq2. -intros. -rewrite leEq_def in |- *. -intro H0. -generalize (Lim_less_Lim_so_seq_less_seq _ _ H0); intro H1. -elim H1; intros N H2. -pose (c:=H N). -rewrite -> leEq_def in c. -apply c. -apply H2. -auto with arith. +Proof. + intros. + rewrite leEq_def in |- *. + intro H0. + generalize (Lim_less_Lim_so_seq_less_seq _ _ H0); intro H1. + elim H1; intros N H2. + pose (c:=H N). + rewrite -> leEq_def in c. + apply c. + apply H2. + auto with arith. Qed. Lemma seq_leEq_so_Lim_leEq : forall (seq : CauchySeqR) y, (forall i, seq i [<=] y) -> Lim seq [<=] y. -intros. -rewrite leEq_def in |- *. -intro H0. -generalize (less_Lim_so_less_seq _ _ H0); intro H1. -elim H1; intros N H2. -pose (c:=H N). -rewrite -> leEq_def in c. -apply c. -apply H2. -auto with arith. +Proof. + intros. + rewrite leEq_def in |- *. + intro H0. + generalize (less_Lim_so_less_seq _ _ H0); intro H1. + elim H1; intros N H2. + pose (c:=H N). + rewrite -> leEq_def in c. + apply c. + apply H2. + auto with arith. Qed. Lemma str_seq_leEq_so_Lim_leEq : forall (seq : CauchySeq IR) y, (exists N : nat, (forall i, N <= i -> seq i [<=] y)) -> Lim seq [<=] y. -intros. -rewrite leEq_def; intro H0. -generalize (less_Lim_so_less_seq _ _ H0). -elim H; intros N HN. -intro H1. -elim H1; intros M HM. -cut (y [<] y). -apply less_irreflexive_unfolded. -apply less_leEq_trans with (seq (max N M)). -apply HM; apply le_max_r. -apply HN; apply le_max_l. +Proof. + intros. + rewrite leEq_def; intro H0. + generalize (less_Lim_so_less_seq _ _ H0). + elim H; intros N HN. + intro H1. + elim H1; intros M HM. + cut (y [<] y). + apply less_irreflexive_unfolded. + apply less_leEq_trans with (seq (max N M)). + apply HM; apply le_max_r. + apply HN; apply le_max_l. Qed. Lemma Limits_unique : forall (seq : CauchySeq IR) y, Cauchy_Lim_prop2 seq y -> y [=] Lim seq. -intros seq y H. -apply not_ap_imp_eq. -unfold not in |- *; intro H0. -generalize (ap_imp_less _ _ _ H0); intro H1. -elim H1; intro H2. -elim (less_Lim_so _ _ H2); intro eps; intros H4 H5. -elim H5; intro N; intro H6. -unfold Cauchy_Lim_prop2 in H. -elim (H _ H4); intro N'; intro H7. -generalize (le_max_l N N'); intro H8. -generalize (le_max_r N N'); intro H9. -generalize (H6 _ H8); intro H10. -generalize (H7 _ H9); intro H11. -elim H11; intros H12 H13. -apply less_irreflexive_unfolded with (x := y[+]eps). -eapply less_leEq_trans. -apply H10. -apply plus_cancel_leEq_rht with ([--]y). -rstepr eps. -exact H13. - -(* Second case similar to first case *) -elim (Lim_less_so _ _ H2); intro eps; intros H4 H5. -elim H5; intro N; intros H6. -unfold Cauchy_Lim_prop2 in H. -elim (H _ H4); intro N'; intros H7. -generalize (le_max_l N N'); intro H8. -generalize (le_max_r N N'); intro H9. -generalize (H6 _ H8); intro H10. -generalize (H7 _ H9); intro H11. -elim H11; intros H12 H13. -apply less_irreflexive_unfolded with (x := y). -eapply leEq_less_trans. -2: apply H10. -apply plus_cancel_leEq_rht with ([--]y[-]eps). -rstepl ([--]eps). -rstepr (seq (max N N') [-]y). -assumption. +Proof. + intros seq y H. + apply not_ap_imp_eq. + unfold not in |- *; intro H0. + generalize (ap_imp_less _ _ _ H0); intro H1. + elim H1; intro H2. + elim (less_Lim_so _ _ H2); intro eps; intros H4 H5. + elim H5; intro N; intro H6. + unfold Cauchy_Lim_prop2 in H. + elim (H _ H4); intro N'; intro H7. + generalize (le_max_l N N'); intro H8. + generalize (le_max_r N N'); intro H9. + generalize (H6 _ H8); intro H10. + generalize (H7 _ H9); intro H11. + elim H11; intros H12 H13. + apply less_irreflexive_unfolded with (x := y[+]eps). + eapply less_leEq_trans. + apply H10. + apply plus_cancel_leEq_rht with ([--]y). + rstepr eps. + exact H13. + (* Second case similar to first case *) + elim (Lim_less_so _ _ H2); intro eps; intros H4 H5. + elim H5; intro N; intros H6. + unfold Cauchy_Lim_prop2 in H. + elim (H _ H4); intro N'; intros H7. + generalize (le_max_l N N'); intro H8. + generalize (le_max_r N N'); intro H9. + generalize (H6 _ H8); intro H10. + generalize (H7 _ H9); intro H11. + elim H11; intros H12 H13. + apply less_irreflexive_unfolded with (x := y). + eapply leEq_less_trans. + 2: apply H10. + apply plus_cancel_leEq_rht with ([--]y[-]eps). + rstepl ([--]eps). + rstepr (seq (max N N') [-]y). + assumption. Qed. Lemma Lim_wd : forall (seq : nat -> IR) x y, x [=] y -> Cauchy_Lim_prop2 seq x -> Cauchy_Lim_prop2 seq y. -intros seq x y H H0. -red in |- *; red in H0. -intros eps H1. -elim (H0 _ H1). -intros N HN. -exists N. -intros. -astepr (seq m[-]x). -apply HN; assumption. +Proof. + intros seq x y H H0. + red in |- *; red in H0. + intros eps H1. + elim (H0 _ H1). + intros N HN. + exists N. + intros. + astepr (seq m[-]x). + apply HN; assumption. Qed. Lemma Lim_strext : forall seq1 seq2 : CauchySeq IR, Lim seq1 [#] Lim seq2 -> {n : nat | seq1 n [#] seq2 n}. -intros seq1 seq2 H. -cut ({n : nat | seq1 n [<] seq2 n} or {n : nat | seq2 n [<] seq1 n}). -intro H0; inversion_clear H0; rename X into H1; elim H1; intros n Hn. -exists n; apply less_imp_ap; assumption. -exists n; apply Greater_imp_ap; assumption. -cut (Lim seq1 [<] Lim seq2 or Lim seq2 [<] Lim seq1). intros H0. -2: apply ap_imp_less; assumption. -inversion_clear H0; [ left | right ]. -cut {n : nat | forall m : nat, n <= m -> seq1 m [<] seq2 m}. -2: apply Lim_less_Lim_so_seq_less_seq; assumption. -intro H0; elim H0; intros N HN. -exists N; apply HN; auto with arith. -cut {n : nat | forall m : nat, n <= m -> seq2 m [<] seq1 m}. -2: apply Lim_less_Lim_so_seq_less_seq; assumption. -intro H0; elim H0; intros N HN. -exists N; apply HN; auto with arith. +Proof. + intros seq1 seq2 H. + cut ({n : nat | seq1 n [<] seq2 n} or {n : nat | seq2 n [<] seq1 n}). + intro H0; inversion_clear H0; rename X into H1; elim H1; intros n Hn. + exists n; apply less_imp_ap; assumption. + exists n; apply Greater_imp_ap; assumption. + cut (Lim seq1 [<] Lim seq2 or Lim seq2 [<] Lim seq1). intros H0. + 2: apply ap_imp_less; assumption. + inversion_clear H0; [ left | right ]. + cut {n : nat | forall m : nat, n <= m -> seq1 m [<] seq2 m}. + 2: apply Lim_less_Lim_so_seq_less_seq; assumption. + intro H0; elim H0; intros N HN. + exists N; apply HN; auto with arith. + cut {n : nat | forall m : nat, n <= m -> seq2 m [<] seq1 m}. + 2: apply Lim_less_Lim_so_seq_less_seq; assumption. + intro H0; elim H0; intros N HN. + exists N; apply HN; auto with arith. Qed. Lemma Lim_ap_imp_seq_ap : forall seq1 seq2 : CauchySeq IR, Lim seq1 [#] Lim seq2 -> {N : nat | forall m, N <= m -> seq1 m [#] seq2 m}. -intros seq1 seq2 H. -elim (ap_imp_less _ _ _ H); intro. -elim (Lim_less_Lim_so_seq_less_seq _ _ a); intros N HN. -exists N; intros. -apply less_imp_ap; apply HN; assumption. -elim (Lim_less_Lim_so_seq_less_seq _ _ b); intros N HN. -exists N; intros. -apply Greater_imp_ap; apply HN; assumption. +Proof. + intros seq1 seq2 H. + elim (ap_imp_less _ _ _ H); intro. + elim (Lim_less_Lim_so_seq_less_seq _ _ a); intros N HN. + exists N; intros. + apply less_imp_ap; apply HN; assumption. + elim (Lim_less_Lim_so_seq_less_seq _ _ b); intros N HN. + exists N; intros. + apply Greater_imp_ap; apply HN; assumption. Qed. Lemma Lim_ap_imp_seq_ap' : forall seq1 seq2 : CauchySeq IR, Lim seq1 [#] Lim seq2 -> {N : nat | seq1 N [#] seq2 N}. -intros seq1 seq2 H. -elim (Lim_ap_imp_seq_ap _ _ H); intros N HN. -exists N; apply HN. -apply le_n. +Proof. + intros seq1 seq2 H. + elim (Lim_ap_imp_seq_ap _ _ H); intros N HN. + exists N; apply HN. + apply le_n. Qed. End Inequalities. @@ -507,298 +521,314 @@ Section Equiv_Cauchy. *** Equivalence of formulations of Cauchy *) Lemma Cauchy_prop1_prop : forall seq, Cauchy_prop1 seq -> Cauchy_prop seq. -intros seq H. -unfold Cauchy_prop1 in H. -unfold Cauchy_prop in |- *. -intros. -cut (e [#] Zero). -intro eNZ. -elim (Archimedes (One[/] e[//]eNZ)). -intros x H1. -elim (H x). -intros x0 H2. -split with x0. -intros m H3. -generalize (H2 _ H3). -intro. -apply AbsSmall_leEq_trans with (one_div_succ (R:=IR) x). - -unfold one_div_succ in |- *. -unfold Snring in |- *. -apply shift_div_leEq'. -apply nring_pos. -auto with arith. - -astepr (e[*]nring (S x)). -apply leEq_transitive with (e[*]nring x). -apply shift_leEq_mult' with eNZ. -assumption. - -assumption. - -apply less_leEq. -apply mult_resp_less_lft. -apply nring_less. -auto. - -assumption. - -assumption. -apply pos_ap_zero. -assumption. +Proof. + intros seq H. + unfold Cauchy_prop1 in H. + unfold Cauchy_prop in |- *. + intros. + cut (e [#] Zero). + intro eNZ. + elim (Archimedes (One[/] e[//]eNZ)). + intros x H1. + elim (H x). + intros x0 H2. + split with x0. + intros m H3. + generalize (H2 _ H3). + intro. + apply AbsSmall_leEq_trans with (one_div_succ (R:=IR) x). + unfold one_div_succ in |- *. + unfold Snring in |- *. + apply shift_div_leEq'. + apply nring_pos. + auto with arith. + astepr (e[*]nring (S x)). + apply leEq_transitive with (e[*]nring x). + apply shift_leEq_mult' with eNZ. + assumption. + assumption. + apply less_leEq. + apply mult_resp_less_lft. + apply nring_less. + auto. + assumption. + assumption. + apply pos_ap_zero. + assumption. Qed. Lemma Cauchy_prop2_prop : forall seq, Cauchy_prop2 seq -> Cauchy_prop seq. -intros seq H. -unfold Cauchy_prop in |- *. -intros e H0. -unfold Cauchy_prop2 in H. -elim H. -intro y; intros H1. -unfold Cauchy_Lim_prop2 in H1. -elim (H1 (e [/]TwoNZ)). -intro N. -intros H2. -exists N. -intros m H3. -generalize (H2 _ H3); intro H4. -generalize (le_n N); intro H5. -generalize (H2 _ H5); intro H6. -generalize (AbsSmall_minus _ _ _ _ H6); intro H7. -generalize (AbsSmall_plus _ _ _ _ _ H4 H7); intro H8. -rstepl (e [/]TwoNZ[+]e [/]TwoNZ). -rstepr (seq m[-]y[+] (y[-]seq N)). -assumption. -apply pos_div_two. -assumption. +Proof. + intros seq H. + unfold Cauchy_prop in |- *. + intros e H0. + unfold Cauchy_prop2 in H. + elim H. + intro y; intros H1. + unfold Cauchy_Lim_prop2 in H1. + elim (H1 (e [/]TwoNZ)). + intro N. + intros H2. + exists N. + intros m H3. + generalize (H2 _ H3); intro H4. + generalize (le_n N); intro H5. + generalize (H2 _ H5); intro H6. + generalize (AbsSmall_minus _ _ _ _ H6); intro H7. + generalize (AbsSmall_plus _ _ _ _ _ H4 H7); intro H8. + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + rstepr (seq m[-]y[+] (y[-]seq N)). + assumption. + apply pos_div_two. + assumption. Qed. Lemma Cauchy_Lim_prop3_prop2 : forall seq y, Cauchy_Lim_prop3 seq y -> Cauchy_Lim_prop2 seq y. -intros seq y H. -unfold Cauchy_Lim_prop2 in |- *. -intros eps H0. -unfold Cauchy_Lim_prop3 in H. -generalize (pos_ap_zero _ _ H0); intro Heps. -elim (Archimedes (One[/] eps[//]Heps)). -intro K; intros H1. -elim (H K). -intro N; intros H2. -exists N. -intros m H3. -generalize (H2 _ H3); intro H4. -apply AbsSmall_leEq_trans with (one_div_succ (R:=IR) K); try assumption. -unfold one_div_succ in |- *. -unfold Snring in |- *. -apply shift_div_leEq'. -apply nring_pos. -auto with arith. -apply leEq_transitive with (eps[*]nring K). -apply shift_leEq_mult' with Heps; assumption. - -astepl (nring K[*]eps). -apply less_leEq. -apply mult_resp_less; try assumption. -apply nring_less. -auto with arith. +Proof. + intros seq y H. + unfold Cauchy_Lim_prop2 in |- *. + intros eps H0. + unfold Cauchy_Lim_prop3 in H. + generalize (pos_ap_zero _ _ H0); intro Heps. + elim (Archimedes (One[/] eps[//]Heps)). + intro K; intros H1. + elim (H K). + intro N; intros H2. + exists N. + intros m H3. + generalize (H2 _ H3); intro H4. + apply AbsSmall_leEq_trans with (one_div_succ (R:=IR) K); try assumption. + unfold one_div_succ in |- *. + unfold Snring in |- *. + apply shift_div_leEq'. + apply nring_pos. + auto with arith. + apply leEq_transitive with (eps[*]nring K). + apply shift_leEq_mult' with Heps; assumption. + astepl (nring K[*]eps). + apply less_leEq. + apply mult_resp_less; try assumption. + apply nring_less. + auto with arith. Qed. Lemma Cauchy_prop3_prop2 : forall seq, Cauchy_prop3 seq -> Cauchy_prop2 seq. -unfold Cauchy_prop2 in |- *. -unfold Cauchy_prop3 in |- *. -intros seq H. -elim H; intros x H0. -exists x. -apply Cauchy_Lim_prop3_prop2. -assumption. +Proof. + unfold Cauchy_prop2 in |- *. + unfold Cauchy_prop3 in |- *. + intros seq H. + elim H; intros x H0. + exists x. + apply Cauchy_Lim_prop3_prop2. + assumption. Qed. Lemma Cauchy_prop3_prop : forall seq, Cauchy_prop3 seq -> Cauchy_prop seq. -intros. -apply Cauchy_prop2_prop. -apply Cauchy_prop3_prop2. -assumption. +Proof. + intros. + apply Cauchy_prop2_prop. + apply Cauchy_prop3_prop2. + assumption. Qed. Definition Build_CauchySeq1 : forall seq, Cauchy_prop1 seq -> CauchySeqR. -intros. -unfold CauchySeqR in |- *. -apply Build_CauchySeq with seq. -apply Cauchy_prop1_prop. -assumption. +Proof. + intros. + unfold CauchySeqR in |- *. + apply Build_CauchySeq with seq. + apply Cauchy_prop1_prop. + assumption. Defined. Lemma Cauchy_Lim_prop4_prop3 : forall seq y, Cauchy_Lim_prop4 seq y -> Cauchy_Lim_prop3 seq y. -intros. -unfold Cauchy_Lim_prop4 in H. -unfold Cauchy_Lim_prop3 in |- *. -intros. -exists k. -intros. -apply AbsSmall_leEq_trans with (one_div_succ (R:=IR) m). -2: apply H. -apply one_div_succ_resp_leEq. -assumption. +Proof. + intros. + unfold Cauchy_Lim_prop4 in H. + unfold Cauchy_Lim_prop3 in |- *. + intros. + exists k. + intros. + apply AbsSmall_leEq_trans with (one_div_succ (R:=IR) m). + 2: apply H. + apply one_div_succ_resp_leEq. + assumption. Qed. Lemma Cauchy_Lim_prop4_prop2 : forall seq y, Cauchy_Lim_prop4 seq y -> Cauchy_Lim_prop2 seq y. -intros. -apply Cauchy_Lim_prop3_prop2. -apply Cauchy_Lim_prop4_prop3. -assumption. +Proof. + intros. + apply Cauchy_Lim_prop3_prop2. + apply Cauchy_Lim_prop4_prop3. + assumption. Qed. Lemma Cauchy_prop4_prop3 : forall seq, Cauchy_prop4 seq -> Cauchy_prop3 seq. -unfold Cauchy_prop4 in |- *. -unfold Cauchy_prop3 in |- *. -intros seq H. -elim H; intros. -exists x. -apply Cauchy_Lim_prop4_prop3. -assumption. +Proof. + unfold Cauchy_prop4 in |- *. + unfold Cauchy_prop3 in |- *. + intros seq H. + elim H; intros. + exists x. + apply Cauchy_Lim_prop4_prop3. + assumption. Qed. Lemma Cauchy_prop4_prop : forall seq, Cauchy_prop4 seq -> Cauchy_prop seq. -intros. -apply Cauchy_prop3_prop. -apply Cauchy_prop4_prop3. -assumption. +Proof. + intros. + apply Cauchy_prop3_prop. + apply Cauchy_prop4_prop3. + assumption. Qed. Definition Build_CauchySeq4 : forall seq, Cauchy_prop4 seq -> CauchySeqR. -intros. -unfold CauchySeqR in |- *. -apply Build_CauchySeq with seq. -apply Cauchy_prop4_prop. -assumption. +Proof. + intros. + unfold CauchySeqR in |- *. + apply Build_CauchySeq with seq. + apply Cauchy_prop4_prop. + assumption. Defined. Definition Build_CauchySeq4_y : forall seq y, Cauchy_Lim_prop4 seq y -> CauchySeqR. -intros. -apply Build_CauchySeq4 with seq. -unfold Cauchy_prop4 in |- *. -exists y. -assumption. +Proof. + intros. + apply Build_CauchySeq4 with seq. + unfold Cauchy_prop4 in |- *. + exists y. + assumption. Defined. Lemma Lim_CauchySeq4 : forall seq y H, Lim (Build_CauchySeq4_y seq y H) [=] y. -intros. -apply eq_symmetric_unfolded. -apply Limits_unique. -apply Cauchy_Lim_prop3_prop2. -apply Cauchy_Lim_prop4_prop3. -unfold Build_CauchySeq4_y in |- *. -unfold Build_CauchySeq4 in |- *. -unfold CS_seq in |- *. -assumption. +Proof. + intros. + apply eq_symmetric_unfolded. + apply Limits_unique. + apply Cauchy_Lim_prop3_prop2. + apply Cauchy_Lim_prop4_prop3. + unfold Build_CauchySeq4_y in |- *. + unfold Build_CauchySeq4 in |- *. + unfold CS_seq in |- *. + assumption. Qed. Definition Build_CauchySeq2 : forall seq, Cauchy_prop2 seq -> CauchySeqR. -intros. -unfold CauchySeqR in |- *. -apply Build_CauchySeq with seq. -apply Cauchy_prop2_prop. -assumption. +Proof. + intros. + unfold CauchySeqR in |- *. + apply Build_CauchySeq with seq. + apply Cauchy_prop2_prop. + assumption. Defined. Definition Build_CauchySeq2_y : forall seq y, Cauchy_Lim_prop2 seq y -> CauchySeqR. -intros. -apply Build_CauchySeq2 with seq. -unfold Cauchy_prop2 in |- *. -exists y. -assumption. +Proof. + intros. + apply Build_CauchySeq2 with seq. + unfold Cauchy_prop2 in |- *. + exists y. + assumption. Defined. Lemma Lim_CauchySeq2 : forall seq y H, Lim (Build_CauchySeq2_y seq y H) [=] y. -intros. -apply eq_symmetric_unfolded. -apply Limits_unique. -unfold Build_CauchySeq2_y in |- *. -unfold Build_CauchySeq2 in |- *. -unfold CS_seq in |- *. -assumption. +Proof. + intros. + apply eq_symmetric_unfolded. + apply Limits_unique. + unfold Build_CauchySeq2_y in |- *. + unfold Build_CauchySeq2 in |- *. + unfold CS_seq in |- *. + assumption. Qed. (** Well definedness. *) Lemma Cauchy_prop_wd' : forall seq1 seq2 : nat -> IR, Cauchy_prop seq1 -> {N : nat | forall n, N <= n -> seq1 n [=] seq2 n} -> Cauchy_prop seq2. -intros seq1 seq2 H H0. -red in |- *. intros e H1. -elim (H (e[/]TwoNZ) (pos_div_two IR e H1)). -intros N Hn. -destruct H0 as [M H0]. -exists (max M N). intros. -astepr (seq1 m[-]seq1 (max M N)). -astepr ((seq1 m[-]seq1 N)[+](seq1 N [-]seq1 (max M N))). -apply AbsSmall_eps_div_two. -apply Hn. eauto with arith. -apply AbsSmall_minus. apply Hn. eauto with arith. -rational. -apply cg_minus_wd; apply H0; eauto with arith. +Proof. + intros seq1 seq2 H H0. + red in |- *. intros e H1. + elim (H (e[/]TwoNZ) (pos_div_two IR e H1)). + intros N Hn. + destruct H0 as [M H0]. + exists (max M N). intros. + astepr (seq1 m[-]seq1 (max M N)). + astepr ((seq1 m[-]seq1 N)[+](seq1 N [-]seq1 (max M N))). + apply AbsSmall_eps_div_two. + apply Hn. eauto with arith. + apply AbsSmall_minus. apply Hn. eauto with arith. + rational. + apply cg_minus_wd; apply H0; eauto with arith. Qed. Lemma Cauchy_prop_wd : forall seq1 seq2 : nat -> IR, Cauchy_prop seq1 -> (forall n, seq1 n [=] seq2 n) -> Cauchy_prop seq2. -intros. -apply Cauchy_prop_wd' with seq1; auto. -exists 0. -auto. +Proof. + intros. + apply Cauchy_prop_wd' with seq1; auto. + exists 0. + auto. Qed. Lemma Cauchy_Lim_prop2_wd' : forall seq1 seq2 c, Cauchy_Lim_prop2 seq1 c -> { N : nat | forall n, N <= n -> seq1 n [=] seq2 n} -> Cauchy_Lim_prop2 seq2 c. -intros seq1 seq2 c H1 H2. -red in |- *. intros eps H3. -elim (H1 eps H3). -intros M H4. -destruct H2 as [N H2]. -exists (max N M) . -intros. -assert (N <= m); eauto with arith. -assert (M <= m); eauto with arith. -astepr (seq1 m[-]c). -apply H4; auto. +Proof. + intros seq1 seq2 c H1 H2. + red in |- *. intros eps H3. + elim (H1 eps H3). + intros M H4. + destruct H2 as [N H2]. + exists (max N M) . + intros. + assert (N <= m); eauto with arith. + assert (M <= m); eauto with arith. + astepr (seq1 m[-]c). + apply H4; auto. Qed. Lemma Cauchy_Lim_prop2_wd : forall seq1 seq2 c, Cauchy_Lim_prop2 seq1 c -> - (forall n, seq1 n [=] seq2 n) -> Cauchy_Lim_prop2 seq2 c. -intros. -apply Cauchy_Lim_prop2_wd' with seq1; auto. -exists 0. -auto. + (forall n, seq1 n [=] seq2 n) -> Cauchy_Lim_prop2 seq2 c. +Proof. + intros. + apply Cauchy_Lim_prop2_wd' with seq1; auto. + exists 0. + auto. Qed. Lemma Lim_wd'' : forall seq1 seq2 : CauchySeqR, {N : nat | forall n : nat, N <= n -> seq1 n [=] seq2 n} -> Lim seq1 [=] Lim seq2. -intros seq1 seq2 H. destruct H as [N H]. -cut (Cauchy_Lim_prop2 seq1 (Lim seq2)). -intro. -apply eq_symmetric_unfolded. -apply Limits_unique; assumption. -apply Cauchy_Lim_prop2_wd' with (seq2:nat -> IR). -apply Cauchy_complete. -exists N. -intros; apply eq_symmetric_unfolded. auto. +Proof. + intros seq1 seq2 H. destruct H as [N H]. + cut (Cauchy_Lim_prop2 seq1 (Lim seq2)). + intro. + apply eq_symmetric_unfolded. + apply Limits_unique; assumption. + apply Cauchy_Lim_prop2_wd' with (seq2:nat -> IR). + apply Cauchy_complete. + exists N. + intros; apply eq_symmetric_unfolded. auto. Qed. Lemma Lim_wd' : forall seq1 seq2 : CauchySeqR, (forall n : nat, seq1 n [=] seq2 n) -> Lim seq1 [=] Lim seq2. -intros. -apply Lim_wd''; auto. -exists 0. -auto. +Proof. + intros. + apply Lim_wd''; auto. + exists 0. + auto. Qed. Lemma Lim_unique : forall seq x y, Cauchy_Lim_prop2 seq x -> Cauchy_Lim_prop2 seq y -> x [=] y. -intros. -cut (Cauchy_prop seq); [ intro | apply Cauchy_prop2_prop; exists y; auto ]. -apply eq_transitive_unfolded with (Lim (Build_CauchySeq _ _ X1)). -apply Limits_unique; auto. -apply eq_symmetric_unfolded; apply Limits_unique; auto. +Proof. + intros. + cut (Cauchy_prop seq); [ intro | apply Cauchy_prop2_prop; exists y; auto ]. + apply eq_transitive_unfolded with (Lim (Build_CauchySeq _ _ X1)). + apply Limits_unique; auto. + apply eq_symmetric_unfolded; apply Limits_unique; auto. Qed. End Equiv_Cauchy. @@ -814,188 +844,199 @@ We begin by defining the constant sequence and proving that it is Cauchy with th *) Definition Cauchy_const : IR -> CauchySeq IR. -intro x. -apply Build_CauchySeq with (fun n : nat => x). -intros; exists 0. -intros; astepr ZeroR. -apply zero_AbsSmall; apply less_leEq; assumption. +Proof. + intro x. + apply Build_CauchySeq with (fun n : nat => x). + intros; exists 0. + intros; astepr ZeroR. + apply zero_AbsSmall; apply less_leEq; assumption. Defined. Lemma Lim_const : forall x : IR, x [=] Lim (Cauchy_const x). -intros. -apply Limits_unique. -red in |- *; intro; exists 0. -intros; unfold Cauchy_const in |- *; simpl in |- *. -astepr ZeroR; apply zero_AbsSmall; apply less_leEq; assumption. +Proof. + intros. + apply Limits_unique. + red in |- *; intro; exists 0. + intros; unfold Cauchy_const in |- *; simpl in |- *. + astepr ZeroR; apply zero_AbsSmall; apply less_leEq; assumption. Qed. Lemma Cauchy_Lim_plus : forall seq1 seq2 y1 y2, Cauchy_Lim_prop2 seq1 y1 -> Cauchy_Lim_prop2 seq2 y2 -> Cauchy_Lim_prop2 (fun n => seq1 n [+] seq2 n) (y1 [+] y2). -intros seq1 seq2 y1 y2 H H0. -unfold Cauchy_Lim_prop2 in |- *. -intros eps H1. -cut (Zero [<] eps [/]TwoNZ). -intro H2. -elim (H _ H2); intros x H3. -elim (H0 _ H2); intros x0 H4. -exists (max x x0). -intros. -rstepr (seq1 m[-]y1[+] (seq2 m[-]y2)). -apply AbsSmall_eps_div_two. -apply H3. -apply le_trans with (max x x0). -apply le_max_l. -assumption. - -apply H4. -apply le_trans with (max x x0). -apply le_max_r. -assumption. - -apply pos_div_two. -assumption. +Proof. + intros seq1 seq2 y1 y2 H H0. + unfold Cauchy_Lim_prop2 in |- *. + intros eps H1. + cut (Zero [<] eps [/]TwoNZ). + intro H2. + elim (H _ H2); intros x H3. + elim (H0 _ H2); intros x0 H4. + exists (max x x0). + intros. + rstepr (seq1 m[-]y1[+] (seq2 m[-]y2)). + apply AbsSmall_eps_div_two. + apply H3. + apply le_trans with (max x x0). + apply le_max_l. + assumption. + apply H4. + apply le_trans with (max x x0). + apply le_max_r. + assumption. + apply pos_div_two. + assumption. Qed. Lemma Cauchy_plus : forall seq1 seq2 : CauchySeqR, Cauchy_prop (fun n => seq1 n [+] seq2 n). -intros. -apply Cauchy_prop2_prop. -unfold Cauchy_prop2 in |- *. -exists (Lim seq1[+]Lim seq2). -apply Cauchy_Lim_plus. -apply Cauchy_complete. -apply Cauchy_complete. +Proof. + intros. + apply Cauchy_prop2_prop. + unfold Cauchy_prop2 in |- *. + exists (Lim seq1[+]Lim seq2). + apply Cauchy_Lim_plus. + apply Cauchy_complete. + apply Cauchy_complete. Qed. Lemma Lim_plus : forall seq1 seq2 : CauchySeqR, Lim (Build_CauchySeq _ _ (Cauchy_plus seq1 seq2)) [=] Lim seq1 [+] Lim seq2. -intros. -apply eq_symmetric_unfolded. -apply Limits_unique. -simpl in |- *. -apply Cauchy_Lim_plus. -apply Cauchy_complete. -apply Cauchy_complete. +Proof. + intros. + apply eq_symmetric_unfolded. + apply Limits_unique. + simpl in |- *. + apply Cauchy_Lim_plus. + apply Cauchy_complete. + apply Cauchy_complete. Qed. Lemma Cauchy_Lim_inv : forall seq y, Cauchy_Lim_prop2 seq y -> Cauchy_Lim_prop2 (fun n => [--] (seq n)) [--]y. -intros seq y H. -unfold Cauchy_Lim_prop2 in |- *. -intros eps H0. -elim (H _ H0); intros x H1. -exists x. -intros. -rstepr ([--] (seq m[-]y)). -apply inv_resp_AbsSmall. -apply H1. -assumption. +Proof. + intros seq y H. + unfold Cauchy_Lim_prop2 in |- *. + intros eps H0. + elim (H _ H0); intros x H1. + exists x. + intros. + rstepr ([--] (seq m[-]y)). + apply inv_resp_AbsSmall. + apply H1. + assumption. Qed. Lemma Cauchy_inv : forall seq : CauchySeqR, Cauchy_prop (fun n => [--] (seq n)). -intros. -apply Cauchy_prop2_prop. -unfold Cauchy_prop2 in |- *. -exists ([--] (Lim seq)). -apply Cauchy_Lim_inv. -apply Cauchy_complete. +Proof. + intros. + apply Cauchy_prop2_prop. + unfold Cauchy_prop2 in |- *. + exists ([--] (Lim seq)). + apply Cauchy_Lim_inv. + apply Cauchy_complete. Qed. Lemma Lim_inv : forall seq : CauchySeqR, Lim (Build_CauchySeq _ _ (Cauchy_inv seq)) [=] [--] (Lim seq). -intros. -apply eq_symmetric_unfolded. -apply Limits_unique. -simpl in |- *. -apply Cauchy_Lim_inv. -apply Cauchy_complete. +Proof. + intros. + apply eq_symmetric_unfolded. + apply Limits_unique. + simpl in |- *. + apply Cauchy_Lim_inv. + apply Cauchy_complete. Qed. Lemma Cauchy_Lim_minus : forall seq1 seq2 y1 y2, Cauchy_Lim_prop2 seq1 y1 -> Cauchy_Lim_prop2 seq2 y2 -> Cauchy_Lim_prop2 (fun n => seq1 n[-]seq2 n) (y1[-]y2). -intros. -unfold cg_minus in |- *. -change - (Cauchy_Lim_prop2 (fun n : nat => seq1 n[+] (fun m : nat => [--] (seq2 m)) n) - (y1[+][--]y2)) in |- *. -apply Cauchy_Lim_plus. -assumption. -apply Cauchy_Lim_inv. -assumption. +Proof. + intros. + unfold cg_minus in |- *. + change (Cauchy_Lim_prop2 (fun n : nat => seq1 n[+] (fun m : nat => [--] (seq2 m)) n) + (y1[+][--]y2)) in |- *. + apply Cauchy_Lim_plus. + assumption. + apply Cauchy_Lim_inv. + assumption. Qed. Lemma Cauchy_minus : forall seq1 seq2 : CauchySeqR, Cauchy_prop (fun n => seq1 n[-]seq2 n). -intros. -apply Cauchy_prop2_prop. -unfold Cauchy_prop2 in |- *. -exists (Lim seq1[-]Lim seq2). -apply Cauchy_Lim_minus. -apply Cauchy_complete. -apply Cauchy_complete. +Proof. + intros. + apply Cauchy_prop2_prop. + unfold Cauchy_prop2 in |- *. + exists (Lim seq1[-]Lim seq2). + apply Cauchy_Lim_minus. + apply Cauchy_complete. + apply Cauchy_complete. Qed. Lemma Lim_minus : forall seq1 seq2 : CauchySeqR, Lim (Build_CauchySeq _ _ (Cauchy_minus seq1 seq2)) [=] Lim seq1[-]Lim seq2. -intros. -apply eq_symmetric_unfolded. -apply Limits_unique. -simpl in |- *. -apply Cauchy_Lim_minus. -apply Cauchy_complete. -apply Cauchy_complete. +Proof. + intros. + apply eq_symmetric_unfolded. + apply Limits_unique. + simpl in |- *. + apply Cauchy_Lim_minus. + apply Cauchy_complete. + apply Cauchy_complete. Qed. Lemma Cauchy_Lim_mult : forall seq1 seq2 y1 y2, Cauchy_Lim_prop2 seq1 y1 -> Cauchy_Lim_prop2 seq2 y2 -> Cauchy_Lim_prop2 (fun n => seq1 n [*] seq2 n) (y1 [*] y2). -unfold Cauchy_Lim_prop2 in |- *. intros. rename X into H. rename X0 into H0. rename X1 into H1. -elim (mult_contin _ y1 y2 eps H1). intro c. intros H2 H3. -elim H3. clear H3. intro d. intros H3 H4. -elim (H c H2). clear H. intro N1. intros H. -elim (H0 d H3). clear H0. intro N2. intros H0. -cut {N : nat | N1 <= N /\ N2 <= N}. intro H5. -elim H5. clear H5. intro N. intro H5. elim H5. clear H5. intros. -exists N. intros. -apply AbsSmall_wdr_unfolded with ([--] (y1[*]y2[-]seq1 m[*]seq2 m)). -apply inv_resp_AbsSmall. -apply H4; clear H4; intros. -apply AbsSmall_wdr_unfolded with ([--] (seq1 m[-]y1)). -apply inv_resp_AbsSmall. -apply H. apply le_trans with N; auto. -rational. -apply AbsSmall_wdr_unfolded with ([--] (seq2 m[-]y2)). -apply inv_resp_AbsSmall. -apply H0. apply le_trans with N; auto. -rational. -rational. -elim (le_lt_dec N1 N2); intros. -exists N2. auto. -exists N1. split. auto. auto with arith. +Proof. + unfold Cauchy_Lim_prop2 in |- *. intros. rename X into H. rename X0 into H0. rename X1 into H1. + elim (mult_contin _ y1 y2 eps H1). intro c. intros H2 H3. + elim H3. clear H3. intro d. intros H3 H4. + elim (H c H2). clear H. intro N1. intros H. + elim (H0 d H3). clear H0. intro N2. intros H0. + cut {N : nat | N1 <= N /\ N2 <= N}. intro H5. + elim H5. clear H5. intro N. intro H5. elim H5. clear H5. intros. + exists N. intros. + apply AbsSmall_wdr_unfolded with ([--] (y1[*]y2[-]seq1 m[*]seq2 m)). + apply inv_resp_AbsSmall. + apply H4; clear H4; intros. + apply AbsSmall_wdr_unfolded with ([--] (seq1 m[-]y1)). + apply inv_resp_AbsSmall. + apply H. apply le_trans with N; auto. + rational. + apply AbsSmall_wdr_unfolded with ([--] (seq2 m[-]y2)). + apply inv_resp_AbsSmall. + apply H0. apply le_trans with N; auto. + rational. + rational. + elim (le_lt_dec N1 N2); intros. + exists N2. auto. + exists N1. split. auto. auto with arith. Qed. Lemma Cauchy_mult : forall seq1 seq2 : CauchySeqR, Cauchy_prop (fun n => seq1 n [*] seq2 n). -intros. -apply Cauchy_prop2_prop. -unfold Cauchy_prop2 in |- *. -exists (Lim seq1[*]Lim seq2). -apply Cauchy_Lim_mult. -apply Cauchy_complete. -apply Cauchy_complete. +Proof. + intros. + apply Cauchy_prop2_prop. + unfold Cauchy_prop2 in |- *. + exists (Lim seq1[*]Lim seq2). + apply Cauchy_Lim_mult. + apply Cauchy_complete. + apply Cauchy_complete. Qed. Lemma Lim_mult : forall seq1 seq2 : CauchySeqR, Lim (Build_CauchySeq _ _ (Cauchy_mult seq1 seq2)) [=] Lim seq1 [*] Lim seq2. -intros. -apply eq_symmetric_unfolded. -apply Limits_unique. -simpl in |- *. -apply Cauchy_Lim_mult. -apply Cauchy_complete. -apply Cauchy_complete. +Proof. + intros. + apply eq_symmetric_unfolded. + apply Limits_unique. + simpl in |- *. + apply Cauchy_Lim_mult. + apply Cauchy_complete. + apply Cauchy_complete. Qed. End Cauchy_props. diff --git a/reals/Cauchy_CReals.v b/reals/Cauchy_CReals.v index 1669647ce..9fdbcb910 100644 --- a/reals/Cauchy_CReals.v +++ b/reals/Cauchy_CReals.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Cauchy_COF. Require Export CReals. @@ -64,12 +64,11 @@ Proof. unfold inject_Q in |- *. simpl in |- *; intro H0. elim H0; intro. - elim a; intros N HN. - elim HN; clear H0 a HN; intros e He HN; simpl in HN. - apply (less_irreflexive_unfolded _ e). - apply leEq_less_trans with (Zero:F); auto. - astepr (x[-]x); astepr (y[-]x); eauto with arith. - + elim a; intros N HN. + elim HN; clear H0 a HN; intros e He HN; simpl in HN. + apply (less_irreflexive_unfolded _ e). + apply leEq_less_trans with (Zero:F); auto. + astepr (x[-]x); astepr (y[-]x); eauto with arith. elim b; intros N HN. elim HN; clear H0 b HN; intros e He HN; simpl in HN. apply (less_irreflexive_unfolded _ e). @@ -83,12 +82,11 @@ Proof. unfold inject_Q in |- *. simpl in |- *; intro H. elim H; intro. - elim a; intros N HN. - elim HN; clear H a HN; intros e He HN; simpl in HN. - apply (less_irreflexive_unfolded _ e). - apply leEq_less_trans with (Zero:F); auto. - astepr (x[+]y[-] (x[+]y)); eauto with arith. - + elim a; intros N HN. + elim HN; clear H a HN; intros e He HN; simpl in HN. + apply (less_irreflexive_unfolded _ e). + apply leEq_less_trans with (Zero:F); auto. + astepr (x[+]y[-] (x[+]y)); eauto with arith. elim b; intros N HN. elim HN; clear H b HN; intros e He HN; simpl in HN. apply (less_irreflexive_unfolded _ e). @@ -102,12 +100,11 @@ Proof. unfold inject_Q in |- *. simpl in |- *; intro H. elim H; intro. - elim a; intros N HN. - elim HN; clear H a HN; intros e He HN; simpl in HN. - apply (less_irreflexive_unfolded _ e). - apply leEq_less_trans with (Zero:F); auto. - astepr ( [--]x[-][--]x); eauto with arith. - + elim a; intros N HN. + elim HN; clear H a HN; intros e He HN; simpl in HN. + apply (less_irreflexive_unfolded _ e). + apply leEq_less_trans with (Zero:F); auto. + astepr ( [--]x[-][--]x); eauto with arith. elim b; intros N HN. elim HN; clear H b HN; intros e He HN; simpl in HN. apply (less_irreflexive_unfolded _ e). @@ -121,9 +118,9 @@ Proof. simpl in |- *. exists 0. exists ((y[-]x) [/]TwoNZ). - apply pos_div_two. - apply shift_zero_less_minus. - assumption. + apply pos_div_two. + apply shift_zero_less_minus. + assumption. intros. apply less_leEq; apply pos_div_two'. simpl in |- *. @@ -131,24 +128,25 @@ Proof. Qed. Lemma ing_ap : forall x y : F, x [#] y -> inject_Q x [#] inject_Q y. -intros x y H; elim (ap_imp_less _ _ _ H); intro Hlt; [ left | right ]; - apply ing_lt; auto. + intros x y H; elim (ap_imp_less _ _ _ H); intro Hlt; [ left | right ]; apply ing_lt; auto. Qed. Lemma ing_cancel_eq : forall x y : F, inject_Q x [=] inject_Q y -> x [=] y. -intros x y Hxy. -apply not_ap_imp_eq; intro Hap. -elim (ap_irreflexive_unfolded _ (inject_Q x)). -astepr (inject_Q y). -apply ing_ap; auto. +Proof. + intros x y Hxy. + apply not_ap_imp_eq; intro Hap. + elim (ap_irreflexive_unfolded _ (inject_Q x)). + astepr (inject_Q y). + apply ing_ap; auto. Qed. Lemma ing_cancel_less : forall x y : F, inject_Q x [<] inject_Q y -> x [<] y. -intros x y H. -elim H; intros N HN; elim HN; clear H HN; intros e He HN; simpl in HN. -apply less_leEq_trans with (x[+]e). -apply shift_less_plus'; astepl (Zero:F); auto. -apply shift_plus_leEq'; eauto. +Proof. + intros x y H. + elim H; intros N HN; elim HN; clear H HN; intros e He HN; simpl in HN. + apply less_leEq_trans with (x[+]e). + apply shift_less_plus'; astepl (Zero:F); auto. + apply shift_plus_leEq'; eauto. Qed. Lemma ing_le : forall x y : F, x [<=] y -> inject_Q x [<=] inject_Q y. @@ -176,43 +174,40 @@ Proof. elim H. intros H0 H1. split. - apply ing_cancel_leEq. - astepl ( [--] (inject_Q e)). - astepr (inject_Q x[-]inject_Q y). - assumption. - astepl (inject_Q x[+][--] (inject_Q y)). - apply eq_transitive_unfolded with (inject_Q x[+]inject_Q [--]y). - apply plus_resp_eq. - apply eq_symmetric_unfolded. - apply ing_min. - Step_final (inject_Q (x[+][--]y)). - apply eq_symmetric_unfolded. - apply ing_plus. - apply eq_symmetric_unfolded. - apply ing_min. - + apply ing_cancel_leEq. + astepl ( [--] (inject_Q e)). + astepr (inject_Q x[-]inject_Q y). + assumption. + astepl (inject_Q x[+][--] (inject_Q y)). + apply eq_transitive_unfolded with (inject_Q x[+]inject_Q [--]y). + apply plus_resp_eq. + apply eq_symmetric_unfolded. + apply ing_min. + Step_final (inject_Q (x[+][--]y)). + apply eq_symmetric_unfolded. + apply ing_plus. + apply eq_symmetric_unfolded. + apply ing_min. apply ing_cancel_leEq. astepl (inject_Q x[-]inject_Q y). - assumption. + assumption. astepl (inject_Q x[+][--] (inject_Q y)). apply eq_transitive_unfolded with (inject_Q x[+]inject_Q [--]y). - apply plus_resp_eq. - apply eq_symmetric_unfolded. - apply ing_min. + apply plus_resp_eq. + apply eq_symmetric_unfolded. + apply ing_min. Step_final (inject_Q (x[+][--]y)). apply eq_symmetric_unfolded. apply ing_plus. Qed. Lemma ing_One : inject_Q (One:F) [=] One. +Proof. apply not_ap_imp_eq; intro H. - elim H; intro Hlt; elim Hlt; intros N HN; elim HN; clear H Hlt HN; - intros e He HN; simpl in HN. - - apply (less_irreflexive_unfolded F Zero). - apply less_leEq_trans with e; auto. - astepr (One[-] (One:F)); eauto. - + elim H; intro Hlt; elim Hlt; intros N HN; elim HN; clear H Hlt HN; intros e He HN; simpl in HN. + apply (less_irreflexive_unfolded F Zero). + apply less_leEq_trans with e; auto. + astepr (One[-] (One:F)); eauto. apply (less_irreflexive_unfolded F Zero). apply less_leEq_trans with e; auto. astepr (One[-] (One:F)); eauto. @@ -220,27 +215,25 @@ Qed. Lemma ing_nring' : forall m n : nat, CS_seq _ (nring (R:=R_COrdField') n) m [=] CS_seq _ (inject_Q (nring n)) m. -intros. -induction n as [| n Hrecn]; simpl in |- *; algebra. +Proof. + intros. + induction n as [| n Hrecn]; simpl in |- *; algebra. Qed. Lemma ing_nring : forall n : nat, nring n [=] inject_Q (nring n). Proof. intros. apply not_ap_imp_eq; intro Hap. - elim Hap; intro Hlt; elim Hlt; intros N HN; elim HN; clear Hap Hlt HN; - intros e He HN. - - apply (less_irreflexive_unfolded F Zero). - apply less_leEq_trans with e; auto. - eapply leEq_wdr. - apply (HN N); auto. - apply x_minus_x; apply eq_symmetric_unfolded; apply ing_nring'. - + elim Hap; intro Hlt; elim Hlt; intros N HN; elim HN; clear Hap Hlt HN; intros e He HN. + apply (less_irreflexive_unfolded F Zero). + apply less_leEq_trans with e; auto. + eapply leEq_wdr. + apply (HN N); auto. + apply x_minus_x; apply eq_symmetric_unfolded; apply ing_nring'. apply (less_irreflexive_unfolded F Zero). apply less_leEq_trans with e; auto. eapply leEq_wdr. - apply (HN N); auto. + apply (HN N); auto. apply x_minus_x; apply ing_nring'. Qed. @@ -250,12 +243,11 @@ Proof. unfold inject_Q in |- *. simpl in |- *; intro H. elim H; intro. - elim a; intros N HN. - elim HN; clear H a HN; intros e He HN; simpl in HN. - apply (less_irreflexive_unfolded _ e). - apply leEq_less_trans with (Zero:F); auto. - astepr (x[*]y[-]x[*]y); eauto with arith. - + elim a; intros N HN. + elim HN; clear H a HN; intros e He HN; simpl in HN. + apply (less_irreflexive_unfolded _ e). + apply leEq_less_trans with (Zero:F); auto. + astepr (x[*]y[-]x[*]y); eauto with arith. elim b; intros N HN. elim HN; clear H b HN; intros e He HN; simpl in HN. apply (less_irreflexive_unfolded _ e). @@ -269,17 +261,16 @@ Lemma ing_div_three : forall x, inject_Q x [/]ThreeNZ [=] inject_Q (x [/]ThreeNZ Proof. intros. apply mult_cancel_lft with (Three:R_COrdField'). - apply pos_ap_zero. - apply pos_three. + apply pos_ap_zero. + apply pos_three. (* JZ: Removed Rational. *) apply eq_symmetric_unfolded. - apply - eq_transitive_unfolded with (inject_Q (Three:F) [*]inject_Q (x [/]ThreeNZ)). - apply mult_wdl. - apply ing_nring. + apply eq_transitive_unfolded with (inject_Q (Three:F) [*]inject_Q (x [/]ThreeNZ)). + apply mult_wdl. + apply ing_nring. apply eq_transitive_unfolded with (inject_Q (Three[*]x [/]ThreeNZ)). - apply eq_symmetric_unfolded. - apply ing_mult. + apply eq_symmetric_unfolded. + apply ing_mult. astepr (inject_Q x). apply ing_eq; algebra. Qed. @@ -291,26 +282,22 @@ Lemma ing_n : forall x n H1 H2, Proof. intros. apply mult_cancel_lft with (inject_Q (nring (R:=F) n)). - apply Greater_imp_ap. - astepr (nring (R:=R_COrdField') n). - - apply nring_pos. - apply neq_O_lt. - apply nring_ap_zero_imp with F. - assumption. - - apply ing_nring. - + apply Greater_imp_ap. + astepr (nring (R:=R_COrdField') n). + apply nring_pos. + apply neq_O_lt. + apply nring_ap_zero_imp with F. + assumption. + apply ing_nring. apply eq_transitive_unfolded with (inject_Q x). - rstepr (nring n[*] (inject_Q x[/] nring n[//]H2)). - apply mult_wdl. - apply eq_symmetric_unfolded. - apply ing_nring. - apply eq_symmetric_unfolded. - apply - eq_transitive_unfolded with (inject_Q (nring n[*] (x[/] nring n[//]H1))). + rstepr (nring n[*] (inject_Q x[/] nring n[//]H2)). + apply mult_wdl. + apply eq_symmetric_unfolded. + apply ing_nring. apply eq_symmetric_unfolded. - apply ing_mult. + apply eq_transitive_unfolded with (inject_Q (nring n[*] (x[/] nring n[//]H1))). + apply eq_symmetric_unfolded. + apply ing_mult. apply ing_eq. rational. Qed. @@ -320,103 +307,93 @@ Theorem expand_Q_R : forall (x : R_COrdField') e, Zero [<] e -> forall N, forall m, N <= m -> AbsSmall (inject_Q e) (inject_Q (CS_seq F x m) [-]x). Proof. intros x e H N H0 m H1. - split. + apply less_leEq. + simpl in |- *. + unfold Rlt in |- *. + exists N. + exists (e [/]ThreeNZ). + apply pos_div_three. + assumption. + intros. + change (e [/]ThreeNZ [<=] CS_seq F (inject_Q (CS_seq F x m) [-]x) n[-][--]e) in |- *. + apply plus_cancel_leEq_rht with (R := F) (z := [--]e). + rstepl ( [--] (Two[*]e [/]ThreeNZ)). + rstepr (CS_seq F (inject_Q (CS_seq F x m) [-]x) n). + cut (AbsSmall (e [/]FourNZ) (CS_seq F x m[-]CS_seq F x N)). + intro H3. + elim H3. + intros H4 H5. + cut (AbsSmall (e [/]FourNZ) (CS_seq F x n[-]CS_seq F x N)). + intro H6. + elim H6. + intros H7 H8. + change ( [--] (Two[*]e [/]ThreeNZ) [<=] CS_seq F x m[-]CS_seq F x n) in |- *. + rstepl ( [--] (e [/]ThreeNZ) [+][--] (e [/]ThreeNZ)). + rstepr (CS_seq F x m[-]CS_seq F x N[+] (CS_seq F x N[-]CS_seq F x n)). + apply plus_resp_leEq_both. + apply leEq_transitive with ( [--] (e [/]FourNZ)); auto. + apply inv_resp_leEq. + apply mult_cancel_leEq with (nring (R:=F) 12). + apply nring_pos. + auto with arith. + rstepl (Zero[+]Three[*]e); rstepr (e[+]Three[*]e). + apply plus_resp_leEq; apply less_leEq; auto. + apply inv_cancel_leEq. + rstepl (CS_seq F x n[-]CS_seq F x N). + rstepr (e [/]ThreeNZ). + apply leEq_transitive with (e [/]FourNZ); auto. + apply mult_cancel_leEq with (nring (R:=F) 12). + apply nring_pos. + auto with arith. + rstepl (Zero[+]Three[*]e); rstepr (e[+]Three[*]e). + apply plus_resp_leEq; apply less_leEq; auto. + apply H0. + assumption. + apply H0. + assumption. apply less_leEq. simpl in |- *. unfold Rlt in |- *. exists N. exists (e [/]ThreeNZ). - apply pos_div_three. - assumption. - + apply pos_div_three. + assumption. intros. - change (e [/]ThreeNZ [<=] CS_seq F (inject_Q (CS_seq F x m) [-]x) n[-][--]e) - in |- *. - apply plus_cancel_leEq_rht with (R := F) (z := [--]e). - rstepl ( [--] (Two[*]e [/]ThreeNZ)). - rstepr (CS_seq F (inject_Q (CS_seq F x m) [-]x) n). - cut (AbsSmall (e [/]FourNZ) (CS_seq F x m[-]CS_seq F x N)). - intro H3. - elim H3. - intros H4 H5. - cut (AbsSmall (e [/]FourNZ) (CS_seq F x n[-]CS_seq F x N)). - intro H6. - elim H6. - intros H7 H8. - change ( [--] (Two[*]e [/]ThreeNZ) [<=] CS_seq F x m[-]CS_seq F x n) in |- *. - rstepl ( [--] (e [/]ThreeNZ) [+][--] (e [/]ThreeNZ)). - rstepr (CS_seq F x m[-]CS_seq F x N[+] (CS_seq F x N[-]CS_seq F x n)). - apply plus_resp_leEq_both. - apply leEq_transitive with ( [--] (e [/]FourNZ)); auto. - apply inv_resp_leEq. - apply mult_cancel_leEq with (nring (R:=F) 12). - apply nring_pos. - auto with arith. - rstepl (Zero[+]Three[*]e); rstepr (e[+]Three[*]e). - apply plus_resp_leEq; apply less_leEq; auto. - - apply inv_cancel_leEq. - rstepl (CS_seq F x n[-]CS_seq F x N). - rstepr (e [/]ThreeNZ). - - apply leEq_transitive with (e [/]FourNZ); auto. - apply mult_cancel_leEq with (nring (R:=F) 12). - apply nring_pos. - auto with arith. - rstepl (Zero[+]Three[*]e); rstepr (e[+]Three[*]e). - apply plus_resp_leEq; apply less_leEq; auto. - - apply H0. - assumption. - apply H0. - assumption. - - apply less_leEq. - simpl in |- *. - unfold Rlt in |- *. - exists N. - exists (e [/]ThreeNZ). - apply pos_div_three. - assumption. - - intros. - change (e [/]ThreeNZ [<=] e[-]CS_seq F (inject_Q (CS_seq F x m) [-]x) n) - in |- *. + change (e [/]ThreeNZ [<=] e[-]CS_seq F (inject_Q (CS_seq F x m) [-]x) n) in |- *. apply plus_cancel_leEq_rht with (R := F) (z := [--]e). rstepl ( [--] (Two[*]e [/]ThreeNZ)). rstepr ( [--] (CS_seq F (inject_Q (CS_seq F x m) [-]x) n)). apply inv_resp_leEq. cut (AbsSmall (e [/]FourNZ) (CS_seq F x m[-]CS_seq F x N)). - intro. - elim H3. - intros H4 H5. - cut (AbsSmall (e [/]FourNZ) (CS_seq F x n[-]CS_seq F x N)). - intro. - elim H6. - intros H7 H8. - change (CS_seq F x m[-]CS_seq F x n [<=] Two[*]e [/]ThreeNZ) in |- *. - rstepr (e [/]ThreeNZ[+]e [/]ThreeNZ). - rstepl (CS_seq F x m[-]CS_seq F x N[+] (CS_seq F x N[-]CS_seq F x n)). - apply plus_resp_leEq_both. - apply leEq_transitive with (e [/]FourNZ); auto. - apply mult_cancel_leEq with (nring (R:=F) 12). - apply nring_pos. - auto with arith. - rstepl (Zero[+]Three[*]e); rstepr (e[+]Three[*]e). - apply plus_resp_leEq; apply less_leEq; auto. - apply inv_cancel_leEq. - rstepr (CS_seq F x n[-]CS_seq F x N). - apply leEq_transitive with ( [--] (e [/]FourNZ)); auto. - apply inv_resp_leEq. - apply mult_cancel_leEq with (nring (R:=F) 12). - apply nring_pos. - auto with arith. - rstepl (Zero[+]Three[*]e); rstepr (e[+]Three[*]e). - apply plus_resp_leEq; apply less_leEq; auto. - - apply H0. - assumption. + intro. + elim H3. + intros H4 H5. + cut (AbsSmall (e [/]FourNZ) (CS_seq F x n[-]CS_seq F x N)). + intro. + elim H6. + intros H7 H8. + change (CS_seq F x m[-]CS_seq F x n [<=] Two[*]e [/]ThreeNZ) in |- *. + rstepr (e [/]ThreeNZ[+]e [/]ThreeNZ). + rstepl (CS_seq F x m[-]CS_seq F x N[+] (CS_seq F x N[-]CS_seq F x n)). + apply plus_resp_leEq_both. + apply leEq_transitive with (e [/]FourNZ); auto. + apply mult_cancel_leEq with (nring (R:=F) 12). + apply nring_pos. + auto with arith. + rstepl (Zero[+]Three[*]e); rstepr (e[+]Three[*]e). + apply plus_resp_leEq; apply less_leEq; auto. + apply inv_cancel_leEq. + rstepr (CS_seq F x n[-]CS_seq F x N). + apply leEq_transitive with ( [--] (e [/]FourNZ)); auto. + apply inv_resp_leEq. + apply mult_cancel_leEq with (nring (R:=F) 12). + apply nring_pos. + auto with arith. + rstepl (Zero[+]Three[*]e); rstepr (e[+]Three[*]e). + apply plus_resp_leEq; apply less_leEq; auto. + apply H0. + assumption. apply H0. assumption. Qed. @@ -428,16 +405,14 @@ Proof. case x. intros x_ px. unfold Cauchy_prop in px. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall (one_div_succ M) (x_ m[-]x_ N)}. - intro H. - case H. - intros N H1. - exists N. - intros. - apply H1. - assumption. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (one_div_succ M) (x_ m[-]x_ N)}. + intro H. + case H. + intros N H1. + exists N. + intros. + apply H1. + assumption. apply px. apply one_div_succ_pos. Qed. @@ -465,14 +440,13 @@ Proof. apply less_leEq_trans with e; auto. astepr (x_ (K + Nx) [-]x_ (K + Nx)). eapply leEq_transitive. - apply (HK (K + Nx)); eauto with arith. + apply (HK (K + Nx)); eauto with arith. unfold cg_minus in |- *; apply plus_resp_leEq_lft; apply inv_resp_leEq. rstepl (x_ Nx[+] (x_ (K + Nx) [-]x_ Nx)). apply plus_resp_leEq_both. - apply leEq_wdr with (CS_seq _ (inject_Q (nring N)) (K + Nx)). - simpl in |- *; apply less_leEq; auto. - apply eq_symmetric_unfolded; apply ing_nring'. - + apply leEq_wdr with (CS_seq _ (inject_Q (nring N)) (K + Nx)). + simpl in |- *; apply less_leEq; auto. + apply eq_symmetric_unfolded; apply ing_nring'. elim (HNx (K + Nx)); auto with arith. Qed. @@ -490,15 +464,12 @@ Lemma modulus_property : forall x M m0 m1, T x M <= m0 -> T x M <= m1 -> Proof. intros. rstepl (one_div_succ (R:=F) M[+]one_div_succ M). - rstepr - (CS_seq F x m0[-]CS_seq F x (T x M) [+] (CS_seq F x (T x M) [-]CS_seq F x m1)). + rstepr (CS_seq F x m0[-]CS_seq F x (T x M) [+] (CS_seq F x (T x M) [-]CS_seq F x m1)). generalize (PT x M). intro. apply AbsSmall_plus. - - apply H1. - assumption. - + apply H1. + assumption. apply AbsSmall_minus. apply H1. assumption. @@ -518,10 +489,10 @@ Lemma expand_Q_R_2 : forall x e N, Zero [<] e -> Proof. intros x e N H H0. apply expand_Q_R with (x := x) (e := e) (N := N). - assumption. - intros. - apply H0. - assumption. + assumption. + intros. + apply H0. + assumption. constructor. Qed. @@ -536,177 +507,133 @@ Proof. simpl in |- *. unfold Cauchy_prop in pa. cut (e [#] Zero). - intro H0. - cut {n : nat | (Twelve[/] e[//]H0) [-]One [<] nring n}. - intro H1. - case H1. - intros M H2. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall (inject_Q e [/]SixNZ) (a_ m[-]a_ N)}. - intro H3. - case H3. - intros N H4. - - exists (max N M). - intros. - - apply ing_cancel_AbsSmall. - rstepl - (inject_Q e [/]ThreeNZ[+]inject_Q e [/]ThreeNZ[+]inject_Q e [/]ThreeNZ). - rstepr - (inject_Q (CS_seq F (a_ m) (T (a_ m) m)) [-]a_ m[+] - (a_ (max N M) [-] - inject_Q (CS_seq F (a_ (max N M)) (T (a_ (max N M)) (max N M)))) [+] - (a_ m[-]a_ (max N M))). - apply AbsSmall_plus. - apply AbsSmall_plus. - - astepl (inject_Q (e [/]ThreeNZ)). - apply - AbsSmall_leEq_trans - with (R := R_COrdField') (e1 := inject_Q (Four[*]one_div_succ m)). - apply ing_le. - apply leEq_transitive with (y := Four[*]one_div_succ (R:=F) M). - - apply mult_resp_leEq_lft. - apply one_div_succ_resp_leEq. - eauto with arith. - apply less_leEq. - apply pos_four. - - apply mult_cancel_leEq with (R := F) (z := (nring M[+]One) [*] (Three:F)). - apply mult_resp_pos. - apply less_transitive_unfolded with (F := F) (y := Twelve[/] e[//]H0). - - apply mult_cancel_less with (R := F) (z := e). - assumption. - rstepl (Zero:F). - rstepr (Twelve:F). - apply nring_pos. - apply lt_O_Sn. - apply plus_cancel_less with (R := F) (z := [--] (One:F)). - rstepl ((Twelve[/] e[//]H0) [-]One). - rstepr (nring (R:=F) M). - exact H2. - apply nring_pos. - apply lt_O_Sn. - - unfold one_div_succ in |- *. - unfold Snring in |- *. - change - (Four[*] (One[/] nring M[+]One[//]nringS_ap_zero F M) [*] - ((nring M[+]One) [*]Three) [<=] e [/]ThreeNZ[*] ((nring M[+]One) [*]Three)) - in |- *. - rstepl (Twelve:F). - rstepr (e[*] (nring M[+]One)). - apply mult_cancel_leEq with (R := F) (z := One[/] e[//]H0). - apply recip_resp_pos. - assumption. - rstepr (nring (R:=F) M[+]One). - apply plus_cancel_leEq_rht with (R := F) (z := [--] (One:F)). - rstepl ((Twelve[/] e[//]H0) [-]One). - rstepr (nring (R:=F) M). - apply less_leEq; exact H2. - - apply - expand_Q_R_2 - with (x := a_ m) (e := Four[*]one_div_succ (R:=F) m) (N := T (a_ m) m). - - apply mult_resp_pos. - apply pos_four. - apply one_div_succ_pos. - - intros. - rstepl (one_div_succ (R:=F) m). - apply modulus_property_2. - assumption. - - apply eq_symmetric_unfolded. - apply ing_div_three. - - astepl (inject_Q (e [/]ThreeNZ)). - apply - AbsSmall_leEq_trans - with (R := R_COrdField') (e1 := inject_Q (Four[*]one_div_succ (R:=F) M)). - apply less_leEq. - apply ing_lt. - - apply mult_cancel_less with (R := F) (z := (nring M[+]One) [*] (Three:F)). - apply mult_resp_pos. - apply less_transitive_unfolded with (F := F) (y := Twelve[/] e[//]H0). - - apply mult_cancel_less with (R := F) (z := e). - assumption. - rstepl (Zero:F). - rstepr (Twelve:F). - apply nring_pos. - apply lt_O_Sn. - apply plus_cancel_less with (R := F) (z := [--] (One:F)). - rstepl ((Twelve[/] e[//]H0) [-]One). - rstepr (nring (R:=F) M). - exact H2. - apply pos_three. - - unfold one_div_succ in |- *. - unfold Snring in |- *. - change - (Four[*] (One[/] nring M[+]One[//]nringS_ap_zero F M) [*] - ((nring M[+]One) [*]Three) [<] e [/]ThreeNZ[*] ((nring M[+]One) [*]Three)) - in |- *. - rstepl (Twelve:F). - rstepr (e[*] (nring M[+]One)). - apply mult_cancel_less with (R := F) (z := One[/] e[//]H0). - apply recip_resp_pos. - assumption. - rstepr (nring (R:=F) M[+]One). - apply plus_cancel_less with (R := F) (z := [--] (One:F)). - rstepl ((Twelve[/] e[//]H0) [-]One). - rstepr (nring (R:=F) M). - exact H2. - - apply AbsSmall_minus. - apply - expand_Q_R_2 - with - (x := a_ (max N M)) - (e := Four[*]one_div_succ (R:=F) M) - (N := T (a_ (max N M)) (max N M)). - - apply mult_resp_pos. - apply pos_four. - apply one_div_succ_pos. - - intros. - rstepl (one_div_succ (R:=F) M). - apply - AbsSmall_leEq_trans with (R := F) (e1 := one_div_succ (R:=F) (max N M)). - apply one_div_succ_resp_leEq. - auto with arith. - apply modulus_property_2. - assumption. - - apply eq_symmetric_unfolded. - apply ing_div_three. - - rstepl (inject_Q e [/]SixNZ[+]inject_Q e [/]SixNZ). - rstepr (a_ m[-]a_ N[+] (a_ N[-]a_ (max N M))). - apply AbsSmall_plus. - apply H4; eauto with arith. - apply AbsSmall_minus. - apply H4; eauto with arith. - - apply pa. - - apply mult_cancel_less with (R := R_COrdField') (z := Six:R_COrdField'). - apply pos_six. - rstepl (Zero:R_COrdField'). - rstepr (inject_Q e). - change (inject_Q (Zero:F) [<] inject_Q e) in |- *. - apply ing_lt. - assumption. - - apply F_is_archemaedian. + intro H0. + cut {n : nat | (Twelve[/] e[//]H0) [-]One [<] nring n}. + intro H1. + case H1. + intros M H2. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (inject_Q e [/]SixNZ) (a_ m[-]a_ N)}. + intro H3. + case H3. + intros N H4. + exists (max N M). + intros. + apply ing_cancel_AbsSmall. + rstepl (inject_Q e [/]ThreeNZ[+]inject_Q e [/]ThreeNZ[+]inject_Q e [/]ThreeNZ). + rstepr (inject_Q (CS_seq F (a_ m) (T (a_ m) m)) [-]a_ m[+] (a_ (max N M) [-] + inject_Q (CS_seq F (a_ (max N M)) (T (a_ (max N M)) (max N M)))) [+] (a_ m[-]a_ (max N M))). + apply AbsSmall_plus. + apply AbsSmall_plus. + astepl (inject_Q (e [/]ThreeNZ)). + apply AbsSmall_leEq_trans with (R := R_COrdField') (e1 := inject_Q (Four[*]one_div_succ m)). + apply ing_le. + apply leEq_transitive with (y := Four[*]one_div_succ (R:=F) M). + apply mult_resp_leEq_lft. + apply one_div_succ_resp_leEq. + eauto with arith. + apply less_leEq. + apply pos_four. + apply mult_cancel_leEq with (R := F) (z := (nring M[+]One) [*] (Three:F)). + apply mult_resp_pos. + apply less_transitive_unfolded with (F := F) (y := Twelve[/] e[//]H0). + apply mult_cancel_less with (R := F) (z := e). + assumption. + rstepl (Zero:F). + rstepr (Twelve:F). + apply nring_pos. + apply lt_O_Sn. + apply plus_cancel_less with (R := F) (z := [--] (One:F)). + rstepl ((Twelve[/] e[//]H0) [-]One). + rstepr (nring (R:=F) M). + exact H2. + apply nring_pos. + apply lt_O_Sn. + unfold one_div_succ in |- *. + unfold Snring in |- *. + change (Four[*] (One[/] nring M[+]One[//]nringS_ap_zero F M) [*] + ((nring M[+]One) [*]Three) [<=] e [/]ThreeNZ[*] ((nring M[+]One) [*]Three)) in |- *. + rstepl (Twelve:F). + rstepr (e[*] (nring M[+]One)). + apply mult_cancel_leEq with (R := F) (z := One[/] e[//]H0). + apply recip_resp_pos. + assumption. + rstepr (nring (R:=F) M[+]One). + apply plus_cancel_leEq_rht with (R := F) (z := [--] (One:F)). + rstepl ((Twelve[/] e[//]H0) [-]One). + rstepr (nring (R:=F) M). + apply less_leEq; exact H2. + apply expand_Q_R_2 with (x := a_ m) (e := Four[*]one_div_succ (R:=F) m) (N := T (a_ m) m). + apply mult_resp_pos. + apply pos_four. + apply one_div_succ_pos. + intros. + rstepl (one_div_succ (R:=F) m). + apply modulus_property_2. + assumption. + apply eq_symmetric_unfolded. + apply ing_div_three. + astepl (inject_Q (e [/]ThreeNZ)). + apply AbsSmall_leEq_trans with (R := R_COrdField') (e1 := inject_Q (Four[*]one_div_succ (R:=F) M)). + apply less_leEq. + apply ing_lt. + apply mult_cancel_less with (R := F) (z := (nring M[+]One) [*] (Three:F)). + apply mult_resp_pos. + apply less_transitive_unfolded with (F := F) (y := Twelve[/] e[//]H0). + apply mult_cancel_less with (R := F) (z := e). + assumption. + rstepl (Zero:F). + rstepr (Twelve:F). + apply nring_pos. + apply lt_O_Sn. + apply plus_cancel_less with (R := F) (z := [--] (One:F)). + rstepl ((Twelve[/] e[//]H0) [-]One). + rstepr (nring (R:=F) M). + exact H2. + apply pos_three. + unfold one_div_succ in |- *. + unfold Snring in |- *. + change (Four[*] (One[/] nring M[+]One[//]nringS_ap_zero F M) [*] + ((nring M[+]One) [*]Three) [<] e [/]ThreeNZ[*] ((nring M[+]One) [*]Three)) in |- *. + rstepl (Twelve:F). + rstepr (e[*] (nring M[+]One)). + apply mult_cancel_less with (R := F) (z := One[/] e[//]H0). + apply recip_resp_pos. + assumption. + rstepr (nring (R:=F) M[+]One). + apply plus_cancel_less with (R := F) (z := [--] (One:F)). + rstepl ((Twelve[/] e[//]H0) [-]One). + rstepr (nring (R:=F) M). + exact H2. + apply AbsSmall_minus. + apply expand_Q_R_2 with (x := a_ (max N M)) (e := Four[*]one_div_succ (R:=F) M) + (N := T (a_ (max N M)) (max N M)). + apply mult_resp_pos. + apply pos_four. + apply one_div_succ_pos. + intros. + rstepl (one_div_succ (R:=F) M). + apply AbsSmall_leEq_trans with (R := F) (e1 := one_div_succ (R:=F) (max N M)). + apply one_div_succ_resp_leEq. + auto with arith. + apply modulus_property_2. + assumption. + apply eq_symmetric_unfolded. + apply ing_div_three. + rstepl (inject_Q e [/]SixNZ[+]inject_Q e [/]SixNZ). + rstepr (a_ m[-]a_ N[+] (a_ N[-]a_ (max N M))). + apply AbsSmall_plus. + apply H4; eauto with arith. + apply AbsSmall_minus. + apply H4; eauto with arith. + apply pa. + apply mult_cancel_less with (R := R_COrdField') (z := Six:R_COrdField'). + apply pos_six. + rstepl (Zero:R_COrdField'). + rstepr (inject_Q e). + change (inject_Q (Zero:F) [<] inject_Q e) in |- *. + apply ing_lt. + assumption. + apply F_is_archemaedian. apply Greater_imp_ap. assumption. Qed. @@ -720,53 +647,49 @@ Lemma Q_dense_in_R : forall x, Zero [<] x -> {q : F | Zero [<] q | inject_Q q [< Proof. intros. cut (x [#] Zero). - intro H0. - cut {n : nat | (One[/] x[//]H0) [<=] nring n}. - intro H1. - case H1. - intros n H2. - cut (nring (R:=F) (S n) [#] Zero). - intro H3. - exists (One[/] nring (S n) [//]H3). - apply recip_resp_pos. - apply ing_cancel_less. - change (Zero [<] inject_Q (nring (S n))) in |- *. - apply less_leEq_trans with (R := R_COrdField') (y := One[/] x[//]H0). - apply recip_resp_pos. - assumption. - apply leEq_transitive with (inject_Q (nring n)). - astepr (nring (R:=R_COrdField') n). - assumption. - apply ing_nring. - astepl (nring (R:=R_COrdField') n). - astepr (nring (R:=R_COrdField') (S n)). - apply less_leEq; astepr (nring (R:=R_COrdField') n[+]One); - apply less_plusOne. - apply ing_nring. - apply ing_nring. - - cut (nring (R:=R_COrdField') (S n) [#] Zero). - intro H4. - astepl (inject_Q (One:F) [/] nring (S n) [//]H4). - apply shift_div_less. - apply nring_pos. - auto with arith. - astepl (One:R_COrdField'). - apply shift_less_mult' with H0. - assumption. - eapply leEq_less_trans. - apply H2. - astepr (nring (R:=R_COrdField') n[+]One); apply less_plusOne. - apply ing_n. - - apply nringS_ap_zero. - apply nringS_ap_zero. - - apply R_is_archemaedian. + intro H0. + cut {n : nat | (One[/] x[//]H0) [<=] nring n}. + intro H1. + case H1. + intros n H2. + cut (nring (R:=F) (S n) [#] Zero). + intro H3. + exists (One[/] nring (S n) [//]H3). + apply recip_resp_pos. + apply ing_cancel_less. + change (Zero [<] inject_Q (nring (S n))) in |- *. + apply less_leEq_trans with (R := R_COrdField') (y := One[/] x[//]H0). + apply recip_resp_pos. + assumption. + apply leEq_transitive with (inject_Q (nring n)). + astepr (nring (R:=R_COrdField') n). + assumption. + apply ing_nring. + astepl (nring (R:=R_COrdField') n). + astepr (nring (R:=R_COrdField') (S n)). + apply less_leEq; astepr (nring (R:=R_COrdField') n[+]One); apply less_plusOne. + apply ing_nring. + apply ing_nring. + cut (nring (R:=R_COrdField') (S n) [#] Zero). + intro H4. + astepl (inject_Q (One:F) [/] nring (S n) [//]H4). + apply shift_div_less. + apply nring_pos. + auto with arith. + astepl (One:R_COrdField'). + apply shift_less_mult' with H0. + assumption. + eapply leEq_less_trans. + apply H2. + astepr (nring (R:=R_COrdField') n[+]One); apply less_plusOne. + apply ing_n. + apply nringS_ap_zero. + apply nringS_ap_zero. + apply R_is_archemaedian. apply Greater_imp_ap. assumption. Qed. - + Definition LimR_CauchySeq (a : CauchySeq R_COrdField') := Build_CauchySeq _ _ (CS_seq_diagonal a). @@ -781,193 +704,139 @@ Proof. intros e H. simpl in |- *. set (He := pos_ap_zero _ _ H) in *. - elim (Q_dense_in_R (e [/]ThreeNZ)); - [ intros q Hq Hinj | apply pos_div_three; auto ]. + elim (Q_dense_in_R (e [/]ThreeNZ)); [ intros q Hq Hinj | apply pos_div_three; auto ]. set (Hq' := pos_ap_zero _ _ Hq) in *. elim (F_is_archemaedian ((Four[/] q[//]Hq') [-]One)); intros M HM. unfold Cauchy_prop in pa. elim (pa (e [/]SixNZ)); [ intros N2 HN2 | apply pos_div_six; auto ]. - elim (CS_seq_diagonal (Build_CauchySeq R_COrdField' a_ pa) (q [/]EightNZ)); - [ intros N1 HN1 | apply pos_div_eight; auto ]. - + [ intros N1 HN1 | apply pos_div_eight; auto ]. exists (max M (max N1 N2)). intros. - rstepl (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ). - rstepr - (a_ m[-]a_ (max M (max N1 N2)) [+] - (a_ (max M (max N1 N2)) [-] - inject_Q - (CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) - (max M (max N1 N2)))) [+] - (inject_Q - (CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) - (max M (max N1 N2))) [-] - LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa))). - apply AbsSmall_plus. + rstepr (a_ m[-]a_ (max M (max N1 N2)) [+] (a_ (max M (max N1 N2)) [-] inject_Q + (CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) (max M (max N1 N2)))) [+] (inject_Q + (CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) (max M (max N1 N2))) [-] + LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa))). apply AbsSmall_plus. - - rstepl (e [/]SixNZ[+]e [/]SixNZ). - rstepr (a_ m[-]a_ N2[+] (a_ N2[-]a_ (max M (max N1 N2)))). - apply AbsSmall_plus. - apply HN2; eauto with arith. - - apply AbsSmall_minus; apply HN2; eauto with arith. - - apply AbsSmall_leEq_trans with (R := R_COrdField') (e1 := inject_Q q). - apply less_leEq; assumption. - apply AbsSmall_minus. - simpl in |- *. - - apply - AbsSmall_leEq_trans - with - (R := R_COrdField') - (e1 := Four[*] (one_div_succ (max M (max N1 N2)):R_COrdField')). - - apply less_leEq. - apply - leEq_less_trans - with (R := R_COrdField') (y := Four[*]one_div_succ (R:=R_COrdField') M). - - apply mult_resp_leEq_lft. - apply one_div_succ_resp_leEq. - auto with arith. - - apply less_leEq; apply pos_four. - - apply - mult_cancel_less with (R := R_COrdField') (z := nring M[+]One:R_COrdField'). - - apply - less_transitive_unfolded - with (F := R_COrdField') (y := inject_Q (Four[/] q[//]Hq')). - change (inject_Q (Zero:F) [<] inject_Q (Four[/] q[//]Hq')) in |- *. - apply ing_lt. - - apply mult_cancel_less with (R := F) (z := q). - assumption. - rstepl (Zero:F). - rstepr (Four:F). - apply pos_four. - apply shift_less_plus. - astepl (inject_Q ((Four[/] q[//]Hq') [+][--]One)). - astepr (inject_Q (nring M)). - apply ing_lt. - rstepl ((Four[/] q[//]Hq') [-]One). - exact HM. - apply eq_symmetric_unfolded. - apply ing_nring. - unfold cg_minus in |- *. - apply - eq_transitive_unfolded - with (inject_Q (Four[/] q[//]Hq') [+]inject_Q ( [--]One:F)). - apply ing_plus. - apply plus_resp_eq. - apply eq_transitive_unfolded with ( [--] (inject_Q (One:F))). - apply ing_min. - astepl (Zero[-]inject_Q (One:F)). - Step_final (Zero[-] (One:R_COrdField')). - - unfold one_div_succ in |- *. - unfold Snring in |- *. - change - (Four[*] (One[/] nring M[+]One[//]nringS_ap_zero R_COrdField' M) [*] - (nring M[+]One) [<] inject_Q q[*] (nring M[+]One)) - in |- *. - - rstepl (Four:R_COrdField'). - - astepr (inject_Q q[*]inject_Q (nring M[+]One)). - astepl (inject_Q (Four:F)). - astepr (inject_Q (q[*] (nring M[+]One))). - apply ing_lt. - apply mult_cancel_less with (R := F) (z := One[/] q[//]Hq'). - apply recip_resp_pos. - assumption. - rstepl (Four[/] q[//]Hq'). - rstepr (nring (R:=F) M[+]One). - apply plus_cancel_less with (R := F) (z := [--] (One:F)). - rstepl ((Four[/] q[//]Hq') [-]One). - rstepr (nring (R:=F) M). - exact HM. - apply ing_mult. - apply eq_symmetric_unfolded. - apply ing_nring. - apply mult_wd. - apply ing_eq. - apply eq_reflexive_unfolded. - apply eq_transitive_unfolded with (inject_Q (nring M) [+]inject_Q (One:F)). - apply ing_plus. - astepl (inject_Q (nring M) [+]One). - astepl (One[+]inject_Q (nring M)). - astepr (One[+]nring (R:=R_COrdField') M). - apply plus_resp_eq. - apply eq_symmetric_unfolded. - apply ing_nring. - - astepl (inject_Q (Four[*]one_div_succ (R:=F) (max M (max N1 N2)))). - apply - expand_Q_R_2 - with - (x := a_ (max M (max N1 N2))) + apply AbsSmall_plus. + rstepl (e [/]SixNZ[+]e [/]SixNZ). + rstepr (a_ m[-]a_ N2[+] (a_ N2[-]a_ (max M (max N1 N2)))). + apply AbsSmall_plus. + apply HN2; eauto with arith. + apply AbsSmall_minus; apply HN2; eauto with arith. + apply AbsSmall_leEq_trans with (R := R_COrdField') (e1 := inject_Q q). + apply less_leEq; assumption. + apply AbsSmall_minus. + simpl in |- *. + apply AbsSmall_leEq_trans with (R := R_COrdField') + (e1 := Four[*] (one_div_succ (max M (max N1 N2)):R_COrdField')). + apply less_leEq. + apply leEq_less_trans with (R := R_COrdField') (y := Four[*]one_div_succ (R:=R_COrdField') M). + apply mult_resp_leEq_lft. + apply one_div_succ_resp_leEq. + auto with arith. + apply less_leEq; apply pos_four. + apply mult_cancel_less with (R := R_COrdField') (z := nring M[+]One:R_COrdField'). + apply less_transitive_unfolded with (F := R_COrdField') (y := inject_Q (Four[/] q[//]Hq')). + change (inject_Q (Zero:F) [<] inject_Q (Four[/] q[//]Hq')) in |- *. + apply ing_lt. + apply mult_cancel_less with (R := F) (z := q). + assumption. + rstepl (Zero:F). + rstepr (Four:F). + apply pos_four. + apply shift_less_plus. + astepl (inject_Q ((Four[/] q[//]Hq') [+][--]One)). + astepr (inject_Q (nring M)). + apply ing_lt. + rstepl ((Four[/] q[//]Hq') [-]One). + exact HM. + apply eq_symmetric_unfolded. + apply ing_nring. + unfold cg_minus in |- *. + apply eq_transitive_unfolded with (inject_Q (Four[/] q[//]Hq') [+]inject_Q ( [--]One:F)). + apply ing_plus. + apply plus_resp_eq. + apply eq_transitive_unfolded with ( [--] (inject_Q (One:F))). + apply ing_min. + astepl (Zero[-]inject_Q (One:F)). + Step_final (Zero[-] (One:R_COrdField')). + unfold one_div_succ in |- *. + unfold Snring in |- *. + change (Four[*] (One[/] nring M[+]One[//]nringS_ap_zero R_COrdField' M) [*] + (nring M[+]One) [<] inject_Q q[*] (nring M[+]One)) in |- *. + rstepl (Four:R_COrdField'). + astepr (inject_Q q[*]inject_Q (nring M[+]One)). + astepl (inject_Q (Four:F)). + astepr (inject_Q (q[*] (nring M[+]One))). + apply ing_lt. + apply mult_cancel_less with (R := F) (z := One[/] q[//]Hq'). + apply recip_resp_pos. + assumption. + rstepl (Four[/] q[//]Hq'). + rstepr (nring (R:=F) M[+]One). + apply plus_cancel_less with (R := F) (z := [--] (One:F)). + rstepl ((Four[/] q[//]Hq') [-]One). + rstepr (nring (R:=F) M). + exact HM. + apply ing_mult. + apply eq_symmetric_unfolded. + apply ing_nring. + apply mult_wd. + apply ing_eq. + apply eq_reflexive_unfolded. + apply eq_transitive_unfolded with (inject_Q (nring M) [+]inject_Q (One:F)). + apply ing_plus. + astepl (inject_Q (nring M) [+]One). + astepl (One[+]inject_Q (nring M)). + astepr (One[+]nring (R:=R_COrdField') M). + apply plus_resp_eq. + apply eq_symmetric_unfolded. + apply ing_nring. + astepl (inject_Q (Four[*]one_div_succ (R:=F) (max M (max N1 N2)))). + apply expand_Q_R_2 with (x := a_ (max M (max N1 N2))) (e := Four[*]one_div_succ (R:=F) (max M (max N1 N2))) - (N := T (a_ (max M (max N1 N2))) (max M (max N1 N2))). - - apply mult_resp_pos. - apply pos_four. - apply one_div_succ_pos. - intros. - rstepl (one_div_succ (R:=F) (max M (max N1 N2))). - apply modulus_property_2. - assumption. - apply - eq_transitive_unfolded - with (inject_Q (Four:F) [*]inject_Q (one_div_succ (max M (max N1 N2)))). - apply ing_mult. - apply - eq_transitive_unfolded - with (Four[*]inject_Q (one_div_succ (max M (max N1 N2)))). - apply mult_wd. - apply eq_symmetric_unfolded. - apply ing_nring. - apply eq_reflexive_unfolded. - apply mult_wd. - apply eq_reflexive_unfolded. - unfold one_div_succ in |- *. - unfold Snring in |- *. - astepl (inject_Q (One[/] _[//]nringS_ap_zero _ (max M (max N1 N2)))). - - Step_final (One[/] _[//]nringS_ap_zero R_COrdField' (max M (max N1 N2))). - apply - eq_transitive_unfolded - with (inject_Q (One:F) [/] _[//]nringS_ap_zero _ (max M (max N1 N2))). - apply eq_symmetric_unfolded. - apply ing_n. - apply div_wd. - exact ing_One. - apply eq_reflexive_unfolded. - + (N := T (a_ (max M (max N1 N2))) (max M (max N1 N2))). + apply mult_resp_pos. + apply pos_four. + apply one_div_succ_pos. + intros. + rstepl (one_div_succ (R:=F) (max M (max N1 N2))). + apply modulus_property_2. + assumption. + apply eq_transitive_unfolded with (inject_Q (Four:F) [*]inject_Q (one_div_succ (max M (max N1 N2)))). + apply ing_mult. + apply eq_transitive_unfolded with (Four[*]inject_Q (one_div_succ (max M (max N1 N2)))). + apply mult_wd. + apply eq_symmetric_unfolded. + apply ing_nring. + apply eq_reflexive_unfolded. + apply mult_wd. + apply eq_reflexive_unfolded. + unfold one_div_succ in |- *. + unfold Snring in |- *. + astepl (inject_Q (One[/] _[//]nringS_ap_zero _ (max M (max N1 N2)))). + Step_final (One[/] _[//]nringS_ap_zero R_COrdField' (max M (max N1 N2))). + apply eq_transitive_unfolded with (inject_Q (One:F) [/] _[//]nringS_ap_zero _ (max M (max N1 N2))). + apply eq_symmetric_unfolded. + apply ing_n. + apply div_wd. + exact ing_One. + apply eq_reflexive_unfolded. apply AbsSmall_leEq_trans with (R := R_COrdField') (e1 := inject_Q q). - apply less_leEq; assumption. - apply - expand_Q_R_2 - with - (x := LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) - (e := q) - (N := max M (max N1 N2)). - assumption. + apply less_leEq; assumption. + apply expand_Q_R_2 with (x := LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) (e := q) + (N := max M (max N1 N2)). + assumption. intros. rstepl (q [/]EightNZ[+]q [/]EightNZ). - rstepr - (CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) m0[-] + rstepr (CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) m0[-] CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) N1[+] - (CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) N1[-] - CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) - (max M (max N1 N2)))). + (CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) N1[-] + CS_seq F (LimR_CauchySeq (Build_CauchySeq R_COrdField' a_ pa)) (max M (max N1 N2)))). apply AbsSmall_plus. - unfold LimR_CauchySeq in |- *; simpl in |- *; apply HN1; eauto with arith. + unfold LimR_CauchySeq in |- *; simpl in |- *; apply HN1; eauto with arith. apply AbsSmall_minus. unfold LimR_CauchySeq in |- *; simpl in |- *; apply HN1; eauto with arith. Qed. diff --git a/reals/Cesaro.v b/reals/Cesaro.v index fec5063e0..9b6b9dd96 100644 --- a/reals/Cesaro.v +++ b/reals/Cesaro.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Series. Require Export PosSeq. @@ -44,21 +44,22 @@ Lemma algebraic_transform1 : forall (l : IR) (x : nat->IR) (y : nat->IR) seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m) [=] ((seq_part_sum (fun k : nat => x k[*]y k) (S m)[/] seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m)[-]l). -intros. -rstepr (((seq_part_sum (fun k : nat => x k[*]y k) (S m))[-] l[*](seq_part_sum y (S m)))[/] - seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -apply div_wd. -2: apply eq_reflexive_unfolded. -unfold seq_part_sum. -unfold cg_minus. -astepr (Sum0 (G:=IR) (S m) (fun k : nat => x k[*]y k)[+] +Proof. + intros. + rstepr (((seq_part_sum (fun k : nat => x k[*]y k) (S m))[-] l[*](seq_part_sum y (S m)))[/] + seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). + apply div_wd. + 2: apply eq_reflexive_unfolded. + unfold seq_part_sum. + unfold cg_minus. + astepr (Sum0 (G:=IR) (S m) (fun k : nat => x k[*]y k)[+] Sum0 (G:=IR) (S m) (fun k : nat => [--]l[*]y k)). -astepr (Sum0 (G:=IR) (S m) (fun k : nat => x k[*]y k[+][--]l[*]y k)). -apply Sum0_wd. intros. rational. -apply (Sum0_plus_Sum0 IR (fun k : nat => x k [*] y k) (fun k : nat => [--] l [*] y k) (S m)). -apply plus_resp_eq. -astepr ([--]l [*] (Sum0 (G:=IR) (S m) y)). -apply mult_distr_sum0_lft. + astepr (Sum0 (G:=IR) (S m) (fun k : nat => x k[*]y k[+][--]l[*]y k)). + apply Sum0_wd. intros. rational. + apply (Sum0_plus_Sum0 IR (fun k : nat => x k [*] y k) (fun k : nat => [--] l [*] y k) (S m)). + apply plus_resp_eq. + astepr ([--]l [*] (Sum0 (G:=IR) (S m) y)). + apply mult_distr_sum0_lft. Qed. Lemma algebraic_transform2 : forall (l : IR) (x : nat->IR) (y : nat->IR) @@ -68,13 +69,14 @@ Lemma algebraic_transform2 : forall (l : IR) (x : nat->IR) (y : nat->IR) seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m) [=] (seq_part_sum (fun k : nat => y k [*] (x k [-] l)) (S m)[/] seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -intros. -unfold seq_part_sum. -apply div_wd. -2: apply eq_reflexive_unfolded. -unfold Sum. -unfold Sum1. -rational. +Proof. + intros. + unfold seq_part_sum. + apply div_wd. + 2: apply eq_reflexive_unfolded. + unfold Sum. + unfold Sum1. + rational. Qed. Lemma algebraic_transform3: forall (eps: IR) (y : nat->IR) @@ -83,135 +85,124 @@ Lemma algebraic_transform3: forall (eps: IR) (y : nat->IR) seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m)) [=] (Sum (G:=IR) (S N1) m (fun k : nat => y k[*]eps [/]TwoNZ)[/] seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -intros. -astepl ((eps[/]TwoNZ [*] (Sum (S N1) m (fun k: nat => y k)))[/] - seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -astepr (Sum (G:=IR) (S N1) m (fun k : nat => eps[/]TwoNZ[*]y k)[/] - seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -apply div_wd. -2: apply eq_reflexive_unfolded. -apply eq_symmetric_unfolded. -astepr (eps[/]TwoNZ[*]Sum (G:=IR) (S N1) m y). -apply mult_distr_sum_lft. +Proof. + intros. + astepl ((eps[/]TwoNZ [*] (Sum (S N1) m (fun k: nat => y k)))[/] + seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). + astepr (Sum (G:=IR) (S N1) m (fun k : nat => eps[/]TwoNZ[*]y k)[/] + seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). + apply div_wd. + 2: apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded. + astepr (eps[/]TwoNZ[*]Sum (G:=IR) (S N1) m y). + apply mult_distr_sum_lft. Qed. -Lemma algebraic_estimate1 : +Lemma algebraic_estimate1 : forall (e l: IR) (H1 : Zero [<] e) (x : nat -> IR) (y : nat->IR) (H2 : seq_pos y) (m N1: nat) (H3 : S N1 <= m) -(H4 : forall i, S N1 <= i -> i <= m -> AbsSmall e (x i[-]l)), -AbsSmall +(H4 : forall i, S N1 <= i -> i <= m -> AbsSmall e (x i[-]l)), +AbsSmall (Sum (G:=IR) (S N1) m (fun k : nat => y k[*]e)[/] seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m) (Sum (G:=IR) (S N1) m (fun k : nat => y k[*](x k[-]l))[/] seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -intros. -apply AbsSmall_cancel_mult with (seq_part_sum y (S m)). -apply seq_pos_imp_sum_pos; auto. -astepl (Sum (G:=IR) (S N1) m (fun k : nat => y k[*]e)). -astepr (Sum (G:=IR) (S N1) m (fun k : nat => y k[*](x k[-]l))). -apply sum_resp_AbsSmall; auto. -intros. -apply mult_resp_AbsSmall. -apply less_leEq. -apply H2. -apply H4; auto. +Proof. + intros. + apply AbsSmall_cancel_mult with (seq_part_sum y (S m)). + apply seq_pos_imp_sum_pos; auto. + astepl (Sum (G:=IR) (S N1) m (fun k : nat => y k[*]e)). + astepr (Sum (G:=IR) (S N1) m (fun k : nat => y k[*](x k[-]l))). + apply sum_resp_AbsSmall; auto. + intros. + apply mult_resp_AbsSmall. + apply less_leEq. + apply H2. + apply H4; auto. Qed. End AlgebraBits. Section Cesaro. - + Theorem cesaro_transform : -forall (l : IR) (x : nat -> IR) (y : nat -> IR) +forall (l : IR) (x : nat -> IR) (y : nat -> IR) (H1 : Cauchy_Lim_prop2 x l) (H2 : seq_pos y) (H3 : seq_inf_sum y), Cauchy_Lim_prop2 (fun n : nat => seq_part_sum (fun k : nat => x k [*] y k) (S n) [/](seq_part_sum y (S n)) [//] (seq_pos_imp_ap_zero y H2 n)) l. -unfold Cauchy_Lim_prop2. -intros. - -(* Find N such that forall m > N |x - l| < eps / 2*) - -assert (H4 : Zero [<] eps[/]TwoNZ). apply pos_div_two. auto. -assert ({N : nat | forall m, N <= m -> AbsSmall (eps[/]TwoNZ) ((x m) [-] l) }). -apply (H1 (eps[/]TwoNZ) H4). -destruct X0 as [N1 H5]. - -(* find N1 such that a the following will be less that eps/2 also *) - -set (C := seq_part_sum (fun k : nat => y k [*] (x k [-] l)) (S N1)); -assert -(H7 : { N : nat | - forall m : nat, N <= m -> AbsSmall (eps[/]TwoNZ) (C [/](seq_part_sum y (S m)) [//] (seq_pos_imp_ap_zero y H2 m))}). - -apply (seq_inf_sum_imp_div_small y H3 H2 C (eps[/]TwoNZ) H4). -destruct H7 as [N2 H7]. - -(* Now we can choose N as max of N1 and N2 *) - -exists (S (max (S N1) N2)). -intros. -astepr (seq_part_sum (fun k : nat => y k [*] (x k [-] l)) (S m)[/] - seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -2: apply (algebraic_transform1 l x y H2 m). - -astepr ((seq_part_sum (fun k : nat => y k [*] (x k [-] l)) (S N1)[+] - Sum (S N1) m (fun k : nat => y k [*] (x k [-] l)) )[/] - seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -2: apply (algebraic_transform2 l x y H2 m). - -astepr (((seq_part_sum (fun k : nat => y k [*] (x k [-] l)) (S N1)) - [/]seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m) - [+] - ((Sum (S N1) m (fun k : nat => y k [*] (x k [-] l)))[/] - seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m)). -apply AbsSmall_eps_div_two. - -(* We are ready for estimates *) -apply H7. -eauto with arith. - -apply AbsSmall_leEq_trans with ((Sum (S N1) m (fun k : nat => y k [*] eps [/]TwoNZ))[/] - seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -astepl (eps[/]TwoNZ [*] (Sum (S N1) m (fun k: nat => y k)[/] - seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m)). -2: apply algebraic_transform3. - -astepr (eps[/]TwoNZ[*]One). -apply mult_resp_leEq_lft. -cut (AbsSmall One (Sum (G:=IR) (S N1) m (fun k : nat => y k)[/] - seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m)). -unfold AbsSmall. tauto. -apply seq_inf_sum_ratio_bound. -eauto with arith. -apply less_leEq; auto. -apply algebraic_estimate1; auto. -eauto with arith. -intros. -apply H5. -auto with arith. +Proof. + unfold Cauchy_Lim_prop2. + intros. + (* Find N such that forall m > N |x - l| < eps / 2*) + assert (H4 : Zero [<] eps[/]TwoNZ). apply pos_div_two. auto. + assert ({N : nat | forall m, N <= m -> AbsSmall (eps[/]TwoNZ) ((x m) [-] l) }). + apply (H1 (eps[/]TwoNZ) H4). + destruct X0 as [N1 H5]. + (* find N1 such that a the following will be less that eps/2 also *) + set (C := seq_part_sum (fun k : nat => y k [*] (x k [-] l)) (S N1)); assert (H7 : { N : nat | + forall m : nat, N <= m -> AbsSmall (eps[/]TwoNZ) (C [/](seq_part_sum y (S m)) [//] (seq_pos_imp_ap_zero y H2 m))}). + apply (seq_inf_sum_imp_div_small y H3 H2 C (eps[/]TwoNZ) H4). + destruct H7 as [N2 H7]. + (* Now we can choose N as max of N1 and N2 *) + exists (S (max (S N1) N2)). + intros. + astepr (seq_part_sum (fun k : nat => y k [*] (x k [-] l)) (S m)[/] + seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). + 2: apply (algebraic_transform1 l x y H2 m). + astepr ((seq_part_sum (fun k : nat => y k [*] (x k [-] l)) (S N1)[+] + Sum (S N1) m (fun k : nat => y k [*] (x k [-] l)) )[/] + seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). + 2: apply (algebraic_transform2 l x y H2 m). + astepr (((seq_part_sum (fun k : nat => y k [*] (x k [-] l)) (S N1)) + [/]seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m) [+] + ((Sum (S N1) m (fun k : nat => y k [*] (x k [-] l)))[/] + seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m)). + apply AbsSmall_eps_div_two. + (* We are ready for estimates *) + apply H7. + eauto with arith. + apply AbsSmall_leEq_trans with ((Sum (S N1) m (fun k : nat => y k [*] eps [/]TwoNZ))[/] + seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). + astepl (eps[/]TwoNZ [*] (Sum (S N1) m (fun k: nat => y k)[/] + seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m)). + 2: apply algebraic_transform3. + astepr (eps[/]TwoNZ[*]One). + apply mult_resp_leEq_lft. + cut (AbsSmall One (Sum (G:=IR) (S N1) m (fun k : nat => y k)[/] + seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m)). + unfold AbsSmall. tauto. + apply seq_inf_sum_ratio_bound. + eauto with arith. + apply less_leEq; auto. + apply algebraic_estimate1; auto. + eauto with arith. + intros. + apply H5. + auto with arith. Qed. Theorem cesaro_sum : forall (l : IR) (x : nat -> IR) (H1 : Cauchy_Lim_prop2 x l), Cauchy_Lim_prop2 (fun n : nat => seq_part_sum x (S n) [/]nring (S n)[//](nringS_ap_zero _ n)) l. -intros. -set (y := (fun k : nat => One : IR)). -assert (H2 : seq_pos y). -apply One_seq_is_pos. -assert (H3 : seq_inf_sum y). -apply One_seq_is_inf_sum. -apply Cauchy_Lim_prop2_wd' with (fun n : nat => seq_part_sum (fun k : nat => x k[*] y k) (S n) - [/]seq_part_sum y (S n)[//]seq_pos_imp_ap_zero y H2 n). -apply cesaro_transform; auto. -exists 0. -intros. -apply div_wd. -unfold seq_part_sum. -apply Sum0_wd. -intros. unfold y. algebra. -apply One_part_sum. +Proof. + intros. + set (y := (fun k : nat => One : IR)). + assert (H2 : seq_pos y). + apply One_seq_is_pos. + assert (H3 : seq_inf_sum y). + apply One_seq_is_inf_sum. + apply Cauchy_Lim_prop2_wd' with (fun n : nat => seq_part_sum (fun k : nat => x k[*] y k) (S n) + [/]seq_part_sum y (S n)[//]seq_pos_imp_ap_zero y H2 n). + apply cesaro_transform; auto. + exists 0. + intros. + apply div_wd. + unfold seq_part_sum. + apply Sum0_wd. + intros. unfold y. algebra. + apply One_part_sum. Qed. End Cesaro. diff --git a/reals/IVT.v b/reals/IVT.v index b88e486cd..60110d1dd 100644 --- a/reals/IVT.v +++ b/reals/IVT.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CPoly_Contin. @@ -58,50 +58,54 @@ Hypothesis a_b : forall i : nat, a i [<] b i. Hypothesis b_a : forall eps : IR, Zero [<] eps -> {i : nat | b i [<=] a i[+]eps}. Lemma a_mon' : forall i j : nat, i <= j -> a i [<=] a j. -intros. -apply local_mon'_imp_mon'; auto. +Proof. + intros. + apply local_mon'_imp_mon'; auto. Qed. Lemma b_mon' : forall i j : nat, i <= j -> b j [<=] b i. -intros. -set (b' := fun i : nat => [--] (b i)) in *. -astepl ( [--][--] (b j)). -astepr ( [--][--] (b i)). -fold (b' i) (b' j) in |- *. -apply inv_resp_leEq. -apply local_mon'_imp_mon'. -unfold b' in |- *; intro; apply inv_resp_leEq; auto. -auto. +Proof. + intros. + set (b' := fun i : nat => [--] (b i)) in *. + astepl ( [--][--] (b j)). + astepr ( [--][--] (b i)). + fold (b' i) (b' j) in |- *. + apply inv_resp_leEq. + apply local_mon'_imp_mon'. + unfold b' in |- *; intro; apply inv_resp_leEq; auto. + auto. Qed. Lemma a_b' : forall i j : nat, a i [<] b j. -intros. -elim (le_lt_dec i j); intro. -apply leEq_less_trans with (a j). -apply a_mon'. auto. -auto. -apply less_leEq_trans with (b i). -auto. -apply b_mon'. auto with arith. +Proof. + intros. + elim (le_lt_dec i j); intro. + apply leEq_less_trans with (a j). + apply a_mon'. auto. + auto. + apply less_leEq_trans with (b i). + auto. + apply b_mon'. auto with arith. Qed. Lemma intervals_cauchy : Cauchy_prop a. -unfold Cauchy_prop in |- *. -unfold AbsSmall in |- *. -intro eps. intros H. -elim (b_a eps H). intro n. intros. exists n. -intro i. intros. -split; apply less_leEq. -apply less_leEq_trans with ZeroR. -astepr ( [--]ZeroR). -apply inv_resp_less. auto. -astepl (a n[-]a n). -apply minus_resp_leEq. -apply a_mon'. auto. -apply shift_minus_less'. -apply less_leEq_trans with (b n). -apply a_b'. -auto. +Proof. + unfold Cauchy_prop in |- *. + unfold AbsSmall in |- *. + intro eps. intros H. + elim (b_a eps H). intro n. intros. exists n. + intro i. intros. + split; apply less_leEq. + apply less_leEq_trans with ZeroR. + astepr ( [--]ZeroR). + apply inv_resp_less. auto. + astepl (a n[-]a n). + apply minus_resp_leEq. + apply a_mon'. auto. + apply shift_minus_less'. + apply less_leEq_trans with (b n). + apply a_b'. + auto. Qed. (* begin hide *) @@ -109,35 +113,36 @@ Let a' := Build_CauchySeq _ a intervals_cauchy. (* end hide *) Lemma Cnested_intervals_limit : {z : IR | forall i, a i [<=] z | forall i, z [<=] b i}. -exists (Lim a'). -intros. -rewrite leEq_def in |- *. unfold Not in |- *. intros. -elim (Lim_less_so_seq_less a' (a i)). intro n. intros H0. -elim (le_lt_dec n i); intro H1. -cut (Not (a i [<] a i)). intro H2. -unfold Not in H1. elim H2. apply H0. auto. -apply less_irreflexive_unfolded. -cut (forall i j : nat, i <= j -> a i [<=] a j). intro a_mon''. -pose (c:=a_mon'' i n). -rewrite -> leEq_def in c. -apply c. -auto with arith. -apply H0. -auto. -intros. apply a_mon'; auto. -auto. -intros i. rewrite leEq_def. unfold Not. intros H. -elim (less_Lim_so_less_seq a' (b i) H). intro n. intros H0. -elim (le_lt_dec n i); intro H1. -cut (Not (a i [<] b i)). unfold Not in |- *. intro. -elim H2. auto. apply less_antisymmetric_unfolded. -apply H0. -auto. -cut (Not (a n [<] b n)). unfold Not in |- *. intro H2. -apply H2. auto. apply less_antisymmetric_unfolded. -apply leEq_less_trans with (b i). -apply b_mon'. auto with arith. -apply H0. auto. +Proof. + exists (Lim a'). + intros. + rewrite leEq_def in |- *. unfold Not in |- *. intros. + elim (Lim_less_so_seq_less a' (a i)). intro n. intros H0. + elim (le_lt_dec n i); intro H1. + cut (Not (a i [<] a i)). intro H2. + unfold Not in H1. elim H2. apply H0. auto. + apply less_irreflexive_unfolded. + cut (forall i j : nat, i <= j -> a i [<=] a j). intro a_mon''. + pose (c:=a_mon'' i n). + rewrite -> leEq_def in c. + apply c. + auto with arith. + apply H0. + auto. + intros. apply a_mon'; auto. + auto. + intros i. rewrite leEq_def. unfold Not. intros H. + elim (less_Lim_so_less_seq a' (b i) H). intro n. intros H0. + elim (le_lt_dec n i); intro H1. + cut (Not (a i [<] b i)). unfold Not in |- *. intro. + elim H2. auto. apply less_antisymmetric_unfolded. + apply H0. + auto. + cut (Not (a n [<] b n)). unfold Not in |- *. intro H2. + apply H2. auto. apply less_antisymmetric_unfolded. + apply leEq_less_trans with (b i). + apply b_mon'. auto with arith. + apply H0. auto. Qed. (** %\begin{convention}% Let [f] be a continuous real function. @@ -149,51 +154,53 @@ Hypothesis f_contin : contin f. Lemma f_contin_pos : forall z : IR, Zero [<] f z -> {eps : IR | Zero [<] eps | forall x, x [<=] z[+]eps -> z [<=] x[+]eps -> Zero [<] f x}. -intros z H. -unfold contin in f_contin. -unfold continAt in f_contin. -unfold funLim in f_contin. -unfold AbsSmall in f_contin. -elim (f_contin z (f z [/]TwoNZ) (pos_div_two _ _ H)). intro eps. intros H1 H2. -exists eps. -auto. intros. -elim (H2 x). intros H5 H6. -astepl (f z[-]f z). -apply shift_minus_less. -apply shift_less_plus'. -apply leEq_less_trans with (f z [/]TwoNZ). auto. apply pos_div_two'. auto. -split. -apply shift_leEq_minus. -rstepl (x[-]eps). -apply shift_minus_leEq. auto. -apply shift_minus_leEq. astepr (x[+]eps). auto. +Proof. + intros z H. + unfold contin in f_contin. + unfold continAt in f_contin. + unfold funLim in f_contin. + unfold AbsSmall in f_contin. + elim (f_contin z (f z [/]TwoNZ) (pos_div_two _ _ H)). intro eps. intros H1 H2. + exists eps. + auto. intros. + elim (H2 x). intros H5 H6. + astepl (f z[-]f z). + apply shift_minus_less. + apply shift_less_plus'. + apply leEq_less_trans with (f z [/]TwoNZ). auto. apply pos_div_two'. auto. + split. + apply shift_leEq_minus. + rstepl (x[-]eps). + apply shift_minus_leEq. auto. + apply shift_minus_leEq. astepr (x[+]eps). auto. Qed. Lemma f_contin_neg : forall z : IR, f z [<] Zero -> {eps : IR | Zero [<] eps | forall x, x [<=] z[+]eps -> z [<=] x[+]eps -> f x [<] Zero}. -intros. -unfold contin in f_contin. -unfold continAt in f_contin. -unfold funLim in f_contin. -unfold AbsSmall in f_contin. -cut (Zero [<] [--] (f z)). intro H0. -elim (f_contin z ( [--] (f z) [/]TwoNZ) (pos_div_two _ _ H0)). intro eps. intros H2 H3. -exists eps. -auto. intros. -elim (H3 x). intros H6 H7. -rstepr (f z[-][--][--] (f z)). -apply shift_less_minus'. -apply shift_plus_less. -apply less_leEq_trans with (f z [/]TwoNZ). -astepl (f z). apply inv_cancel_less. rstepl ( [--] (f z) [/]TwoNZ). apply pos_div_two'. auto. -rstepl ( [--] ( [--] (f z) [/]TwoNZ)). auto. -split. -apply shift_leEq_minus. -rstepl (x[-]eps). -apply shift_minus_leEq. auto. -apply shift_minus_leEq. astepr (x[+]eps). auto. -astepl ( [--]ZeroR). -apply inv_resp_less. auto. +Proof. + intros. + unfold contin in f_contin. + unfold continAt in f_contin. + unfold funLim in f_contin. + unfold AbsSmall in f_contin. + cut (Zero [<] [--] (f z)). intro H0. + elim (f_contin z ( [--] (f z) [/]TwoNZ) (pos_div_two _ _ H0)). intro eps. intros H2 H3. + exists eps. + auto. intros. + elim (H3 x). intros H6 H7. + rstepr (f z[-][--][--] (f z)). + apply shift_less_minus'. + apply shift_plus_less. + apply less_leEq_trans with (f z [/]TwoNZ). + astepl (f z). apply inv_cancel_less. rstepl ( [--] (f z) [/]TwoNZ). apply pos_div_two'. auto. + rstepl ( [--] ( [--] (f z) [/]TwoNZ)). auto. + split. + apply shift_leEq_minus. + rstepl (x[-]eps). + apply shift_minus_leEq. auto. + apply shift_minus_leEq. astepr (x[+]eps). auto. + astepl ( [--]ZeroR). + apply inv_resp_less. auto. Qed. (** Assume also that [forall i, f (a i) [<=] Zero [<=] f (b i)]. *) @@ -202,30 +209,31 @@ Hypothesis f_a : forall i, f (a i) [<=] Zero. Hypothesis f_b : forall i, Zero [<=] f (b i). Lemma Cnested_intervals_zero : {z : IR | a 0 [<=] z /\ z [<=] b 0 /\ f z [=] Zero}. -elim Cnested_intervals_limit. intro z. intros H0 H1. exists z. -split. auto. split. auto. -apply not_ap_imp_eq. -unfold Not in |- *. -intros H2. -elim (ap_imp_less _ _ _ H2); intros H3. -elim (f_contin_neg z H3). intro eps. intros H5 H6. -elim (b_a eps). intro i. intros H7. -cut (b i [<=] z[+]eps). intro. -cut (z [<=] b i[+]eps). intro. -pose (c:= f_b i). rewrite -> leEq_def in c. apply c. apply H6. auto. auto. -apply leEq_transitive with (b i). auto. -astepl (b i[+]Zero). apply plus_resp_leEq_lft. apply less_leEq. auto. -apply leEq_transitive with (a i[+]eps). auto. -apply plus_resp_leEq. auto. auto. -elim (f_contin_pos z H3). intro eps. intros H5 H6. -elim (b_a eps). intro i. intros H7. -cut (a i [<=] z[+]eps). intro. -cut (z [<=] a i[+]eps). intro. -pose (c:= f_a i). rewrite -> leEq_def in c; apply c. apply H6. auto. auto. -apply leEq_transitive with (b i). auto. -auto. apply leEq_transitive with z. auto. -astepl (z[+]Zero). apply less_leEq. apply plus_resp_less_lft. auto. -auto. +Proof. + elim Cnested_intervals_limit. intro z. intros H0 H1. exists z. + split. auto. split. auto. + apply not_ap_imp_eq. + unfold Not in |- *. + intros H2. + elim (ap_imp_less _ _ _ H2); intros H3. + elim (f_contin_neg z H3). intro eps. intros H5 H6. + elim (b_a eps). intro i. intros H7. + cut (b i [<=] z[+]eps). intro. + cut (z [<=] b i[+]eps). intro. + pose (c:= f_b i). rewrite -> leEq_def in c. apply c. apply H6. auto. auto. + apply leEq_transitive with (b i). auto. + astepl (b i[+]Zero). apply plus_resp_leEq_lft. apply less_leEq. auto. + apply leEq_transitive with (a i[+]eps). auto. + apply plus_resp_leEq. auto. auto. + elim (f_contin_pos z H3). intro eps. intros H5 H6. + elim (b_a eps). intro i. intros H7. + cut (a i [<=] z[+]eps). intro. + cut (z [<=] a i[+]eps). intro. + pose (c:= f_a i). rewrite -> leEq_def in c; apply c. apply H6. auto. auto. + apply leEq_transitive with (b i). auto. + auto. apply leEq_transitive with z. auto. + astepl (z[+]Zero). apply less_leEq. apply plus_resp_less_lft. auto. + auto. Qed. End Nested_Intervals. @@ -255,67 +263,73 @@ Let rht := (a[+]Two[*]b) [/]ThreeNZ. (* end hide *) Lemma a_lft : a [<] lft. -unfold lft in |- *. -apply shift_less_div. -apply pos_three. -rstepl (Two[*]a[+]a). -apply plus_resp_less_lft. -auto. +Proof. + unfold lft in |- *. + apply shift_less_div. + apply pos_three. + rstepl (Two[*]a[+]a). + apply plus_resp_less_lft. + auto. Qed. Lemma rht_b : rht [<] b. -unfold rht in |- *. -apply shift_div_less. -apply pos_three. -rstepr (b[+]Two[*]b). -apply plus_resp_less_rht. -auto. +Proof. + unfold rht in |- *. + apply shift_div_less. + apply pos_three. + rstepr (b[+]Two[*]b). + apply plus_resp_less_rht. + auto. Qed. Lemma lft_rht : lft [<] rht. -unfold lft in |- *. unfold rht in |- *. -apply div_resp_less_rht. -rstepl (a[+]b[+]a). -rstepr (a[+]b[+]b). -apply plus_resp_less_lft. -auto. -apply pos_three. +Proof. + unfold lft in |- *. unfold rht in |- *. + apply div_resp_less_rht. + rstepl (a[+]b[+]a). + rstepr (a[+]b[+]b). + apply plus_resp_less_lft. + auto. + apply pos_three. Qed. Lemma smaller_lft : rht[-]a [=] Small[*] (b[-]a). -unfold Small in |- *. unfold rht in |- *. -rational. +Proof. + unfold Small in |- *. unfold rht in |- *. + rational. Qed. Lemma smaller_rht : b[-]lft [=] Small[*] (b[-]a). -unfold Small in |- *. unfold lft in |- *. -rational. +Proof. + unfold Small in |- *. unfold lft in |- *. + rational. Qed. Hint Resolve smaller_lft smaller_rht: algebra. Lemma Cbisect' : {a' : IR | {b' : IR | a' [<] b' | a [<=] a' /\ b' [<=] b /\ b'[-]a' [<=] Small[*] (b[-]a) /\ f a' [<=] Zero /\ Zero [<=] f b'}}. -elim (f_apzero_interval lft rht lft_rht). intro c. intro H. -elim H. intros H0 H2 H3. -cut ({f c [<=] Zero} + {Zero [<=] f c}). -intro H4; inversion_clear H4. -exists c. exists b. -apply leEq_less_trans with rht. auto. apply rht_b. -split. apply leEq_transitive with lft. apply less_leEq. apply a_lft. auto. -split. apply leEq_reflexive. -split. astepr (b[-]lft). apply minus_resp_leEq_rht. auto. -split. auto. auto. -exists a. exists c. -apply less_leEq_trans with lft. apply a_lft. auto. -split. apply leEq_reflexive. -split. apply less_leEq. apply leEq_less_trans with rht. auto. apply rht_b. -split. -astepr (rht[-]a). apply minus_resp_leEq. auto. -split. auto. auto. -elim (ap_imp_less _ _ _ H3); intros. -left. apply less_leEq. auto. -right. apply less_leEq. auto. +Proof. + elim (f_apzero_interval lft rht lft_rht). intro c. intro H. + elim H. intros H0 H2 H3. + cut ({f c [<=] Zero} + {Zero [<=] f c}). + intro H4; inversion_clear H4. + exists c. exists b. + apply leEq_less_trans with rht. auto. apply rht_b. + split. apply leEq_transitive with lft. apply less_leEq. apply a_lft. auto. + split. apply leEq_reflexive. + split. astepr (b[-]lft). apply minus_resp_leEq_rht. auto. + split. auto. auto. + exists a. exists c. + apply less_leEq_trans with lft. apply a_lft. auto. + split. apply leEq_reflexive. + split. apply less_leEq. apply leEq_less_trans with rht. auto. apply rht_b. + split. + astepr (rht[-]a). apply minus_resp_leEq. auto. + split. auto. auto. + elim (ap_imp_less _ _ _ H3); intros. + left. apply less_leEq. auto. + right. apply less_leEq. auto. Qed. End Bisection. @@ -330,28 +344,28 @@ Hypothesis C_f_apzero_interval : Let Small : IR := Two [/]ThreeNZ. (* end hide *) -Record bisect_interval : Type := +Record bisect_interval : Type := {interval_lft : IR; interval_rht : IR; interval_lft_rht : interval_lft [<] interval_rht; interval_f_lft : f interval_lft [<=] Zero; interval_f_rht : Zero [<=] f interval_rht}. -Lemma Cbisect_exists : forall I : bisect_interval, {I' : bisect_interval | +Lemma Cbisect_exists : forall I : bisect_interval, {I' : bisect_interval | interval_rht I'[-]interval_lft I' [<=] Small[*] (interval_rht I[-]interval_lft I) /\ interval_lft I [<=] interval_lft I' /\ interval_rht I' [<=] interval_rht I}. -intros. -elim - (Cbisect' f C_f_apzero_interval _ _ (interval_lft_rht I) ( - interval_f_lft I) (interval_f_rht I)). -intro lft. intro H. -elim H. intro rht. intros H1 H2. elim H2. intros H3 H4. elim H4. intros H5 H6. -elim H6. intros H7 H8. -elim H8. intros H9 H10. -exists (Build_bisect_interval lft rht H1 H9 H10). -simpl in |- *. -unfold Small in |- *. -split. auto. split. auto. auto. +Proof. + intros. + elim (Cbisect' f C_f_apzero_interval _ _ (interval_lft_rht I) ( + interval_f_lft I) (interval_f_rht I)). + intro lft. intro H. + elim H. intro rht. intros H1 H2. elim H2. intros H3 H4. elim H4. intros H5 H6. + elim H6. intros H7 H8. + elim H8. intros H9 H10. + exists (Build_bisect_interval lft rht H1 H9 H10). + simpl in |- *. + unfold Small in |- *. + split. auto. split. auto. auto. Qed. Definition bisect I : bisect_interval := ProjT1 (Cbisect_exists I). @@ -359,9 +373,10 @@ Definition bisect I : bisect_interval := ProjT1 (Cbisect_exists I). Lemma bisect_prop : forall I : bisect_interval, interval_rht (bisect I) [-]interval_lft (bisect I) [<=] Small[*] (interval_rht I[-]interval_lft I) /\ interval_lft I [<=] interval_lft (bisect I) /\ interval_rht (bisect I) [<=] interval_rht I. -intros. -unfold bisect in |- *. -apply proj2_sigT. +Proof. + intros. + unfold bisect in |- *. + apply proj2_sigT. Qed. End Bisect_Interval. @@ -396,116 +411,121 @@ Let a_ (i : nat) := interval_lft _ (interval_sequence i). Let b_ (i : nat) := interval_rht _ (interval_sequence i). Lemma intervals_smaller : forall i, b_ i[-]a_ i [<=] Small[^]i[*] (b[-]a). -intros. -induction i as [| i Hreci]; intros. -unfold a_ in |- *. unfold b_ in |- *. simpl in |- *. -rstepr (b[-]a). -apply leEq_reflexive. -apply leEq_transitive with (Small[*] (b_ i[-]a_ i)). -elim (bisect_prop f f_apzero_interval (interval_sequence i)). -intros H H0. -elim H0; intros H1 H2. -auto. -simpl in |- *. -replace (nexp _ i Small) with (Small[^]i). 2: auto. -rstepr (Small[*] (Small[^]i[*] (b[-]a))). -apply mult_resp_leEq_lft. -auto. -apply less_leEq. -unfold Small in |- *. apply div_resp_pos. apply pos_three. apply pos_two. +Proof. + intros. + induction i as [| i Hreci]; intros. + unfold a_ in |- *. unfold b_ in |- *. simpl in |- *. + rstepr (b[-]a). + apply leEq_reflexive. + apply leEq_transitive with (Small[*] (b_ i[-]a_ i)). + elim (bisect_prop f f_apzero_interval (interval_sequence i)). + intros H H0. + elim H0; intros H1 H2. + auto. + simpl in |- *. + replace (nexp _ i Small) with (Small[^]i). 2: auto. + rstepr (Small[*] (Small[^]i[*] (b[-]a))). + apply mult_resp_leEq_lft. + auto. + apply less_leEq. + unfold Small in |- *. apply div_resp_pos. apply pos_three. apply pos_two. Qed. Lemma intervals_small'' : forall i : nat, Small[^]i[*]nring i [<=] One. -intros. -apply mult_cancel_leEq with (Three[^]i:IR). -apply nexp_resp_pos. apply pos_three. -astepr (Three[^]i:IR). -apply leEq_wdl with (nring i[*]Two[^]i:IR). -2: rstepr (nring i[*] (Small[^]i[*]Three[^]i)). -2: astepr (nring i[*] (Small[*]Three) [^]i). -2: cut (Small[*]Three [=] Two); algebra. -2: unfold Small in |- *; rational. -induction i as [| i Hreci]. -simpl in |- *. astepl ZeroR. apply less_leEq. apply pos_one. -elim (zerop i); intro y. -rewrite y. simpl in |- *. -rstepl (Two:IR). rstepr (Three:IR). -apply less_leEq. apply two_less_three. -elim (le_lt_eq_dec _ _ (lt_le_S _ _ y)); intros H0. -apply mult_cancel_leEq with (nring i:IR). -astepl (nring 0:IR). apply nring_less. auto. -apply leEq_wdl with (nring (S i) [*]Two[*] (nring i[*]Two[^]i:IR)). -2: simpl in |- *; rational. -apply leEq_wdr with (nring i[*]Three[*]Three[^]i:IR). -2: simpl in |- *; rational. -apply leEq_transitive with (nring i[*]Three[*] (nring i[*]Two[^]i:IR)). -apply mult_resp_leEq_rht. -simpl in |- *. -rstepl (nring i[*]Two[+] (Two:IR)). -rstepr (nring i[*]Two[+] (nring i:IR)). -apply plus_resp_leEq_lft. -elim (le_lt_eq_dec _ _ (lt_le_S _ _ H0)); intros H1. -apply less_leEq. apply nring_less. auto. -rewrite <- H1. apply leEq_reflexive. -apply less_leEq. apply mult_resp_pos. -astepl (nring 0:IR). apply nring_less. auto. -apply nexp_resp_pos. apply pos_two. -apply mult_resp_leEq_lft. auto. -apply less_leEq. apply mult_resp_pos. -astepl (nring 0:IR). apply nring_less. auto. -apply pos_three. -rewrite <- H0. -rstepl (nring (R:=IR) 8). -rstepr (nring (R:=IR) 9). -apply nring_leEq. auto. +Proof. + intros. + apply mult_cancel_leEq with (Three[^]i:IR). + apply nexp_resp_pos. apply pos_three. + astepr (Three[^]i:IR). + apply leEq_wdl with (nring i[*]Two[^]i:IR). + 2: rstepr (nring i[*] (Small[^]i[*]Three[^]i)). + 2: astepr (nring i[*] (Small[*]Three) [^]i). + 2: cut (Small[*]Three [=] Two); algebra. + 2: unfold Small in |- *; rational. + induction i as [| i Hreci]. + simpl in |- *. astepl ZeroR. apply less_leEq. apply pos_one. + elim (zerop i); intro y. + rewrite y. simpl in |- *. + rstepl (Two:IR). rstepr (Three:IR). + apply less_leEq. apply two_less_three. + elim (le_lt_eq_dec _ _ (lt_le_S _ _ y)); intros H0. + apply mult_cancel_leEq with (nring i:IR). + astepl (nring 0:IR). apply nring_less. auto. + apply leEq_wdl with (nring (S i) [*]Two[*] (nring i[*]Two[^]i:IR)). + 2: simpl in |- *; rational. + apply leEq_wdr with (nring i[*]Three[*]Three[^]i:IR). + 2: simpl in |- *; rational. + apply leEq_transitive with (nring i[*]Three[*] (nring i[*]Two[^]i:IR)). + apply mult_resp_leEq_rht. + simpl in |- *. + rstepl (nring i[*]Two[+] (Two:IR)). + rstepr (nring i[*]Two[+] (nring i:IR)). + apply plus_resp_leEq_lft. + elim (le_lt_eq_dec _ _ (lt_le_S _ _ H0)); intros H1. + apply less_leEq. apply nring_less. auto. + rewrite <- H1. apply leEq_reflexive. + apply less_leEq. apply mult_resp_pos. + astepl (nring 0:IR). apply nring_less. auto. + apply nexp_resp_pos. apply pos_two. + apply mult_resp_leEq_lft. auto. + apply less_leEq. apply mult_resp_pos. + astepl (nring 0:IR). apply nring_less. auto. + apply pos_three. + rewrite <- H0. + rstepl (nring (R:=IR) 8). + rstepr (nring (R:=IR) 9). + apply nring_leEq. auto. Qed. Lemma intervals_small' : forall eps, Zero [<] eps -> {i : nat | Small[^]i[*] (b[-]a) [<=] eps}. -intros. -cut (eps [#] Zero). intro H0. -elim (Archimedes (b[-]a[/] eps[//]H0)). intro i. intros H1. exists i. -astepr (eps[*]One). -apply shift_leEq_mult' with H0. auto. -apply leEq_transitive with (Small[^]i[*]nring i). -astepl (Small[^]i[*] (b[-]a[/] eps[//]H0)). -apply mult_resp_leEq_lft. -auto. -apply nexp_resp_nonneg. -apply less_leEq. -astepl (ZeroR [/]ThreeNZ). unfold Small in |- *. -apply div_resp_less_rht. apply pos_two. apply pos_three. -apply intervals_small''. -apply Greater_imp_ap. auto. +Proof. + intros. + cut (eps [#] Zero). intro H0. + elim (Archimedes (b[-]a[/] eps[//]H0)). intro i. intros H1. exists i. + astepr (eps[*]One). + apply shift_leEq_mult' with H0. auto. + apply leEq_transitive with (Small[^]i[*]nring i). + astepl (Small[^]i[*] (b[-]a[/] eps[//]H0)). + apply mult_resp_leEq_lft. + auto. + apply nexp_resp_nonneg. + apply less_leEq. + astepl (ZeroR [/]ThreeNZ). unfold Small in |- *. + apply div_resp_less_rht. apply pos_two. apply pos_three. + apply intervals_small''. + apply Greater_imp_ap. auto. Qed. Lemma intervals_small : forall eps, Zero [<] eps -> {i : nat | b_ i [<=] a_ i[+]eps}. -intros eps H. -elim (intervals_small' eps H). intro i. intros. exists i. -apply shift_leEq_plus'. -apply leEq_transitive with (Small[^]i[*] (b[-]a)). -apply intervals_smaller. -auto. +Proof. + intros eps H. + elim (intervals_small' eps H). intro i. intros. exists i. + apply shift_leEq_plus'. + apply leEq_transitive with (Small[^]i[*] (b[-]a)). + apply intervals_smaller. + auto. Qed. Lemma Civt_op : {z : IR | a [<=] z /\ z [<=] b /\ f z [=] Zero}. -cut (forall i : nat, a_ i [<=] a_ (S i)). intro H. -cut (forall i : nat, b_ (S i) [<=] b_ i). intro H0. -cut (forall i : nat, a_ i [<] b_ i). intro H1. -cut (forall i : nat, f (a_ i) [<=] Zero). intro H2. -cut (forall i : nat, Zero [<=] f (b_ i)). intro H3. -elim (Cnested_intervals_zero a_ b_ H H0 H1 intervals_small f f_contin H2 H3). -intro z. intro H4. exists z. -exact H4. -intros. exact (interval_f_rht _ (interval_sequence i)). -intros. exact (interval_f_lft _ (interval_sequence i)). -intros. exact (interval_lft_rht _ (interval_sequence i)). -intros. elim (bisect_prop f f_apzero_interval (interval_sequence i)). -intros H0 H1. elim H1. intros H2 H3. -unfold b_ in |- *. simpl in |- *. -assumption. -intros. elim (bisect_prop f f_apzero_interval (interval_sequence i)). -intros H H0. elim H0. intros H1 H2. -unfold a_ in |- *. simpl in |- *. auto. +Proof. + cut (forall i : nat, a_ i [<=] a_ (S i)). intro H. + cut (forall i : nat, b_ (S i) [<=] b_ i). intro H0. + cut (forall i : nat, a_ i [<] b_ i). intro H1. + cut (forall i : nat, f (a_ i) [<=] Zero). intro H2. + cut (forall i : nat, Zero [<=] f (b_ i)). intro H3. + elim (Cnested_intervals_zero a_ b_ H H0 H1 intervals_small f f_contin H2 H3). + intro z. intro H4. exists z. + exact H4. + intros. exact (interval_f_rht _ (interval_sequence i)). + intros. exact (interval_f_lft _ (interval_sequence i)). + intros. exact (interval_lft_rht _ (interval_sequence i)). + intros. elim (bisect_prop f f_apzero_interval (interval_sequence i)). + intros H0 H1. elim H1. intros H2 H3. + unfold b_ in |- *. simpl in |- *. + assumption. + intros. elim (bisect_prop f f_apzero_interval (interval_sequence i)). + intros H H0. elim H0. intros H1 H2. + unfold a_ in |- *. simpl in |- *. auto. Qed. End IVT_Op. @@ -517,14 +537,15 @@ Section IVT_Poly. Lemma Civt_poly : forall f : cpoly_cring IR, f [#] Zero -> forall a b, a [<] b -> f ! a [<=] Zero -> Zero [<=] f ! b -> {x : IR | a [<=] x /\ x [<=] b /\ f ! x [=] Zero}. -intros. -cut ({x : IR | a [<=] x /\ x [<=] b /\ cpoly_csetoid_op _ f x [=] Zero}). -intro. auto. -apply Civt_op; auto. -apply cpoly_op_contin. -intros. -change {c : IR | a0 [<=] c /\ c [<=] b0 | f ! c [#] Zero} in |- *. -apply Cpoly_apzero_interval. auto. auto. +Proof. + intros. + cut ({x : IR | a [<=] x /\ x [<=] b /\ cpoly_csetoid_op _ f x [=] Zero}). + intro. auto. + apply Civt_op; auto. + apply cpoly_op_contin. + intros. + change {c : IR | a0 [<=] c /\ c [<=] b0 | f ! c [#] Zero} in |- *. + apply Cpoly_apzero_interval. auto. auto. Qed. End IVT_Poly. diff --git a/reals/Intervals.v b/reals/Intervals.v index fb70f4ed5..9e119aa33 100644 --- a/reals/Intervals.v +++ b/reals/Intervals.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CSetoidInc. Require Export RealLists. @@ -65,21 +65,23 @@ Variables a b : IR. Hypothesis Hab : a [<=] b. Lemma compact_inc_lft : compact a b Hab a. -intros; split; [ apply leEq_reflexive | auto ]. +Proof. + intros; split; [ apply leEq_reflexive | auto ]. Qed. Lemma compact_inc_rht : compact a b Hab b. -intros; split; [ auto | apply leEq_reflexive ]. +Proof. + intros; split; [ auto | apply leEq_reflexive ]. Qed. Lemma compact_Min_lft : forall Hab', compact (Min a b) (Max a b) Hab' a. - -split; [ apply Min_leEq_lft | apply lft_leEq_Max ]. +Proof. + split; [ apply Min_leEq_lft | apply lft_leEq_Max ]. Qed. Lemma compact_Min_rht : forall Hab', compact (Min a b) (Max a b) Hab' b. - -split; [ apply Min_leEq_rht | apply rht_leEq_Max ]. +Proof. + split; [ apply Min_leEq_rht | apply rht_leEq_Max ]. Qed. (** @@ -88,10 +90,11 @@ interval, we want this predicate to be well defined. *) Lemma compact_wd : pred_wd IR (compact a b Hab). -intros; red in |- *; intros x y H H0. -inversion_clear H; split. -apply leEq_wdr with x; assumption. -apply leEq_wdl with x; assumption. +Proof. + intros; red in |- *; intros x y H H0. + inversion_clear H; split. + apply leEq_wdr with x; assumption. + apply leEq_wdl with x; assumption. Qed. (** @@ -100,10 +103,11 @@ Also, it will sometimes be necessary to rewrite the endpoints of an interval. Lemma compact_wd' : forall (a' b' : IR) Hab' (x : IR), a [=] a' -> b [=] b' -> compact a b Hab x -> compact a' b' Hab' x. -intros a' b' Hab' x H H0 H1. -inversion_clear H1; split. -apply leEq_wdl with a; auto. -apply leEq_wdr with b; auto. +Proof. + intros a' b' Hab' x H H0 H1. + inversion_clear H1; split. + apply leEq_wdl with a; auto. + apply leEq_wdr with b; auto. Qed. (** @@ -117,10 +121,11 @@ returns the restriction $F|_P$# of F to P#. *) Definition Frestr F P (HP : pred_wd IR P) (H : included P (Dom F)) : PartIR. -intros. -apply Build_PartFunct with P (fun (x : IR) (Hx : P x) => Part F x (H x Hx)). -assumption. -intros. exact (pfstrx _ _ _ _ _ _ X). +Proof. + intros. + apply Build_PartFunct with P (fun (x : IR) (Hx : P x) => Part F x (H x Hx)). + assumption. + intros. exact (pfstrx _ _ _ _ _ _ X). Defined. End Intervals. @@ -132,45 +137,49 @@ Notation FRestr := (Frestr (compact_wd _ _ _)). Section More_Intervals. Lemma included_refl' : forall a b Hab Hab', included (compact a b Hab) (compact a b Hab'). -intros. -red in |- *; intros x H. -inversion_clear H; split; auto. +Proof. + intros. + red in |- *; intros x H. + inversion_clear H; split; auto. Qed. (** We prove some inclusions of compact intervals. *) Definition compact_map1 : forall a b Hab Hab', included (compact (Min a b) (Max a b) Hab') (compact a b Hab). -intros. -red in |- *; intros x H. -red in |- *; red in H. -inversion_clear H. -split. -eapply leEq_wdl; [ apply H0 | apply leEq_imp_Min_is_lft; auto ]. -eapply leEq_wdr; [ apply H1 | apply leEq_imp_Max_is_rht; auto ]. +Proof. + intros. + red in |- *; intros x H. + red in |- *; red in H. + inversion_clear H. + split. + eapply leEq_wdl; [ apply H0 | apply leEq_imp_Min_is_lft; auto ]. + eapply leEq_wdr; [ apply H1 | apply leEq_imp_Max_is_rht; auto ]. Defined. Definition compact_map2 : forall a b Hab Hab', included (compact a b Hab) (compact (Min a b) (Max a b) Hab'). -intros. -red in |- *; intros x H. -red in |- *; red in H. -inversion_clear H. -split. -eapply leEq_transitive; [ apply Min_leEq_lft | apply H0 ]. -eapply leEq_transitive; [ apply H1 | apply rht_leEq_Max ]. +Proof. + intros. + red in |- *; intros x H. + red in |- *; red in H. + inversion_clear H. + split. + eapply leEq_transitive; [ apply Min_leEq_lft | apply H0 ]. + eapply leEq_transitive; [ apply H1 | apply rht_leEq_Max ]. Defined. Definition compact_map3 : forall a b e Hab Hab', Zero [<] e -> included (compact a (b[-]e) Hab') (compact a b Hab). -intros; red in |- *. try rename X into H. -intros x H0. inversion_clear H0; split. -auto. -eapply leEq_transitive. -apply H2. -apply shift_minus_leEq. -apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; assumption. +Proof. + intros; red in |- *. try rename X into H. + intros x H0. inversion_clear H0; split. + auto. + eapply leEq_transitive. + apply H2. + apply shift_minus_leEq. + apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; assumption. Qed. End More_Intervals. @@ -206,181 +215,175 @@ and that we defined compacts as we did. *) Lemma compact_is_totally_bounded : forall a b Hab, totally_bounded (compact a b Hab). -intros; split. -exists a. -apply compact_inc_lft. -cut - (forall (n : nat) (a b e : IR) (Hab : a [<=] b) (He : Zero [<] e), - (b[-]a[/] e[//]pos_ap_zero _ _ He) [<=] nring n -> - (2 <= n -> nring n[-]Two [<=] (b[-]a[/] e[//]pos_ap_zero _ _ He)) -> - {l : list IR | forall x : IR, member x l -> compact a b Hab x | - forall x : IR, - compact a b Hab x -> {y : IR | member y l | AbsIR (x[-]y) [<=] e}}). -intros H e He. -elim (str_Archimedes (b[-]a[/] _[//]pos_ap_zero _ _ (pos_div_two _ _ He))). -intros n Hn. -inversion_clear Hn. -elim (H n a b _ Hab (pos_div_two _ _ He)). -intros l Hl' Hl. -2: assumption. -2: assumption. -exists l. -assumption. -intros x Hx; elim (Hl x Hx). -intros y Hy Hy'. -exists y. -assumption. -apply AbsIR_imp_AbsSmall. -apply leEq_transitive with (e [/]TwoNZ). -assumption. -apply less_leEq; apply pos_div_two'; assumption. -apply shift_leEq_div; - [ apply pos_div_two; assumption | apply shift_leEq_minus ]. -rstepl a; assumption. -clear Hab a b; intro n; induction n as [| n Hrecn]. -intros. -exists (a::nil). -intros x H1. -inversion H1. rename X into H2. -elim H2. -apply compact_wd with a; algebra. -apply compact_inc_lft. -intros. -exists a. -right; algebra. -apply leEq_wdl with ZeroR. -apply less_leEq; auto. -astepl (AbsIR Zero). -apply AbsIR_wd. -apply leEq_imp_eq. try rename X into H1. -apply shift_leEq_minus; astepl a; elim H1; auto. -apply shift_minus_leEq. -apply leEq_transitive with b. try rename X into H1. -elim H1; auto. -apply shift_leEq_plus. -apply mult_cancel_leEq with (One[/] _[//]pos_ap_zero _ _ He). -apply recip_resp_pos; auto. -astepr ZeroR. -rstepl (b[-]a[/] _[//]pos_ap_zero _ _ He); auto. -clear Hrecn; induction n as [| n Hrecn]. -intros. -exists (a::nil). -intros x H1. -inversion_clear H1 as [H2|]. -elim H2. -apply compact_wd with a; [ apply compact_inc_lft | algebra ]. -intros x Hx; inversion_clear Hx. -exists a. -simpl in |- *; right; algebra. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply leEq_transitive with (b[-]a). -apply minus_resp_leEq; assumption. -rstepr (e[*]nring 1); eapply shift_leEq_mult'; [ assumption | apply H ]. -apply shift_leEq_minus; astepl a. -assumption. -clear Hrecn; induction n as [| n Hrecn]. -intros. -set (enz := pos_ap_zero _ _ He) in *. -exists (cons ((a[+]b) [/]TwoNZ) (@nil IR)). -intros x H1. -inversion_clear H1 as [H2|]. -inversion_clear H2. -apply compact_wd with ((a[+]b) [/]TwoNZ); [ split | algebra ]. -astepl (a[+]Zero); apply shift_plus_leEq'. -apply mult_cancel_leEq with (Two:IR). -apply pos_two. -astepl ZeroR. -rstepr (b[-]a). -apply shift_leEq_minus; astepl a; auto. -astepr (b[+]Zero); apply shift_leEq_plus'. -apply mult_cancel_leEq with (Two:IR). -apply pos_two. -astepr ZeroR. -rstepl (a[-]b). -apply shift_minus_leEq; astepr b; auto. -intros. -exists ((a[+]b) [/]TwoNZ). -right; algebra. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply Abs_Max. -apply shift_minus_leEq; apply Max_leEq; apply shift_leEq_plus'; - apply leEq_Min. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; auto. -apply shift_minus_leEq. -apply leEq_transitive with b. try rename X into H1. -elim H1; auto. -apply shift_leEq_plus'. -apply mult_cancel_leEq with (Two:IR). -apply pos_two. -apply shift_leEq_mult' with enz. -auto. -rstepl (b[-]a[/] e[//]enz); auto. -apply leEq_transitive with a. -2: try rename X into H1; elim H1; auto. -apply shift_minus_leEq; apply shift_leEq_plus'. -apply mult_cancel_leEq with (Two:IR). -apply pos_two. -apply shift_leEq_mult' with enz. -auto. -rstepl (b[-]a[/] e[//]enz); auto. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; auto. -intros. -set (b' := b[-]e) in *. -cut (a [<=] b'); intros. -elim (Hrecn a b' e H1 He). -intros l Hl' Hl. -exists (cons b' l). -intros. -unfold b' in H1; apply compact_map3 with (e := e) (Hab' := H1) (b := b). -assumption. try rename X into H2. -simpl in H2; inversion_clear H2. -apply Hl'; assumption. -apply compact_wd with b'; [ apply compact_inc_rht | algebra ]. -intros. -cut (x [<] b' or b'[-]e [<] x). intros H3. -inversion_clear H3. -cut (compact a b' H1 x). intros H3. -elim (Hl x H3). -intros y Hy Hy'. -exists y. -left; assumption. -auto. try rename X into H2. -inversion_clear H2; split. -assumption. -apply less_leEq; auto. -exists b'. -right; algebra. -simpl in |- *; unfold ABSIR in |- *. -apply Max_leEq. -apply shift_minus_leEq; unfold b' in |- *. -rstepr b. try rename X into H2. -elim H2; auto. -rstepl (b'[-]x); apply shift_minus_leEq; apply shift_leEq_plus'; - apply less_leEq; assumption. -cut (b'[-]e [<] x or x [<] b'); [ tauto | apply less_cotransitive_unfolded ]. -apply shift_minus_less; apply shift_less_plus'; astepl ZeroR; assumption. - -unfold b' in |- *. -rstepl ((b[-]a[/] e[//]pos_ap_zero _ _ He) [-]One). -apply shift_minus_leEq. -astepr (nring (R:=IR) (S (S (S n)))); auto. -intro. -unfold b' in |- *. -rstepr ((b[-]a[/] e[//]pos_ap_zero _ _ He) [-]One). -apply shift_leEq_minus. -rstepl (nring (R:=IR) (S (S n)) [+]One[-]Two). -auto with arith. - -unfold b' in |- *. -apply shift_leEq_minus; apply shift_plus_leEq'. -astepl (One[*]e); apply shift_mult_leEq with (pos_ap_zero _ _ He). -auto. -apply leEq_transitive with (nring (R:=IR) (S (S (S n))) [-]Two). -apply shift_leEq_minus; rstepl (Three:IR); apply nring_leEq; auto with arith. -auto with arith. +Proof. + intros; split. + exists a. + apply compact_inc_lft. + cut (forall (n : nat) (a b e : IR) (Hab : a [<=] b) (He : Zero [<] e), + (b[-]a[/] e[//]pos_ap_zero _ _ He) [<=] nring n -> + (2 <= n -> nring n[-]Two [<=] (b[-]a[/] e[//]pos_ap_zero _ _ He)) -> + {l : list IR | forall x : IR, member x l -> compact a b Hab x | forall x : IR, + compact a b Hab x -> {y : IR | member y l | AbsIR (x[-]y) [<=] e}}). + intros H e He. + elim (str_Archimedes (b[-]a[/] _[//]pos_ap_zero _ _ (pos_div_two _ _ He))). + intros n Hn. + inversion_clear Hn. + elim (H n a b _ Hab (pos_div_two _ _ He)). + intros l Hl' Hl. + 2: assumption. + 2: assumption. + exists l. + assumption. + intros x Hx; elim (Hl x Hx). + intros y Hy Hy'. + exists y. + assumption. + apply AbsIR_imp_AbsSmall. + apply leEq_transitive with (e [/]TwoNZ). + assumption. + apply less_leEq; apply pos_div_two'; assumption. + apply shift_leEq_div; [ apply pos_div_two; assumption | apply shift_leEq_minus ]. + rstepl a; assumption. + clear Hab a b; intro n; induction n as [| n Hrecn]. + intros. + exists (a::nil). + intros x H1. + inversion H1. rename X into H2. + elim H2. + apply compact_wd with a; algebra. + apply compact_inc_lft. + intros. + exists a. + right; algebra. + apply leEq_wdl with ZeroR. + apply less_leEq; auto. + astepl (AbsIR Zero). + apply AbsIR_wd. + apply leEq_imp_eq. try rename X into H1. + apply shift_leEq_minus; astepl a; elim H1; auto. + apply shift_minus_leEq. + apply leEq_transitive with b. try rename X into H1. + elim H1; auto. + apply shift_leEq_plus. + apply mult_cancel_leEq with (One[/] _[//]pos_ap_zero _ _ He). + apply recip_resp_pos; auto. + astepr ZeroR. + rstepl (b[-]a[/] _[//]pos_ap_zero _ _ He); auto. + clear Hrecn; induction n as [| n Hrecn]. + intros. + exists (a::nil). + intros x H1. + inversion_clear H1 as [H2|]. + elim H2. + apply compact_wd with a; [ apply compact_inc_lft | algebra ]. + intros x Hx; inversion_clear Hx. + exists a. + simpl in |- *; right; algebra. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply leEq_transitive with (b[-]a). + apply minus_resp_leEq; assumption. + rstepr (e[*]nring 1); eapply shift_leEq_mult'; [ assumption | apply H ]. + apply shift_leEq_minus; astepl a. + assumption. + clear Hrecn; induction n as [| n Hrecn]. + intros. + set (enz := pos_ap_zero _ _ He) in *. + exists (cons ((a[+]b) [/]TwoNZ) (@nil IR)). + intros x H1. + inversion_clear H1 as [H2|]. + inversion_clear H2. + apply compact_wd with ((a[+]b) [/]TwoNZ); [ split | algebra ]. + astepl (a[+]Zero); apply shift_plus_leEq'. + apply mult_cancel_leEq with (Two:IR). + apply pos_two. + astepl ZeroR. + rstepr (b[-]a). + apply shift_leEq_minus; astepl a; auto. + astepr (b[+]Zero); apply shift_leEq_plus'. + apply mult_cancel_leEq with (Two:IR). + apply pos_two. + astepr ZeroR. + rstepl (a[-]b). + apply shift_minus_leEq; astepr b; auto. + intros. + exists ((a[+]b) [/]TwoNZ). + right; algebra. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Abs_Max. + apply shift_minus_leEq; apply Max_leEq; apply shift_leEq_plus'; apply leEq_Min. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; auto. + apply shift_minus_leEq. + apply leEq_transitive with b. try rename X into H1. + elim H1; auto. + apply shift_leEq_plus'. + apply mult_cancel_leEq with (Two:IR). + apply pos_two. + apply shift_leEq_mult' with enz. + auto. + rstepl (b[-]a[/] e[//]enz); auto. + apply leEq_transitive with a. + 2: try rename X into H1; elim H1; auto. + apply shift_minus_leEq; apply shift_leEq_plus'. + apply mult_cancel_leEq with (Two:IR). + apply pos_two. + apply shift_leEq_mult' with enz. + auto. + rstepl (b[-]a[/] e[//]enz); auto. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; auto. + intros. + set (b' := b[-]e) in *. + cut (a [<=] b'); intros. + elim (Hrecn a b' e H1 He). + intros l Hl' Hl. + exists (cons b' l). + intros. + unfold b' in H1; apply compact_map3 with (e := e) (Hab' := H1) (b := b). + assumption. try rename X into H2. + simpl in H2; inversion_clear H2. + apply Hl'; assumption. + apply compact_wd with b'; [ apply compact_inc_rht | algebra ]. + intros. + cut (x [<] b' or b'[-]e [<] x). intros H3. + inversion_clear H3. + cut (compact a b' H1 x). intros H3. + elim (Hl x H3). + intros y Hy Hy'. + exists y. + left; assumption. + auto. try rename X into H2. + inversion_clear H2; split. + assumption. + apply less_leEq; auto. + exists b'. + right; algebra. + simpl in |- *; unfold ABSIR in |- *. + apply Max_leEq. + apply shift_minus_leEq; unfold b' in |- *. + rstepr b. try rename X into H2. + elim H2; auto. + rstepl (b'[-]x); apply shift_minus_leEq; apply shift_leEq_plus'; apply less_leEq; assumption. + cut (b'[-]e [<] x or x [<] b'); [ tauto | apply less_cotransitive_unfolded ]. + apply shift_minus_less; apply shift_less_plus'; astepl ZeroR; assumption. + unfold b' in |- *. + rstepl ((b[-]a[/] e[//]pos_ap_zero _ _ He) [-]One). + apply shift_minus_leEq. + astepr (nring (R:=IR) (S (S (S n)))); auto. + intro. + unfold b' in |- *. + rstepr ((b[-]a[/] e[//]pos_ap_zero _ _ He) [-]One). + apply shift_leEq_minus. + rstepl (nring (R:=IR) (S (S n)) [+]One[-]Two). + auto with arith. + unfold b' in |- *. + apply shift_leEq_minus; apply shift_plus_leEq'. + astepl (One[*]e); apply shift_mult_leEq with (pos_ap_zero _ _ He). + auto. + apply leEq_transitive with (nring (R:=IR) (S (S (S n))) [-]Two). + apply shift_leEq_minus; rstepl (Three:IR); apply nring_leEq; auto with arith. + auto with arith. Qed. (** @@ -396,7 +399,7 @@ Definition set_lub_IR (P : IR -> CProp) a : CProp := (forall x, P x -> x [<=] a) Definition fun_image F (P : IR -> CProp) x : CProp := {y : IR | P y and Dom F y and (forall Hy, F y Hy [=] x)}. - + Definition fun_glb_IR F (P : IR -> CProp) a : CProp := set_glb_IR (fun_image F P) a. @@ -409,35 +412,36 @@ Let aux_seq_lub (P : IR -> CProp) (H : totally_bounded P) : Build_SubCSetoid IR (fun x : IR => P x and (forall y : IR, P y -> y[-]x [<=] Two[*]one_div_succ k)). -intros P H; elim H; clear H; intros non_empty H k. -elim (H (one_div_succ k) (one_div_succ_pos IR k)). -intros l Hl' Hl; clear H. -cut {y : IR | member y l | maxlist l[-]one_div_succ k [<=] y}. -intro H; inversion_clear H. -2: apply maxlist_leEq_eps. -2: inversion_clear non_empty. -2: elim (Hl x). -2: intros. -2: exists x0. -2: tauto. -2: assumption. -2: apply one_div_succ_pos. -exists x; split. -apply Hl'; assumption. -intros y Hy. -elim (Hl y Hy). -intros z Hz Hz'. -rstepl (y[-]z[+] (z[-]x)). -rstepr (one_div_succ (R:=IR) k[+]one_div_succ k). -apply plus_resp_leEq_both. -apply leEq_transitive with (AbsIR (y[-]z)). -apply leEq_AbsIR. -apply AbsSmall_imp_AbsIR; assumption. -apply shift_minus_leEq. -apply leEq_transitive with (maxlist l). -apply maxlist_greater; assumption. -apply shift_leEq_plus'. -assumption. +Proof. + intros P H; elim H; clear H; intros non_empty H k. + elim (H (one_div_succ k) (one_div_succ_pos IR k)). + intros l Hl' Hl; clear H. + cut {y : IR | member y l | maxlist l[-]one_div_succ k [<=] y}. + intro H; inversion_clear H. + 2: apply maxlist_leEq_eps. + 2: inversion_clear non_empty. + 2: elim (Hl x). + 2: intros. + 2: exists x0. + 2: tauto. + 2: assumption. + 2: apply one_div_succ_pos. + exists x; split. + apply Hl'; assumption. + intros y Hy. + elim (Hl y Hy). + intros z Hz Hz'. + rstepl (y[-]z[+] (z[-]x)). + rstepr (one_div_succ (R:=IR) k[+]one_div_succ k). + apply plus_resp_leEq_both. + apply leEq_transitive with (AbsIR (y[-]z)). + apply leEq_AbsIR. + apply AbsSmall_imp_AbsIR; assumption. + apply shift_minus_leEq. + apply leEq_transitive with (maxlist l). + apply maxlist_greater; assumption. + apply shift_leEq_plus'. + assumption. Qed. Let aux_seq_lub_prop : @@ -445,17 +449,14 @@ Let aux_seq_lub_prop : (forall k : nat, P (scs_elem _ _ (aux_seq_lub P H k))) and (forall (k : nat) (y : IR), P y -> y[-]scs_elem _ _ (aux_seq_lub P H k) [<=] Two[*]one_div_succ k). -intros; - cut - (forall k : nat, - P (scs_elem _ _ (aux_seq_lub P H k)) - and (forall y : IR, - P y -> y[-]scs_elem _ _ (aux_seq_lub P H k) [<=] Two[*]one_div_succ k)). -intro H0. -split; intro; elim (H0 k); intros. -assumption. -apply b; assumption. -intro; apply scs_prf. +Proof. + intros; cut (forall k : nat, P (scs_elem _ _ (aux_seq_lub P H k)) and (forall y : IR, + P y -> y[-]scs_elem _ _ (aux_seq_lub P H k) [<=] Two[*]one_div_succ k)). + intro H0. + split; intro; elim (H0 k); intros. + assumption. + apply b; assumption. + intro; apply scs_prf. Qed. (* end hide *) @@ -465,128 +466,117 @@ The following are probably the most important results in this section. Lemma totally_bounded_has_lub : forall P, totally_bounded P -> {z : IR | set_lub_IR P z}. -intros P tot_bnd. -red in tot_bnd. -elim tot_bnd; intros non_empty H. -cut - {sequence : nat -> IR | forall k : nat, P (sequence k) | - forall (k : nat) (x : IR), P x -> x[-]sequence k [<=] Two[*]one_div_succ k}. -intros H0. -elim H0. -intros seq Hseq Hseq'. -cut (Cauchy_prop seq). -intro H1. -set (seq1 := Build_CauchySeq IR seq H1) in *. -exists (Lim seq1). -split; intros. -apply shift_leEq_rht. -astepl ( [--]ZeroR); rstepr ( [--] (x[-]Lim seq1)). -apply inv_resp_leEq. -set (seq2 := Cauchy_const x) in *. -apply leEq_wdl with (Lim seq2[-]Lim seq1). -2: apply cg_minus_wd; - [ unfold seq2 in |- *; apply eq_symmetric_unfolded; apply Lim_const - | algebra ]. -apply - leEq_wdl - with - (Lim - (Build_CauchySeq IR (fun n : nat => seq2 n[-]seq1 n) - (Cauchy_minus seq2 seq1))). -apply leEq_transitive with (Lim twice_inv_seq). -apply Lim_leEq_Lim; intro; simpl in |- *. -apply Hseq'; assumption. -apply eq_imp_leEq. -apply eq_symmetric_unfolded; apply Limits_unique. -red in |- *; fold (SeqLimit twice_inv_seq Zero) in |- *. -apply twice_inv_seq_Lim. -apply Lim_minus. -cut (Cauchy_Lim_prop2 seq (Lim seq1)). -intro H4; red in H4. try rename X into H2. -elim (H4 (e [/]TwoNZ) (pos_div_two _ _ H2)); clear H4. -intros n Hn. -exists (seq n). -apply Hseq. -apply leEq_less_trans with (AbsIR (Lim seq1[-]seq n)). -apply leEq_AbsIR. -apply leEq_less_trans with (e [/]TwoNZ). -apply AbsSmall_imp_AbsIR. -apply AbsSmall_minus; simpl in |- *; apply Hn. -apply le_n. -apply pos_div_two'; auto. -cut (Cauchy_Lim_prop2 seq1 (Lim seq1)); intros. -try rename X0 into H3. -red in |- *; red in H3. -intros eps Heps; elim (H3 eps Heps); clear H3; intros. -exists x. -intros m Hm; elim (p m Hm); clear p. -intros. -astepr (seq1 m[-]Lim seq1). -apply AbsIR_eq_AbsSmall; assumption. -red in |- *; fold (SeqLimit seq1 (Lim seq1)) in |- *. -apply ax_Lim. -apply crl_proof. -red in |- *; intros. try rename X into H1. -elim (Archimedes (One[/] e[//]pos_ap_zero _ _ H1)). -intros n Hn. -exists (S (2 * n)); intros. -cut (Zero [<] nring (R:=IR) n); intros. -apply AbsIR_eq_AbsSmall. try rename X into H3. -apply leEq_transitive with ( [--] (One[/] nring n[//]pos_ap_zero _ _ H3)). -apply inv_resp_leEq. -apply shift_div_leEq. -assumption. -eapply shift_leEq_mult'; [ assumption | apply Hn ]. -rstepr ( [--] (seq (S (2 * n)) [-]seq m)); apply inv_resp_leEq. -apply leEq_transitive with (Two[*]one_div_succ (R:=IR) m). -auto. -apply leEq_transitive with (one_div_succ (R:=IR) n). -unfold one_div_succ in |- *. -unfold Snring in |- *. -rstepl - (One[/] nring (S m) [/]TwoNZ[//] - div_resp_ap_zero_rev _ _ _ _ (nring_ap_zero IR (S m) (sym_not_eq (O_S m)))). -apply recip_resp_leEq. -apply pos_nring_S. -apply shift_leEq_div. -apply pos_two. -simpl in |- *; fold (Two:IR) in |- *. -rstepl (Two[*]nring (R:=IR) n[+]One[+]One). -apply plus_resp_leEq. -apply leEq_wdl with (nring (R:=IR) (S (2 * n))). -apply nring_leEq; assumption. -Step_final (nring (R:=IR) (2 * n) [+]One). -unfold one_div_succ in |- *; unfold Snring in |- *; apply recip_resp_leEq. -assumption. -simpl in |- *; apply less_leEq; apply less_plusOne. -apply leEq_transitive with (Two[*]one_div_succ (R:=IR) (S (2 * n))). -auto. -apply less_leEq. try rename X into H3. -apply less_leEq_trans with (One[/] nring n[//]pos_ap_zero _ _ H3). -astepl (one_div_succ (R:=IR) (S (2 * n)) [*]Two). -unfold one_div_succ in |- *; unfold Snring in |- *. -apply shift_mult_less with (two_ap_zero IR). -apply pos_two. -rstepr - (One[/] Two[*]nring n[//] - mult_resp_ap_zero _ _ _ (two_ap_zero IR) (pos_ap_zero _ _ H3)). -apply recip_resp_less. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; - [ apply pos_two | assumption ]. -apply less_wdr with (Two[*]nring (R:=IR) n[+]One[+]One). -apply less_transitive_unfolded with (Two[*]nring (R:=IR) n[+]One); - apply less_plusOne. -astepr (nring (R:=IR) (S (2 * n)) [+]One). -Step_final (nring (R:=IR) (2 * n) [+]One[+]One). -rstepr - (One[/] One[/] e[//]pos_ap_zero _ _ H1[//] - div_resp_ap_zero_rev _ _ _ _ (one_ap_zero IR)). -apply recip_resp_leEq; [ apply recip_resp_pos; assumption | assumption ]. -eapply less_leEq_trans. -2: apply Hn. -apply recip_resp_pos; assumption. -elim (aux_seq_lub_prop P tot_bnd). -exists (fun k : nat => scs_elem _ _ (aux_seq_lub P tot_bnd k)); auto. +Proof. + intros P tot_bnd. + red in tot_bnd. + elim tot_bnd; intros non_empty H. + cut {sequence : nat -> IR | forall k : nat, P (sequence k) | + forall (k : nat) (x : IR), P x -> x[-]sequence k [<=] Two[*]one_div_succ k}. + intros H0. + elim H0. + intros seq Hseq Hseq'. + cut (Cauchy_prop seq). + intro H1. + set (seq1 := Build_CauchySeq IR seq H1) in *. + exists (Lim seq1). + split; intros. + apply shift_leEq_rht. + astepl ( [--]ZeroR); rstepr ( [--] (x[-]Lim seq1)). + apply inv_resp_leEq. + set (seq2 := Cauchy_const x) in *. + apply leEq_wdl with (Lim seq2[-]Lim seq1). + 2: apply cg_minus_wd; [ unfold seq2 in |- *; apply eq_symmetric_unfolded; apply Lim_const + | algebra ]. + apply leEq_wdl with (Lim (Build_CauchySeq IR (fun n : nat => seq2 n[-]seq1 n) + (Cauchy_minus seq2 seq1))). + apply leEq_transitive with (Lim twice_inv_seq). + apply Lim_leEq_Lim; intro; simpl in |- *. + apply Hseq'; assumption. + apply eq_imp_leEq. + apply eq_symmetric_unfolded; apply Limits_unique. + red in |- *; fold (SeqLimit twice_inv_seq Zero) in |- *. + apply twice_inv_seq_Lim. + apply Lim_minus. + cut (Cauchy_Lim_prop2 seq (Lim seq1)). + intro H4; red in H4. try rename X into H2. + elim (H4 (e [/]TwoNZ) (pos_div_two _ _ H2)); clear H4. + intros n Hn. + exists (seq n). + apply Hseq. + apply leEq_less_trans with (AbsIR (Lim seq1[-]seq n)). + apply leEq_AbsIR. + apply leEq_less_trans with (e [/]TwoNZ). + apply AbsSmall_imp_AbsIR. + apply AbsSmall_minus; simpl in |- *; apply Hn. + apply le_n. + apply pos_div_two'; auto. + cut (Cauchy_Lim_prop2 seq1 (Lim seq1)); intros. + try rename X0 into H3. + red in |- *; red in H3. + intros eps Heps; elim (H3 eps Heps); clear H3; intros. + exists x. + intros m Hm; elim (p m Hm); clear p. + intros. + astepr (seq1 m[-]Lim seq1). + apply AbsIR_eq_AbsSmall; assumption. + red in |- *; fold (SeqLimit seq1 (Lim seq1)) in |- *. + apply ax_Lim. + apply crl_proof. + red in |- *; intros. try rename X into H1. + elim (Archimedes (One[/] e[//]pos_ap_zero _ _ H1)). + intros n Hn. + exists (S (2 * n)); intros. + cut (Zero [<] nring (R:=IR) n); intros. + apply AbsIR_eq_AbsSmall. try rename X into H3. + apply leEq_transitive with ( [--] (One[/] nring n[//]pos_ap_zero _ _ H3)). + apply inv_resp_leEq. + apply shift_div_leEq. + assumption. + eapply shift_leEq_mult'; [ assumption | apply Hn ]. + rstepr ( [--] (seq (S (2 * n)) [-]seq m)); apply inv_resp_leEq. + apply leEq_transitive with (Two[*]one_div_succ (R:=IR) m). + auto. + apply leEq_transitive with (one_div_succ (R:=IR) n). + unfold one_div_succ in |- *. + unfold Snring in |- *. + rstepl (One[/] nring (S m) [/]TwoNZ[//] + div_resp_ap_zero_rev _ _ _ _ (nring_ap_zero IR (S m) (sym_not_eq (O_S m)))). + apply recip_resp_leEq. + apply pos_nring_S. + apply shift_leEq_div. + apply pos_two. + simpl in |- *; fold (Two:IR) in |- *. + rstepl (Two[*]nring (R:=IR) n[+]One[+]One). + apply plus_resp_leEq. + apply leEq_wdl with (nring (R:=IR) (S (2 * n))). + apply nring_leEq; assumption. + Step_final (nring (R:=IR) (2 * n) [+]One). + unfold one_div_succ in |- *; unfold Snring in |- *; apply recip_resp_leEq. + assumption. + simpl in |- *; apply less_leEq; apply less_plusOne. + apply leEq_transitive with (Two[*]one_div_succ (R:=IR) (S (2 * n))). + auto. + apply less_leEq. try rename X into H3. + apply less_leEq_trans with (One[/] nring n[//]pos_ap_zero _ _ H3). + astepl (one_div_succ (R:=IR) (S (2 * n)) [*]Two). + unfold one_div_succ in |- *; unfold Snring in |- *. + apply shift_mult_less with (two_ap_zero IR). + apply pos_two. + rstepr (One[/] Two[*]nring n[//] mult_resp_ap_zero _ _ _ (two_ap_zero IR) (pos_ap_zero _ _ H3)). + apply recip_resp_less. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; + [ apply pos_two | assumption ]. + apply less_wdr with (Two[*]nring (R:=IR) n[+]One[+]One). + apply less_transitive_unfolded with (Two[*]nring (R:=IR) n[+]One); apply less_plusOne. + astepr (nring (R:=IR) (S (2 * n)) [+]One). + Step_final (nring (R:=IR) (2 * n) [+]One[+]One). + rstepr (One[/] One[/] e[//]pos_ap_zero _ _ H1[//] div_resp_ap_zero_rev _ _ _ _ (one_ap_zero IR)). + apply recip_resp_leEq; [ apply recip_resp_pos; assumption | assumption ]. + eapply less_leEq_trans. + 2: apply Hn. + apply recip_resp_pos; assumption. + elim (aux_seq_lub_prop P tot_bnd). + exists (fun k : nat => scs_elem _ _ (aux_seq_lub P tot_bnd k)); auto. Qed. (* begin hide *) @@ -595,36 +585,37 @@ Let aux_seq_glb (P : IR -> CProp) (H : totally_bounded P) : Build_SubCSetoid IR (fun x : IR => P x and (forall y : IR, P y -> x[-]y [<=] Two[*]one_div_succ k)). -intros P H; elim H; clear H; intros non_empty H k. -elim (H (one_div_succ k) (one_div_succ_pos IR k)). -intros l Hl' Hl; clear H. -cut {y : IR | member y l | y [<=] minlist l[+]one_div_succ k}. -intro H; inversion_clear H. -2: apply minlist_leEq_eps. -2: inversion_clear non_empty. -2: elim (Hl x). -2: intros. -2: exists x0. -2: tauto. -2: assumption. -2: apply one_div_succ_pos. -exists x; split. -apply Hl'; assumption. -intros y Hy. -elim (Hl y Hy). -intros z Hz Hz'. -rstepl (x[-]z[+] (z[-]y)). -rstepr (one_div_succ (R:=IR) k[+]one_div_succ k). -apply plus_resp_leEq_both. -apply shift_minus_leEq. -apply shift_leEq_plus'. -apply leEq_transitive with (minlist l). -apply shift_minus_leEq. -assumption. -apply minlist_smaller; assumption. -apply leEq_transitive with (AbsIR (y[-]z)). -rstepl ( [--] (y[-]z)); apply inv_leEq_AbsIR. -apply AbsSmall_imp_AbsIR; assumption. +Proof. + intros P H; elim H; clear H; intros non_empty H k. + elim (H (one_div_succ k) (one_div_succ_pos IR k)). + intros l Hl' Hl; clear H. + cut {y : IR | member y l | y [<=] minlist l[+]one_div_succ k}. + intro H; inversion_clear H. + 2: apply minlist_leEq_eps. + 2: inversion_clear non_empty. + 2: elim (Hl x). + 2: intros. + 2: exists x0. + 2: tauto. + 2: assumption. + 2: apply one_div_succ_pos. + exists x; split. + apply Hl'; assumption. + intros y Hy. + elim (Hl y Hy). + intros z Hz Hz'. + rstepl (x[-]z[+] (z[-]y)). + rstepr (one_div_succ (R:=IR) k[+]one_div_succ k). + apply plus_resp_leEq_both. + apply shift_minus_leEq. + apply shift_leEq_plus'. + apply leEq_transitive with (minlist l). + apply shift_minus_leEq. + assumption. + apply minlist_smaller; assumption. + apply leEq_transitive with (AbsIR (y[-]z)). + rstepl ( [--] (y[-]z)); apply inv_leEq_AbsIR. + apply AbsSmall_imp_AbsIR; assumption. Qed. Let aux_seq_glb_prop : @@ -632,147 +623,133 @@ Let aux_seq_glb_prop : (forall k : nat, P (scs_elem _ _ (aux_seq_glb P H k))) and (forall (k : nat) (y : IR), P y -> scs_elem _ _ (aux_seq_glb P H k) [-]y [<=] Two[*]one_div_succ k). -intros; - cut - (forall k : nat, - P (scs_elem _ _ (aux_seq_glb P H k)) - and (forall y : IR, - P y -> scs_elem _ _ (aux_seq_glb P H k) [-]y [<=] Two[*]one_div_succ k)). -intro H0. -split; intro k; elim (H0 k); intros. -assumption. -apply b; assumption. -intro; apply scs_prf. +Proof. + intros; cut (forall k : nat, P (scs_elem _ _ (aux_seq_glb P H k)) and (forall y : IR, + P y -> scs_elem _ _ (aux_seq_glb P H k) [-]y [<=] Two[*]one_div_succ k)). + intro H0. + split; intro k; elim (H0 k); intros. + assumption. + apply b; assumption. + intro; apply scs_prf. Qed. (* end hide *) Lemma totally_bounded_has_glb : forall P : IR -> CProp, totally_bounded P -> {z : IR | set_glb_IR P z}. -intros P tot_bnd. -red in tot_bnd. -elim tot_bnd; intros non_empty H. -cut - {sequence : nat -> IR | forall k : nat, P (sequence k) | - forall (k : nat) (x : IR), P x -> sequence k[-]x [<=] Two[*]one_div_succ k}. -intros H0. -elim H0. -clear H0; intros seq H0 H1. -cut (Cauchy_prop seq). -intro H2. -set (seq1 := Build_CauchySeq IR seq H2) in *. -exists (Lim seq1). -split; intros. -apply shift_leEq_rht. -astepl ( [--]ZeroR); rstepr ( [--] (Lim seq1[-]x)). -apply inv_resp_leEq. -set (seq2 := Cauchy_const x) in *. -apply leEq_wdl with (Lim seq1[-]Lim seq2). -2: apply cg_minus_wd; - [ algebra - | unfold seq2 in |- *; apply eq_symmetric_unfolded; apply Lim_const ]. -apply - leEq_wdl - with - (Lim - (Build_CauchySeq IR (fun n : nat => seq1 n[-]seq2 n) - (Cauchy_minus seq1 seq2))). -apply leEq_transitive with (Lim twice_inv_seq). -apply Lim_leEq_Lim; intro. -simpl in |- *. -apply H1; assumption. -apply eq_imp_leEq. -apply eq_symmetric_unfolded; apply Limits_unique. -red in |- *; fold (SeqLimit twice_inv_seq Zero) in |- *. -apply twice_inv_seq_Lim. -apply Lim_minus. -cut (Cauchy_Lim_prop2 seq (Lim seq1)). -intro H4; red in H4. try rename X into H3. -elim (H4 (e [/]TwoNZ) (pos_div_two _ _ H3)); clear H4. -intros n Hn. -exists (seq n). -apply H0. -apply leEq_less_trans with (AbsIR (Lim seq1[-]seq n)). -rstepl ( [--] (Lim seq1[-]seq n)). -apply inv_leEq_AbsIR. -apply leEq_less_trans with (e [/]TwoNZ). -apply AbsSmall_imp_AbsIR. -apply AbsSmall_minus; simpl in |- *; apply Hn. -apply le_n. -apply pos_div_two'; auto. -cut (Cauchy_Lim_prop2 seq1 (Lim seq1)); intros. -try rename X0 into H4. -red in |- *; red in H4. -intros eps Heps; elim (H4 eps Heps); clear H4; intros. -exists x. -intros m Hm; elim (p m Hm); clear p. -intros. -astepr (seq1 m[-]Lim seq1). -apply AbsIR_eq_AbsSmall; assumption. -red in |- *; fold (SeqLimit seq1 (Lim seq1)) in |- *. -apply ax_Lim. -apply crl_proof. -red in |- *; intros e H2. -elim (Archimedes (One[/] e[//]pos_ap_zero _ _ H2)). -intros n Hn. -exists (S (2 * n)); intros. -cut (Zero [<] nring (R:=IR) n); intros. -apply AbsIR_eq_AbsSmall. -try rename X into H4. -apply leEq_transitive with ( [--] (One[/] nring n[//]pos_ap_zero _ _ H4)). -apply inv_resp_leEq. -apply shift_div_leEq. -assumption. -eapply shift_leEq_mult'; [ assumption | apply Hn ]. -apply less_leEq. -rstepr ( [--] (seq (S (2 * n)) [-]seq m)); apply inv_resp_less. -apply leEq_less_trans with (Two[*]one_div_succ (R:=IR) (S (2 * n))). -apply H1; apply H0. -astepl (one_div_succ (R:=IR) (S (2 * n)) [*]Two). -unfold one_div_succ in |- *; unfold Snring in |- *. -apply shift_mult_less with (two_ap_zero IR). -apply pos_two. -rstepr - (One[/] Two[*]nring n[//] - mult_resp_ap_zero _ _ _ (two_ap_zero IR) (pos_ap_zero _ _ H4)). -apply recip_resp_less. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; - [ apply pos_two | assumption ]. -apply less_wdr with (Two[*]nring (R:=IR) n[+]One[+]One). -apply less_transitive_unfolded with (Two[*]nring (R:=IR) n[+]One); - apply less_plusOne. -astepr (nring (R:=IR) (S (2 * n)) [+]One). -Step_final (nring (R:=IR) (2 * n) [+]One[+]One). -apply leEq_transitive with (Two[*]one_div_succ (R:=IR) m). -apply H1; apply H0. -apply leEq_transitive with (one_div_succ (R:=IR) n). -unfold one_div_succ in |- *. -unfold Snring in |- *. -rstepl - (One[/] nring (R:=IR) (S m) [/]TwoNZ[//] - div_resp_ap_zero_rev _ _ _ _ (nring_ap_zero IR (S m) (sym_not_eq (O_S m)))). -apply recip_resp_leEq. -apply pos_nring_S. -apply shift_leEq_div. -apply pos_two. -simpl in |- *; fold (Two:IR) in |- *. -rstepl (Two[*]nring (R:=IR) n[+]One[+]One). -apply plus_resp_leEq. -apply leEq_wdl with (nring (R:=IR) (S (2 * n))). -apply nring_leEq; assumption. -Step_final (nring (R:=IR) (2 * n) [+]One). -unfold one_div_succ in |- *; unfold Snring in |- *. -rstepr - (One[/] One[/] e[//]pos_ap_zero _ _ H2[//] - div_resp_ap_zero_rev _ _ _ _ (one_ap_zero IR)). -apply recip_resp_leEq. -apply recip_resp_pos; assumption. -apply leEq_transitive with (nring (R:=IR) n); - [ assumption | simpl in |- *; apply less_leEq; apply less_plusOne ]. -eapply less_leEq_trans. -2: apply Hn. -apply recip_resp_pos; assumption. -elim (aux_seq_glb_prop P tot_bnd). -exists (fun k : nat => scs_elem _ _ (aux_seq_glb P tot_bnd k)); auto. +Proof. + intros P tot_bnd. + red in tot_bnd. + elim tot_bnd; intros non_empty H. + cut {sequence : nat -> IR | forall k : nat, P (sequence k) | + forall (k : nat) (x : IR), P x -> sequence k[-]x [<=] Two[*]one_div_succ k}. + intros H0. + elim H0. + clear H0; intros seq H0 H1. + cut (Cauchy_prop seq). + intro H2. + set (seq1 := Build_CauchySeq IR seq H2) in *. + exists (Lim seq1). + split; intros. + apply shift_leEq_rht. + astepl ( [--]ZeroR); rstepr ( [--] (Lim seq1[-]x)). + apply inv_resp_leEq. + set (seq2 := Cauchy_const x) in *. + apply leEq_wdl with (Lim seq1[-]Lim seq2). + 2: apply cg_minus_wd; [ algebra + | unfold seq2 in |- *; apply eq_symmetric_unfolded; apply Lim_const ]. + apply leEq_wdl with (Lim (Build_CauchySeq IR (fun n : nat => seq1 n[-]seq2 n) + (Cauchy_minus seq1 seq2))). + apply leEq_transitive with (Lim twice_inv_seq). + apply Lim_leEq_Lim; intro. + simpl in |- *. + apply H1; assumption. + apply eq_imp_leEq. + apply eq_symmetric_unfolded; apply Limits_unique. + red in |- *; fold (SeqLimit twice_inv_seq Zero) in |- *. + apply twice_inv_seq_Lim. + apply Lim_minus. + cut (Cauchy_Lim_prop2 seq (Lim seq1)). + intro H4; red in H4. try rename X into H3. + elim (H4 (e [/]TwoNZ) (pos_div_two _ _ H3)); clear H4. + intros n Hn. + exists (seq n). + apply H0. + apply leEq_less_trans with (AbsIR (Lim seq1[-]seq n)). + rstepl ( [--] (Lim seq1[-]seq n)). + apply inv_leEq_AbsIR. + apply leEq_less_trans with (e [/]TwoNZ). + apply AbsSmall_imp_AbsIR. + apply AbsSmall_minus; simpl in |- *; apply Hn. + apply le_n. + apply pos_div_two'; auto. + cut (Cauchy_Lim_prop2 seq1 (Lim seq1)); intros. + try rename X0 into H4. + red in |- *; red in H4. + intros eps Heps; elim (H4 eps Heps); clear H4; intros. + exists x. + intros m Hm; elim (p m Hm); clear p. + intros. + astepr (seq1 m[-]Lim seq1). + apply AbsIR_eq_AbsSmall; assumption. + red in |- *; fold (SeqLimit seq1 (Lim seq1)) in |- *. + apply ax_Lim. + apply crl_proof. + red in |- *; intros e H2. + elim (Archimedes (One[/] e[//]pos_ap_zero _ _ H2)). + intros n Hn. + exists (S (2 * n)); intros. + cut (Zero [<] nring (R:=IR) n); intros. + apply AbsIR_eq_AbsSmall. + try rename X into H4. + apply leEq_transitive with ( [--] (One[/] nring n[//]pos_ap_zero _ _ H4)). + apply inv_resp_leEq. + apply shift_div_leEq. + assumption. + eapply shift_leEq_mult'; [ assumption | apply Hn ]. + apply less_leEq. + rstepr ( [--] (seq (S (2 * n)) [-]seq m)); apply inv_resp_less. + apply leEq_less_trans with (Two[*]one_div_succ (R:=IR) (S (2 * n))). + apply H1; apply H0. + astepl (one_div_succ (R:=IR) (S (2 * n)) [*]Two). + unfold one_div_succ in |- *; unfold Snring in |- *. + apply shift_mult_less with (two_ap_zero IR). + apply pos_two. + rstepr (One[/] Two[*]nring n[//] mult_resp_ap_zero _ _ _ (two_ap_zero IR) (pos_ap_zero _ _ H4)). + apply recip_resp_less. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; + [ apply pos_two | assumption ]. + apply less_wdr with (Two[*]nring (R:=IR) n[+]One[+]One). + apply less_transitive_unfolded with (Two[*]nring (R:=IR) n[+]One); apply less_plusOne. + astepr (nring (R:=IR) (S (2 * n)) [+]One). + Step_final (nring (R:=IR) (2 * n) [+]One[+]One). + apply leEq_transitive with (Two[*]one_div_succ (R:=IR) m). + apply H1; apply H0. + apply leEq_transitive with (one_div_succ (R:=IR) n). + unfold one_div_succ in |- *. + unfold Snring in |- *. + rstepl (One[/] nring (R:=IR) (S m) [/]TwoNZ[//] + div_resp_ap_zero_rev _ _ _ _ (nring_ap_zero IR (S m) (sym_not_eq (O_S m)))). + apply recip_resp_leEq. + apply pos_nring_S. + apply shift_leEq_div. + apply pos_two. + simpl in |- *; fold (Two:IR) in |- *. + rstepl (Two[*]nring (R:=IR) n[+]One[+]One). + apply plus_resp_leEq. + apply leEq_wdl with (nring (R:=IR) (S (2 * n))). + apply nring_leEq; assumption. + Step_final (nring (R:=IR) (2 * n) [+]One). + unfold one_div_succ in |- *; unfold Snring in |- *. + rstepr (One[/] One[/] e[//]pos_ap_zero _ _ H2[//] div_resp_ap_zero_rev _ _ _ _ (one_ap_zero IR)). + apply recip_resp_leEq. + apply recip_resp_pos; assumption. + apply leEq_transitive with (nring (R:=IR) n); + [ assumption | simpl in |- *; apply less_leEq; apply less_plusOne ]. + eapply less_leEq_trans. + 2: apply Hn. + apply recip_resp_pos; assumption. + elim (aux_seq_glb_prop P tot_bnd). + exists (fun k : nat => scs_elem _ _ (aux_seq_glb P tot_bnd k)); auto. Qed. End Totally_Bounded. @@ -790,13 +767,14 @@ The following characterization of inclusion can be very useful: Lemma included_compact : forall (a b c d : IR) Hab Hcd, compact a b Hab c -> compact a b Hab d -> included (compact c d Hcd) (compact a b Hab). -intros a b c d Hab Hcd H H0 x H1. -inversion_clear H. -inversion_clear H0. -inversion_clear H1. -split. -apply leEq_transitive with c; auto. -apply leEq_transitive with d; auto. +Proof. + intros a b c d Hab Hcd H H0 x H1. + inversion_clear H. + inversion_clear H0. + inversion_clear H1. + split. + apply leEq_transitive with c; auto. + apply leEq_transitive with d; auto. Qed. (** @@ -834,13 +812,13 @@ Definition compact_nat := ProjT1 (Archimedes (b[-]a[/] e[//]pos_ap_zero _ _ He)) (** Obviously such an [n] must be greater than zero.*) Lemma pos_compact_nat : Zero [<] nring (R:=IR) compact_nat. - -apply less_leEq_trans with (b[-]a[/] e[//]pos_ap_zero _ _ He). -rstepr ((b[-]a) [*] (One[/] e[//]pos_ap_zero _ _ He)). -apply mult_resp_pos. -apply shift_less_minus; astepl a; assumption. -apply recip_resp_pos; assumption. -unfold compact_nat in |- *; apply proj2_sigT. +Proof. + apply less_leEq_trans with (b[-]a[/] e[//]pos_ap_zero _ _ He). + rstepr ((b[-]a) [*] (One[/] e[//]pos_ap_zero _ _ He)). + apply mult_resp_pos. + apply shift_less_minus; astepl a; assumption. + apply recip_resp_pos; assumption. + unfold compact_nat in |- *; apply proj2_sigT. Qed. (** @@ -850,27 +828,28 @@ prove that all of its points are really in that interval. *) Definition compact_part (i : nat) : i <= compact_nat -> IR. -intros. -apply (a[+]nring i[*] (b[-]a[/] _[//]pos_ap_zero _ _ pos_compact_nat)). +Proof. + intros. + apply (a[+]nring i[*] (b[-]a[/] _[//]pos_ap_zero _ _ pos_compact_nat)). Defined. Lemma compact_part_hyp : forall i Hi, compact a b Hab (compact_part i Hi). -intros; unfold compact_part in |- *. -split. -astepl (a[+]Zero); apply plus_resp_leEq_lft. -astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. -apply nring_nonneg. -apply shift_leEq_div. -apply pos_compact_nat. -apply shift_leEq_minus; rstepl a; apply less_leEq; assumption. -rstepr - (a[+]nring compact_nat[*] (b[-]a[/] _[//]pos_ap_zero _ _ pos_compact_nat)). -apply plus_resp_leEq_lft. -apply mult_resp_leEq_rht; try apply nring_nonneg. -apply nring_leEq; assumption. -apply shift_leEq_div. -apply pos_compact_nat. -apply shift_leEq_minus; rstepl a; apply less_leEq; assumption. +Proof. + intros; unfold compact_part in |- *. + split. + astepl (a[+]Zero); apply plus_resp_leEq_lft. + astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. + apply nring_nonneg. + apply shift_leEq_div. + apply pos_compact_nat. + apply shift_leEq_minus; rstepl a; apply less_leEq; assumption. + rstepr (a[+]nring compact_nat[*] (b[-]a[/] _[//]pos_ap_zero _ _ pos_compact_nat)). + apply plus_resp_leEq_lft. + apply mult_resp_leEq_rht; try apply nring_nonneg. + apply nring_leEq; assumption. + apply shift_leEq_div. + apply pos_compact_nat. + apply shift_leEq_minus; rstepl a; apply less_leEq; assumption. Qed. (** @@ -878,73 +857,77 @@ This sequence is strictly increasing and each two consecutive points are apart by less than [e].*) Lemma compact_less : forall i Hi HSi, Zero [<] compact_part (S i) HSi[-]compact_part i Hi. -intros i H1 H2. -apply shift_less_minus; astepl (compact_part _ H1). -unfold compact_part in |- *. -apply plus_resp_less_lft. -apply mult_resp_less. -simpl in |- *; apply less_plusOne. -apply div_resp_pos. -apply pos_compact_nat. -apply shift_less_minus; astepl a; assumption. +Proof. + intros i H1 H2. + apply shift_less_minus; astepl (compact_part _ H1). + unfold compact_part in |- *. + apply plus_resp_less_lft. + apply mult_resp_less. + simpl in |- *; apply less_plusOne. + apply div_resp_pos. + apply pos_compact_nat. + apply shift_less_minus; astepl a; assumption. Qed. Lemma compact_leEq : forall i Hi HSi, compact_part (S i) HSi[-]compact_part i Hi [<=] e. -intros i H1 H2. -unfold compact_part in |- *; simpl in |- *. -rstepl (b[-]a[/] _[//]pos_ap_zero _ _ pos_compact_nat). -apply shift_div_leEq. -apply pos_compact_nat. -apply shift_leEq_mult' with (pos_ap_zero _ _ He). -assumption. -exact (ProjT2 (Archimedes _)). +Proof. + intros i H1 H2. + unfold compact_part in |- *; simpl in |- *. + rstepl (b[-]a[/] _[//]pos_ap_zero _ _ pos_compact_nat). + apply shift_div_leEq. + apply pos_compact_nat. + apply shift_leEq_mult' with (pos_ap_zero _ _ He). + assumption. + exact (ProjT2 (Archimedes _)). Qed. (** When we proceed to integration, this lemma will also be useful: *) Lemma compact_partition_lemma : forall n Hn i, i <= n -> Compact Hab (a[+]nring i[*] (b[-]a[/] _[//]nring_ap_zero' _ n Hn)). -intros n Hn i H; split. -apply shift_leEq_plus'. -astepl ZeroR. -apply mult_resp_nonneg. -apply nring_nonneg. -apply shift_leEq_div. -apply nring_pos; apply neq_O_lt; auto. -apply shift_leEq_minus. -rstepl a; assumption. -apply shift_plus_leEq'. -rstepr (nring n[*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hn)). -astepl (Zero[+]nring i[*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hn)). -apply shift_plus_leEq. -rstepr ((nring n[-]nring i) [*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hn)). -apply mult_resp_nonneg. -apply shift_leEq_minus. -astepl (nring (R:=IR) i). -apply nring_leEq; assumption. -apply shift_leEq_div. -apply nring_pos; apply neq_O_lt; auto. -apply shift_leEq_minus. -rstepl a; assumption. +Proof. + intros n Hn i H; split. + apply shift_leEq_plus'. + astepl ZeroR. + apply mult_resp_nonneg. + apply nring_nonneg. + apply shift_leEq_div. + apply nring_pos; apply neq_O_lt; auto. + apply shift_leEq_minus. + rstepl a; assumption. + apply shift_plus_leEq'. + rstepr (nring n[*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hn)). + astepl (Zero[+]nring i[*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hn)). + apply shift_plus_leEq. + rstepr ((nring n[-]nring i) [*] (b[-]a[/] _[//]nring_ap_zero' _ _ Hn)). + apply mult_resp_nonneg. + apply shift_leEq_minus. + astepl (nring (R:=IR) i). + apply nring_leEq; assumption. + apply shift_leEq_div. + apply nring_pos; apply neq_O_lt; auto. + apply shift_leEq_minus. + rstepl a; assumption. Qed. (** The next lemma provides an upper bound for the distance between two points in an interval: *) Lemma compact_elements : forall x y : IR, Compact Hab x -> Compact Hab y -> AbsIR (x[-]y) [<=] AbsIR (b[-]a). -clear Hab' He e. -do 2 intro; intros Hx Hy. -apply leEq_wdr with (b[-]a). -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl a; auto. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply Abs_Max. -inversion_clear Hx. -inversion_clear Hy. -unfold cg_minus in |- *; apply plus_resp_leEq_both. -apply Max_leEq; auto. -apply inv_resp_leEq. -apply leEq_Min; auto. +Proof. + clear Hab' He e. + do 2 intro; intros Hx Hy. + apply leEq_wdr with (b[-]a). + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl a; auto. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Abs_Max. + inversion_clear Hx. + inversion_clear Hy. + unfold cg_minus in |- *; apply plus_resp_leEq_both. + apply Max_leEq; auto. + apply inv_resp_leEq. + apply leEq_Min; auto. Qed. Opaque Min Max. @@ -953,19 +936,20 @@ Opaque Min Max. Lemma compact_elements' : forall c d Hcd x y, Compact Hab x -> compact c d Hcd y -> AbsIR (x[-]y) [<=] AbsIR (Max b d[-]Min a c). -do 5 intro; intros Hx Hy. -eapply leEq_transitive. -2: apply leEq_AbsIR. -inversion_clear Hx. -inversion_clear Hy. -simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. -unfold cg_minus in |- *; apply plus_resp_leEq_both. -apply leEq_transitive with b; auto; apply lft_leEq_Max. -apply inv_resp_leEq; apply leEq_transitive with c; auto; apply Min_leEq_rht. -rstepl (y[-]x). -unfold cg_minus in |- *; apply plus_resp_leEq_both. -apply leEq_transitive with d; auto; apply rht_leEq_Max. -apply inv_resp_leEq; apply leEq_transitive with a; auto; apply Min_leEq_lft. +Proof. + do 5 intro; intros Hx Hy. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + inversion_clear Hx. + inversion_clear Hy. + simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. + unfold cg_minus in |- *; apply plus_resp_leEq_both. + apply leEq_transitive with b; auto; apply lft_leEq_Max. + apply inv_resp_leEq; apply leEq_transitive with c; auto; apply Min_leEq_rht. + rstepl (y[-]x). + unfold cg_minus in |- *; apply plus_resp_leEq_both. + apply leEq_transitive with d; auto; apply rht_leEq_Max. + apply inv_resp_leEq; apply leEq_transitive with a; auto; apply Min_leEq_lft. Qed. (** The following lemma is a bit more specific: it shows that we can @@ -974,14 +958,15 @@ any of its points. *) Lemma compact_bnd_AbsIR : forall x y d H, compact (x[-]d) (x[+]d) H y -> AbsIR (x[-]y) [<=] d. -intros x y d H H0. -inversion_clear H0. -simpl in |- *; unfold ABSIR in |- *. -apply Max_leEq. -apply shift_minus_leEq; apply shift_leEq_plus'; auto. -rstepl (y[-]x). -apply shift_minus_leEq. -astepr (x[+]d); auto. +Proof. + intros x y d H H0. + inversion_clear H0. + simpl in |- *; unfold ABSIR in |- *. + apply Max_leEq. + apply shift_minus_leEq; apply shift_leEq_plus'; auto. + rstepl (y[-]x). + apply shift_minus_leEq. + astepr (x[+]d); auto. Qed. (** Finally, two more useful lemmas to prove inclusion of compact @@ -990,36 +975,38 @@ elementary properties of the integral. *) Lemma included2_compact : forall x y Hxy, Compact Hab x -> Compact Hab y -> included (compact (Min x y) (Max x y) Hxy) (Compact Hab). -do 3 intro. intros H H0. -inversion_clear H. -inversion_clear H0. -apply included_compact; split. -apply leEq_Min; auto. -apply leEq_transitive with y. -apply Min_leEq_rht. -auto. -apply leEq_transitive with y. -auto. -apply rht_leEq_Max. -apply Max_leEq; auto. +Proof. + do 3 intro. intros H H0. + inversion_clear H. + inversion_clear H0. + apply included_compact; split. + apply leEq_Min; auto. + apply leEq_transitive with y. + apply Min_leEq_rht. + auto. + apply leEq_transitive with y. + auto. + apply rht_leEq_Max. + apply Max_leEq; auto. Qed. Lemma included3_compact : forall x y z Hxyz, Compact Hab x -> Compact Hab y -> Compact Hab z -> included (compact (Min (Min x y) z) (Max (Max x y) z) Hxyz) (Compact Hab). -do 4 intro. intros H H0 H1. -inversion_clear H. -inversion_clear H0. -inversion_clear H1. -apply included_compact; split. -repeat apply leEq_Min; auto. -apply leEq_transitive with z. -apply Min_leEq_rht. -auto. -apply leEq_transitive with z. -auto. -apply rht_leEq_Max. -repeat apply Max_leEq; auto. +Proof. + do 4 intro. intros H H0 H1. + inversion_clear H. + inversion_clear H0. + inversion_clear H1. + apply included_compact; split. + repeat apply leEq_Min; auto. + apply leEq_transitive with z. + apply Min_leEq_rht. + auto. + apply leEq_transitive with z. + auto. + apply rht_leEq_Max. + repeat apply Max_leEq; auto. Qed. End Compact. diff --git a/reals/Max_AbsIR.v b/reals/Max_AbsIR.v index cd450a5bf..78caf7d24 100644 --- a/reals/Max_AbsIR.v +++ b/reals/Max_AbsIR.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Max %\ensuremath{\max}% *) (** printing Min %\ensuremath{\min}% *) @@ -56,55 +56,56 @@ Let [x] and [y] be reals Variables x y : IR. Definition Max_seq : nat -> IR. -intro i. -elim (less_cotransitive_unfolded IR Zero (one_div_succ i)) with (x[-]y). - 3: apply one_div_succ_pos. - intro H; apply x. -intro H; apply y. +Proof. + intro i. + elim (less_cotransitive_unfolded IR Zero (one_div_succ i)) with (x[-]y). + 3: apply one_div_succ_pos. + intro H; apply x. + intro H; apply y. Defined. Lemma Max_seq_char : forall n, Zero [<] x[-]y and Max_seq n [=] x or x[-]y [<] one_div_succ n and Max_seq n [=] y. -intros. -unfold Max_seq in |- *. -elim less_cotransitive_unfolded; intro H; simpl in |- *. - left; split; algebra. -right; split; algebra. +Proof. + intros. + unfold Max_seq in |- *. + elim less_cotransitive_unfolded; intro H; simpl in |- *. + left; split; algebra. + right; split; algebra. Qed. Lemma Cauchy_Max_seq : Cauchy_prop Max_seq. -apply Cauchy_prop1_prop. -intro k. -exists k; intros m H. -unfold Max_seq in |- *. -elim less_cotransitive_unfolded; intro Hm; simpl in |- *; - elim less_cotransitive_unfolded; intro Hk; simpl in |- *. - -astepr ZeroR; split; apply less_leEq. - astepr ( [--]ZeroR); apply inv_resp_less; apply one_div_succ_pos. -apply one_div_succ_pos. - -apply leEq_imp_AbsSmall; apply less_leEq; auto. - -apply AbsSmall_minus. -apply leEq_imp_AbsSmall; apply less_leEq; auto. -apply less_leEq_trans with (one_div_succ (R:=IR) m); auto. -apply one_div_succ_resp_leEq; auto. - -astepr ZeroR; split; apply less_leEq. - astepr ( [--]ZeroR); apply inv_resp_less; apply one_div_succ_pos. -apply one_div_succ_pos. +Proof. + apply Cauchy_prop1_prop. + intro k. + exists k; intros m H. + unfold Max_seq in |- *. + elim less_cotransitive_unfolded; intro Hm; simpl in |- *; + elim less_cotransitive_unfolded; intro Hk; simpl in |- *. + astepr ZeroR; split; apply less_leEq. + astepr ( [--]ZeroR); apply inv_resp_less; apply one_div_succ_pos. + apply one_div_succ_pos. + apply leEq_imp_AbsSmall; apply less_leEq; auto. + apply AbsSmall_minus. + apply leEq_imp_AbsSmall; apply less_leEq; auto. + apply less_leEq_trans with (one_div_succ (R:=IR) m); auto. + apply one_div_succ_resp_leEq; auto. + astepr ZeroR; split; apply less_leEq. + astepr ( [--]ZeroR); apply inv_resp_less; apply one_div_succ_pos. + apply one_div_succ_pos. Qed. Definition Max_CauchySeq : CauchySeqR. -unfold CauchySeqR in |- *. -apply Build_CauchySeq with Max_seq. -exact Cauchy_Max_seq. +Proof. + unfold CauchySeqR in |- *. + apply Build_CauchySeq with Max_seq. + exact Cauchy_Max_seq. Defined. Definition MAX : IR. -apply Lim. -exact Max_CauchySeq. +Proof. + apply Lim. + exact Max_CauchySeq. Defined. (** @@ -122,95 +123,98 @@ With strong extensionality, we can make the binary operation [Max]. *) Lemma lft_leEq_MAX : x [<=] MAX. -astepr (Zero[+]MAX); apply shift_leEq_plus. -apply approach_zero_weak. -intros e He. -apply leEq_wdl with (Lim (Cauchy_const x) [-]MAX). - 2: apply cg_minus_wd; - [ apply eq_symmetric_unfolded; apply Lim_const | algebra ]. -unfold MAX in |- *. -eapply leEq_wdl. - 2: apply Lim_minus. -simpl in |- *. -elim (Archimedes (One[/] e[//]pos_ap_zero _ _ He)); intros n Hn. -cut (Zero [<] nring (R:=IR) n). -intro posn. -apply str_seq_leEq_so_Lim_leEq. -exists n; intros i Hi. -simpl in |- *. -unfold Max_seq in |- *. -elim less_cotransitive_unfolded; intro H; simpl in |- *. - astepl ZeroR; apply less_leEq; auto. -apply less_leEq; eapply less_transitive_unfolded. -apply H. -unfold one_div_succ, Snring in |- *; apply shift_div_less. - apply pos_nring_S. -apply shift_less_mult' with (pos_ap_zero _ _ He). - auto. -eapply leEq_less_trans. - apply Hn. -apply nring_less; auto with arith. - -eapply less_leEq_trans. - 2: apply Hn. -apply recip_resp_pos; auto. +Proof. + astepr (Zero[+]MAX); apply shift_leEq_plus. + apply approach_zero_weak. + intros e He. + apply leEq_wdl with (Lim (Cauchy_const x) [-]MAX). + 2: apply cg_minus_wd; [ apply eq_symmetric_unfolded; apply Lim_const | algebra ]. + unfold MAX in |- *. + eapply leEq_wdl. + 2: apply Lim_minus. + simpl in |- *. + elim (Archimedes (One[/] e[//]pos_ap_zero _ _ He)); intros n Hn. + cut (Zero [<] nring (R:=IR) n). + intro posn. + apply str_seq_leEq_so_Lim_leEq. + exists n; intros i Hi. + simpl in |- *. + unfold Max_seq in |- *. + elim less_cotransitive_unfolded; intro H; simpl in |- *. + astepl ZeroR; apply less_leEq; auto. + apply less_leEq; eapply less_transitive_unfolded. + apply H. + unfold one_div_succ, Snring in |- *; apply shift_div_less. + apply pos_nring_S. + apply shift_less_mult' with (pos_ap_zero _ _ He). + auto. + eapply leEq_less_trans. + apply Hn. + apply nring_less; auto with arith. + eapply less_leEq_trans. + 2: apply Hn. + apply recip_resp_pos; auto. Qed. Lemma rht_leEq_MAX : y [<=] MAX. -unfold MAX in |- *. -apply leEq_seq_so_leEq_Lim. -intro i; simpl in |- *. -unfold Max_seq in |- *. -elim less_cotransitive_unfolded; intro H; simpl in |- *. - 2: apply leEq_reflexive. -apply less_leEq; astepl (Zero[+]y). -apply shift_plus_less; auto. +Proof. + unfold MAX in |- *. + apply leEq_seq_so_leEq_Lim. + intro i; simpl in |- *. + unfold Max_seq in |- *. + elim less_cotransitive_unfolded; intro H; simpl in |- *. + 2: apply leEq_reflexive. + apply less_leEq; astepl (Zero[+]y). + apply shift_plus_less; auto. Qed. Lemma less_MAX_imp : forall z : IR, z [<] MAX -> z [<] x or z [<] y. -intros z H. -unfold MAX in H. -elim (less_Lim_so_less_seq _ _ H). -intros N HN. -simpl in HN. -elim (Max_seq_char N); intro Hseq; inversion_clear Hseq; [ left | right ]; - astepr (Max_seq N); auto with arith. +Proof. + intros z H. + unfold MAX in H. + elim (less_Lim_so_less_seq _ _ H). + intros N HN. + simpl in HN. + elim (Max_seq_char N); intro Hseq; inversion_clear Hseq; [ left | right ]; + astepr (Max_seq N); auto with arith. Qed. End Max_function. Lemma MAX_strext : bin_op_strext _ MAX. -unfold bin_op_strext in |- *. -unfold bin_fun_strext in |- *. -intros x1 x2 y1 y2 H. -generalize (ap_imp_less _ _ _ H); intro H0. -elim H0; intro H1. - generalize (less_MAX_imp _ _ _ H1); intro H2. - elim H2; intro H3. - left. +Proof. + unfold bin_op_strext in |- *. + unfold bin_fun_strext in |- *. + intros x1 x2 y1 y2 H. + generalize (ap_imp_less _ _ _ H); intro H0. + elim H0; intro H1. + generalize (less_MAX_imp _ _ _ H1); intro H2. + elim H2; intro H3. + left. + apply less_imp_ap. + apply leEq_less_trans with (MAX x1 y1); auto. + apply lft_leEq_MAX. + right. apply less_imp_ap. apply leEq_less_trans with (MAX x1 y1); auto. + apply rht_leEq_MAX. + generalize (less_MAX_imp _ _ _ H1); intro H2. + elim H2; intro. + left. + apply Greater_imp_ap. + apply leEq_less_trans with (MAX x2 y2); auto. apply lft_leEq_MAX. right. - apply less_imp_ap. - apply leEq_less_trans with (MAX x1 y1); auto. - apply rht_leEq_MAX. -generalize (less_MAX_imp _ _ _ H1); intro H2. -elim H2; intro. - left. apply Greater_imp_ap. apply leEq_less_trans with (MAX x2 y2); auto. - apply lft_leEq_MAX. -right. -apply Greater_imp_ap. -apply leEq_less_trans with (MAX x2 y2); auto. -apply rht_leEq_MAX. + apply rht_leEq_MAX. Qed. Lemma MAX_wd : bin_op_wd IR MAX. -unfold bin_op_wd in |- *. -apply bin_fun_strext_imp_wd. -exact MAX_strext. +Proof. + unfold bin_op_wd in |- *. + apply bin_fun_strext_imp_wd. + exact MAX_strext. Qed. Section properties_of_Max. @@ -222,222 +226,237 @@ Definition Max := Build_CSetoid_bin_op _ MAX MAX_strext. Lemma Max_wd_unfolded : forall x y x' y', x [=] x' -> y [=] y' -> Max x y [=] Max x' y'. -cut (bin_op_wd _ MAX); [ intro | apply MAX_wd ]. -red in H. -red in H. -intros; apply H; assumption. +Proof. + cut (bin_op_wd _ MAX); [ intro | apply MAX_wd ]. + red in H. + red in H. + intros; apply H; assumption. Qed. Lemma lft_leEq_Max : forall x y : IR, x [<=] Max x y. -unfold Max in |- *. -simpl in |- *. -exact lft_leEq_MAX. +Proof. + unfold Max in |- *. + simpl in |- *. + exact lft_leEq_MAX. Qed. Lemma rht_leEq_Max : forall x y : IR, y [<=] Max x y. -unfold Max in |- *. -simpl in |- *. -exact rht_leEq_MAX. +Proof. + unfold Max in |- *. + simpl in |- *. + exact rht_leEq_MAX. Qed. Lemma less_Max_imp : forall x y z : IR, z [<] Max x y -> z [<] x or z [<] y. -unfold Max in |- *. -simpl in |- *. -exact less_MAX_imp. +Proof. + unfold Max in |- *. + simpl in |- *. + exact less_MAX_imp. Qed. Lemma Max_leEq : forall x y z : IR, x [<=] z -> y [<=] z -> Max x y [<=] z. -unfold Max in |- *. -simpl in |- *. -intros. -rewrite leEq_def in |- *. -intro H1. -generalize (less_MAX_imp _ _ _ H1); intro H2. -elim H2; intros. -rewrite -> leEq_def in H; elim H. -assumption. -rewrite -> leEq_def in H0; elim H0. -assumption. +Proof. + unfold Max in |- *. + simpl in |- *. + intros. + rewrite leEq_def in |- *. + intro H1. + generalize (less_MAX_imp _ _ _ H1); intro H2. + elim H2; intros. + rewrite -> leEq_def in H; elim H. + assumption. + rewrite -> leEq_def in H0; elim H0. + assumption. Qed. Lemma Max_less : forall x y z : IR, x [<] z -> y [<] z -> Max x y [<] z. -intros. -elim (smaller _ (z[-]x) (z[-]y)). intro e. intros H1 H2. elim H2. clear H2. intros H2 H3. -cut (z[-]e [/]TwoNZ [<] z). intro H4. -elim (less_cotransitive_unfolded _ _ _ H4 (Max x y)); intros H5. -elim (less_Max_imp _ _ _ H5); intros H6. -cut (Not (e [/]TwoNZ [<] z[-]x)). intro H7. elim H7. -apply less_leEq_trans with e; auto. -apply pos_div_two'; auto. -apply less_antisymmetric_unfolded. -apply shift_minus_less. apply shift_less_plus'. auto. -cut (Not (e [/]TwoNZ [<] z[-]y)). intro H7. elim H7. -apply less_leEq_trans with e; auto. -apply pos_div_two'; auto. -apply less_antisymmetric_unfolded. -apply shift_minus_less. apply shift_less_plus'. auto. -auto. -apply shift_minus_less. astepl (z[+]Zero). -apply plus_resp_less_lft. apply pos_div_two. auto. -apply shift_less_minus. astepl x. auto. -apply shift_less_minus. astepl y. auto. +Proof. + intros. + elim (smaller _ (z[-]x) (z[-]y)). intro e. intros H1 H2. elim H2. clear H2. intros H2 H3. + cut (z[-]e [/]TwoNZ [<] z). intro H4. + elim (less_cotransitive_unfolded _ _ _ H4 (Max x y)); intros H5. + elim (less_Max_imp _ _ _ H5); intros H6. + cut (Not (e [/]TwoNZ [<] z[-]x)). intro H7. elim H7. + apply less_leEq_trans with e; auto. + apply pos_div_two'; auto. + apply less_antisymmetric_unfolded. + apply shift_minus_less. apply shift_less_plus'. auto. + cut (Not (e [/]TwoNZ [<] z[-]y)). intro H7. elim H7. + apply less_leEq_trans with e; auto. + apply pos_div_two'; auto. + apply less_antisymmetric_unfolded. + apply shift_minus_less. apply shift_less_plus'. auto. + auto. + apply shift_minus_less. astepl (z[+]Zero). + apply plus_resp_less_lft. apply pos_div_two. auto. + apply shift_less_minus. astepl x. auto. + apply shift_less_minus. astepl y. auto. Qed. Lemma equiv_imp_eq_max : forall x x' m, (forall y, x [<=] y -> x' [<=] y -> m [<=] y) -> (forall y, m [<=] y -> x [<=] y) -> (forall y, m [<=] y -> x' [<=] y) -> Max x x' [=] m. -intros. -apply not_ap_imp_eq. -intros X. -destruct (ap_imp_less _ _ _ X) as [X0|X0]. -apply (less_irreflexive_unfolded _ (Max x x')). -apply less_leEq_trans with m. -assumption. -apply H. -apply lft_leEq_Max. -apply rht_leEq_Max. -case (less_Max_imp _ _ _ X0). -change (Not (m[<]x)). -rewrite <- (leEq_def). -apply H0. -apply leEq_reflexive. -change (Not (m[<]x')). -rewrite <- (leEq_def). -apply H1. -apply leEq_reflexive. +Proof. + intros. + apply not_ap_imp_eq. + intros X. + destruct (ap_imp_less _ _ _ X) as [X0|X0]. + apply (less_irreflexive_unfolded _ (Max x x')). + apply less_leEq_trans with m. + assumption. + apply H. + apply lft_leEq_Max. + apply rht_leEq_Max. + case (less_Max_imp _ _ _ X0). + change (Not (m[<]x)). + rewrite <- (leEq_def). + apply H0. + apply leEq_reflexive. + change (Not (m[<]x')). + rewrite <- (leEq_def). + apply H1. + apply leEq_reflexive. Qed. Lemma Max_id : forall x : IR, Max x x [=] x. -intros. -apply equiv_imp_eq_max; auto. +Proof. + intros. + apply equiv_imp_eq_max; auto. Qed. Lemma Max_comm : forall x y : IR, Max x y [=] Max y x. -cut (forall x y : IR, Max x y [<=] Max y x). -intros. -apply leEq_imp_eq. -apply H. -apply H. -intros. -apply Max_leEq. -apply rht_leEq_Max. -apply lft_leEq_Max. +Proof. + cut (forall x y : IR, Max x y [<=] Max y x). + intros. + apply leEq_imp_eq. + apply H. + apply H. + intros. + apply Max_leEq. + apply rht_leEq_Max. + apply lft_leEq_Max. Qed. Lemma leEq_imp_Max_is_rht : forall x y : IR, x [<=] y -> Max x y [=] y. -intros. -apply leEq_imp_eq. -apply Max_leEq. -assumption. -apply leEq_reflexive. -apply rht_leEq_Max. +Proof. + intros. + apply leEq_imp_eq. + apply Max_leEq. + assumption. + apply leEq_reflexive. + apply rht_leEq_Max. Qed. Lemma Max_is_rht_imp_leEq : forall x y : IR, Max x y [=] y -> x [<=] y. -intros. -rewrite leEq_def in |- *. -intro H0. -generalize (less_leEq _ _ _ H0); intro H1. -generalize (leEq_imp_Max_is_rht _ _ H1); intro. -cut (y [=] x). -intro. -elim (less_irreflexive_unfolded _ x). -astepl y. -assumption. -astepl (Max x y). -astepr (Max y x). -apply Max_comm. +Proof. + intros. + rewrite leEq_def in |- *. + intro H0. + generalize (less_leEq _ _ _ H0); intro H1. + generalize (leEq_imp_Max_is_rht _ _ H1); intro. + cut (y [=] x). + intro. + elim (less_irreflexive_unfolded _ x). + astepl y. + assumption. + astepl (Max x y). + astepr (Max y x). + apply Max_comm. Qed. Lemma Max_minus_eps_leEq : forall x y e, Zero [<] e -> {Max x y[-]e [<=] x} + {Max x y[-]e [<=] y}. -intros. -cut (Max x y[-]e [<] x or Max x y[-]e [<] y). -intro H0; elim H0; intros; clear H0. -left; apply less_leEq; assumption. -right; apply less_leEq; assumption. -apply less_Max_imp. -apply shift_minus_less. -apply shift_less_plus'. -astepl ZeroR; assumption. +Proof. + intros. + cut (Max x y[-]e [<] x or Max x y[-]e [<] y). + intro H0; elim H0; intros; clear H0. + left; apply less_leEq; assumption. + right; apply less_leEq; assumption. + apply less_Max_imp. + apply shift_minus_less. + apply shift_less_plus'. + astepl ZeroR; assumption. Qed. Lemma max_one_ap_zero : forall x : IR, Max x One [#] Zero. -intros. -apply ap_symmetric_unfolded. -apply less_imp_ap. -apply less_leEq_trans with OneR. -apply pos_one. -apply rht_leEq_Max. +Proof. + intros. + apply ap_symmetric_unfolded. + apply less_imp_ap. + apply less_leEq_trans with OneR. + apply pos_one. + apply rht_leEq_Max. Qed. Lemma pos_max_one : forall x : IR, Zero [<] Max x One. -intro. -apply less_leEq_trans with OneR; [ apply pos_one | apply rht_leEq_Max ]. +Proof. + intro. + apply less_leEq_trans with OneR; [ apply pos_one | apply rht_leEq_Max ]. Qed. Lemma x_div_Max_leEq_x : forall x y : IR, Zero [<] x -> (x[/] Max y One[//]max_one_ap_zero _) [<=] x. -intros. -apply shift_div_leEq'. -apply pos_max_one. -astepl (One[*]x). -apply mult_resp_leEq_rht; - [ apply rht_leEq_Max | apply less_leEq; assumption ]. +Proof. + intros. + apply shift_div_leEq'. + apply pos_max_one. + astepl (One[*]x). + apply mult_resp_leEq_rht; [ apply rht_leEq_Max | apply less_leEq; assumption ]. Qed. Lemma max_plus : forall (a b c : IR), Max (a[+]c) (b[+]c) [=] Max a b [+] c. -intros. -apply equiv_imp_eq_max; intros. -apply shift_plus_leEq. -apply Max_leEq; apply shift_leEq_minus; auto. -apply leEq_transitive with (Max a b [+]c); auto. -apply plus_resp_leEq. -apply lft_leEq_Max. -apply leEq_transitive with (Max a b [+]c); auto. -apply plus_resp_leEq. -apply rht_leEq_Max. -Qed. - -Lemma max_mult : forall (a b c : IR), Zero [<=] c -> +Proof. + intros. + apply equiv_imp_eq_max; intros. + apply shift_plus_leEq. + apply Max_leEq; apply shift_leEq_minus; auto. + apply leEq_transitive with (Max a b [+]c); auto. + apply plus_resp_leEq. + apply lft_leEq_Max. + apply leEq_transitive with (Max a b [+]c); auto. + apply plus_resp_leEq. + apply rht_leEq_Max. +Qed. + +Lemma max_mult : forall (a b c : IR), Zero [<=] c -> (Max (c[*]a) (c[*]b)) [=] c[*](Max a b). -intros a b c H. -apply leEq_imp_eq. -apply Max_leEq; -apply mult_resp_leEq_lft. -apply lft_leEq_Max. -assumption. -apply rht_leEq_Max. -assumption. -rewrite -> leEq_def in *. -intros Z. -assert (Not (Not (Zero[<]c or Zero[=]c))). -intros X. -apply X. -right. -apply not_ap_imp_eq. -intros Y. -destruct (ap_imp_less _ _ _ Y) as [Y0|Y0]. -auto. -auto. -apply H0. -intros X. -generalize Z. -clear H H0 Z. -change (Not (Max (c[*]a) (c[*]b)[<]c[*]Max a b)). -rewrite <- leEq_def. -destruct X as [c0|c0]. -assert (X:c[#]Zero). -apply ap_symmetric; apply less_imp_ap; assumption. -apply shift_mult_leEq' with X. - assumption. -apply Max_leEq;(apply shift_leEq_div;[assumption|]). -rstepl (c[*]a); apply lft_leEq_Max. -rstepl (c[*]b); apply rht_leEq_Max. -stepl (c[*]a). -apply lft_leEq_Max. -csetoid_rewrite_rev c0. -rational. +Proof. + intros a b c H. + apply leEq_imp_eq. + apply Max_leEq; apply mult_resp_leEq_lft. + apply lft_leEq_Max. + assumption. + apply rht_leEq_Max. + assumption. + rewrite -> leEq_def in *. + intros Z. + assert (Not (Not (Zero[<]c or Zero[=]c))). + intros X. + apply X. + right. + apply not_ap_imp_eq. + intros Y. + destruct (ap_imp_less _ _ _ Y) as [Y0|Y0]. + auto. + auto. + apply H0. + intros X. + generalize Z. + clear H H0 Z. + change (Not (Max (c[*]a) (c[*]b)[<]c[*]Max a b)). + rewrite <- leEq_def. + destruct X as [c0|c0]. + assert (X:c[#]Zero). + apply ap_symmetric; apply less_imp_ap; assumption. + apply shift_mult_leEq' with X. + assumption. + apply Max_leEq;(apply shift_leEq_div;[assumption|]). + rstepl (c[*]a); apply lft_leEq_Max. + rstepl (c[*]b); apply rht_leEq_Max. + stepl (c[*]a). + apply lft_leEq_Max. + csetoid_rewrite_rev c0. + rational. Qed. End properties_of_Max. @@ -451,286 +470,295 @@ Section Minimum. (** *** Mininum -The minimum is defined by the formula +The minimum is defined by the formula [Min(x,y) [=] [--]Max( [--]x,[--]y)]. *) Definition MIN (x y : IR) : IR := [--] (Max [--]x [--]y). Lemma MIN_wd : bin_op_wd _ MIN. -intros x1 x2 y1 y2. -unfold MIN in |- *; algebra. +Proof. + intros x1 x2 y1 y2. + unfold MIN in |- *; algebra. Qed. Lemma MIN_strext : bin_op_strext _ MIN. -intros x1 x2 y1 y2 H. -unfold MIN in H. -assert (H':=(un_op_strext_unfolded _ _ _ _ H)). -elim (bin_op_strext_unfolded _ _ _ _ _ _ H'); - intro H1; [left | right]; exact (un_op_strext_unfolded _ _ _ _ H1). +Proof. + intros x1 x2 y1 y2 H. + unfold MIN in H. + assert (H':=(un_op_strext_unfolded _ _ _ _ H)). + elim (bin_op_strext_unfolded _ _ _ _ _ _ H'); + intro H1; [left | right]; exact (un_op_strext_unfolded _ _ _ _ H1). Qed. Definition Min : CSetoid_bin_op IR := Build_CSetoid_bin_op _ MIN MIN_strext. Lemma Min_wd_unfolded : forall x y a b, x [=] a /\ y [=] b -> (Min x y) [=] (Min a b). -intros; inversion H. -apply MIN_wd; auto. +Proof. + intros; inversion H. + apply MIN_wd; auto. Qed. Lemma Min_strext_unfolded : forall x y a b, (Min x y) [#] (Min a b) -> x [#] a or y [#] b. -intros. -apply MIN_strext; auto. +Proof. + intros. + apply MIN_strext; auto. Qed. Lemma Min_leEq_lft : forall x y : IR, Min x y [<=] x. -intros. -simpl in |- *; unfold MIN. -rstepr ( [--][--]x). -apply inv_resp_leEq. -apply lft_leEq_Max. +Proof. + intros. + simpl in |- *; unfold MIN. + rstepr ( [--][--]x). + apply inv_resp_leEq. + apply lft_leEq_Max. Qed. Lemma Min_leEq_rht : forall x y : IR, Min x y [<=] y. -intros. -simpl; unfold MIN. -rstepr ( [--][--]y). -apply inv_resp_leEq. -apply rht_leEq_Max. +Proof. + intros. + simpl; unfold MIN. + rstepr ( [--][--]y). + apply inv_resp_leEq. + apply rht_leEq_Max. Qed. Lemma Min_less_imp : forall x y z : IR, Min x y [<] z -> x [<] z or y [<] z. -simpl; unfold MIN. -intros. -cut ( [--]z [<] [--]x or [--]z [<] [--]y). -intros H0. -elim H0; intro. -left. -apply inv_cancel_less; assumption. -right. -apply inv_cancel_less; assumption. -apply less_Max_imp. -apply inv_cancel_less. -apply less_wdr with z. -assumption. -algebra. +Proof. + simpl; unfold MIN. + intros. + cut ( [--]z [<] [--]x or [--]z [<] [--]y). + intros H0. + elim H0; intro. + left. + apply inv_cancel_less; assumption. + right. + apply inv_cancel_less; assumption. + apply less_Max_imp. + apply inv_cancel_less. + apply less_wdr with z. + assumption. + algebra. Qed. Lemma leEq_Min : forall x y z : IR, z [<=] x -> z [<=] y -> z [<=] Min x y. -intros. -simpl; unfold MIN. -rstepl ( [--][--]z). -apply inv_resp_leEq. -apply Max_leEq; apply inv_resp_leEq; assumption. +Proof. + intros. + simpl; unfold MIN. + rstepl ( [--][--]z). + apply inv_resp_leEq. + apply Max_leEq; apply inv_resp_leEq; assumption. Qed. Lemma less_Min : forall x y z : IR, z [<] x -> z [<] y -> z [<] Min x y. -intros. -simpl; unfold MIN. -rstepl ( [--][--]z). -apply inv_resp_less. -apply Max_less; apply inv_resp_less; assumption. +Proof. + intros. + simpl; unfold MIN. + rstepl ( [--][--]z). + apply inv_resp_less. + apply Max_less; apply inv_resp_less; assumption. Qed. Lemma equiv_imp_eq_min : forall x x' m, (forall y, y [<=] x -> y [<=] x' -> y [<=] m) -> (forall y, y [<=] m -> y [<=] x) -> (forall y, y [<=] m -> y [<=] x') -> Min x x' [=] m. -intros x x' m X X0 X1. -simpl; unfold MIN. -astepr ( [--][--]m). -apply un_op_wd_unfolded. -apply equiv_imp_eq_max. -intros. -rstepr ( [--][--]y). -apply inv_resp_leEq. -apply X. -rstepr ( [--][--]x). -apply inv_resp_leEq. -assumption. -rstepr ( [--][--]x'). -apply inv_resp_leEq. -assumption. -intros. -rstepr ( [--][--]y). -apply inv_resp_leEq. -apply X0. -rstepr ( [--][--]m). -apply inv_resp_leEq. -assumption. -intros. -rstepr ( [--][--]y). -apply inv_resp_leEq. -apply X1. -rstepr ( [--][--]m). -apply inv_resp_leEq. -assumption. +Proof. + intros x x' m X X0 X1. + simpl; unfold MIN. + astepr ( [--][--]m). + apply un_op_wd_unfolded. + apply equiv_imp_eq_max. + intros. + rstepr ( [--][--]y). + apply inv_resp_leEq. + apply X. + rstepr ( [--][--]x). + apply inv_resp_leEq. + assumption. + rstepr ( [--][--]x'). + apply inv_resp_leEq. + assumption. + intros. + rstepr ( [--][--]y). + apply inv_resp_leEq. + apply X0. + rstepr ( [--][--]m). + apply inv_resp_leEq. + assumption. + intros. + rstepr ( [--][--]y). + apply inv_resp_leEq. + apply X1. + rstepr ( [--][--]m). + apply inv_resp_leEq. + assumption. Qed. Lemma Min_id : forall x : IR, Min x x [=] x. -intro. -simpl; unfold MIN. -astepr ( [--][--]x). -apply un_op_wd_unfolded; apply Max_id. +Proof. + intro. + simpl; unfold MIN. + astepr ( [--][--]x). + apply un_op_wd_unfolded; apply Max_id. Qed. Lemma Min_comm : forall x y : IR, Min x y [=] Min y x. -intros. -simpl; unfold MIN. -apply un_op_wd_unfolded; apply Max_comm. +Proof. + intros. + simpl; unfold MIN. + apply un_op_wd_unfolded; apply Max_comm. Qed. Lemma leEq_imp_Min_is_lft : forall x y : IR, x [<=] y -> Min x y [=] x. -intros. -simpl; unfold MIN. -astepr ( [--][--]x). -apply un_op_wd_unfolded. -apply eq_transitive_unfolded with (Max [--]y [--]x). -apply Max_comm. -apply leEq_imp_Max_is_rht. -apply inv_resp_leEq. -assumption. +Proof. + intros. + simpl; unfold MIN. + astepr ( [--][--]x). + apply un_op_wd_unfolded. + apply eq_transitive_unfolded with (Max [--]y [--]x). + apply Max_comm. + apply leEq_imp_Max_is_rht. + apply inv_resp_leEq. + assumption. Qed. Lemma Min_is_lft_imp_leEq : forall x y : IR, Min x y [=] x -> x [<=] y. -simpl; unfold MIN. -intros. -rstepl ( [--][--]x). -rstepr ( [--][--]y). -apply inv_resp_leEq. -apply Max_is_rht_imp_leEq. -astepl ( [--][--] (Max [--]y [--]x)). -apply eq_transitive_unfolded with ( [--][--] (Max [--]x [--]y)). -apply un_op_wd_unfolded; apply un_op_wd_unfolded; apply Max_comm. -apply un_op_wd_unfolded; assumption. +Proof. + simpl; unfold MIN. + intros. + rstepl ( [--][--]x). + rstepr ( [--][--]y). + apply inv_resp_leEq. + apply Max_is_rht_imp_leEq. + astepl ( [--][--] (Max [--]y [--]x)). + apply eq_transitive_unfolded with ( [--][--] (Max [--]x [--]y)). + apply un_op_wd_unfolded; apply un_op_wd_unfolded; apply Max_comm. + apply un_op_wd_unfolded; assumption. Qed. Lemma leEq_Min_plus_eps : forall x y e, Zero [<] e -> {x [<=] Min x y[+]e} + {y [<=] Min x y[+]e}. -intros. -cut (x [<] Min x y[+]e or y [<] Min x y[+]e). -intro H0; elim H0; intros; clear H0. -left; apply less_leEq; assumption. -right; apply less_leEq; assumption. -apply Min_less_imp. -apply shift_less_plus'. -astepl ZeroR; assumption. +Proof. + intros. + cut (x [<] Min x y[+]e or y [<] Min x y[+]e). + intro H0; elim H0; intros; clear H0. + left; apply less_leEq; assumption. + right; apply less_leEq; assumption. + apply Min_less_imp. + apply shift_less_plus'. + astepl ZeroR; assumption. Qed. Variables a b : IR. Lemma Min_leEq_Max : Min a b [<=] Max a b. -intros. -apply leEq_transitive with a; [ apply Min_leEq_lft | apply lft_leEq_Max ]. +Proof. + intros. + apply leEq_transitive with a; [ apply Min_leEq_lft | apply lft_leEq_Max ]. Qed. Lemma Min_leEq_Max' : forall z : IR, Min a z [<=] Max b z. -intros; apply leEq_transitive with z. -apply Min_leEq_rht. -apply rht_leEq_Max. +Proof. + intros; apply leEq_transitive with z. + apply Min_leEq_rht. + apply rht_leEq_Max. Qed. Lemma Min3_leEq_Max3 : forall c : IR, Min (Min a b) c [<=] Max (Max a b) c. -intros; eapply leEq_transitive. -apply Min_leEq_rht. -apply rht_leEq_Max. +Proof. + intros; eapply leEq_transitive. + apply Min_leEq_rht. + apply rht_leEq_Max. Qed. Lemma Min_less_Max : forall c d : IR, a [<] b -> Min a c [<] Max b d. -intros. -apply leEq_less_trans with a. -apply Min_leEq_lft. -apply less_leEq_trans with b. -assumption. -apply lft_leEq_Max. +Proof. + intros. + apply leEq_less_trans with a. + apply Min_leEq_lft. + apply less_leEq_trans with b. + assumption. + apply lft_leEq_Max. Qed. Lemma ap_imp_Min_less_Max : a [#] b -> Min a b [<] Max a b. -intro Hap; elim (ap_imp_less _ _ _ Hap); - (intro H; - [ eapply leEq_less_trans; - [ idtac | eapply less_leEq_trans; [ apply H | idtac ] ] ]). -apply Min_leEq_lft. -apply rht_leEq_Max. -apply Min_leEq_rht. -apply lft_leEq_Max. +Proof. + intro Hap; elim (ap_imp_less _ _ _ Hap); (intro H; [ eapply leEq_less_trans; + [ idtac | eapply less_leEq_trans; [ apply H | idtac ] ] ]). + apply Min_leEq_lft. + apply rht_leEq_Max. + apply Min_leEq_rht. + apply lft_leEq_Max. Qed. Lemma Min_less_Max_imp_ap : Min a b [<] Max a b -> a [#] b. -intro H. -elim (Min_less_imp _ _ _ H); clear H; intro H; elim (less_Max_imp _ _ _ H); - intro H0. -elimtype False; exact (less_irreflexive _ _ H0). -apply less_imp_ap; auto. -apply Greater_imp_ap; auto. -elimtype False; exact (less_irreflexive _ _ H0). +Proof. + intro H. + elim (Min_less_imp _ _ _ H); clear H; intro H; elim (less_Max_imp _ _ _ H); intro H0. + elimtype False; exact (less_irreflexive _ _ H0). + apply less_imp_ap; auto. + apply Greater_imp_ap; auto. + elimtype False; exact (less_irreflexive _ _ H0). Qed. -Lemma Max_monotone : forall (f: PartIR), - (forall (x y:IR) Hx Hy, (Min a b)[<=]x -> x[<=]y -> y[<=](Max a b) -> +Lemma Max_monotone : forall (f: PartIR), + (forall (x y:IR) Hx Hy, (Min a b)[<=]x -> x[<=]y -> y[<=](Max a b) -> (f x Hx)[<=](f y Hy)) -> forall Ha Hb Hc, (Max (f a Ha) (f b Hb)) [=] f (Max a b) Hc. Proof. -intros f H Ha Hb Hc. -apply leEq_imp_eq. - apply Max_leEq; apply H; - (apply leEq_reflexive || - apply Min_leEq_lft || - apply Min_leEq_rht || - apply lft_leEq_Max || - apply rht_leEq_Max). -rewrite leEq_def. -intros X. -apply (leEq_or_leEq IR a b). -intros H0. -generalize X; clear X. -change (Not (Max (f a Ha) (f b Hb)[<]f (Max a b) Hc)). -rewrite <- leEq_def. -destruct H0. - stepl (f b Hb). - apply rht_leEq_Max. + intros f H Ha Hb Hc. + apply leEq_imp_eq. + apply Max_leEq; apply H; (apply leEq_reflexive || apply Min_leEq_lft || apply Min_leEq_rht || + apply lft_leEq_Max || apply rht_leEq_Max). + rewrite leEq_def. + intros X. + apply (leEq_or_leEq IR a b). + intros H0. + generalize X; clear X. + change (Not (Max (f a Ha) (f b Hb)[<]f (Max a b) Hc)). + rewrite <- leEq_def. + destruct H0. + stepl (f b Hb). + apply rht_leEq_Max. + apply pfwdef. + apply eq_symmetric; apply leEq_imp_Max_is_rht. + assumption. + stepl (f a Ha). + apply lft_leEq_Max. apply pfwdef. + stepr (Max b a) by apply Max_comm. apply eq_symmetric; apply leEq_imp_Max_is_rht. assumption. -stepl (f a Ha). - apply lft_leEq_Max. -apply pfwdef. -stepr (Max b a) by apply Max_comm. -apply eq_symmetric; apply leEq_imp_Max_is_rht. -assumption. Qed. -Lemma Min_monotone : forall (f: PartIR), - (forall (x y:IR) Hx Hy, (Min a b)[<=]x -> x[<=]y -> y[<=](Max a b) -> +Lemma Min_monotone : forall (f: PartIR), + (forall (x y:IR) Hx Hy, (Min a b)[<=]x -> x[<=]y -> y[<=](Max a b) -> (f x Hx)[<=](f y Hy)) -> forall Ha Hb Hc, (Min (f a Ha) (f b Hb)) [=] f (Min a b) Hc. Proof. -intros f H Ha Hb Hc. -apply leEq_imp_eq;[| - apply leEq_Min; apply H; - (apply leEq_reflexive || - apply Min_leEq_lft || - apply Min_leEq_rht || - apply lft_leEq_Max || - apply rht_leEq_Max)]. -rewrite leEq_def. -intros X. -apply (leEq_or_leEq IR a b). -intros H0. -generalize X; clear X. -change (Not (f (Min a b) Hc[<]Min (f a Ha) (f b Hb))). -rewrite <- leEq_def. -destruct H0. - stepr (f a Ha). - apply Min_leEq_lft. + intros f H Ha Hb Hc. + apply leEq_imp_eq;[| apply leEq_Min; apply H; (apply leEq_reflexive || apply Min_leEq_lft || + apply Min_leEq_rht || apply lft_leEq_Max || apply rht_leEq_Max)]. + rewrite leEq_def. + intros X. + apply (leEq_or_leEq IR a b). + intros H0. + generalize X; clear X. + change (Not (f (Min a b) Hc[<]Min (f a Ha) (f b Hb))). + rewrite <- leEq_def. + destruct H0. + stepr (f a Ha). + apply Min_leEq_lft. + apply pfwdef. + apply eq_symmetric; apply leEq_imp_Min_is_lft. + assumption. + stepr (f b Hb). + apply Min_leEq_rht. apply pfwdef. + stepr (Min b a) by apply Min_comm. apply eq_symmetric; apply leEq_imp_Min_is_lft. assumption. -stepr (f b Hb). - apply Min_leEq_rht. -apply pfwdef. -stepr (Min b a) by apply Min_comm. -apply eq_symmetric; apply leEq_imp_Min_is_lft. -assumption. Qed. End Minimum. @@ -746,483 +774,508 @@ Definition ABSIR (x : IR) : IR := Max x [--]x. Lemma ABSIR_strext : un_op_strext _ ABSIR. -unfold un_op_strext in |- *. -unfold fun_strext in |- *. -unfold ABSIR in |- *. -intros. -generalize (csbf_strext _ _ _ Max); intro H0. -unfold bin_fun_strext in H0. -generalize (H0 _ _ _ _ X); intro H1. -elim H1. -intro H2. -assumption. -intro H2. -apply zero_minus_apart. -generalize (minus_ap_zero _ _ _ H2); intro H3. -generalize (inv_resp_ap_zero _ _ H3); intro H4. -cut (x[-]y [=] [--] ( [--]x[-][--]y)). -intro. -astepl ( [--] ( [--]x[-][--]y)). auto. -rational. +Proof. + unfold un_op_strext in |- *. + unfold fun_strext in |- *. + unfold ABSIR in |- *. + intros. + generalize (csbf_strext _ _ _ Max); intro H0. + unfold bin_fun_strext in H0. + generalize (H0 _ _ _ _ X); intro H1. + elim H1. + intro H2. + assumption. + intro H2. + apply zero_minus_apart. + generalize (minus_ap_zero _ _ _ H2); intro H3. + generalize (inv_resp_ap_zero _ _ H3); intro H4. + cut (x[-]y [=] [--] ( [--]x[-][--]y)). + intro. + astepl ( [--] ( [--]x[-][--]y)). auto. + rational. Qed. Lemma ABSIR_wd : un_op_wd _ ABSIR. -unfold un_op_wd in |- *. -apply fun_strext_imp_wd. -exact ABSIR_strext. +Proof. + unfold un_op_wd in |- *. + apply fun_strext_imp_wd. + exact ABSIR_strext. Qed. Definition AbsIR : CSetoid_un_op IR := Build_CSetoid_un_op _ ABSIR ABSIR_strext. Lemma AbsIR_wd : forall x y : IR, x [=] y -> AbsIR x [=] AbsIR y. -algebra. +Proof. + algebra. Qed. Lemma AbsIR_wdl : forall x y e, x [=] y -> AbsIR x [<] e -> AbsIR y [<] e. Proof. -intros. -apply less_wdl with (AbsIR x). -assumption. -algebra. + intros. + apply less_wdl with (AbsIR x). + assumption. + algebra. Qed. Lemma AbsIR_wdr : forall x y e, x [=] y -> e [<] AbsIR x -> e [<] AbsIR y. Proof. -intros. -apply less_wdr with (AbsIR x). -assumption. -algebra. + intros. + apply less_wdr with (AbsIR x). + assumption. + algebra. Qed. Lemma AbsIRz_isz : AbsIR Zero [=] Zero. -intros. unfold AbsIR in |- *. simpl in |- *. unfold ABSIR in |- *. -Step_final (Max Zero Zero). +Proof. + intros. unfold AbsIR in |- *. simpl in |- *. unfold ABSIR in |- *. + Step_final (Max Zero Zero). Qed. Lemma AbsIR_nonneg : forall x : IR, Zero [<=] AbsIR x. -intro x; rewrite leEq_def; intro H. -cut (Zero [<] ZeroR). -apply less_irreflexive. -apply less_wdl with (AbsIR x); auto. -eapply eq_transitive_unfolded. -2: apply AbsIRz_isz. -apply AbsIR_wd. -unfold AbsIR in H; simpl in H; unfold ABSIR in H. -apply leEq_imp_eq; apply less_leEq. -apply leEq_less_trans with (Max x [--]x). -apply lft_leEq_Max. -assumption. -apply inv_cancel_less. -apply leEq_less_trans with (Max x [--]x). -apply rht_leEq_Max. -astepr ZeroR; auto. +Proof. + intro x; rewrite leEq_def; intro H. + cut (Zero [<] ZeroR). + apply less_irreflexive. + apply less_wdl with (AbsIR x); auto. + eapply eq_transitive_unfolded. + 2: apply AbsIRz_isz. + apply AbsIR_wd. + unfold AbsIR in H; simpl in H; unfold ABSIR in H. + apply leEq_imp_eq; apply less_leEq. + apply leEq_less_trans with (Max x [--]x). + apply lft_leEq_Max. + assumption. + apply inv_cancel_less. + apply leEq_less_trans with (Max x [--]x). + apply rht_leEq_Max. + astepr ZeroR; auto. Qed. Lemma AbsIR_pos : forall x : IR, x [#] Zero -> Zero [<] AbsIR x. -intros. -cut (x [<] Zero or Zero [<] x). -2: apply ap_imp_less; assumption. -intros H0. -unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. -elim H0. -intro. -apply less_leEq_trans with ( [--]x). -astepl ( [--]ZeroR). -apply inv_resp_less. -assumption. -apply rht_leEq_Max. -intro. -apply less_leEq_trans with x. -assumption. -apply lft_leEq_Max. +Proof. + intros. + cut (x [<] Zero or Zero [<] x). + 2: apply ap_imp_less; assumption. + intros H0. + unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. + elim H0. + intro. + apply less_leEq_trans with ( [--]x). + astepl ( [--]ZeroR). + apply inv_resp_less. + assumption. + apply rht_leEq_Max. + intro. + apply less_leEq_trans with x. + assumption. + apply lft_leEq_Max. Qed. Lemma AbsIR_cancel_ap_zero : forall x : IR, AbsIR x [#] Zero -> x [#] Zero. -intros. -apply un_op_strext_unfolded with AbsIR. -apply ap_wdr_unfolded with ZeroR. -assumption. -apply eq_symmetric_unfolded; apply AbsIRz_isz. +Proof. + intros. + apply un_op_strext_unfolded with AbsIR. + apply ap_wdr_unfolded with ZeroR. + assumption. + apply eq_symmetric_unfolded; apply AbsIRz_isz. Qed. Lemma AbsIR_resp_ap_zero : forall x : IR, x [#] Zero -> AbsIR x [#] Zero. -intros. -apply ap_symmetric_unfolded; apply less_imp_ap. -apply AbsIR_pos; assumption. +Proof. + intros. + apply ap_symmetric_unfolded; apply less_imp_ap. + apply AbsIR_pos; assumption. Qed. Lemma leEq_AbsIR : forall x : IR, x [<=] AbsIR x. -intros. -unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *; apply lft_leEq_Max. +Proof. + intros. + unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *; apply lft_leEq_Max. Qed. Lemma inv_leEq_AbsIR : forall x : IR, [--]x [<=] AbsIR x. -intros. -unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *; apply rht_leEq_Max. +Proof. + intros. + unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *; apply rht_leEq_Max. Qed. Lemma AbsSmall_e : forall e x : IR, AbsSmall e x -> Zero [<=] e. -intros. -red in H. -cut ( [--]e [<=] e). -2: inversion_clear H; apply leEq_transitive with x; assumption. -intro. -apply mult_cancel_leEq with (Two:IR); astepl ZeroR. -apply pos_two. -rstepr (e[+]e). -apply shift_leEq_plus; astepl ( [--]e). -assumption. +Proof. + intros. + red in H. + cut ( [--]e [<=] e). + 2: inversion_clear H; apply leEq_transitive with x; assumption. + intro. + apply mult_cancel_leEq with (Two:IR); astepl ZeroR. + apply pos_two. + rstepr (e[+]e). + apply shift_leEq_plus; astepl ( [--]e). + assumption. Qed. Lemma AbsSmall_imp_AbsIR : forall x y : IR, AbsSmall y x -> AbsIR x [<=] y. -intros. -unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. -inversion_clear H. -apply Max_leEq. -assumption. -apply inv_cancel_leEq. -astepr x; auto. +Proof. + intros. + unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. + inversion_clear H. + apply Max_leEq. + assumption. + apply inv_cancel_leEq. + astepr x; auto. Qed. Lemma AbsIR_eq_AbsSmall : forall x e : IR, [--]e [<=] x -> x [<=] e -> AbsSmall e x. -intros. -unfold AbsSmall in |- *. -auto. +Proof. + intros. + unfold AbsSmall in |- *. + auto. Qed. Lemma AbsIR_imp_AbsSmall : forall x y : IR, AbsIR x [<=] y -> AbsSmall y x. -intros. -unfold AbsSmall in |- *. -simpl in H. -unfold ABSIR in H. -simpl in H. -split. -generalize (rht_leEq_Max x [--]x). -intro H1. -generalize (leEq_transitive _ _ (MAX x [--]x) _ H1 H). -intro H2. -rstepr ( [--][--]x). -apply inv_resp_leEq. -assumption. -generalize (lft_leEq_Max x [--]x). -intro H1. -generalize (leEq_transitive _ _ (MAX x [--]x) _ H1 H). -auto. +Proof. + intros. + unfold AbsSmall in |- *. + simpl in H. + unfold ABSIR in H. + simpl in H. + split. + generalize (rht_leEq_Max x [--]x). + intro H1. + generalize (leEq_transitive _ _ (MAX x [--]x) _ H1 H). + intro H2. + rstepr ( [--][--]x). + apply inv_resp_leEq. + assumption. + generalize (lft_leEq_Max x [--]x). + intro H1. + generalize (leEq_transitive _ _ (MAX x [--]x) _ H1 H). + auto. Qed. Lemma AbsSmall_transitive : forall e x y : IR, AbsSmall e x -> AbsIR y [<=] AbsIR x -> AbsSmall e y. -intros. -apply AbsIR_imp_AbsSmall. -eapply leEq_transitive. -apply H0. -apply AbsSmall_imp_AbsIR; assumption. +Proof. + intros. + apply AbsIR_imp_AbsSmall. + eapply leEq_transitive. + apply H0. + apply AbsSmall_imp_AbsIR; assumption. Qed. Lemma zero_less_AbsIR_plus_one : forall q : IR, Zero [<] AbsIR q[+]One. -intros. -apply less_leEq_trans with (Zero[+]OneR). -rstepr OneR; apply pos_one. -apply plus_resp_leEq; apply AbsIR_nonneg. +Proof. + intros. + apply less_leEq_trans with (Zero[+]OneR). + rstepr OneR; apply pos_one. + apply plus_resp_leEq; apply AbsIR_nonneg. Qed. Lemma AbsIR_inv : forall x : IR, AbsIR x [=] AbsIR [--]x. -intros. -unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. -apply eq_transitive_unfolded with (Max [--][--]x [--]x). -apply bin_op_wd_unfolded; algebra. -apply Max_comm. +Proof. + intros. + unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. + apply eq_transitive_unfolded with (Max [--][--]x [--]x). + apply bin_op_wd_unfolded; algebra. + apply Max_comm. Qed. Lemma AbsIR_minus : forall x y : IR, AbsIR (x[-]y) [=] AbsIR (y[-]x). -intros. -eapply eq_transitive_unfolded. -apply AbsIR_inv. -apply AbsIR_wd; rational. +Proof. + intros. + eapply eq_transitive_unfolded. + apply AbsIR_inv. + apply AbsIR_wd; rational. Qed. Lemma AbsIR_mult : forall (x c: IR) (H : Zero [<=]c), c[*] AbsIR (x) [=] AbsIR (c[*]x). -intros. -unfold AbsIR. -simpl. -unfold ABSIR. -rstepr (Max (c[*]x) (c[*]([--]x))). -apply eq_symmetric_unfolded. -apply max_mult; auto. +Proof. + intros. + unfold AbsIR. + simpl. + unfold ABSIR. + rstepr (Max (c[*]x) (c[*]([--]x))). + apply eq_symmetric_unfolded. + apply max_mult; auto. Qed. Lemma AbsIR_eq_x : forall x : IR, Zero [<=] x -> AbsIR x [=] x. -intros. -unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. -apply eq_transitive_unfolded with (Max [--]x x). -apply Max_comm. -apply leEq_imp_Max_is_rht. -apply leEq_transitive with ZeroR. -2: assumption. -astepr ( [--]ZeroR). -apply inv_resp_leEq. -assumption. +Proof. + intros. + unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. + apply eq_transitive_unfolded with (Max [--]x x). + apply Max_comm. + apply leEq_imp_Max_is_rht. + apply leEq_transitive with ZeroR. + 2: assumption. + astepr ( [--]ZeroR). + apply inv_resp_leEq. + assumption. Qed. Lemma AbsIR_eq_inv_x : forall x : IR, x [<=] Zero -> AbsIR x [=] [--]x. -intros. -apply eq_transitive_unfolded with (AbsIR [--]x). -apply AbsIR_inv. -apply AbsIR_eq_x. -astepl ( [--]ZeroR). -apply inv_resp_leEq. -assumption. +Proof. + intros. + apply eq_transitive_unfolded with (AbsIR [--]x). + apply AbsIR_inv. + apply AbsIR_eq_x. + astepl ( [--]ZeroR). + apply inv_resp_leEq. + assumption. Qed. Lemma less_AbsIR : forall x y, Zero [<] x -> x [<] AbsIR y -> x [<] y or y [<] [--]x. -intros x y H H0. -simpl in H0. -unfold ABSIR in H0. -cut (x [<] y or x [<] [--]y). -intro H1; inversion_clear H1. -left; assumption. -right; astepl ( [--][--]y); apply inv_resp_less; assumption. -apply less_Max_imp; assumption. +Proof. + intros x y H H0. + simpl in H0. + unfold ABSIR in H0. + cut (x [<] y or x [<] [--]y). + intro H1; inversion_clear H1. + left; assumption. + right; astepl ( [--][--]y); apply inv_resp_less; assumption. + apply less_Max_imp; assumption. Qed. Lemma leEq_distr_AbsIR : forall x y : IR, Zero [<] x -> x [<=] AbsIR y -> {x [<=] y} + {y [<=] [--]x}. -intros. -cut (x[*]Three [/]FourNZ [<] AbsIR y); intros. -elim (less_AbsIR (x[*]Three [/]FourNZ) y); intros; - [ left | right | idtac | auto ]. -astepr (Zero[+]y); apply shift_leEq_plus. -apply approach_zero. -cut (forall e : IR, Zero [<] e -> e [<] x [/]TwoNZ -> x[-]y [<] e); intros. -cut (x [/]FourNZ [<] x [/]TwoNZ); intros. -2: rstepl ((x [/]TwoNZ) [/]TwoNZ); apply pos_div_two'; apply pos_div_two; - auto. -rename X3 into H4. -elim (less_cotransitive_unfolded _ _ _ H4 e); intro. -apply leEq_less_trans with (x [/]FourNZ); auto. -apply less_leEq. -apply shift_minus_less; apply shift_less_plus'. -rstepl (x[*]Three [/]FourNZ); auto. -rename X1 into H2. apply H2; auto. -apply shift_minus_less; apply shift_less_plus'. -cut (x[-]e [<] AbsIR y); intros. -2: apply less_leEq_trans with x; auto. -2: apply shift_minus_less; apply shift_less_plus'; astepl ZeroR; auto. -elim (less_AbsIR (x[-]e) y); auto. -intro; elimtype False. -apply (less_irreflexive_unfolded _ y). -eapply leEq_less_trans. -2: apply a. -apply less_leEq; eapply less_transitive_unfolded. -apply b. -astepl (Zero[-] (x[-]e)). -apply shift_minus_less. -astepr (x[*]Three [/]FourNZ[+]x[-]e). -apply shift_less_minus; astepl e. -eapply less_leEq_trans. -rename X2 into H3. apply H3. -apply less_leEq. -rstepl (x[*] (Zero[+]Zero[+]One [/]TwoNZ)); - rstepr (x[*] (One[+]One [/]FourNZ[+]One [/]TwoNZ)). -apply mult_resp_less_lft; auto. -apply plus_resp_less_rht; apply plus_resp_less_leEq. -apply pos_one. -apply less_leEq; apply pos_div_four; apply pos_one. -apply shift_less_minus; astepl e. -eapply less_leEq_trans. -rename X2 into H3. apply H3. -apply less_leEq; apply pos_div_two'; auto. -astepr (Zero[+][--]x); apply shift_leEq_plus. -apply leEq_wdl with (y[+]x). -2: unfold cg_minus in |- *; algebra. -apply approach_zero. -cut (forall e : IR, Zero [<] e -> e [<] x [/]TwoNZ -> y[+]x [<] e); intros. -cut (x [/]FourNZ [<] x [/]TwoNZ); intros. -2: rstepl ((x [/]TwoNZ) [/]TwoNZ); apply pos_div_two'; apply pos_div_two; - auto. -rename X3 into H4. -elim (less_cotransitive_unfolded _ _ _ H4 e); intro. -apply leEq_less_trans with (x [/]FourNZ); auto. -apply less_leEq; apply shift_plus_less. -rstepr ( [--] (x[*]Three [/]FourNZ)); auto. -rename X1 into H2. apply H2; auto. -cut (x[-]e [<] AbsIR y); intros. -2: apply less_leEq_trans with x; auto. -2: apply shift_minus_less; apply shift_less_plus'; astepl ZeroR; auto. -elim (less_AbsIR (x[-]e) y); auto. -intro; elimtype False. -apply (less_irreflexive_unfolded _ y). -eapply leEq_less_trans. -2: apply a. -apply less_leEq; eapply less_transitive_unfolded. -apply b. -apply shift_less_minus; apply shift_plus_less'. -eapply less_transitive_unfolded. -rename X2 into H3. apply H3. -rstepl (x[*] (Zero[+]Zero[+]One [/]TwoNZ)); - rstepr (x[*] (One[+]One [/]FourNZ[+]One [/]TwoNZ)). -apply mult_resp_less_lft; auto. -apply plus_resp_less_rht; apply plus_resp_less_leEq. -apply pos_one. -apply less_leEq; apply pos_div_four; apply pos_one. -intro. -rstepl (y[-][--]x). -apply shift_minus_less. -rstepr ( [--] (x[-]e)); auto. -apply shift_less_minus; astepl e. -eapply less_leEq_trans. -rename X2 into H3. apply H3. -apply less_leEq; apply pos_div_two'; auto. -astepl (ZeroR[*]Three [/]FourNZ). -apply mult_resp_less; auto. -apply pos_div_four; apply pos_three. -apply less_leEq_trans with x; auto. -astepr (x[*]One). -astepr (x[*]Four [/]FourNZ). -apply mult_resp_less_lft; auto. -apply div_resp_less. -apply pos_four. -apply three_less_four. +Proof. + intros. + cut (x[*]Three [/]FourNZ [<] AbsIR y); intros. + elim (less_AbsIR (x[*]Three [/]FourNZ) y); intros; [ left | right | idtac | auto ]. + astepr (Zero[+]y); apply shift_leEq_plus. + apply approach_zero. + cut (forall e : IR, Zero [<] e -> e [<] x [/]TwoNZ -> x[-]y [<] e); intros. + cut (x [/]FourNZ [<] x [/]TwoNZ); intros. + 2: rstepl ((x [/]TwoNZ) [/]TwoNZ); apply pos_div_two'; apply pos_div_two; auto. + rename X3 into H4. + elim (less_cotransitive_unfolded _ _ _ H4 e); intro. + apply leEq_less_trans with (x [/]FourNZ); auto. + apply less_leEq. + apply shift_minus_less; apply shift_less_plus'. + rstepl (x[*]Three [/]FourNZ); auto. + rename X1 into H2. apply H2; auto. + apply shift_minus_less; apply shift_less_plus'. + cut (x[-]e [<] AbsIR y); intros. + 2: apply less_leEq_trans with x; auto. + 2: apply shift_minus_less; apply shift_less_plus'; astepl ZeroR; auto. + elim (less_AbsIR (x[-]e) y); auto. + intro; elimtype False. + apply (less_irreflexive_unfolded _ y). + eapply leEq_less_trans. + 2: apply a. + apply less_leEq; eapply less_transitive_unfolded. + apply b. + astepl (Zero[-] (x[-]e)). + apply shift_minus_less. + astepr (x[*]Three [/]FourNZ[+]x[-]e). + apply shift_less_minus; astepl e. + eapply less_leEq_trans. + rename X2 into H3. apply H3. + apply less_leEq. + rstepl (x[*] (Zero[+]Zero[+]One [/]TwoNZ)); rstepr (x[*] (One[+]One [/]FourNZ[+]One [/]TwoNZ)). + apply mult_resp_less_lft; auto. + apply plus_resp_less_rht; apply plus_resp_less_leEq. + apply pos_one. + apply less_leEq; apply pos_div_four; apply pos_one. + apply shift_less_minus; astepl e. + eapply less_leEq_trans. + rename X2 into H3. apply H3. + apply less_leEq; apply pos_div_two'; auto. + astepr (Zero[+][--]x); apply shift_leEq_plus. + apply leEq_wdl with (y[+]x). + 2: unfold cg_minus in |- *; algebra. + apply approach_zero. + cut (forall e : IR, Zero [<] e -> e [<] x [/]TwoNZ -> y[+]x [<] e); intros. + cut (x [/]FourNZ [<] x [/]TwoNZ); intros. + 2: rstepl ((x [/]TwoNZ) [/]TwoNZ); apply pos_div_two'; apply pos_div_two; auto. + rename X3 into H4. + elim (less_cotransitive_unfolded _ _ _ H4 e); intro. + apply leEq_less_trans with (x [/]FourNZ); auto. + apply less_leEq; apply shift_plus_less. + rstepr ( [--] (x[*]Three [/]FourNZ)); auto. + rename X1 into H2. apply H2; auto. + cut (x[-]e [<] AbsIR y); intros. + 2: apply less_leEq_trans with x; auto. + 2: apply shift_minus_less; apply shift_less_plus'; astepl ZeroR; auto. + elim (less_AbsIR (x[-]e) y); auto. + intro; elimtype False. + apply (less_irreflexive_unfolded _ y). + eapply leEq_less_trans. + 2: apply a. + apply less_leEq; eapply less_transitive_unfolded. + apply b. + apply shift_less_minus; apply shift_plus_less'. + eapply less_transitive_unfolded. + rename X2 into H3. apply H3. + rstepl (x[*] (Zero[+]Zero[+]One [/]TwoNZ)); rstepr (x[*] (One[+]One [/]FourNZ[+]One [/]TwoNZ)). + apply mult_resp_less_lft; auto. + apply plus_resp_less_rht; apply plus_resp_less_leEq. + apply pos_one. + apply less_leEq; apply pos_div_four; apply pos_one. + intro. + rstepl (y[-][--]x). + apply shift_minus_less. + rstepr ( [--] (x[-]e)); auto. + apply shift_less_minus; astepl e. + eapply less_leEq_trans. + rename X2 into H3. apply H3. + apply less_leEq; apply pos_div_two'; auto. + astepl (ZeroR[*]Three [/]FourNZ). + apply mult_resp_less; auto. + apply pos_div_four; apply pos_three. + apply less_leEq_trans with x; auto. + astepr (x[*]One). + astepr (x[*]Four [/]FourNZ). + apply mult_resp_less_lft; auto. + apply div_resp_less. + apply pos_four. + apply three_less_four. Qed. Lemma AbsIR_approach_zero : forall x, (forall e, Zero [<] e -> AbsIR x [<=] e) -> x [=] Zero. -intros. -apply leEq_imp_eq. -apply approach_zero_weak. -intros e H0. -eapply leEq_transitive; [ apply leEq_AbsIR | exact (H e H0) ]. -astepl ( [--]ZeroR); astepr ( [--][--]x); apply inv_resp_leEq. -apply approach_zero_weak. -intros e H0. -eapply leEq_transitive; [ apply inv_leEq_AbsIR | exact (H e H0) ]. +Proof. + intros. + apply leEq_imp_eq. + apply approach_zero_weak. + intros e H0. + eapply leEq_transitive; [ apply leEq_AbsIR | exact (H e H0) ]. + astepl ( [--]ZeroR); astepr ( [--][--]x); apply inv_resp_leEq. + apply approach_zero_weak. + intros e H0. + eapply leEq_transitive; [ apply inv_leEq_AbsIR | exact (H e H0) ]. Qed. Lemma AbsSmall_approach : forall (a b : IR), (forall (e : IR), Zero[<]e -> AbsSmall (a[+]e) b) -> AbsSmall a b. -unfold AbsSmall. -intros a b H. -split. -assert (forall e : IR, Zero[<]e -> [--]a[-]b[<=]e). -intros. -assert ([--](a[+]e)[<=]b /\ b[<=]a[+]e). -apply H; auto. destruct H0. -apply shift_minus_leEq. -apply shift_leEq_plus'. -astepl ([--]a[+][--]e). -astepl ([--](a[+]e)). -auto. -astepr (b[+]Zero). -apply shift_leEq_plus'. -apply approach_zero_weak; auto. -assert (forall e : IR, Zero[<]e -> b[-]a[<=]e). -intros. -assert ([--](a[+]e)[<=]b /\ b[<=]a[+]e). -apply H; auto. destruct H0. -apply shift_minus_leEq. -astepr (a[+]e). -auto. -astepr (a[+]Zero). -apply shift_leEq_plus'. -apply approach_zero_weak; auto. +Proof. + unfold AbsSmall. + intros a b H. + split. + assert (forall e : IR, Zero[<]e -> [--]a[-]b[<=]e). + intros. + assert ([--](a[+]e)[<=]b /\ b[<=]a[+]e). + apply H; auto. destruct H0. + apply shift_minus_leEq. + apply shift_leEq_plus'. + astepl ([--]a[+][--]e). + astepl ([--](a[+]e)). + auto. + astepr (b[+]Zero). + apply shift_leEq_plus'. + apply approach_zero_weak; auto. + assert (forall e : IR, Zero[<]e -> b[-]a[<=]e). + intros. + assert ([--](a[+]e)[<=]b /\ b[<=]a[+]e). + apply H; auto. destruct H0. + apply shift_minus_leEq. + astepr (a[+]e). + auto. + astepr (a[+]Zero). + apply shift_leEq_plus'. + apply approach_zero_weak; auto. Qed. Lemma AbsIR_eq_zero : forall x : IR, AbsIR x [=] Zero -> x [=] Zero. -intros. -apply AbsIR_approach_zero; intros. -astepl ZeroR; apply less_leEq; auto. +Proof. + intros. + apply AbsIR_approach_zero; intros. + astepl ZeroR; apply less_leEq; auto. Qed. Lemma Abs_Max : forall a b : IR, AbsIR (a[-]b) [=] Max a b[-]Min a b. -intros. -apply leEq_imp_eq. -apply leEq_wdl with (Max (a[-]b) (b[-]a)). -2: simpl in |- *; unfold ABSIR in |- *. -2: apply Max_wd_unfolded; rational. -apply Max_leEq. -unfold cg_minus in |- *; apply plus_resp_leEq_both. -apply lft_leEq_Max. -apply inv_resp_leEq; apply Min_leEq_rht. -unfold cg_minus in |- *; apply plus_resp_leEq_both. -apply rht_leEq_Max. -apply inv_resp_leEq; apply Min_leEq_lft. -astepr (Zero[+]AbsIR (a[-]b)). -apply shift_leEq_plus. -apply approach_zero_weak. -intros. -do 2 apply shift_minus_leEq. -eapply leEq_wdr. -2: apply CSemiGroups.plus_assoc. -apply shift_leEq_plus'. -rename X into H. -elim (Max_minus_eps_leEq a b e H); intro. -apply leEq_transitive with a. -assumption. -apply shift_leEq_plus'. -apply leEq_Min. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply AbsIR_nonneg. -apply shift_minus_leEq; apply shift_leEq_plus'. -apply leEq_AbsIR. -apply leEq_transitive with b. -assumption. -apply shift_leEq_plus'. -apply leEq_Min. -apply shift_minus_leEq; apply shift_leEq_plus'. -rstepl ( [--] (a[-]b)); apply inv_leEq_AbsIR. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply AbsIR_nonneg. +Proof. + intros. + apply leEq_imp_eq. + apply leEq_wdl with (Max (a[-]b) (b[-]a)). + 2: simpl in |- *; unfold ABSIR in |- *. + 2: apply Max_wd_unfolded; rational. + apply Max_leEq. + unfold cg_minus in |- *; apply plus_resp_leEq_both. + apply lft_leEq_Max. + apply inv_resp_leEq; apply Min_leEq_rht. + unfold cg_minus in |- *; apply plus_resp_leEq_both. + apply rht_leEq_Max. + apply inv_resp_leEq; apply Min_leEq_lft. + astepr (Zero[+]AbsIR (a[-]b)). + apply shift_leEq_plus. + apply approach_zero_weak. + intros. + do 2 apply shift_minus_leEq. + eapply leEq_wdr. + 2: apply CSemiGroups.plus_assoc. + apply shift_leEq_plus'. + rename X into H. + elim (Max_minus_eps_leEq a b e H); intro. + apply leEq_transitive with a. + assumption. + apply shift_leEq_plus'. + apply leEq_Min. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply AbsIR_nonneg. + apply shift_minus_leEq; apply shift_leEq_plus'. + apply leEq_AbsIR. + apply leEq_transitive with b. + assumption. + apply shift_leEq_plus'. + apply leEq_Min. + apply shift_minus_leEq; apply shift_leEq_plus'. + rstepl ( [--] (a[-]b)); apply inv_leEq_AbsIR. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply AbsIR_nonneg. Qed. Lemma AbsIR_str_bnd : forall a b e : IR, AbsIR (a[-]b) [<] e -> b [<] a[+]e. -intros. -apply shift_less_plus'. -apply leEq_less_trans with (AbsIR (a[-]b)); auto. -eapply leEq_wdr; [ apply leEq_AbsIR | apply AbsIR_minus ]. +Proof. + intros. + apply shift_less_plus'. + apply leEq_less_trans with (AbsIR (a[-]b)); auto. + eapply leEq_wdr; [ apply leEq_AbsIR | apply AbsIR_minus ]. Qed. Lemma AbsIR_bnd : forall a b e : IR, AbsIR (a[-]b) [<=] e -> b [<=] a[+]e. -intros. -apply shift_leEq_plus'. -apply leEq_transitive with (AbsIR (a[-]b)); auto. -eapply leEq_wdr; [ apply leEq_AbsIR | apply AbsIR_minus ]. +Proof. + intros. + apply shift_leEq_plus'. + apply leEq_transitive with (AbsIR (a[-]b)); auto. + eapply leEq_wdr; [ apply leEq_AbsIR | apply AbsIR_minus ]. Qed. Lemma AbsIR_less : forall a b, a[<]b -> [--]b[<]a -> AbsIR a[<]b. -intros a b H0 H1. -destruct (smaller _ _ _ (shift_zero_less_minus _ _ _ H0) (shift_zero_less_minus _ _ _ H1)) as - [z Hz0 [Hz1 Hz2]]. -apply shift_zero_less_minus'. -eapply less_leEq_trans. -apply Hz0. -apply shift_leEq_minus. -apply shift_plus_leEq'. -apply AbsSmall_imp_AbsIR. -split. -rstepl (z[-]b). -apply shift_minus_leEq. -rstepr (a[-][--]b). -assumption. -apply shift_leEq_minus. -apply shift_plus_leEq'. -assumption. +Proof. + intros a b H0 H1. + destruct (smaller _ _ _ (shift_zero_less_minus _ _ _ H0) (shift_zero_less_minus _ _ _ H1)) as + [z Hz0 [Hz1 Hz2]]. + apply shift_zero_less_minus'. + eapply less_leEq_trans. + apply Hz0. + apply shift_leEq_minus. + apply shift_plus_leEq'. + apply AbsSmall_imp_AbsIR. + split. + rstepl (z[-]b). + apply shift_minus_leEq. + rstepr (a[-][--]b). + assumption. + apply shift_leEq_minus. + apply shift_plus_leEq'. + assumption. Qed. Lemma AbsIR_Qabs : forall (a:Q), AbsIR (inj_Q IR a)[=]inj_Q IR (Qabs a). Proof. -intros a. -apply Qabs_case; intros H. - apply AbsIR_eq_x. - stepl (inj_Q IR Zero) by apply (inj_Q_nring IR 0). + intros a. + apply Qabs_case; intros H. + apply AbsIR_eq_x. + stepl (inj_Q IR Zero) by apply (inj_Q_nring IR 0). + apply inj_Q_leEq. + assumption. + stepr ([--](inj_Q IR a)) by apply eq_symmetric;apply inj_Q_inv. + apply AbsIR_eq_inv_x. + stepr (inj_Q IR Zero) by apply (inj_Q_nring IR 0). apply inj_Q_leEq. assumption. -stepr ([--](inj_Q IR a)) by apply eq_symmetric;apply inj_Q_inv. -apply AbsIR_eq_inv_x. -stepr (inj_Q IR Zero) by apply (inj_Q_nring IR 0). -apply inj_Q_leEq. -assumption. Qed. End Absolute. @@ -1242,16 +1295,17 @@ Fixpoint SeqBound0 (n : nat) : IR := | S m => Max (AbsIR (seq m)) (SeqBound0 m) end. -Lemma SeqBound0_greater : forall (m n : nat), +Lemma SeqBound0_greater : forall (m n : nat), m < n -> AbsIR (seq m) [<=] SeqBound0 n. -intros. -elim H. -simpl. apply lft_leEq_MAX. -intros. simpl. -apply leEq_transitive with (SeqBound0 m0); auto. -apply rht_leEq_MAX. -Qed. - +Proof. + intros. + elim H. + simpl. apply lft_leEq_MAX. + intros. simpl. + apply leEq_transitive with (SeqBound0 m0); auto. + apply rht_leEq_MAX. +Qed. + End SeqMax. Section Part_Function_Max. @@ -1274,12 +1328,13 @@ Let Q := Dom G. (* end hide *) Lemma part_function_Max_strext : forall x y (Hx : Conj P Q x) (Hy : Conj P Q y), - Max (F x (Prj1 Hx)) (G x (Prj2 Hx)) [#] Max (F y (Prj1 Hy)) (G y (Prj2 Hy)) -> + Max (F x (Prj1 Hx)) (G x (Prj2 Hx)) [#] Max (F y (Prj1 Hy)) (G y (Prj2 Hy)) -> x [#] y. -intros. rename X into H. -elim (cs_bin_op_strext _ _ _ _ _ _ H). -exact (pfstrx _ F _ _ _ _). -exact (pfstrx _ G _ _ _ _). +Proof. + intros. rename X into H. + elim (cs_bin_op_strext _ _ _ _ _ _ H). + exact (pfstrx _ F _ _ _ _). + exact (pfstrx _ G _ _ _ _). Qed. Definition FMax := Build_PartFunct IR _ (conj_wd (dom_wd _ _) (dom_wd _ _)) @@ -1300,16 +1355,18 @@ Definition FMin := {--} (FMax {--}F {--}G). Definition FAbs := FMax F {--}F. Lemma FMin_char : forall x Hx Hx' Hx'', FMin x Hx [=] Min (F x Hx') (G x Hx''). -intros. -Opaque Max. -simpl in |- *; unfold MIN; algebra. +Proof. + intros. + Opaque Max. + simpl in |- *; unfold MIN; algebra. Qed. Transparent Max. Lemma FAbs_char : forall x Hx Hx', FAbs x Hx [=] AbsIR (F x Hx'). -intros. -simpl in |- *; unfold ABSIR in |- *; apply MAX_wd; algebra. +Proof. + intros. + simpl in |- *; unfold ABSIR in |- *; apply MAX_wd; algebra. Qed. End Part_Function_Abs. @@ -1317,20 +1374,22 @@ End Part_Function_Abs. Hint Resolve FAbs_char: algebra. Lemma FAbs_char' : forall F x Hx, AbsIR (FAbs F x Hx) [=] AbsIR (F x (ProjIR1 Hx)). -intros. -eapply eq_transitive_unfolded. - apply AbsIR_eq_x. - 2: apply FAbs_char. -eapply leEq_wdr. - 2: apply eq_symmetric_unfolded; apply FAbs_char with (Hx' := ProjIR1 Hx). -apply AbsIR_nonneg. +Proof. + intros. + eapply eq_transitive_unfolded. + apply AbsIR_eq_x. + 2: apply FAbs_char. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply FAbs_char with (Hx' := ProjIR1 Hx). + apply AbsIR_nonneg. Qed. Lemma FAbs_nonneg : forall F x Hx, Zero [<=] FAbs F x Hx. -intros. -eapply leEq_wdr. - 2: apply eq_symmetric_unfolded; apply FAbs_char with (Hx' := ProjIR1 Hx). -apply AbsIR_nonneg. +Proof. + intros. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply FAbs_char with (Hx' := ProjIR1 Hx). + apply AbsIR_nonneg. Qed. Hint Resolve FAbs_char': algebra. @@ -1352,35 +1411,43 @@ Let Q := Dom G. Variable R : IR -> CProp. Lemma included_FMax : included R P -> included R Q -> included R (Dom (FMax F G)). -intros; simpl in |- *; apply included_conj; assumption. +Proof. + intros; simpl in |- *; apply included_conj; assumption. Qed. Lemma included_FMax' : included R (Dom (FMax F G)) -> included R P. -intro H; simpl in H; eapply included_conj_lft; apply H. +Proof. + intro H; simpl in H; eapply included_conj_lft; apply H. Qed. Lemma included_FMax'' : included R (Dom (FMax F G)) -> included R Q. -intro H; simpl in H; eapply included_conj_rht; apply H. +Proof. + intro H; simpl in H; eapply included_conj_rht; apply H. Qed. Lemma included_FMin : included R P -> included R Q -> included R (Dom (FMin F G)). -intros; simpl in |- *; apply included_conj; assumption. +Proof. + intros; simpl in |- *; apply included_conj; assumption. Qed. Lemma included_FMin' : included R (Dom (FMin F G)) -> included R P. -intro H; simpl in H; eapply included_conj_lft; apply H. +Proof. + intro H; simpl in H; eapply included_conj_lft; apply H. Qed. Lemma included_FMin'' : included R (Dom (FMin F G)) -> included R Q. -intro H; simpl in H; eapply included_conj_rht; apply H. +Proof. + intro H; simpl in H; eapply included_conj_rht; apply H. Qed. Lemma included_FAbs : included R P -> included R (Dom (FAbs F)). -intros; simpl in |- *; apply included_conj; assumption. +Proof. + intros; simpl in |- *; apply included_conj; assumption. Qed. Lemma included_FAbs' : included R (Dom (FAbs F)) -> included R P. -intro H; simpl in H; eapply included_conj_lft; apply H. +Proof. + intro H; simpl in H; eapply included_conj_lft; apply H. Qed. End Inclusion. diff --git a/reals/NRootIR.v b/reals/NRootIR.v index 95e169c09..5456b7ec1 100644 --- a/reals/NRootIR.v +++ b/reals/NRootIR.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing NRoot %\ensuremath{\sqrt[n]{\cdot}}% *) (** printing sqrt %\ensuremath{\sqrt{\cdot}}% *) @@ -61,42 +61,42 @@ Let p := _X_[^]n[-]_C_ c. (* end hide *) Lemma CnrootIR : {x : IR | Zero [<=] x | x[^]n [=] c}. -intros. -cut (monic n p). intro. -elim (Ccpoly_pos' _ p Zero n); auto. -intro X. intros H0 H1. -cut {x : IR | Zero [<=] x /\ x [<=] X /\ p ! x [=] Zero}. intro H2. -elim H2. clear H2. intro. intro H2. -elim H2. clear H2. intros H2 H3. elim H3. clear H3. intros. -exists x. auto. -apply cg_inv_unique_2. -astepl (_X_ ! x[^]n[-] (_C_ c) ! x). -astepl ((_X_[^]n) ! x[-] (_C_ c) ! x). -Step_final (_X_[^]n[-]_C_ c) ! x. - -apply Civt_poly; auto. -apply monic_apzero with n; auto. -unfold p in |- *. -astepl ((_X_[^]n) ! Zero[-] (_C_ c) ! Zero). -astepl (_X_ ! Zero[^]n[-]c). -astepl (Zero[^]n[-]c). -astepl (Zero[-]c). -astepl ( [--]c). -astepr ( [--]ZeroR). apply inv_resp_leEq. auto. -unfold p in |- *. -apply monic_minus with 0. -apply degree_le_c_. -pattern n at 1 in |- *. replace n with (1 * n). -apply monic_nexp. -apply monic_x_. -auto with arith. -auto. +Proof. + intros. + cut (monic n p). intro. + elim (Ccpoly_pos' _ p Zero n); auto. + intro X. intros H0 H1. + cut {x : IR | Zero [<=] x /\ x [<=] X /\ p ! x [=] Zero}. intro H2. + elim H2. clear H2. intro. intro H2. + elim H2. clear H2. intros H2 H3. elim H3. clear H3. intros. + exists x. auto. + apply cg_inv_unique_2. + astepl (_X_ ! x[^]n[-] (_C_ c) ! x). + astepl ((_X_[^]n) ! x[-] (_C_ c) ! x). + Step_final (_X_[^]n[-]_C_ c) ! x. + apply Civt_poly; auto. + apply monic_apzero with n; auto. + unfold p in |- *. + astepl ((_X_[^]n) ! Zero[-] (_C_ c) ! Zero). + astepl (_X_ ! Zero[^]n[-]c). + astepl (Zero[^]n[-]c). + astepl (Zero[-]c). + astepl ( [--]c). + astepr ( [--]ZeroR). apply inv_resp_leEq. auto. + unfold p in |- *. + apply monic_minus with 0. + apply degree_le_c_. + pattern n at 1 in |- *. replace n with (1 * n). + apply monic_nexp. + apply monic_x_. + auto with arith. + auto. Qed. End NRoot. -(** We define the root of order [n] for any nonnegative real number and -prove its main properties: +(** We define the root of order [n] for any nonnegative real number and +prove its main properties: - $\left(\sqrt[n]x\right)^n=x$#(sqrt(n) x)^n =x#; - $0\leq\sqrt[n]x$#0≤sqrt(n)x#; - if [Zero [<] x] then $0<\sqrt[n]x$#0<sqrt(n)x#; @@ -110,76 +110,84 @@ prove its main properties: Section Nth_Root. Lemma nroot : forall x k, Zero [<=] x -> 0 < k -> {y : IR | Zero [<=] y | y[^]k [=] x}. -intros. -elim (CnrootIR k H0 x H). intro y. intros. -exists y; auto. +Proof. + intros. + elim (CnrootIR k H0 x H). intro y. intros. + exists y; auto. Qed. Definition NRoot x n Hx Hn : IR := proj1_sig2T _ _ _ (nroot x n Hx Hn). Lemma NRoot_power : forall x k Hx Hk, NRoot x k Hx Hk[^]k [=] x. -intros. -unfold NRoot in |- *. -apply proj2b_sig2T. +Proof. + intros. + unfold NRoot in |- *. + apply proj2b_sig2T. Qed. Hint Resolve NRoot_power: algebra. Lemma NRoot_nonneg : forall x k Hx Hk, Zero [<=] NRoot x k Hx Hk. -intros. -unfold NRoot in |- *. -apply proj2a_sig2T. +Proof. + intros. + unfold NRoot in |- *. + apply proj2a_sig2T. Qed. Lemma NRoot_pos : forall x Hx k Hk, Zero [<] x -> Zero [<] NRoot x k Hx Hk. -intros. rename X into H. -cut (Zero [<=] NRoot x k Hx Hk); intros. -cut (NRoot x k Hx Hk [<] Zero or Zero [<] NRoot x k Hx Hk). intros H1. -elim H1; clear H1; intro H1. -rewrite -> leEq_def in H0; elim (H0 H1). -auto. -apply ap_imp_less. -apply un_op_strext_unfolded with (nexp_op (R:=IR) k). -astepl x; astepr ZeroR. -apply pos_ap_zero; auto. -apply NRoot_nonneg. +Proof. + intros. rename X into H. + cut (Zero [<=] NRoot x k Hx Hk); intros. + cut (NRoot x k Hx Hk [<] Zero or Zero [<] NRoot x k Hx Hk). intros H1. + elim H1; clear H1; intro H1. + rewrite -> leEq_def in H0; elim (H0 H1). + auto. + apply ap_imp_less. + apply un_op_strext_unfolded with (nexp_op (R:=IR) k). + astepl x; astepr ZeroR. + apply pos_ap_zero; auto. + apply NRoot_nonneg. Qed. Lemma NRoot_power' : forall x k Hx' Hk, Zero [<=] x -> NRoot (x[^]k) k Hx' Hk [=] x. -intros. -apply root_unique with k; auto. -apply NRoot_nonneg. -apply NRoot_power. +Proof. + intros. + apply root_unique with k; auto. + apply NRoot_nonneg. + apply NRoot_power. Qed. Lemma NRoot_pres_less : forall x Hx y Hy k Hk, x [<] y -> NRoot x k Hx Hk [<] NRoot y k Hy Hk. -intros. -apply power_cancel_less with k. -apply NRoot_nonneg. -eapply less_wdl. -2: apply eq_symmetric_unfolded; apply NRoot_power. -eapply less_wdr. -2: apply eq_symmetric_unfolded; apply NRoot_power. -auto. +Proof. + intros. + apply power_cancel_less with k. + apply NRoot_nonneg. + eapply less_wdl. + 2: apply eq_symmetric_unfolded; apply NRoot_power. + eapply less_wdr. + 2: apply eq_symmetric_unfolded; apply NRoot_power. + auto. Qed. Lemma NRoot_less_one : forall x Hx k Hk, x [<] One -> NRoot x k Hx Hk [<] One. -intros. -apply power_cancel_less with k. -apply less_leEq; apply pos_one. -eapply less_wdl. -2: apply eq_symmetric_unfolded; apply NRoot_power. -astepr OneR. -assumption. +Proof. + intros. + apply power_cancel_less with k. + apply less_leEq; apply pos_one. + eapply less_wdl. + 2: apply eq_symmetric_unfolded; apply NRoot_power. + astepr OneR. + assumption. Qed. Lemma NRoot_cancel : forall x Hx y Hy k Hk, NRoot x k Hx Hk [=] NRoot y k Hy Hk -> x [=] y. -intros. -apply eq_transitive_unfolded with (NRoot x k Hx Hk[^]k). -apply eq_symmetric_unfolded; apply NRoot_power. -apply eq_transitive_unfolded with (NRoot y k Hy Hk[^]k). -2: apply NRoot_power. -apply nexp_wd; algebra. +Proof. + intros. + apply eq_transitive_unfolded with (NRoot x k Hx Hk[^]k). + apply eq_symmetric_unfolded; apply NRoot_power. + apply eq_transitive_unfolded with (NRoot y k Hy Hk[^]k). + 2: apply NRoot_power. + apply nexp_wd; algebra. Qed. (** %\begin{convention}% Let [x,y] be nonnegative real numbers. @@ -190,24 +198,26 @@ Hypothesis Hx : Zero [<=] x. Hypothesis Hy : Zero [<=] y. Lemma NRoot_wd : forall k Hk Hk', x [=] y -> NRoot x k Hx Hk [=] NRoot y k Hy Hk'. -intros. -apply root_unique with k; auto. -apply NRoot_nonneg. -apply NRoot_nonneg. -eapply eq_transitive_unfolded. -eapply eq_transitive_unfolded. -2: apply H. -apply NRoot_power. -apply eq_symmetric_unfolded; apply NRoot_power. +Proof. + intros. + apply root_unique with k; auto. + apply NRoot_nonneg. + apply NRoot_nonneg. + eapply eq_transitive_unfolded. + eapply eq_transitive_unfolded. + 2: apply H. + apply NRoot_power. + apply eq_symmetric_unfolded; apply NRoot_power. Qed. Lemma NRoot_unique : forall k Hk, Zero [<] x -> x[^]k [=] y -> x [=] NRoot y k Hy Hk. -intros. rename H into H0. -apply root_unique with k; auto. -apply NRoot_nonneg. -eapply eq_transitive_unfolded. -apply H0. -apply eq_symmetric_unfolded; apply NRoot_power. +Proof. + intros. rename H into H0. + apply root_unique with k; auto. + apply NRoot_nonneg. + eapply eq_transitive_unfolded. + apply H0. + apply eq_symmetric_unfolded; apply NRoot_power. Qed. End Nth_Root. @@ -218,46 +228,47 @@ Hint Resolve NRoot_power NRoot_power': algebra. Lemma NRoot_resp_leEq : forall x y xpos ypos k kpos, x [<=] y -> NRoot (x:=x) (n:=k) xpos kpos [<=] NRoot (x:=y) (n:=k) ypos kpos. -intros. -rewrite leEq_def; intro H0. -assert (NRoot ypos kpos[^]k [<=] NRoot xpos kpos[^]k). -apply power_resp_leEq. - apply NRoot_nonneg. -apply less_leEq; auto. - -assert (x [=] y). -apply leEq_imp_eq; auto. -eapply leEq_wdl. - eapply leEq_wdr. - eexact H1. - algebra. -algebra. - -clear H H1. -generalize (NRoot_wd _ _ xpos ypos k kpos kpos H2). -intro. -apply (less_irreflexive_unfolded _ (NRoot ypos kpos)). -astepr (NRoot xpos kpos). -auto. +Proof. + intros. + rewrite leEq_def; intro H0. + assert (NRoot ypos kpos[^]k [<=] NRoot xpos kpos[^]k). + apply power_resp_leEq. + apply NRoot_nonneg. + apply less_leEq; auto. + assert (x [=] y). + apply leEq_imp_eq; auto. + eapply leEq_wdl. + eapply leEq_wdr. + eexact H1. + algebra. + algebra. + clear H H1. + generalize (NRoot_wd _ _ xpos ypos k kpos kpos H2). + intro. + apply (less_irreflexive_unfolded _ (NRoot ypos kpos)). + astepr (NRoot xpos kpos). + auto. Qed. Lemma NRoot_cancel_less : forall x (Hx:Zero[<=]x) y (Hy:Zero[<=]y) k (Hk Hk':0 x [<] y. -intros x Hx y Hy k Hk Hk' H. -astepl (NRoot Hx Hk[^]k). -astepr (NRoot Hy Hk'[^]k). -apply nexp_resp_less. - auto with *. - apply NRoot_nonneg. -assumption. +Proof. + intros x Hx y Hy k Hk Hk' H. + astepl (NRoot Hx Hk[^]k). + astepr (NRoot Hy Hk'[^]k). + apply nexp_resp_less. + auto with *. + apply NRoot_nonneg. + assumption. Qed. Lemma NRoot_str_ext : forall k (Hk Hk':0 < k) x y (Hx:Zero[<=]x) (Hy:Zero[<=]y), NRoot Hx Hk [#] NRoot Hy Hk' -> x[#]y. -intros k Hk Hk' x y Hx Hy H0. -destruct (ap_imp_less _ _ _ H0) as [H1|H1]. - apply less_imp_ap. +Proof. + intros k Hk Hk' x y Hx Hy H0. + destruct (ap_imp_less _ _ _ H0) as [H1|H1]. + apply less_imp_ap. + refine (NRoot_cancel_less _ _ _ _ _ _ _ H1). + apply Greater_imp_ap. refine (NRoot_cancel_less _ _ _ _ _ _ _ H1). -apply Greater_imp_ap. -refine (NRoot_cancel_less _ _ _ _ _ _ _ H1). Qed. (*---------------------------------*) @@ -270,91 +281,102 @@ Section Square_root. Definition sqrt x xpos : IR := NRoot (x:=x) (n:=2) xpos (lt_O_Sn 1). Lemma sqrt_sqr : forall x xpos, sqrt x xpos[^]2 [=] x. -intros. -unfold sqrt in |- *. -apply NRoot_power. +Proof. + intros. + unfold sqrt in |- *. + apply NRoot_power. Qed. Hint Resolve sqrt_sqr: algebra. Lemma sqrt_nonneg : forall x xpos, Zero [<=] sqrt x xpos. -intros. -unfold sqrt in |- *. -apply NRoot_nonneg. +Proof. + intros. + unfold sqrt in |- *. + apply NRoot_nonneg. Qed. Lemma sqrt_wd : forall x y xpos ypos, x [=] y -> sqrt x xpos [=] sqrt y ypos. -intros. -unfold sqrt in |- *. -apply NRoot_wd. -auto. +Proof. + intros. + unfold sqrt in |- *. + apply NRoot_wd. + auto. Qed. Hint Resolve sqrt_wd: algebra_c. Lemma sqrt_to_nonneg : forall x, Zero [<=] x -> forall x2pos, sqrt (x[^]2) x2pos [=] x. -intros. -apply root_unique with 2. -apply sqrt_nonneg. auto. auto. -Step_final (x[^]2). +Proof. + intros. + apply root_unique with 2. + apply sqrt_nonneg. auto. auto. + Step_final (x[^]2). Qed. Lemma sqrt_to_nonpos : forall x, x [<=] Zero -> forall x2pos, sqrt (x[^]2) x2pos [=] [--]x. -intros. -apply root_unique with 2. -apply sqrt_nonneg. -astepl ( [--]ZeroR). apply inv_resp_leEq. auto. -auto. -astepl (x[^]2). rational. +Proof. + intros. + apply root_unique with 2. + apply sqrt_nonneg. + astepl ( [--]ZeroR). apply inv_resp_leEq. auto. + auto. + astepl (x[^]2). rational. Qed. Lemma sqrt_mult : forall x y xpos ypos xypos, sqrt (x[*]y) xypos [=] sqrt x xpos[*]sqrt y ypos. -intros. -apply root_unique with 2. -apply sqrt_nonneg. -apply mult_resp_nonneg; apply sqrt_nonneg. -auto. -astepl (x[*]y). -astepl (sqrt x xpos[^]2[*]sqrt y ypos[^]2). -rational. +Proof. + intros. + apply root_unique with 2. + apply sqrt_nonneg. + apply mult_resp_nonneg; apply sqrt_nonneg. + auto. + astepl (x[*]y). + astepl (sqrt x xpos[^]2[*]sqrt y ypos[^]2). + rational. Qed. Hint Resolve sqrt_mult: algebra. Lemma sqrt_mult_wd : forall x y z xpos ypos zpos, z [=] x[*]y -> sqrt z zpos [=] sqrt x xpos[*]sqrt y ypos. -intros. -cut (Zero [<=] x[*]y). intro. -Step_final (sqrt (x[*]y) H0). -apply mult_resp_nonneg; auto. +Proof. + intros. + cut (Zero [<=] x[*]y). intro. + Step_final (sqrt (x[*]y) H0). + apply mult_resp_nonneg; auto. Qed. Lemma sqrt_less : forall x y ypos, x[^]2 [<] y -> x [<] sqrt y ypos. -intros. -apply power_cancel_less with 2. -apply sqrt_nonneg. -astepr y. auto. +Proof. + intros. + apply power_cancel_less with 2. + apply sqrt_nonneg. + astepr y. auto. Qed. Lemma sqrt_less' : forall x y ypos, x[^]2 [<] y -> [--]x [<] sqrt y ypos. -intros. -apply power_cancel_less with 2. -apply sqrt_nonneg. -rstepl (x[^]2). astepr y. auto. +Proof. + intros. + apply power_cancel_less with 2. + apply sqrt_nonneg. + rstepl (x[^]2). astepr y. auto. Qed. Lemma sqrt_resp_leEq : forall x y xpos ypos, x [<=] y -> sqrt x xpos [<=] sqrt y ypos. -intros. -unfold sqrt in |- *. -apply NRoot_resp_leEq. -auto. +Proof. + intros. + unfold sqrt in |- *. + apply NRoot_resp_leEq. + auto. Qed. Lemma sqrt_resp_less : forall x y xpos ypos, x [<] y -> sqrt x xpos [<] sqrt y ypos. -intros. -unfold sqrt in |- *. -apply NRoot_pres_less. -auto. +Proof. + intros. + unfold sqrt in |- *. + apply NRoot_pres_less. + auto. Qed. End Square_root. @@ -368,305 +390,318 @@ Section Absolute_Props. (** ** More on absolute value -With the help of square roots, we can prove some more properties of absolute +With the help of square roots, we can prove some more properties of absolute values in [IR]. *) Lemma AbsIR_sqrt_sqr : forall x x2pos, AbsIR x [=] sqrt (x[^]2) x2pos. -intros x xxpos. unfold AbsIR in |- *. simpl in |- *. unfold ABSIR in |- *. -apply equiv_imp_eq_max; intros. -apply power_cancel_leEq with 2. -auto. -apply mult_cancel_leEq with (Two:IR). apply pos_two. -rstepl (x[+][--]x). -rstepr (y[+]y). -apply plus_resp_leEq_both; auto. -astepl (One[*]x[*]x). -rstepl (x[^]2[+]Zero). -apply shift_plus_leEq'. -rstepr ((y[-]x) [*] (y[-][--]x)). -apply mult_resp_nonneg. -apply shift_zero_leEq_minus. auto. -apply shift_zero_leEq_minus. auto. -apply leEq_transitive with (sqrt (x[^]2) xxpos). -apply power_cancel_leEq with 2. auto. -apply sqrt_nonneg. -astepr (x[^]2). -apply leEq_reflexive. -auto. -apply leEq_transitive with (sqrt (x[^]2) xxpos). -apply power_cancel_leEq with 2. auto. -apply sqrt_nonneg. -astepr (x[^]2). -rstepl (x[^]2). -apply leEq_reflexive. -auto. +Proof. + intros x xxpos. unfold AbsIR in |- *. simpl in |- *. unfold ABSIR in |- *. + apply equiv_imp_eq_max; intros. + apply power_cancel_leEq with 2. + auto. + apply mult_cancel_leEq with (Two:IR). apply pos_two. + rstepl (x[+][--]x). + rstepr (y[+]y). + apply plus_resp_leEq_both; auto. + astepl (One[*]x[*]x). + rstepl (x[^]2[+]Zero). + apply shift_plus_leEq'. + rstepr ((y[-]x) [*] (y[-][--]x)). + apply mult_resp_nonneg. + apply shift_zero_leEq_minus. auto. + apply shift_zero_leEq_minus. auto. + apply leEq_transitive with (sqrt (x[^]2) xxpos). + apply power_cancel_leEq with 2. auto. + apply sqrt_nonneg. + astepr (x[^]2). + apply leEq_reflexive. + auto. + apply leEq_transitive with (sqrt (x[^]2) xxpos). + apply power_cancel_leEq with 2. auto. + apply sqrt_nonneg. + astepr (x[^]2). + rstepl (x[^]2). + apply leEq_reflexive. + auto. Qed. Hint Resolve AbsIR_sqrt_sqr: algebra. Lemma AbsIR_resp_mult : forall x y, AbsIR (x[*]y) [=] AbsIR x[*]AbsIR y. -intros. -astepl (sqrt ((x[*]y) [^]2) (sqr_nonneg _ (x[*]y))). -cut (Zero [<=] x[^]2[*]y[^]2). intro. -astepl (sqrt (x[^]2[*]y[^]2) H). -Step_final (sqrt (x[^]2) (sqr_nonneg _ x) [*]sqrt (y[^]2) (sqr_nonneg _ y)). -apply mult_resp_nonneg; apply sqr_nonneg. +Proof. + intros. + astepl (sqrt ((x[*]y) [^]2) (sqr_nonneg _ (x[*]y))). + cut (Zero [<=] x[^]2[*]y[^]2). intro. + astepl (sqrt (x[^]2[*]y[^]2) H). + Step_final (sqrt (x[^]2) (sqr_nonneg _ x) [*]sqrt (y[^]2) (sqr_nonneg _ y)). + apply mult_resp_nonneg; apply sqr_nonneg. Qed. Lemma AbsIR_mult_pos : forall x y, Zero [<=] y -> AbsIR (x[*]y) [=] AbsIR x[*]y. -intros. -apply eq_transitive_unfolded with (AbsIR x[*]AbsIR y). -apply AbsIR_resp_mult. -apply bin_op_wd_unfolded. -algebra. -unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. -apply eq_transitive_unfolded with (Max [--]y y). -apply Max_comm. -apply leEq_imp_Max_is_rht. -apply leEq_transitive with ZeroR. -astepr ( [--]ZeroR). -apply inv_resp_leEq; assumption. -assumption. +Proof. + intros. + apply eq_transitive_unfolded with (AbsIR x[*]AbsIR y). + apply AbsIR_resp_mult. + apply bin_op_wd_unfolded. + algebra. + unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. + apply eq_transitive_unfolded with (Max [--]y y). + apply Max_comm. + apply leEq_imp_Max_is_rht. + apply leEq_transitive with ZeroR. + astepr ( [--]ZeroR). + apply inv_resp_leEq; assumption. + assumption. Qed. Lemma AbsIR_mult_pos' : forall x y, Zero [<=] x -> AbsIR (x[*]y) [=] x[*]AbsIR y. -intros. -astepl (AbsIR (y[*]x)). -eapply eq_transitive_unfolded. -apply AbsIR_mult_pos; auto. -algebra. +Proof. + intros. + astepl (AbsIR (y[*]x)). + eapply eq_transitive_unfolded. + apply AbsIR_mult_pos; auto. + algebra. Qed. Lemma AbsIR_nexp : forall x n, AbsIR (nexp _ n x) [=] nexp _ n (AbsIR x). -intros. -induction n as [| n Hrecn]. -simpl in |- *; apply AbsIR_eq_x; apply less_leEq; apply pos_one. -simpl in |- *. -eapply eq_transitive_unfolded. -apply AbsIR_resp_mult. -algebra. +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *; apply AbsIR_eq_x; apply less_leEq; apply pos_one. + simpl in |- *. + eapply eq_transitive_unfolded. + apply AbsIR_resp_mult. + algebra. Qed. Lemma AbsIR_nexp_op : forall n x, AbsIR (x[^]n) [=] AbsIR x[^]n. -intros; simpl in |- *; apply AbsIR_nexp. +Proof. + intros; simpl in |- *; apply AbsIR_nexp. Qed. Lemma AbsIR_less_square : forall x y, AbsIR x [<] y -> x[^]2 [<] y[^]2. -intros. -eapply less_wdl. -2: apply AbsIR_eq_x; apply sqr_nonneg. -eapply less_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_nexp_op. -apply nexp_resp_less; auto. -apply AbsIR_nonneg. +Proof. + intros. + eapply less_wdl. + 2: apply AbsIR_eq_x; apply sqr_nonneg. + eapply less_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_nexp_op. + apply nexp_resp_less; auto. + apply AbsIR_nonneg. Qed. Lemma AbsIR_leEq_square : forall x y, AbsIR x [<=] y -> x[^]2 [<=] y[^]2. -intros. -eapply leEq_wdl. -2: apply AbsIR_eq_x; apply sqr_nonneg. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_nexp_op. -apply nexp_resp_leEq; auto. -apply AbsIR_nonneg. +Proof. + intros. + eapply leEq_wdl. + 2: apply AbsIR_eq_x; apply sqr_nonneg. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_nexp_op. + apply nexp_resp_leEq; auto. + apply AbsIR_nonneg. Qed. Lemma AbsIR_division : forall x y y_ y__, AbsIR (x[/] y[//]y_) [=] (AbsIR x[/] AbsIR y[//]y__). -intros x y H Hy. -rstepr (AbsIR x[*] (One[/] AbsIR y[//]Hy)). -apply eq_transitive_unfolded with (AbsIR (x[*] (One[/] y[//]H))). -apply un_op_wd_unfolded; rational. -apply eq_transitive_unfolded with (AbsIR x[*]AbsIR (One[/] y[//]H)). -apply AbsIR_resp_mult. -apply mult_wdr. -cut (y [<] Zero or Zero [<] y). -intros H0. -elim H0. -intros. -apply eq_transitive_unfolded with ( [--] (One[/] y[//]H)). -apply AbsIR_eq_inv_x. -rstepr (Zero[/] [--]y[//]inv_resp_ap_zero _ _ H). -apply shift_leEq_div. -astepl ( [--]ZeroR). -apply inv_resp_less; assumption. -rstepl ( [--]OneR). -astepr ( [--]ZeroR); apply inv_resp_leEq; apply less_leEq; apply pos_one. -rstepl (One[/] [--]y[//]inv_resp_ap_zero _ _ H). -apply div_wd. -algebra. -apply eq_symmetric_unfolded; apply AbsIR_eq_inv_x. -apply less_leEq; assumption. -intros. -apply eq_transitive_unfolded with (One[/] y[//]H). -apply AbsIR_eq_x. -apply less_leEq; apply recip_resp_pos; assumption. -apply div_wd; - [ algebra - | apply eq_symmetric_unfolded; apply AbsIR_eq_x; apply less_leEq; assumption ]. -apply ap_imp_less. -assumption. +Proof. + intros x y H Hy. + rstepr (AbsIR x[*] (One[/] AbsIR y[//]Hy)). + apply eq_transitive_unfolded with (AbsIR (x[*] (One[/] y[//]H))). + apply un_op_wd_unfolded; rational. + apply eq_transitive_unfolded with (AbsIR x[*]AbsIR (One[/] y[//]H)). + apply AbsIR_resp_mult. + apply mult_wdr. + cut (y [<] Zero or Zero [<] y). + intros H0. + elim H0. + intros. + apply eq_transitive_unfolded with ( [--] (One[/] y[//]H)). + apply AbsIR_eq_inv_x. + rstepr (Zero[/] [--]y[//]inv_resp_ap_zero _ _ H). + apply shift_leEq_div. + astepl ( [--]ZeroR). + apply inv_resp_less; assumption. + rstepl ( [--]OneR). + astepr ( [--]ZeroR); apply inv_resp_leEq; apply less_leEq; apply pos_one. + rstepl (One[/] [--]y[//]inv_resp_ap_zero _ _ H). + apply div_wd. + algebra. + apply eq_symmetric_unfolded; apply AbsIR_eq_inv_x. + apply less_leEq; assumption. + intros. + apply eq_transitive_unfolded with (One[/] y[//]H). + apply AbsIR_eq_x. + apply less_leEq; apply recip_resp_pos; assumption. + apply div_wd; [ algebra + | apply eq_symmetric_unfolded; apply AbsIR_eq_x; apply less_leEq; assumption ]. + apply ap_imp_less. + assumption. Qed. (** Some special cases. *) Lemma AbsIR_recip : forall x x_ x__, AbsIR (One[/] x[//]x_) [=] (One[/] AbsIR x[//]x__). -intros x H Ha. -apply eq_transitive_unfolded with (AbsIR One[/] AbsIR x[//]Ha). -apply AbsIR_division. -apply div_wd. -2: algebra. -apply AbsIR_eq_x; apply less_leEq; apply pos_one. +Proof. + intros x H Ha. + apply eq_transitive_unfolded with (AbsIR One[/] AbsIR x[//]Ha). + apply AbsIR_division. + apply div_wd. + 2: algebra. + apply AbsIR_eq_x; apply less_leEq; apply pos_one. Qed. Lemma AbsIR_div_two : forall x, AbsIR (x [/]TwoNZ) [=] AbsIR x [/]TwoNZ. -intros. -apply - eq_transitive_unfolded - with - (AbsIR x[/] AbsIR Two[//] - AbsIR_resp_ap_zero _ - (ap_symmetric_unfolded _ _ _ (less_imp_ap _ _ _ (pos_two _)))). -apply AbsIR_division. -apply div_wd. -algebra. -apply AbsIR_eq_x; apply less_leEq; apply pos_two. +Proof. + intros. + apply eq_transitive_unfolded with (AbsIR x[/] AbsIR Two[//] AbsIR_resp_ap_zero _ + (ap_symmetric_unfolded _ _ _ (less_imp_ap _ _ _ (pos_two _)))). + apply AbsIR_division. + apply div_wd. + algebra. + apply AbsIR_eq_x; apply less_leEq; apply pos_two. Qed. (** Cauchy-Schwartz for IR and variants on that subject. *) Lemma triangle_IR : forall x y, AbsIR (x[+]y) [<=] AbsIR x[+]AbsIR y. -intros. -astepl (sqrt ((x[+]y) [^]2) (sqr_nonneg _ (x[+]y))). -astepr (sqrt (x[^]2) (sqr_nonneg _ x) [+]sqrt (y[^]2) (sqr_nonneg _ y)). -apply power_cancel_leEq with 2. auto. -astepl (Zero[+]ZeroR). apply plus_resp_leEq_both; apply sqrt_nonneg. -astepl ((x[+]y) [^]2). -rstepl (x[^]2[+]y[^]2[+]Two[*] (x[*]y)). -rstepr - (sqrt (x[^]2) (sqr_nonneg IR x) [^]2[+]sqrt (y[^]2) (sqr_nonneg IR y) [^]2[+] - Two[*] (sqrt (x[^]2) (sqr_nonneg IR x) [*]sqrt (y[^]2) (sqr_nonneg IR y))). -apply plus_resp_leEq_both. -astepr (x[^]2[+]y[^]2). apply leEq_reflexive. -apply mult_resp_leEq_lft. -apply power_cancel_leEq with 2. auto. -apply mult_resp_nonneg; apply sqrt_nonneg. -rstepr - (sqrt (x[^]2) (sqr_nonneg _ x) [^]2[*]sqrt (y[^]2) (sqr_nonneg _ y) [^]2). -astepr (x[^]2[*]y[^]2). -astepl (x[^]2[*]y[^]2). -apply leEq_reflexive. -apply less_leEq. apply pos_two. +Proof. + intros. + astepl (sqrt ((x[+]y) [^]2) (sqr_nonneg _ (x[+]y))). + astepr (sqrt (x[^]2) (sqr_nonneg _ x) [+]sqrt (y[^]2) (sqr_nonneg _ y)). + apply power_cancel_leEq with 2. auto. + astepl (Zero[+]ZeroR). apply plus_resp_leEq_both; apply sqrt_nonneg. + astepl ((x[+]y) [^]2). + rstepl (x[^]2[+]y[^]2[+]Two[*] (x[*]y)). + rstepr (sqrt (x[^]2) (sqr_nonneg IR x) [^]2[+]sqrt (y[^]2) (sqr_nonneg IR y) [^]2[+] + Two[*] (sqrt (x[^]2) (sqr_nonneg IR x) [*]sqrt (y[^]2) (sqr_nonneg IR y))). + apply plus_resp_leEq_both. + astepr (x[^]2[+]y[^]2). apply leEq_reflexive. + apply mult_resp_leEq_lft. + apply power_cancel_leEq with 2. auto. + apply mult_resp_nonneg; apply sqrt_nonneg. + rstepr (sqrt (x[^]2) (sqr_nonneg _ x) [^]2[*]sqrt (y[^]2) (sqr_nonneg _ y) [^]2). + astepr (x[^]2[*]y[^]2). + astepl (x[^]2[*]y[^]2). + apply leEq_reflexive. + apply less_leEq. apply pos_two. Qed. Lemma triangle_SumIR : forall k l s, k <= S l -> AbsIR (Sum k l s) [<=] Sum k l (fun i => AbsIR (s i)). -intros. induction l as [| l Hrecl]. -generalize (toCle _ _ H); clear H; intro H. -inversion H as [|m H0 H1]. -unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. -rstepr ZeroR. -astepr (AbsIR Zero). -apply eq_imp_leEq. apply AbsIR_wd. rational. -inversion H0. -unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. -rstepr (ABSIR (s 0)). -apply eq_imp_leEq. apply AbsIR_wd. rational. -elim (le_lt_eq_dec k (S (S l))); try intro y. -apply leEq_wdl with (AbsIR (Sum k l s[+]s (S l))). -apply leEq_wdr with (Sum k l (fun i : nat => AbsIR (s i)) [+]AbsIR (s (S l))). -apply leEq_transitive with (AbsIR (Sum k l s) [+]AbsIR (s (S l))). -apply triangle_IR. -apply plus_resp_leEq. apply Hrecl. auto with arith. -apply eq_symmetric_unfolded. -apply Sum_last with (f := fun i : nat => AbsIR (s i)). -apply AbsIR_wd. -apply eq_symmetric_unfolded. apply Sum_last. -rewrite y. -unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. -rstepr ZeroR. -astepr (AbsIR Zero). -apply eq_imp_leEq. apply AbsIR_wd. rational. -auto. +Proof. + intros. induction l as [| l Hrecl]. + generalize (toCle _ _ H); clear H; intro H. + inversion H as [|m H0 H1]. + unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. + rstepr ZeroR. + astepr (AbsIR Zero). + apply eq_imp_leEq. apply AbsIR_wd. rational. + inversion H0. + unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. + rstepr (ABSIR (s 0)). + apply eq_imp_leEq. apply AbsIR_wd. rational. + elim (le_lt_eq_dec k (S (S l))); try intro y. + apply leEq_wdl with (AbsIR (Sum k l s[+]s (S l))). + apply leEq_wdr with (Sum k l (fun i : nat => AbsIR (s i)) [+]AbsIR (s (S l))). + apply leEq_transitive with (AbsIR (Sum k l s) [+]AbsIR (s (S l))). + apply triangle_IR. + apply plus_resp_leEq. apply Hrecl. auto with arith. + apply eq_symmetric_unfolded. + apply Sum_last with (f := fun i : nat => AbsIR (s i)). + apply AbsIR_wd. + apply eq_symmetric_unfolded. apply Sum_last. + rewrite y. + unfold Sum in |- *. unfold Sum1 in |- *. simpl in |- *. + rstepr ZeroR. + astepr (AbsIR Zero). + apply eq_imp_leEq. apply AbsIR_wd. rational. + auto. Qed. Lemma triangle_IR_minus : forall x y, AbsIR (x[-]y) [<=] AbsIR x[+]AbsIR y. -intros. -unfold cg_minus in |- *. -apply leEq_wdr with (AbsIR x[+]AbsIR [--]y). -apply triangle_IR. -apply bin_op_wd_unfolded. -algebra. -unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. -apply eq_transitive_unfolded with (Max [--]y y). -apply bin_op_wd_unfolded; algebra. -apply Max_comm. +Proof. + intros. + unfold cg_minus in |- *. + apply leEq_wdr with (AbsIR x[+]AbsIR [--]y). + apply triangle_IR. + apply bin_op_wd_unfolded. + algebra. + unfold AbsIR in |- *; simpl in |- *; unfold ABSIR in |- *. + apply eq_transitive_unfolded with (Max [--]y y). + apply bin_op_wd_unfolded; algebra. + apply Max_comm. Qed. Lemma weird_triangleIR : forall x y, AbsIR x[-]AbsIR (y[-]x) [<=] AbsIR y. -intros. -apply shift_minus_leEq. -simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. -rstepl (y[+][--] (y[-]x)). -apply plus_resp_leEq_both; [ apply lft_leEq_Max | apply rht_leEq_Max ]. -rstepl ( [--]y[+] (y[-]x)). -apply plus_resp_leEq_both; [ apply rht_leEq_Max | apply lft_leEq_Max ]. +Proof. + intros. + apply shift_minus_leEq. + simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. + rstepl (y[+][--] (y[-]x)). + apply plus_resp_leEq_both; [ apply lft_leEq_Max | apply rht_leEq_Max ]. + rstepl ( [--]y[+] (y[-]x)). + apply plus_resp_leEq_both; [ apply rht_leEq_Max | apply lft_leEq_Max ]. Qed. Lemma triangle_IR_minus' : forall x y, AbsIR x[-]AbsIR y [<=] AbsIR (x[-]y). -intros. -eapply leEq_wdr. -2: apply AbsIR_minus. -apply shift_minus_leEq; apply shift_leEq_plus'. -apply weird_triangleIR. +Proof. + intros. + eapply leEq_wdr. + 2: apply AbsIR_minus. + apply shift_minus_leEq; apply shift_leEq_plus'. + apply weird_triangleIR. Qed. Lemma triangle_SumxIR : forall n (f : forall i, i < n -> IR), AbsIR (Sumx f) [<=] Sumx (fun i H => AbsIR (f i H)). -simple induction n. -intros; simpl in |- *. -apply eq_imp_leEq; apply AbsIRz_isz. -clear n; intros. -simpl in |- *; eapply leEq_transitive. -apply triangle_IR. -apply plus_resp_leEq. -eapply leEq_wdr. -apply H. -apply Sumx_wd. -intros; algebra. +Proof. + simple induction n. + intros; simpl in |- *. + apply eq_imp_leEq; apply AbsIRz_isz. + clear n; intros. + simpl in |- *; eapply leEq_transitive. + apply triangle_IR. + apply plus_resp_leEq. + eapply leEq_wdr. + apply H. + apply Sumx_wd. + intros; algebra. Qed. Lemma triangle_Sum2IR : forall m n (f : forall i, m <= i -> i <= n -> IR), m <= S n -> AbsIR (Sum2 f) [<=] Sum2 (fun i Hm Hn => AbsIR (f i Hm Hn)). -intros. -unfold Sum2 in |- *. -eapply leEq_wdr. -apply triangle_SumIR. -assumption. -apply Sum_wd'. -assumption. -intros. -elim (le_lt_dec m i); intro; - [ simpl in |- * | elimtype False; apply (le_not_lt m i); auto with arith ]. -elim (le_lt_dec i n); intro; - [ simpl in |- * | elimtype False; apply (le_not_lt i n); auto with arith ]. -algebra. +Proof. + intros. + unfold Sum2 in |- *. + eapply leEq_wdr. + apply triangle_SumIR. + assumption. + apply Sum_wd'. + assumption. + intros. + elim (le_lt_dec m i); intro; + [ simpl in |- * | elimtype False; apply (le_not_lt m i); auto with arith ]. + elim (le_lt_dec i n); intro; + [ simpl in |- * | elimtype False; apply (le_not_lt i n); auto with arith ]. + algebra. Qed. Lemma AbsIR_str_bnd_AbsIR : forall a b e, AbsIR (a[-]b) [<] e -> AbsIR b [<] AbsIR a[+]e. -do 3 intro. intro H. -apply shift_less_plus'. -eapply leEq_less_trans. -apply triangle_IR_minus'. -eapply less_wdl; [ apply H | apply AbsIR_minus ]. +Proof. + do 3 intro. intro H. + apply shift_less_plus'. + eapply leEq_less_trans. + apply triangle_IR_minus'. + eapply less_wdl; [ apply H | apply AbsIR_minus ]. Qed. Lemma AbsIR_bnd_AbsIR : forall a b e, AbsIR (a[-]b) [<=] e -> AbsIR b [<=] AbsIR a[+]e. -intros. -apply shift_leEq_plus'. -eapply leEq_transitive. -apply triangle_IR_minus'. -eapply leEq_wdl; [ apply H | apply AbsIR_minus ]. +Proof. + intros. + apply shift_leEq_plus'. + eapply leEq_transitive. + apply triangle_IR_minus'. + eapply leEq_wdl; [ apply H | apply AbsIR_minus ]. Qed. End Absolute_Props. @@ -676,106 +711,96 @@ Section Consequences. (** ** Cauchy sequences -With these results, we can also prove that the sequence of reciprocals of a -Cauchy sequence that is never zero and whose Limit is not zero is also a +With these results, we can also prove that the sequence of reciprocals of a +Cauchy sequence that is never zero and whose Limit is not zero is also a Cauchy sequence. *) Lemma Cauchy_Lim_recip : forall seq y, Cauchy_Lim_prop2 seq y -> forall seq_ y_, Cauchy_Lim_prop2 (fun n : nat => One[/] seq n[//]seq_ n) (One[/] y[//]y_). -intros seq y H Hn Hy. -red in |- *; red in H. -intros eps He. -cut {n0 : nat | forall n : nat, n0 <= n -> AbsIR y [/]TwoNZ [<=] AbsIR (seq n)}. -intro H0. -elim H0; clear H0; intros n0 Hn0. -cut (Zero [<] eps [/]TwoNZ[*] (AbsIR y[*]AbsIR y)). -intro H0. -elim (H _ H0); clear H. -intros N HN. -exists (max N n0). -intros. -apply AbsIR_imp_AbsSmall. -apply - leEq_wdl - with - ((One[/] _[//]AbsIR_resp_ap_zero _ (Hn m)) [*] +Proof. + intros seq y H Hn Hy. + red in |- *; red in H. + intros eps He. + cut {n0 : nat | forall n : nat, n0 <= n -> AbsIR y [/]TwoNZ [<=] AbsIR (seq n)}. + intro H0. + elim H0; clear H0; intros n0 Hn0. + cut (Zero [<] eps [/]TwoNZ[*] (AbsIR y[*]AbsIR y)). + intro H0. + elim (H _ H0); clear H. + intros N HN. + exists (max N n0). + intros. + apply AbsIR_imp_AbsSmall. + apply leEq_wdl with ((One[/] _[//]AbsIR_resp_ap_zero _ (Hn m)) [*] (One[/] _[//]AbsIR_resp_ap_zero _ Hy) [*]AbsIR (seq m[-]y)). -rstepr - ((Two[/] _[//]AbsIR_resp_ap_zero _ Hy) [*] - (One[/] _[//]AbsIR_resp_ap_zero _ Hy) [*] - (eps [/]TwoNZ[*] (AbsIR y[*]AbsIR y))). -apply mult_resp_leEq_both. -astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. -apply less_leEq; apply recip_resp_pos; apply AbsIR_pos; apply Hn. -apply less_leEq; apply recip_resp_pos; apply AbsIR_pos; apply Hy. -apply AbsIR_nonneg. -apply mult_resp_leEq_rht. -rstepr - (One[/] _[//] - div_resp_ap_zero_rev _ _ _ (two_ap_zero _) (AbsIR_resp_ap_zero _ Hy)). -apply recip_resp_leEq. -apply pos_div_two; apply AbsIR_pos; apply Hy. -apply Hn0. -apply le_trans with (max N n0); auto with arith. -apply less_leEq; apply recip_resp_pos; apply AbsIR_pos; apply Hy. -apply AbsSmall_imp_AbsIR. -apply HN. -apply le_trans with (max N n0); auto with arith. -apply - eq_transitive_unfolded - with - (AbsIR (One[/] _[//]Hn m) [*]AbsIR (One[/] _[//]Hy) [*]AbsIR (y[-]seq m)). -repeat apply mult_wd; apply eq_symmetric_unfolded. -apply AbsIR_recip. -apply AbsIR_recip. -apply AbsIR_minus. -apply - eq_transitive_unfolded - with (AbsIR ((One[/] _[//]Hn m) [*] (One[/] _[//]Hy) [*] (y[-]seq m))). -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_wdl. -apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply AbsIR_wd. -rational. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. -apply pos_div_two; assumption. -astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; - apply AbsIR_pos; apply Hy. -cut - {n0 : nat | - forall n : nat, n0 <= n -> AbsSmall (AbsIR y [/]TwoNZ) (seq n[-]y)}. -2: apply H. -2: eapply less_wdr. -3: apply AbsIR_div_two. -2: apply AbsIR_pos. -2: apply div_resp_ap_zero_rev; apply Hy. -intro H0. -elim H0; intros n0 Hn0; clear H0; exists n0; intros. -apply leEq_transitive with (AbsIR y[-]AbsIR (seq n[-]y)). -apply shift_leEq_minus; apply shift_plus_leEq'. -rstepr (AbsIR y [/]TwoNZ). -apply AbsSmall_imp_AbsIR. -apply Hn0; assumption. -apply weird_triangleIR. + rstepr ((Two[/] _[//]AbsIR_resp_ap_zero _ Hy) [*] (One[/] _[//]AbsIR_resp_ap_zero _ Hy) [*] + (eps [/]TwoNZ[*] (AbsIR y[*]AbsIR y))). + apply mult_resp_leEq_both. + astepl (ZeroR[*]Zero); apply mult_resp_leEq_both; try apply leEq_reflexive. + apply less_leEq; apply recip_resp_pos; apply AbsIR_pos; apply Hn. + apply less_leEq; apply recip_resp_pos; apply AbsIR_pos; apply Hy. + apply AbsIR_nonneg. + apply mult_resp_leEq_rht. + rstepr (One[/] _[//] div_resp_ap_zero_rev _ _ _ (two_ap_zero _) (AbsIR_resp_ap_zero _ Hy)). + apply recip_resp_leEq. + apply pos_div_two; apply AbsIR_pos; apply Hy. + apply Hn0. + apply le_trans with (max N n0); auto with arith. + apply less_leEq; apply recip_resp_pos; apply AbsIR_pos; apply Hy. + apply AbsSmall_imp_AbsIR. + apply HN. + apply le_trans with (max N n0); auto with arith. + apply eq_transitive_unfolded with + (AbsIR (One[/] _[//]Hn m) [*]AbsIR (One[/] _[//]Hy) [*]AbsIR (y[-]seq m)). + repeat apply mult_wd; apply eq_symmetric_unfolded. + apply AbsIR_recip. + apply AbsIR_recip. + apply AbsIR_minus. + apply eq_transitive_unfolded with (AbsIR ((One[/] _[//]Hn m) [*] (One[/] _[//]Hy) [*] (y[-]seq m))). + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_wdl. + apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply AbsIR_wd. + rational. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive. + apply pos_div_two; assumption. + astepl (ZeroR[*]Zero); apply mult_resp_less_both; try apply leEq_reflexive; + apply AbsIR_pos; apply Hy. + cut {n0 : nat | forall n : nat, n0 <= n -> AbsSmall (AbsIR y [/]TwoNZ) (seq n[-]y)}. + 2: apply H. + 2: eapply less_wdr. + 3: apply AbsIR_div_two. + 2: apply AbsIR_pos. + 2: apply div_resp_ap_zero_rev; apply Hy. + intro H0. + elim H0; intros n0 Hn0; clear H0; exists n0; intros. + apply leEq_transitive with (AbsIR y[-]AbsIR (seq n[-]y)). + apply shift_leEq_minus; apply shift_plus_leEq'. + rstepr (AbsIR y [/]TwoNZ). + apply AbsSmall_imp_AbsIR. + apply Hn0; assumption. + apply weird_triangleIR. Qed. Lemma Cauchy_recip : forall seq seq_, Lim seq [#] (Zero:IR) -> Cauchy_prop (fun n => One[/] seq n[//]seq_ n). -intros seq Hn Hy. -apply Cauchy_prop2_prop. -exists (One[/] _[//]Hy). -apply Cauchy_Lim_recip. -apply Cauchy_complete. +Proof. + intros seq Hn Hy. + apply Cauchy_prop2_prop. + exists (One[/] _[//]Hy). + apply Cauchy_Lim_recip. + apply Cauchy_complete. Qed. Lemma Lim_recip : forall seq seq_ seq__, Lim (Build_CauchySeq _ _ (Cauchy_recip seq seq_ seq__)) [=] (One[/] _[//]seq__). -intros. -apply eq_symmetric_unfolded; apply Limits_unique. -simpl in |- *; apply Cauchy_Lim_recip. -apply Cauchy_complete. +Proof. + intros. + apply eq_symmetric_unfolded; apply Limits_unique. + simpl in |- *; apply Cauchy_Lim_recip. + apply Cauchy_complete. Qed. End Consequences. @@ -804,20 +829,20 @@ Hypothesis Hn : 0 < n. Lemma part_function_NRoot_strext : forall x y Hx Hy, NRoot (Ext2R x Hx) Hn [#] NRoot (Ext2R y Hy) Hn -> x [#] y. Proof. -intros x y Hx Hy H. -refine (pfstrx _ _ _ _ _ _ (NRoot_str_ext _ _ _ _ _ _ _ H)). + intros x y Hx Hy H. + refine (pfstrx _ _ _ _ _ _ (NRoot_str_ext _ _ _ _ _ _ _ H)). Qed. Lemma part_function_NRoot_pred_wd : pred_wd _ R. Proof. -intros x y H H0. -elim H. -intros H1 H2. -split. - apply (dom_wd _ F x y H1 H0). -intros H3. -astepr (F x H1). -auto. + intros x y H H0. + elim H. + intros H1 H2. + split. + apply (dom_wd _ F x y H1 H0). + intros H3. + astepr (F x H1). + auto. Qed. Definition FNRoot := Build_PartFunct IR _ part_function_NRoot_pred_wd @@ -829,20 +854,22 @@ Variable S:IR -> CProp. Lemma included_FNRoot : included S P -> (forall x, S x -> forall Hx, Zero[<=]F x Hx) -> included S (Dom FNRoot). -intros H H0. -simpl in |- *. -unfold extend in |- *. -split. -apply H; assumption. -intros; apply H0; assumption. +Proof. + intros H H0. + simpl in |- *. + unfold extend in |- *. + split. + apply H; assumption. + intros; apply H0; assumption. Qed. Lemma included_FNRoot' : included S (Dom FNRoot) -> included S P. -intro H; simpl in H; eapply included_extend; unfold R in *; apply H. +Proof. + intro H; simpl in H; eapply included_extend; unfold R in *; apply H. Qed. End Included. End Part_Function_NRoot. -Hint Resolve included_FNRoot included_FNRoot' : included. \ No newline at end of file +Hint Resolve included_FNRoot included_FNRoot' : included. diff --git a/reals/OddPolyRootIR.v b/reals/OddPolyRootIR.v index f45a637ef..887fe65c5 100644 --- a/reals/OddPolyRootIR.v +++ b/reals/OddPolyRootIR.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export IVT. @@ -54,66 +54,70 @@ Let RX := (cpoly R). (* end hide *) Lemma Cbigger : forall x y : R, {z : R | x [<=] z | y [<=] z}. -intros. -elim (less_cotransitive_unfolded _ x (x[+]One) (less_plusOne _ _) y); intro. -exists (y[+]One); apply less_leEq. -apply less_leEq_trans with y. auto. apply less_leEq; apply less_plusOne. -apply less_plusOne. -exists (x[+]One); apply less_leEq. -apply less_plusOne. -auto. +Proof. + intros. + elim (less_cotransitive_unfolded _ x (x[+]One) (less_plusOne _ _) y); intro. + exists (y[+]One); apply less_leEq. + apply less_leEq_trans with y. auto. apply less_leEq; apply less_plusOne. + apply less_plusOne. + exists (x[+]One); apply less_leEq. + apply less_plusOne. + auto. Qed. Lemma Ccpoly_big : forall (p : RX) n, 0 < n -> monic n p -> forall Y, {X : R | forall x, X [<=] x -> Y [<=] p ! x}. -intro. elim p. -unfold monic in |- *. simpl in |- *. intros. elim H0. intros H1 H2. -cut (Zero[~=] (One:R)). intro. elim (H3 H1). -apply ap_imp_neq. apply ap_symmetric_unfolded. apply ring_non_triv. -intros c q. intros H n H0 H1 Y. -elim (O_or_S n); intro y. elim y. intro m. intro y0. -rewrite <- y0 in H1. -elim (zerop m); intro y1. simpl in |- *. -exists (Y[-]c). intros. -rewrite y1 in H1. -apply shift_leEq_plus'. -cut (q ! x [=] One). intro. -astepr (x[*]One). astepr x. auto. -apply monic_one with c. auto. -cut (monic m q). intro H2. -elim (Cbigger Zero (Y[-]c)). intro Y'. intros H3 H4. -elim (H m y1 H2 Y'). intro X'. intro H5. -simpl in |- *. -elim (Cbigger One X'). intro X. intros H6 H7. -exists X. intros. -apply shift_leEq_plus'. -apply leEq_transitive with (One[*]Y'). -astepr Y'. auto. -apply mult_resp_leEq_both; auto. -apply less_leEq. apply pos_one. -apply leEq_transitive with X; auto. -change (Y' [<=] q ! x) in |- *. -apply H5. -apply leEq_transitive with X; auto. -apply monic_cpoly_linear with c; auto. -rewrite <- y in H0. -elim (lt_irrefl _ H0). +Proof. + intro. elim p. + unfold monic in |- *. simpl in |- *. intros. elim H0. intros H1 H2. + cut (Zero[~=] (One:R)). intro. elim (H3 H1). + apply ap_imp_neq. apply ap_symmetric_unfolded. apply ring_non_triv. + intros c q. intros H n H0 H1 Y. + elim (O_or_S n); intro y. elim y. intro m. intro y0. + rewrite <- y0 in H1. + elim (zerop m); intro y1. simpl in |- *. + exists (Y[-]c). intros. + rewrite y1 in H1. + apply shift_leEq_plus'. + cut (q ! x [=] One). intro. + astepr (x[*]One). astepr x. auto. + apply monic_one with c. auto. + cut (monic m q). intro H2. + elim (Cbigger Zero (Y[-]c)). intro Y'. intros H3 H4. + elim (H m y1 H2 Y'). intro X'. intro H5. + simpl in |- *. + elim (Cbigger One X'). intro X. intros H6 H7. + exists X. intros. + apply shift_leEq_plus'. + apply leEq_transitive with (One[*]Y'). + astepr Y'. auto. + apply mult_resp_leEq_both; auto. + apply less_leEq. apply pos_one. + apply leEq_transitive with X; auto. + change (Y' [<=] q ! x) in |- *. + apply H5. + apply leEq_transitive with X; auto. + apply monic_cpoly_linear with c; auto. + rewrite <- y in H0. + elim (lt_irrefl _ H0). Qed. Lemma cpoly_pos : forall (p : RX) n, 0 < n -> monic n p -> {x : R | Zero [<=] p ! x}. -intros. -elim (Ccpoly_big _ _ H H0 Zero). intros x H1. -exists (x[+]One). -apply H1. apply less_leEq. apply less_plusOne. +Proof. + intros. + elim (Ccpoly_big _ _ H H0 Zero). intros x H1. + exists (x[+]One). + apply H1. apply less_leEq. apply less_plusOne. Qed. Lemma Ccpoly_pos' : forall (p : RX) a n, 0 < n -> monic n p -> {x : R | a [<] x | Zero [<=] p ! x}. -intros. -elim (Ccpoly_big _ _ H H0 Zero). intro x'. intro H1. -elim (Cbigger (a[+]One) x'). intro x. intros. -exists x; auto. -apply less_leEq_trans with (a[+]One). -apply less_plusOne. auto. +Proof. + intros. + elim (Ccpoly_big _ _ H H0 Zero). intro x'. intro H1. + elim (Cbigger (a[+]One) x'). intro x. intros. + exists x; auto. + apply less_leEq_trans with (a[+]One). + apply less_plusOne. auto. Qed. End CPoly_Big. @@ -139,44 +143,45 @@ Fixpoint flip (p : RX) : RX := end. Lemma flip_poly : forall (p : RX) x, (flip p) ! x [=] [--]p ! ( [--]x). -intro p. elim p. -intros. simpl in |- *. algebra. -intros c q. intros. -change - ( [--]c[+]x[*] (cpoly_inv _ (flip q)) ! x [=] [--] (c[+][--]x[*]q ! ( [--]x))) - in |- *. -astepl ( [--]c[+]x[*][--] (flip q) ! x). -astepl ( [--]c[+]x[*][--][--]q ! ( [--]x)). -rational. +Proof. + intro p. elim p. + intros. simpl in |- *. algebra. + intros c q. intros. + change ( [--]c[+]x[*] (cpoly_inv _ (flip q)) ! x [=] [--] (c[+][--]x[*]q ! ( [--]x))) in |- *. + astepl ( [--]c[+]x[*][--] (flip q) ! x). + astepl ( [--]c[+]x[*][--][--]q ! ( [--]x)). + rational. Qed. Lemma flip_coefficient : forall (p : RX) i, nth_coeff i (flip p) [=] [--] ( [--]One[^]i) [*]nth_coeff i p. -intro p. elim p. -simpl in |- *. algebra. -intros c q. intros. -elim i. simpl in |- *. rational. -intros. simpl in |- *. -astepl ( [--] (nth_coeff n (flip q))). -astepl ( [--] ( [--] ( [--]One[^]n) [*]nth_coeff n q)). -simpl in |- *. rational. +Proof. + intro p. elim p. + simpl in |- *. algebra. + intros c q. intros. + elim i. simpl in |- *. rational. + intros. simpl in |- *. + astepl ( [--] (nth_coeff n (flip q))). + astepl ( [--] ( [--] ( [--]One[^]n) [*]nth_coeff n q)). + simpl in |- *. rational. Qed. Hint Resolve flip_coefficient: algebra. Lemma flip_odd : forall (p : RX) n, odd n -> monic n p -> monic n (flip p). -unfold monic in |- *. unfold degree_le in |- *. -intros. -elim H0. clear H0. intros. -split. -astepl ( [--] ( [--]One[^]n) [*]nth_coeff n p). -astepl ( [--][--] (One[^]n) [*]nth_coeff n p). -astepl (One[^]n[*]nth_coeff n p). -astepl (One[*]nth_coeff n p). -Step_final (One[*] (One:R)). -intros. -astepl ( [--] ( [--]One[^]m) [*]nth_coeff m p). -Step_final ( [--] ( [--]One[^]m) [*] (Zero:R)). +Proof. + unfold monic in |- *. unfold degree_le in |- *. + intros. + elim H0. clear H0. intros. + split. + astepl ( [--] ( [--]One[^]n) [*]nth_coeff n p). + astepl ( [--][--] (One[^]n) [*]nth_coeff n p). + astepl (One[^]n[*]nth_coeff n p). + astepl (One[*]nth_coeff n p). + Step_final (One[*] (One:R)). + intros. + astepl ( [--] ( [--]One[^]m) [*]nth_coeff m p). + Step_final ( [--] ( [--]One[^]m) [*] (Zero:R)). Qed. End Flip_Poly. @@ -199,27 +204,30 @@ Let RX := (cpoly R). (* end hide *) Lemma oddpoly_pos : forall (p : RX) n, odd n -> monic n p -> {x : R | Zero [<=] p ! x}. -intros. -apply cpoly_pos with n; auto. -elim H. intros. auto with arith. +Proof. + intros. + apply cpoly_pos with n; auto. + elim H. intros. auto with arith. Qed. Lemma oddpoly_pos' : forall (p : RX) a n, odd n -> monic n p -> {x : R | a [<] x | Zero [<=] p ! x}. -intros. -elim (Ccpoly_pos' _ p a n). intros x H1 H2. -exists x; assumption. -elim H; auto with arith. -assumption. +Proof. + intros. + elim (Ccpoly_pos' _ p a n). intros x H1 H2. + exists x; assumption. + elim H; auto with arith. + assumption. Qed. Lemma oddpoly_neg : forall (p : RX) n, odd n -> monic n p -> {x : R | p ! x [<=] Zero}. -intros. -elim (oddpoly_pos _ _ H (flip_odd _ _ _ H H0)). intro x. intros. -exists ( [--]x). -astepl ( [--][--]p ! ( [--]x)). astepr ( [--] (Zero:R)). -apply inv_resp_leEq. -astepr (flip _ p) ! x. auto. +Proof. + intros. + elim (oddpoly_pos _ _ H (flip_odd _ _ _ H H0)). intro x. intros. + exists ( [--]x). + astepl ( [--][--]p ! ( [--]x)). astepr ( [--] (Zero:R)). + apply inv_resp_leEq. + astepr (flip _ p) ! x. auto. Qed. End OddPoly_Signs. @@ -240,33 +248,32 @@ Let RX := cpoly_cring R. (* end hide *) Lemma poly_norm_aux : forall (p : RX) n, degree n p -> nth_coeff n p [#] Zero. -unfold degree in |- *. intros p n H. -elim H. auto. +Proof. + unfold degree in |- *. intros p n H. + elim H. auto. Qed. Definition poly_norm p n H := _C_ (One[/] _[//]poly_norm_aux p n H) [*]p. Lemma poly_norm_monic : forall p n H, monic n (poly_norm p n H). -unfold poly_norm in |- *. unfold monic in |- *. unfold degree in |- *. unfold degree_le in |- *. intros. -elim H. intros H0 H1. -split. -Step_final - ((One[/] nth_coeff n p[//]poly_norm_aux p n (CAnd_intro _ _ H0 H1)) [*] - nth_coeff n p). -intros. -astepl - ((One[/] nth_coeff n p[//]poly_norm_aux p n (CAnd_intro _ _ H0 H1)) [*] - nth_coeff m p). -Step_final ((One[/] nth_coeff n p[//]poly_norm_aux p n H) [*]Zero). +Proof. + unfold poly_norm in |- *. unfold monic in |- *. unfold degree in |- *. unfold degree_le in |- *. intros. + elim H. intros H0 H1. + split. + Step_final ((One[/] nth_coeff n p[//]poly_norm_aux p n (CAnd_intro _ _ H0 H1)) [*] nth_coeff n p). + intros. + astepl ((One[/] nth_coeff n p[//]poly_norm_aux p n (CAnd_intro _ _ H0 H1)) [*] nth_coeff m p). + Step_final ((One[/] nth_coeff n p[//]poly_norm_aux p n H) [*]Zero). Qed. Lemma poly_norm_apply : forall p n H x, (poly_norm p n H) ! x [=] Zero -> p ! x [=] Zero. -unfold poly_norm in |- *. intros. -apply mult_cancel_lft with (One[/] nth_coeff n p[//]poly_norm_aux p n H). -apply div_resp_ap_zero_rev. apply ring_non_triv. -astepl ((_C_ (One[/] nth_coeff n p[//]poly_norm_aux p n H)) ! x[*]p ! x). -astepl (_C_ (One[/] nth_coeff n p[//]poly_norm_aux p n H) [*]p) ! x. -Step_final (Zero:R). +Proof. + unfold poly_norm in |- *. intros. + apply mult_cancel_lft with (One[/] nth_coeff n p[//]poly_norm_aux p n H). + apply div_resp_ap_zero_rev. apply ring_non_triv. + astepl ((_C_ (One[/] nth_coeff n p[//]poly_norm_aux p n H)) ! x[*]p ! x). + astepl (_C_ (One[/] nth_coeff n p[//]poly_norm_aux p n H) [*]p) ! x. + Step_final (Zero:R). Qed. End Poly_Norm. @@ -279,36 +286,39 @@ Section OddPoly_Root. Polynomials of odd degree over the reals always have a root. *) Lemma oddpoly_root' : forall f n, odd n -> monic n f -> {x : IR | f ! x [=] Zero}. -intros. -elim (oddpoly_neg _ f n); auto. intro a. intro H1. -elim (oddpoly_pos' _ f a n); auto. intro b. intros H2 H3. -cut {x : IR | a [<=] x /\ x [<=] b /\ f ! x [=] Zero}. -intro H4. -elim H4. clear H4. intros x H4. -elim H4. clear H4. intros H4 H5. -elim H5. clear H5. intros. -exists x. auto. -apply Civt_poly; auto. -apply monic_apzero with n; auto. +Proof. + intros. + elim (oddpoly_neg _ f n); auto. intro a. intro H1. + elim (oddpoly_pos' _ f a n); auto. intro b. intros H2 H3. + cut {x : IR | a [<=] x /\ x [<=] b /\ f ! x [=] Zero}. + intro H4. + elim H4. clear H4. intros x H4. + elim H4. clear H4. intros H4 H5. + elim H5. clear H5. intros. + exists x. auto. + apply Civt_poly; auto. + apply monic_apzero with n; auto. Qed. Lemma oddpoly_root : forall f n, odd n -> degree n f -> {x : IR | f ! x [=] Zero}. -intros f n H H0. -elim (oddpoly_root' (poly_norm _ f n H0) n); auto. -intros. exists x. -apply poly_norm_apply with n H0; auto. -apply poly_norm_monic; auto. +Proof. + intros f n H H0. + elim (oddpoly_root' (poly_norm _ f n H0) n); auto. + intros. exists x. + apply poly_norm_apply with n H0; auto. + apply poly_norm_monic; auto. Qed. Lemma realpolyn_oddhaszero : forall f, odd_cpoly _ f -> {x : IR | f ! x [=] Zero}. -unfold odd_cpoly in |- *. -intros f H. -elim H. clear H. intro n. intros H H0. -cut (odd n). -intro. -elim (oddpoly_root f n H1 H0). intros. exists x. auto. -apply Codd_to. -assumption. +Proof. + unfold odd_cpoly in |- *. + intros f H. + elim H. clear H. intro n. intros H H0. + cut (odd n). + intro. + elim (oddpoly_root f n H1 H0). intros. exists x. auto. + apply Codd_to. + assumption. Qed. End OddPoly_Root. diff --git a/reals/PosSeq.v b/reals/PosSeq.v index 731f04fc5..df4637529 100644 --- a/reals/PosSeq.v +++ b/reals/PosSeq.v @@ -18,144 +18,151 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Series. Section SeqProperties. Definition seq_pos (x : nat -> IR) := forall n : nat, Zero [<] x n. -Definition seq_inf_sum (x : nat -> IR) := +Definition seq_inf_sum (x : nat -> IR) := forall M : IR, {N : nat | forall m : nat, N <= m -> M [<] seq_part_sum x m}. Lemma One_part_sum : forall (m : nat), seq_part_sum (fun n : nat => One) m [=] nring m. -intros. -induction m; simpl; algebra. +Proof. + intros. + induction m; simpl; algebra. Qed. Lemma One_seq_is_pos : seq_pos (fun n : nat => One). -unfold seq_pos. -intros. apply pos_one. +Proof. + unfold seq_pos. + intros. apply pos_one. Qed. Lemma One_seq_is_inf_sum : seq_inf_sum (fun n : nat => One). -unfold seq_inf_sum. -intros. -assert ({N : nat | M [<] nring N}). -apply Archimedes'. -destruct X as [N H]. -exists N. intros. -apply less_leEq_trans with (nring (R:=IR) N); auto. -assert (seq_part_sum (fun n : nat => One) m [=] nring m). -apply One_part_sum. -astepr (nring (R:=IR) m). -apply nring_leEq. -auto. +Proof. + unfold seq_inf_sum. + intros. + assert ({N : nat | M [<] nring N}). + apply Archimedes'. + destruct X as [N H]. + exists N. intros. + apply less_leEq_trans with (nring (R:=IR) N); auto. + assert (seq_part_sum (fun n : nat => One) m [=] nring m). + apply One_part_sum. + astepr (nring (R:=IR) m). + apply nring_leEq. + auto. Qed. Lemma seq_pos_imp_sum_pos : forall (x : nat -> IR), seq_pos x -> forall n, Zero [<] seq_part_sum x (S n). -intros. -induction n. -simpl. - astepl (Zero[+]Zero:IR). - apply plus_resp_less_lft. apply X. - simpl. -simpl in |- *. - apply plus_resp_pos. - apply IHn. - apply X. +Proof. + intros. + induction n. + simpl. + astepl (Zero[+]Zero:IR). + apply plus_resp_less_lft. apply X. + simpl. + simpl in |- *. + apply plus_resp_pos. + apply IHn. + apply X. Qed. -Lemma seq_pos_imp_sum_pos' : - forall (x : nat -> IR) (H1 : seq_pos x) (n m : nat) (H2 : m < n), +Lemma seq_pos_imp_sum_pos' : + forall (x : nat -> IR) (H1 : seq_pos x) (n m : nat) (H2 : m < n), Zero [<] Sum m n x. -unfold seq_pos. -intros. -induction n. -assert (~ m < 0). auto with arith. contradiction. -elim (le_lt_eq_dec _ _ H2); intros H3. -astepr (Sum m n x [+] x (S n)). -apply plus_resp_pos. -apply IHn; auto with arith. -apply H1. -replace n with m; auto. -astepr (Sum m m x [+]x (S m)). -apply plus_resp_pos. -astepr (x m). -apply H1. -apply H1. +Proof. + unfold seq_pos. + intros. + induction n. + assert (~ m < 0). auto with arith. contradiction. + elim (le_lt_eq_dec _ _ H2); intros H3. + astepr (Sum m n x [+] x (S n)). + apply plus_resp_pos. + apply IHn; auto with arith. + apply H1. + replace n with m; auto. + astepr (Sum m m x [+]x (S m)). + apply plus_resp_pos. + astepr (x m). + apply H1. + apply H1. Qed. Lemma seq_pos_imp_ap_zero : forall (x : nat -> IR), seq_pos x -> forall n, seq_part_sum x (S n) [#] Zero. -unfold seq_pos. -intros. -apply ap_symmetric_unfolded. -apply less_imp_ap. -apply seq_pos_imp_sum_pos; auto. +Proof. + unfold seq_pos. + intros. + apply ap_symmetric_unfolded. + apply less_imp_ap. + apply seq_pos_imp_sum_pos; auto. Qed. Lemma seq_inf_sum_imp_div_small : forall (x : nat -> IR) (H1 : seq_inf_sum x) (H2: seq_pos x) (C e : IR) -(H4 : Zero [<] e), { N : nat | +(H4 : Zero [<] e), { N : nat | forall m : nat, N <= m -> AbsSmall e (C [/](seq_part_sum x (S m)) [//] (seq_pos_imp_ap_zero x H2 m))}. -unfold seq_inf_sum. unfold seq_pos. -intros. -assert ({N : nat | forall m : nat, - N <= m -> ((AbsIR C)[/]e[//]pos_ap_zero IR e H4)[<]seq_part_sum x m}). -apply (H1 ((AbsIR C) [/] e [//] (pos_ap_zero IR e H4))). -destruct X as [N H]. -exists N. -intros. -assert (H3 : ((AbsIR C)[/]e[//]pos_ap_zero IR e H4)[<]seq_part_sum x (S m)). -apply H; auto. -astepr ((C [/] seq_part_sum x (S m)[//] - (seq_pos_imp_ap_zero x H2 m))). -assert (AbsSmall ((seq_part_sum x (S m))[*]e) C). -apply AbsIR_imp_AbsSmall. -apply less_leEq. -apply (shift_less_mult IR (AbsIR C) (seq_part_sum x (S m)) e (pos_ap_zero IR e H4)); auto. -rstepl ((seq_part_sum x (S m))[*]e [/] (seq_part_sum x (S m))[//] - pos_ap_zero IR (seq_part_sum x (S m)) (seq_pos_imp_sum_pos x H2 m)). -rstepr (C [/] (seq_part_sum x (S m))[//] - pos_ap_zero IR (seq_part_sum x (S m)) (seq_pos_imp_sum_pos x H2 m)). -apply div_resp_AbsSmall. -auto. +Proof. + unfold seq_inf_sum. unfold seq_pos. + intros. + assert ({N : nat | forall m : nat, + N <= m -> ((AbsIR C)[/]e[//]pos_ap_zero IR e H4)[<]seq_part_sum x m}). + apply (H1 ((AbsIR C) [/] e [//] (pos_ap_zero IR e H4))). + destruct X as [N H]. + exists N. + intros. + assert (H3 : ((AbsIR C)[/]e[//]pos_ap_zero IR e H4)[<]seq_part_sum x (S m)). + apply H; auto. + astepr ((C [/] seq_part_sum x (S m)[//] (seq_pos_imp_ap_zero x H2 m))). + assert (AbsSmall ((seq_part_sum x (S m))[*]e) C). + apply AbsIR_imp_AbsSmall. + apply less_leEq. + apply (shift_less_mult IR (AbsIR C) (seq_part_sum x (S m)) e (pos_ap_zero IR e H4)); auto. + rstepl ((seq_part_sum x (S m))[*]e [/] (seq_part_sum x (S m))[//] + pos_ap_zero IR (seq_part_sum x (S m)) (seq_pos_imp_sum_pos x H2 m)). + rstepr (C [/] (seq_part_sum x (S m))[//] + pos_ap_zero IR (seq_part_sum x (S m)) (seq_pos_imp_sum_pos x H2 m)). + apply div_resp_AbsSmall. + auto. Qed. Lemma seq_inf_sum_ratio_bound : -forall (y : nat->IR) (H2 : seq_pos y) (m N1: nat) (H3: S N1 < m), +forall (y : nat->IR) (H2 : seq_pos y) (m N1: nat) (H3: S N1 < m), AbsSmall One (Sum (G:=IR) (S N1) m (fun k : nat => y k)[/] seq_part_sum y (S m)[//]seq_pos_imp_ap_zero y H2 m). -intros. -apply leEq_imp_AbsSmall. -apply shift_leEq_div. -apply seq_pos_imp_sum_pos; auto. -astepl (Zero:IR). -apply less_leEq. -apply seq_pos_imp_sum_pos'; auto. -apply shift_div_leEq. -apply seq_pos_imp_sum_pos; auto. -astepl (Sum (G:=IR) (S N1) m y). -astepr (seq_part_sum y (S m)). -unfold Sum. unfold Sum1. unfold seq_part_sum. -apply shift_zero_leEq_minus'. -rstepr (Sum0 (G:=IR) (S N1) y). -apply less_leEq. -astepr (seq_part_sum y (S N1)). -apply seq_pos_imp_sum_pos; auto. +Proof. + intros. + apply leEq_imp_AbsSmall. + apply shift_leEq_div. + apply seq_pos_imp_sum_pos; auto. + astepl (Zero:IR). + apply less_leEq. + apply seq_pos_imp_sum_pos'; auto. + apply shift_div_leEq. + apply seq_pos_imp_sum_pos; auto. + astepl (Sum (G:=IR) (S N1) m y). + astepr (seq_part_sum y (S m)). + unfold Sum. unfold Sum1. unfold seq_part_sum. + apply shift_zero_leEq_minus'. + rstepr (Sum0 (G:=IR) (S N1) y). + apply less_leEq. + astepr (seq_part_sum y (S N1)). + apply seq_pos_imp_sum_pos; auto. Qed. End SeqProperties. diff --git a/reals/Q_dense.v b/reals/Q_dense.v index 6c7775aba..14707ec32 100644 --- a/reals/Q_dense.v +++ b/reals/Q_dense.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) Require Export Q_in_CReals. @@ -47,9 +47,9 @@ Proof. elim H0. intros. case H. - intro H3. - apply H3. - assumption. + intro H3. + apply H3. + assumption. intro H3. apply H3. assumption. @@ -57,8 +57,8 @@ Qed. Section Interval_definition. Variable OF : COrdField. - - Record Interval : Type := + + Record Interval : Type := {pair_crr :> prodT OF OF; is_interval : fstT pair_crr[<]sndT pair_crr}. Definition Length (I1 : Interval) : OF := sndT I1[-]fstT I1. @@ -100,12 +100,12 @@ Lemma AbsSmall_pos_reflexive : forall x : OF, (Zero[<=]x) -> AbsSmall x x. Proof. intros. split. - apply leEq_transitive with (y := Zero:OF). - apply inv_cancel_leEq. - rstepl (Zero:OF). - rstepr x. - assumption. - assumption. + apply leEq_transitive with (y := Zero:OF). + apply inv_cancel_leEq. + rstepl (Zero:OF). + rstepr x. + assumption. + assumption. apply leEq_reflexive. Qed. @@ -113,14 +113,14 @@ Lemma AbsSmall_neg_reflexive : forall x : OF, (Zero[<=]x) -> AbsSmall x [--]x. Proof. intros. split. - apply leEq_reflexive. + apply leEq_reflexive. apply leEq_transitive with (y := Zero:OF). - apply inv_cancel_leEq. - rstepl (Zero:OF). - rstepr x. - assumption. + apply inv_cancel_leEq. + rstepl (Zero:OF). + rstepr x. + assumption. assumption. -Qed. +Qed. Lemma AbsSmall_subinterval : @@ -129,16 +129,16 @@ Lemma AbsSmall_subinterval : Proof. intros. split. - rstepl (a[+][--]b). - rstepr (x[+][--]y). - apply plus_resp_leEq_both. - assumption. - apply inv_resp_leEq. - assumption. + rstepl (a[+][--]b). + rstepr (x[+][--]y). + apply plus_resp_leEq_both. + assumption. + apply inv_resp_leEq. + assumption. rstepl (x[+][--]y). rstepr (b[+][--]a). apply plus_resp_leEq_both. - assumption. + assumption. apply inv_resp_leEq. assumption. Qed. @@ -169,7 +169,7 @@ Lemma start_of_sequence_property : Proof. intro. unfold start_l, start_r in |- *. - elim start_of_sequence2; auto. + elim start_of_sequence2; auto. Qed. @@ -187,17 +187,15 @@ Lemma shrink23 : (q1[<]q2) -> q1[+](q2[-]q1) [/]ThreeNZ[<]q2[-](q2[-]q1) [/]ThreeNZ. Proof. intros. - apply - plus_cancel_less with (R := Q_as_COrdField) (z := (q2[-]q1) [/]ThreeNZ). + apply plus_cancel_less with (R := Q_as_COrdField) (z := (q2[-]q1) [/]ThreeNZ). rstepl (q2[-](q2[-]q1) [/]ThreeNZ). rstepr q2. apply plus_cancel_less with (R := Q_as_COrdField) (z := [--]q2). rstepr [--](Zero:Q_as_COrdField). rstepl [--]((q2[-]q1) [/]ThreeNZ). apply inv_resp_less. - apply - mult_cancel_less with (R := Q_as_COrdField) (z := Three:Q_as_COrdField). - apply pos_nring_S. + apply mult_cancel_less with (R := Q_as_COrdField) (z := Three:Q_as_COrdField). + apply pos_nring_S. rstepl (Zero:Q_as_COrdField). rstepr (q2[-]q1). apply shift_zero_less_minus. @@ -210,12 +208,12 @@ Lemma shrink13 : Proof. intros. apply less_transitive_unfolded with (q1[+](q2[-]q1) [/]ThreeNZ). - astepl (q1[+]Zero). - apply plus_resp_less_lft. - apply div_resp_pos. - apply pos_three. - apply shift_zero_less_minus. - assumption. + astepl (q1[+]Zero). + apply plus_resp_less_lft. + apply div_resp_pos. + apply pos_three. + apply shift_zero_less_minus. + assumption. apply shrink23. assumption. Qed. @@ -225,8 +223,8 @@ Lemma shrink24 : Proof. intros. apply less_transitive_unfolded with (q2[-](q2[-]q1) [/]ThreeNZ). - apply shrink23. - assumption. + apply shrink23. + assumption. astepl (q2[+][--]((q2[-]q1) [/]ThreeNZ)). astepr (q2[+]Zero). apply plus_resp_less_lft. @@ -234,7 +232,7 @@ Proof. rstepl (Zero:Q_as_COrdField). rstepr ((q2[-]q1) [/]ThreeNZ). apply div_resp_pos. - apply pos_three. + apply pos_three. apply shift_zero_less_minus. assumption. Qed. @@ -242,16 +240,17 @@ Qed. Definition cotrans_analyze : forall (x : R1) (q1 q2 : Q_as_COrdField), (q1[<]q2) -> Q_as_COrdField. -intros. -cut (inj_Q R1 q1[<]inj_Q R1 q2). -intro H0. -case (less_cotransitive_unfolded R1 (inj_Q R1 q1) (inj_Q R1 q2) H0 x). -intro. -exact q1. -intro. -exact q2. -apply inj_Q_less. -assumption. +Proof. + intros. + cut (inj_Q R1 q1[<]inj_Q R1 q2). + intro H0. + case (less_cotransitive_unfolded R1 (inj_Q R1 q1) (inj_Q R1 q2) H0 x). + intro. + exact q1. + intro. + exact q2. + apply inj_Q_less. + assumption. Defined. @@ -263,36 +262,33 @@ Lemma cotrans_analyze_strong : Proof. intros. unfold cotrans_analyze in |- *. - elim - (less_cotransitive_unfolded R1 (inj_Q R1 q1) (inj_Q R1 q2) - (inj_Q_less R1 q1 q2 H) x). - intros. - left. - split. - assumption. - algebra. + elim (less_cotransitive_unfolded R1 (inj_Q R1 q1) (inj_Q R1 q2) (inj_Q_less R1 q1 q2 H) x). + intros. + left. + split. + assumption. + algebra. intros. right. split. - assumption. + assumption. algebra. Qed. Definition trichotomy : R1 -> Q_as_COrdField -> Q_as_COrdField -> Q_as_COrdField. -intros x q1 q2. -case (Qlt_eq_gt_dec' q1 q2). -intro s. -elim s. -intro a. -exact - (cotrans_analyze x (q1[+](q2[-]q1) [/]ThreeNZ) (q2[-](q2[-]q1) [/]ThreeNZ) - (shrink23 q1 q2 a)). -intro. -exact Zero. -intro. -exact q1. +Proof. + intros x q1 q2. + case (Qlt_eq_gt_dec' q1 q2). + intro s. + elim s. + intro a. + exact (cotrans_analyze x (q1[+](q2[-]q1) [/]ThreeNZ) (q2[-](q2[-]q1) [/]ThreeNZ) (shrink23 q1 q2 a)). + intro. + exact Zero. + intro. + exact q1. Defined. @@ -306,40 +302,39 @@ Proof. intros. unfold trichotomy in |- *. elim (Qlt_eq_gt_dec' q1 q2). - intro y. - elim y. - intro y0. - simpl in |- *. - apply cotrans_analyze_strong. - intro. - apply False_rect. - generalize b. - change (Not (q2[<]q1)) in |- *. - apply less_antisymmetric_unfolded. - assumption. + intro y. + elim y. + intro y0. + simpl in |- *. + apply cotrans_analyze_strong. + intro. + apply False_rect. + generalize b. + change (Not (q2[<]q1)) in |- *. + apply less_antisymmetric_unfolded. + assumption. intro. elimtype False. - generalize b. - change (q1[~=]q2) in |- *. - apply ap_imp_neq. - apply less_imp_ap. - assumption. + generalize b. + change (q1[~=]q2) in |- *. + apply ap_imp_neq. + apply less_imp_ap. + assumption. Qed. Notation "( A , B )" := (pairT A B). Definition if_cotrans : forall (x : R1) (I1 : Rat_Interval), Rat_Interval. -intros. -case I1. -intros i pi. -elim (trichotomy_strong1 (fstT i) (sndT i) x pi). -intro. -exact - (Build_Interval _ (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ, sndT i) +Proof. + intros. + case I1. + intros i pi. + elim (trichotomy_strong1 (fstT i) (sndT i) x pi). + intro. + exact (Build_Interval _ (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ, sndT i) (shrink24 (fstT i) (sndT i) pi)). -intro. -exact - (Build_Interval _ (fstT i, sndT i[-](sndT i[-]fstT i) [/]ThreeNZ) - (shrink13 (fstT i) (sndT i) pi)). + intro. + exact (Build_Interval _ (fstT i, sndT i[-](sndT i[-]fstT i) [/]ThreeNZ) + (shrink13 (fstT i) (sndT i) pi)). Defined. @@ -359,55 +354,42 @@ Proof. case I1. intros i pi. elim (trichotomy_strong1 (fstT i) (sndT i) x pi). - intro y. - elim y. - intros H H0. - left. - split. - exact H. - cut - (if_cotrans x (Build_Interval Q_as_COrdField i pi) = - Build_Interval Q_as_COrdField - (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ, sndT i) - (shrink24 (fstT i) (sndT i) pi)). - intro H1. - - rewrite H1. - simpl in |- *. - reflexivity. - - unfold if_cotrans in |- *. - apply not_r_cor_rect. - - apply or_not_and. - right. - change (trichotomy x (fstT i) (sndT i)[~=]sndT i[-](sndT i[-]fstT i) [/]ThreeNZ) in |- *. - apply ap_imp_neq. - astepl (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ). - apply less_imp_ap. - apply shrink23. - assumption. - + intro y. + elim y. + intros H H0. + left. + split. + exact H. + cut (if_cotrans x (Build_Interval Q_as_COrdField i pi) = Build_Interval Q_as_COrdField + (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ, sndT i) (shrink24 (fstT i) (sndT i) pi)). + intro H1. + rewrite H1. + simpl in |- *. + reflexivity. + unfold if_cotrans in |- *. + apply not_r_cor_rect. + apply or_not_and. + right. + change (trichotomy x (fstT i) (sndT i)[~=]sndT i[-](sndT i[-]fstT i) [/]ThreeNZ) in |- *. + apply ap_imp_neq. + astepl (fstT i[+](sndT i[-]fstT i) [/]ThreeNZ). + apply less_imp_ap. + apply shrink23. + assumption. intro. elim b. intros H H0. - right. + right. split. - exact H. - cut - (if_cotrans x (Build_Interval Q_as_COrdField i pi) = - Build_Interval Q_as_COrdField - (fstT i, sndT i[-](sndT i[-]fstT i) [/]ThreeNZ) - (shrink13 (fstT i) (sndT i) pi)). - intro H1. - - rewrite H1. - simpl in |- *. - reflexivity. - + exact H. + cut (if_cotrans x (Build_Interval Q_as_COrdField i pi) = Build_Interval Q_as_COrdField + (fstT i, sndT i[-](sndT i[-]fstT i) [/]ThreeNZ) (shrink13 (fstT i) (sndT i) pi)). + intro H1. + rewrite H1. + simpl in |- *. + reflexivity. unfold if_cotrans in |- *. apply not_l_cor_rect. - apply or_not_and. right. change (trichotomy x (fstT i) (sndT i)[~=] (fstT i)[+]((sndT i[-]fstT i) [/]ThreeNZ)) in |- *. @@ -444,15 +426,14 @@ Proof. unfold Length in |- *. simpl in |- *. rational. - - intro H. - elim H. - intros H0 H1. - simpl in |- *. - rewrite H1. - unfold Length in |- *. - simpl in |- *. - rational. + intro H. + elim H. + intros H0 H1. + simpl in |- *. + rewrite H1. + unfold Length in |- *. + simpl in |- *. + rational. Qed. Lemma Length_Intrvl : @@ -461,16 +442,14 @@ Lemma Length_Intrvl : Proof. intros. induction n as [| n Hrecn]. - - (* n=0 *) - unfold Length in |- *. - simpl in |- *. - rational. - + (* n=0 *) + unfold Length in |- *. + simpl in |- *. + rational. (* n=(S n0) & induction hypothesis *) astepr (Two [/]ThreeNZ[*]((Two [/]ThreeNZ)[^]n[*](start_r x[-]start_l x))). - astepr (Two [/]ThreeNZ[*]Length Q_as_COrdField (Intrvl x n)). - apply delta_Intrvl. + astepr (Two [/]ThreeNZ[*]Length Q_as_COrdField (Intrvl x n)). + apply delta_Intrvl. astepr ((Two [/]ThreeNZ)[^]n[*]Two [/]ThreeNZ[*](start_r x[-]start_l x)). rational. Qed. @@ -482,58 +461,54 @@ Lemma Intrvl_inside_l_n : Proof. intros. induction n as [| n Hrecn]. - - (* n=0 *) - cut (m = 0). - intro. - rewrite H0. - - apply leEq_reflexive. - symmetry in |- *. - apply le_n_O_eq. - assumption. - + (* n=0 *) + cut (m = 0). + intro. + rewrite H0. + apply leEq_reflexive. + symmetry in |- *. + apply le_n_O_eq. + assumption. (* n=(S n0) *) - cut ({m = S n} + {m <= n}). + cut ({m = S n} + {m <= n}). intro. case H0. - intro H1. - rewrite H1. - apply leEq_reflexive. - intro. + intro H1. + rewrite H1. + apply leEq_reflexive. + intro. apply leEq_transitive with (fstT (Intrvl x n)). - apply Hrecn. - assumption. + apply Hrecn. + assumption. case (if_cotrans_strong x (Intrvl x n)). + intro H2. + elim H2. + intros H3 H4. + change (fstT (Intrvl x n)[<=]fstT (if_cotrans x (Intrvl x n))) in |- *. + rewrite H4. + astepl (fstT (Intrvl x n)[+]Zero). + simpl. + apply (plus_resp_leEq_both Q_as_COrdField). + apply leEq_reflexive. + apply less_leEq. + apply (div_resp_pos Q_as_COrdField). + apply (pos_three Q_as_COrdField). + apply (shift_zero_less_minus Q_as_COrdField). + apply (is_interval Q_as_COrdField). intro H2. elim H2. intros H3 H4. change (fstT (Intrvl x n)[<=]fstT (if_cotrans x (Intrvl x n))) in |- *. rewrite H4. - astepl (fstT (Intrvl x n)[+]Zero). - simpl. - apply (plus_resp_leEq_both Q_as_COrdField). apply leEq_reflexive. - apply less_leEq. - apply (div_resp_pos Q_as_COrdField). - apply (pos_three Q_as_COrdField). - apply (shift_zero_less_minus Q_as_COrdField). - apply (is_interval Q_as_COrdField). - - intro H2. - elim H2. - intros H3 H4. - change (fstT (Intrvl x n)[<=]fstT (if_cotrans x (Intrvl x n))) in |- *. - rewrite H4. - apply leEq_reflexive. - case (le_lt_eq_dec m (S n) H). + case (le_lt_eq_dec m (S n) H). intro. right. apply lt_n_Sm_le. assumption. - intro. - left. - assumption. + intro. + left. + assumption. Qed. Lemma Intrvl_inside_r_n : @@ -542,67 +517,59 @@ Lemma Intrvl_inside_r_n : Proof. intros. induction n as [| n Hrecn]. - - (* n=0 *) - cut (m = 0). - intro. - rewrite H0. - apply leEq_reflexive. - symmetry in |- *. - apply le_n_O_eq. - assumption. - + (* n=0 *) + cut (m = 0). + intro. + rewrite H0. + apply leEq_reflexive. + symmetry in |- *. + apply le_n_O_eq. + assumption. (* n=(S n0) *) - cut ({m = S n} + {m <= n}). + cut ({m = S n} + {m <= n}). intro H0. case H0. - intro H1. - rewrite H1. - apply leEq_reflexive. - intro. + intro H1. + rewrite H1. + apply leEq_reflexive. + intro. apply leEq_transitive with (sndT (Intrvl x n)). - case (if_cotrans_strong x (Intrvl x n)). - intro H2. - elim H2. - intros H3 H4. - change (sndT (if_cotrans x (Intrvl x n))[<=]sndT (Intrvl x n)) in |- *. - rewrite H4. - apply leEq_reflexive. - intro H2. - elim H2. - intros H3 H4. - change (sndT (if_cotrans x (Intrvl x n))[<=]sndT (Intrvl x n)) in |- *. - rewrite H4. - astepr (sndT (Intrvl x n)[+]Zero). - astepl - (sndT (Intrvl x n)[+] - [--]((sndT (Intrvl x n)[-]fstT (Intrvl x n)) [/]ThreeNZ)). - apply plus_resp_leEq_both. - apply leEq_reflexive. - - apply inv_cancel_leEq. - astepl (Zero:Q_as_COrdField). - astepr ((sndT (Intrvl x n)[-]fstT (Intrvl x n)) [/]ThreeNZ). - apply less_leEq. - apply div_resp_pos. - apply pos_three. - apply shift_zero_less_minus. - - apply is_interval. - + case (if_cotrans_strong x (Intrvl x n)). + intro H2. + elim H2. + intros H3 H4. + change (sndT (if_cotrans x (Intrvl x n))[<=]sndT (Intrvl x n)) in |- *. + rewrite H4. + apply leEq_reflexive. + intro H2. + elim H2. + intros H3 H4. + change (sndT (if_cotrans x (Intrvl x n))[<=]sndT (Intrvl x n)) in |- *. + rewrite H4. + astepr (sndT (Intrvl x n)[+]Zero). + astepl (sndT (Intrvl x n)[+] [--]((sndT (Intrvl x n)[-]fstT (Intrvl x n)) [/]ThreeNZ)). + apply plus_resp_leEq_both. + apply leEq_reflexive. + apply inv_cancel_leEq. + astepl (Zero:Q_as_COrdField). + astepr ((sndT (Intrvl x n)[-]fstT (Intrvl x n)) [/]ThreeNZ). + apply less_leEq. + apply div_resp_pos. + apply pos_three. + apply shift_zero_less_minus. + apply is_interval. apply Hrecn. - assumption. - - case (le_lt_eq_dec m (S n) H). + assumption. + case (le_lt_eq_dec m (S n) H). intro. right. apply lt_n_Sm_le. assumption. - intro. - left. - assumption. + intro. + left. + assumption. Qed. - + Lemma G_m_n_lower : forall (x : R1) (m n : nat), m <= n -> fstT (Intrvl x m)[<]G x n. @@ -610,8 +577,8 @@ Proof. intros. unfold G in |- *. apply leEq_less_trans with (fstT (Intrvl x n)). - apply Intrvl_inside_l_n. - assumption. + apply Intrvl_inside_l_n. + assumption. apply Smallest_less_Average. apply is_interval. Qed. @@ -622,11 +589,11 @@ Proof. intros. unfold G in |- *. apply less_leEq_trans with (sndT (Intrvl x n)). - apply Average_less_Greatest. - apply is_interval. + apply Average_less_Greatest. + apply is_interval. apply Intrvl_inside_r_n. assumption. -Qed. +Qed. Opaque Q_as_COrdField. @@ -638,72 +605,64 @@ Lemma a_simple_inequality : Proof. intros. induction m as [| m Hrecm]. - apply False_rect. - generalize H. - change (~ 4 <= 0) in |- *. - apply le_Sn_O. + apply False_rect. + generalize H. + change (~ 4 <= 0) in |- *. + apply le_Sn_O. case (le_lt_eq_dec 4 (S m) H). intro. - apply - less_transitive_unfolded - with - (Two [/]ThreeNZ[*] - ((One:Q_as_COrdField)[/] nring (S m)[//]nringS_ap_zero _ m)). - astepl (((Two:Q_as_COrdField) [/]ThreeNZ)[^]m[*]Two [/]ThreeNZ). - astepl ((Two:Q_as_COrdField) [/]ThreeNZ[*](Two [/]ThreeNZ)[^]m). - apply mult_resp_less_lft. - apply Hrecm. - apply lt_n_Sm_le. - assumption. - apply div_resp_pos. - apply pos_three. - apply pos_two. -(* - astepl ((Two::Q_as_COrdField)[/]ThreeNZ)[*](Two[/]ThreeNZ)[^]m. + apply less_transitive_unfolded with (Two [/]ThreeNZ[*] + ((One:Q_as_COrdField)[/] nring (S m)[//]nringS_ap_zero _ m)). + astepl (((Two:Q_as_COrdField) [/]ThreeNZ)[^]m[*]Two [/]ThreeNZ). + astepl ((Two:Q_as_COrdField) [/]ThreeNZ[*](Two [/]ThreeNZ)[^]m). + apply mult_resp_less_lft. + apply Hrecm. + apply lt_n_Sm_le. + assumption. + apply div_resp_pos. + apply pos_three. + apply pos_two. + (* astepl ((Two::Q_as_COrdField)[/]ThreeNZ)[*](Two[/]ThreeNZ)[^]m. Apply nexp_Sn with ((Two::Q_as_COrdField)[/]ThreeNZ). *) - apply - mult_cancel_less - with ((Three:Q_as_COrdField)[*]nring (S m)[*]nring (S (S m))). - apply mult_resp_pos. - apply mult_resp_pos. - apply pos_three. - apply pos_nring_S. - apply pos_nring_S. + apply mult_cancel_less with ((Three:Q_as_COrdField)[*]nring (S m)[*]nring (S (S m))). + apply mult_resp_pos. + apply mult_resp_pos. + apply pos_three. + apply pos_nring_S. + apply pos_nring_S. rstepl ((Two:Q_as_COrdField)[*]nring (S (S m))). rstepr ((Three:Q_as_COrdField)[*]nring (S m)). astepl ((Two:Q_as_COrdField)[*](nring m[+]Two)). - astepr ((Three:Q_as_COrdField)[*](nring m[+]One)). - apply plus_cancel_less with ([--]((Two:Q_as_COrdField)[*]nring m[+]Three)). - rstepl (One:Q_as_COrdField). - rstepr (nring (R:=Q_as_COrdField) m). - astepl (nring (R:=Q_as_COrdField) 1). - apply nring_less. - apply lt_trans with (m := 3). - constructor. - constructor. - apply lt_S_n. - assumption. + astepr ((Three:Q_as_COrdField)[*](nring m[+]One)). + apply plus_cancel_less with ([--]((Two:Q_as_COrdField)[*]nring m[+]Three)). + rstepl (One:Q_as_COrdField). + rstepr (nring (R:=Q_as_COrdField) m). + astepl (nring (R:=Q_as_COrdField) 1). + apply nring_less. + apply lt_trans with (m := 3). + constructor. + constructor. + apply lt_S_n. + assumption. simpl in |- *. rational. - - intro. - rewrite <- e. - - apply mult_cancel_less with (nring (R:=Q_as_COrdField) 5[*]Three[^]4). + intro. + rewrite <- e. + apply mult_cancel_less with (nring (R:=Q_as_COrdField) 5[*]Three[^]4). apply mult_resp_pos. - apply pos_nring_S. + apply pos_nring_S. rstepr (Three[^]2[*]Three[^]2:Q_as_COrdField). apply mult_resp_pos. + apply pos_square. + apply nringS_ap_zero. apply pos_square. apply nringS_ap_zero. - apply pos_square. - apply nringS_ap_zero. - rstepl (Two[^]4[*]nring (R:=Q_as_COrdField) 5). - rstepr (Three[^]4:Q_as_COrdField). - rstepl (nring (R:=Q_as_COrdField) 80). - rstepr (nring (R:=Q_as_COrdField) 81). - apply nring_less. - constructor. + rstepl (Two[^]4[*]nring (R:=Q_as_COrdField) 5). + rstepr (Three[^]4:Q_as_COrdField). + rstepl (nring (R:=Q_as_COrdField) 80). + rstepr (nring (R:=Q_as_COrdField) 81). + apply nring_less. + constructor. Qed. Lemma G_conversion_rate2 : @@ -715,25 +674,24 @@ Lemma G_conversion_rate2 : Proof. intros. apply AbsSmall_leEq_trans with (Length _ (Intrvl x m)). - astepl ((Two [/]ThreeNZ)[^]m[*](start_r x[-]start_l x)). - rstepr - ((One[/] nring (S m)[//]nringS_ap_zero _ m)[*](start_r x[-]start_l x)). - apply less_leEq. - apply mult_resp_less. - apply a_simple_inequality. - assumption. - apply shift_zero_less_minus. - apply l_less_r. - apply eq_symmetric_unfolded. - apply Length_Intrvl. + astepl ((Two [/]ThreeNZ)[^]m[*](start_r x[-]start_l x)). + rstepr ((One[/] nring (S m)[//]nringS_ap_zero _ m)[*](start_r x[-]start_l x)). + apply less_leEq. + apply mult_resp_less. + apply a_simple_inequality. + assumption. + apply shift_zero_less_minus. + apply l_less_r. + apply eq_symmetric_unfolded. + apply Length_Intrvl. unfold Length in |- *. apply AbsSmall_subinterval; apply less_leEq. - apply G_m_n_lower. - constructor. - apply G_m_n_lower. - assumption. - apply G_m_n_upper. - constructor. + apply G_m_n_lower. + constructor. + apply G_m_n_lower. + assumption. + apply G_m_n_upper. + constructor. apply G_m_n_upper. assumption. Qed. @@ -743,36 +701,30 @@ Proof. intros. unfold Cauchy_prop in |- *. intros e H. - cut - {n : nat | - (start_r x[-]start_l x[/] e[//]Greater_imp_ap _ e Zero H)[<]nring n}. - intro H0. - case H0. - intro N. - intro. - exists (S (N + 3)). - intros. - apply AbsSmall_minus. - apply - AbsSmall_leEq_trans - with - (start_r x[-]start_l x[/] nring (S (S (N + 3)))[//] - nringS_ap_zero Q_as_COrdField (S (N + 3))). - apply less_leEq. - apply swap_div with (z_ := Greater_imp_ap _ e Zero H). - apply pos_nring_S. - assumption. - apply less_transitive_unfolded with (nring (R:=Q_as_COrdField) N). - assumption. - apply nring_less. - apply le_lt_n_Sm. - constructor. - apply le_plus_l. - - apply G_conversion_rate2 with (m := S (N + 3)). - apply le_n_S. - apply le_plus_r. - assumption. + cut {n : nat | (start_r x[-]start_l x[/] e[//]Greater_imp_ap _ e Zero H)[<]nring n}. + intro H0. + case H0. + intro N. + intro. + exists (S (N + 3)). + intros. + apply AbsSmall_minus. + apply AbsSmall_leEq_trans with (start_r x[-]start_l x[/] nring (S (S (N + 3)))[//] + nringS_ap_zero Q_as_COrdField (S (N + 3))). + apply less_leEq. + apply swap_div with (z_ := Greater_imp_ap _ e Zero H). + apply pos_nring_S. + assumption. + apply less_transitive_unfolded with (nring (R:=Q_as_COrdField) N). + assumption. + apply nring_less. + apply le_lt_n_Sm. + constructor. + apply le_plus_l. + apply G_conversion_rate2 with (m := S (N + 3)). + apply le_n_S. + apply le_plus_r. + assumption. apply Q_is_archemaedian. (* Note the use of Q_is_archemaedian *) Qed. @@ -785,9 +737,7 @@ Lemma CS_seq_inj_Q_G : forall x : R1, Cauchy_prop (fun m : nat => inj_Q R1 (G x m)). Proof. intro. - change - (Cauchy_prop (fun m : nat => inj_Q R1 (CS_seq _ (G_as_CauchySeq x) m))) - in |- *. + change (Cauchy_prop (fun m : nat => inj_Q R1 (CS_seq _ (G_as_CauchySeq x) m))) in |- *. apply inj_Q_Cauchy. Qed. @@ -800,23 +750,23 @@ Lemma x_in_Intrvl_l : Proof. intros. induction n as [| n Hrecn]. - (* n=0 *) - simpl in |- *. - cut ((inj_Q R1 (start_l x)[<]x) and (x[<]inj_Q R1 (start_r x))). - intro H. - elim H. - intros. - assumption. - apply start_of_sequence_property. + (* n=0 *) + simpl in |- *. + cut ((inj_Q R1 (start_l x)[<]x) and (x[<]inj_Q R1 (start_r x))). + intro H. + elim H. + intros. + assumption. + apply start_of_sequence_property. (* n= (S n0) *) case (if_cotrans_strong x (Intrvl x n)). - intro H. - elim H. - intros H0 H1. - change (inj_Q R1 (fstT (if_cotrans x (Intrvl x n)))[<]x) in |- *. - rewrite H1. - simpl in |- *. - assumption. + intro H. + elim H. + intros H0 H1. + change (inj_Q R1 (fstT (if_cotrans x (Intrvl x n)))[<]x) in |- *. + rewrite H1. + simpl in |- *. + assumption. intro H. elim H. intros H0 H1. @@ -825,29 +775,29 @@ Proof. simpl in |- *. assumption. Qed. - + Lemma x_in_Intrvl_r : forall (x : R1) (n : nat), x[<]inj_Q R1 (sndT (Intrvl x n)). Proof. intros. induction n as [| n Hrecn]. - (* n=0 *) - simpl in |- *. - cut ((inj_Q R1 (start_l x)[<]x) and (x[<]inj_Q R1 (start_r x))). - intro H. - elim H. - intros. - assumption. - apply start_of_sequence_property. + (* n=0 *) + simpl in |- *. + cut ((inj_Q R1 (start_l x)[<]x) and (x[<]inj_Q R1 (start_r x))). + intro H. + elim H. + intros. + assumption. + apply start_of_sequence_property. (* n= (S n0) *) case (if_cotrans_strong x (Intrvl x n)). - intro H. - elim H. - intros H0 H1. - change (x[<]inj_Q R1 (sndT (if_cotrans x (Intrvl x n)))) in |- *. - rewrite H1. - simpl in |- *. - assumption. + intro H. + elim H. + intros H0 H1. + change (x[<]inj_Q R1 (sndT (if_cotrans x (Intrvl x n)))) in |- *. + rewrite H1. + simpl in |- *. + assumption. intro H. elim H. intros H0 H1. @@ -868,133 +818,102 @@ Lemma G_conversion_rate_resp_x : Proof. intros. apply AbsSmall_leEq_trans with (e1 := inj_Q R1 (Length _ (Intrvl x m))). - apply less_leEq. - apply inj_Q_less. - astepl ((Two [/]ThreeNZ)[^]m[*](start_r x[-]start_l x)). - rstepr - ((One[/] nring (S m)[//]nringS_ap_zero _ m)[*](start_r x[-]start_l x)). - apply mult_resp_less. - apply a_simple_inequality. - assumption. - apply shift_zero_less_minus. - apply l_less_r. - apply eq_symmetric_unfolded. - apply Length_Intrvl. + apply less_leEq. + apply inj_Q_less. + astepl ((Two [/]ThreeNZ)[^]m[*](start_r x[-]start_l x)). + rstepr ((One[/] nring (S m)[//]nringS_ap_zero _ m)[*](start_r x[-]start_l x)). + apply mult_resp_less. + apply a_simple_inequality. + assumption. + apply shift_zero_less_minus. + apply l_less_r. + apply eq_symmetric_unfolded. + apply Length_Intrvl. unfold Length in |- *. astepl (inj_Q R1 (sndT (Intrvl x m))[-]inj_Q R1 (fstT (Intrvl x m))). apply AbsSmall_subinterval; apply less_leEq. - apply inj_Q_less. - apply G_m_n_lower. - constructor. - apply x_in_Intrvl_l. - apply inj_Q_less. - apply G_m_n_upper. - constructor. + apply inj_Q_less. + apply G_m_n_lower. + constructor. + apply x_in_Intrvl_l. + apply inj_Q_less. + apply G_m_n_upper. + constructor. apply x_in_Intrvl_r. Qed. -Lemma x_is_SeqLimit_G : forall x : R1, SeqLimit (inj_Q_G_as_CauchySeq x) x. +Lemma x_is_SeqLimit_G : forall x : R1, SeqLimit (inj_Q_G_as_CauchySeq x) x. Proof. intros. unfold SeqLimit in |- *. intros e H. unfold inj_Q_G_as_CauchySeq in |- *. unfold CS_seq in |- *. - cut - {n : nat | - (inj_Q R1 (start_r x[-]start_l x)[/] e[//]Greater_imp_ap _ e Zero H)[<] - nring n}. - intro H0. - case H0. - intro N. - intro. - exists (S (N + 3)). - intros. - apply - AbsSmall_leEq_trans - with - (e1 := inj_Q R1 - ((start_r x[-]start_l x)[/]nring (S (S (N + 3)))[//] - nringS_ap_zero Q_as_COrdField (S (N + 3)))). - apply less_leEq. - apply - less_transitive_unfolded - with - (y := inj_Q R1 - ((start_r x[-]start_l x)[/]nring (R:=Q_as_COrdField) (S N)[//] - nringS_ap_zero _ N)). - apply inj_Q_less. - apply - mult_cancel_less - with (nring (R:=Q_as_COrdField) (S (S (N + 3)))[*]nring (S N)). - apply mult_resp_pos. - apply pos_nring_S. - apply pos_nring_S. - rstepl ((start_r x[-]start_l x)[*]nring (S N)). - rstepr ((start_r x[-]start_l x)[*]nring (S (S (N + 3)))). - apply mult_resp_less_lft. - apply nring_less. - apply lt_n_S. - apply le_lt_n_Sm. - apply le_plus_l. - apply shift_zero_less_minus. - apply l_less_r. - astepl - (inj_Q R1 (start_r x[-]start_l x)[/]nring (S N)[//]nringS_ap_zero R1 N). - apply swap_div with (z_ := Greater_imp_ap _ e Zero H). - apply pos_nring_S. - assumption. - apply less_transitive_unfolded with (y := nring (R:=R1) N). - assumption. - apply nring_less. - apply le_lt_n_Sm. - constructor. - apply mult_cancel_lft with (z := nring (R:=R1) (S N)). - apply nringS_ap_zero. - rstepl (inj_Q R1 (start_r x[-]start_l x)). - astepr - (inj_Q R1 (nring (S N))[*] - inj_Q R1 - ((start_r x[-]start_l x)[/]nring (S N)[//] - nringS_ap_zero Q_as_COrdField N)). - astepr - (inj_Q R1 - (nring (S N)[*] - ((start_r x[-]start_l x)[/]nring (S N)[//] - nringS_ap_zero Q_as_COrdField N))). - apply inj_Q_wd. - rational. - - apply - AbsSmall_leEq_trans - with - (e1 := inj_Q R1 - ((start_r x[-]start_l x)[/]nring (S m)[//] - nringS_ap_zero Q_as_COrdField m)). - apply inj_Q_leEq. - - apply - mult_cancel_leEq - with (nring (R:=Q_as_COrdField) (S (S (N + 3)))[*]nring (S m)). - apply mult_resp_pos. - apply pos_nring_S. - apply pos_nring_S. - - rstepl ((start_r x[-]start_l x)[*]nring (S (S (N + 3)))). - rstepr ((start_r x[-]start_l x)[*]nring (S m)). - apply mult_resp_leEq_lft. - apply nring_leEq. - apply le_n_S. - assumption. - - apply less_leEq. - apply shift_zero_less_minus. - apply l_less_r. - apply G_conversion_rate_resp_x. - apply le_trans with (m := S (N + 3)). - apply le_n_S. - apply le_plus_r. - assumption. + cut {n : nat | (inj_Q R1 (start_r x[-]start_l x)[/] e[//]Greater_imp_ap _ e Zero H)[<] nring n}. + intro H0. + case H0. + intro N. + intro. + exists (S (N + 3)). + intros. + apply AbsSmall_leEq_trans with (e1 := inj_Q R1 ((start_r x[-]start_l x)[/]nring (S (S (N + 3)))[//] + nringS_ap_zero Q_as_COrdField (S (N + 3)))). + apply less_leEq. + apply less_transitive_unfolded with (y := inj_Q R1 + ((start_r x[-]start_l x)[/]nring (R:=Q_as_COrdField) (S N)[//] nringS_ap_zero _ N)). + apply inj_Q_less. + apply mult_cancel_less with (nring (R:=Q_as_COrdField) (S (S (N + 3)))[*]nring (S N)). + apply mult_resp_pos. + apply pos_nring_S. + apply pos_nring_S. + rstepl ((start_r x[-]start_l x)[*]nring (S N)). + rstepr ((start_r x[-]start_l x)[*]nring (S (S (N + 3)))). + apply mult_resp_less_lft. + apply nring_less. + apply lt_n_S. + apply le_lt_n_Sm. + apply le_plus_l. + apply shift_zero_less_minus. + apply l_less_r. + astepl (inj_Q R1 (start_r x[-]start_l x)[/]nring (S N)[//]nringS_ap_zero R1 N). + apply swap_div with (z_ := Greater_imp_ap _ e Zero H). + apply pos_nring_S. + assumption. + apply less_transitive_unfolded with (y := nring (R:=R1) N). + assumption. + apply nring_less. + apply le_lt_n_Sm. + constructor. + apply mult_cancel_lft with (z := nring (R:=R1) (S N)). + apply nringS_ap_zero. + rstepl (inj_Q R1 (start_r x[-]start_l x)). + astepr (inj_Q R1 (nring (S N))[*] inj_Q R1 ((start_r x[-]start_l x)[/]nring (S N)[//] + nringS_ap_zero Q_as_COrdField N)). + astepr (inj_Q R1 (nring (S N)[*] ((start_r x[-]start_l x)[/]nring (S N)[//] + nringS_ap_zero Q_as_COrdField N))). + apply inj_Q_wd. + rational. + apply AbsSmall_leEq_trans with (e1 := inj_Q R1 ((start_r x[-]start_l x)[/]nring (S m)[//] + nringS_ap_zero Q_as_COrdField m)). + apply inj_Q_leEq. + apply mult_cancel_leEq with (nring (R:=Q_as_COrdField) (S (S (N + 3)))[*]nring (S m)). + apply mult_resp_pos. + apply pos_nring_S. + apply pos_nring_S. + rstepl ((start_r x[-]start_l x)[*]nring (S (S (N + 3)))). + rstepr ((start_r x[-]start_l x)[*]nring (S m)). + apply mult_resp_leEq_lft. + apply nring_leEq. + apply le_n_S. + assumption. + apply less_leEq. + apply shift_zero_less_minus. + apply l_less_r. + apply G_conversion_rate_resp_x. + apply le_trans with (m := S (N + 3)). + apply le_n_S. + apply le_plus_r. + assumption. apply Archimedes'. Qed. diff --git a/reals/Q_in_CReals.v b/reals/Q_in_CReals.v index 62e6bcdfe..7e3dfe1fa 100644 --- a/reals/Q_in_CReals.v +++ b/reals/Q_in_CReals.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** * On density of the image of [Q] in an arbitrary real number structure @@ -62,29 +62,33 @@ Variable R1 : CReals. (* We clone these proofs from CReals1.v just because there IR is an axiom *) (* begin hide *) Lemma CReals_is_CReals : is_CReals R1 (Lim (IR:=R1)). -unfold Lim in |- *. -elim R1; intros. -exact crl_proof. +Proof. + unfold Lim in |- *. + elim R1; intros. + exact crl_proof. Qed. Lemma Lim_Cauchy : forall s : CauchySeq R1, SeqLimit s (Lim s). -elim CReals_is_CReals. -intros. -apply ax_Lim. +Proof. + elim CReals_is_CReals. + intros. + apply ax_Lim. Qed. Lemma Archimedes : forall x : R1, {n : nat | x [<=] nring n}. -elim CReals_is_CReals. -intros. -apply ax_Arch. +Proof. + elim CReals_is_CReals. + intros. + apply ax_Arch. Qed. - + Lemma Archimedes' : forall x : R1, {n : nat | x [<] nring n}. -intro x. -elim (Archimedes (x[+]One)); intros n Hn. -exists n. -apply less_leEq_trans with (x[+]One); auto. -apply less_plusOne. +Proof. + intro x. + elim (Archimedes (x[+]One)); intros n Hn. + exists n. + apply less_leEq_trans with (x[+]One); auto. + apply less_plusOne. Qed. (*--------------------------------------*) @@ -104,19 +108,19 @@ Proof. apply nring_ap_zero. intro. absurd (0 < Qden x). - rewrite H. - auto with arith. + rewrite H. + auto with arith. apply lt_O_nat_of_P. Qed. (** And we define the injection in the natural way, using [zring] and [nring]. We call this [inj_Q], in contrast with [inject_Q] defined in [Cauchy_CReals]. *) Definition inj_Q : Q_as_COrdField -> R1. +Proof. intro x. case x. intros num0 den0. - exact - (zring num0[/]nring (R:=R1) den0[//]den_is_nonzero (Qmake num0 den0)). + exact (zring num0[/]nring (R:=R1) den0[//]den_is_nonzero (Qmake num0 den0)). Defined. (** Next we need some properties of [nring], on the setoid of natural numbers: *) @@ -127,77 +131,72 @@ Proof. intros m n. case m. case n. - intro H. simpl in |- *. red in |- *. simpl in H. cut (Not (Zero [#] (Zero:R1))). - intro. - intro. - elim H0. - assumption. + intro. + intro. + elim H0. + assumption. apply eq_imp_not_ap. apply eq_reflexive_unfolded. - - intros. - simpl in |- *. - red in |- *. - discriminate. - - case n. - - intros. - simpl in |- *. - red in |- *. - discriminate. - - intros. - simpl in |- *. - red in |- *. - intro. - cut (Not (nring (R:=R1) (S n1) [#] nring (R:=R1) (S n0))). - intro H1. - elim H1. - assumption. - apply eq_imp_not_ap. - rewrite H. - apply eq_reflexive_unfolded. + intros. + simpl in |- *. + red in |- *. + discriminate. + case n. + intros. + simpl in |- *. + red in |- *. + discriminate. + intros. + simpl in |- *. + red in |- *. + intro. + cut (Not (nring (R:=R1) (S n1) [#] nring (R:=R1) (S n0))). + intro H1. + elim H1. + assumption. + apply eq_imp_not_ap. + rewrite H. + apply eq_reflexive_unfolded. Qed. Lemma nring_wd : forall m n : nat_as_CMonoid, (m [=] n) -> nring (R:=R1) m [=] nring (R:=R1) n. Proof. intros. - simpl in H. + simpl in H. rewrite H. apply eq_reflexive_unfolded. Qed. - -Lemma nring_eq : forall m n : nat, m = n -> nring (R:=R1) m [=] nring (R:=R1) n. + +Lemma nring_eq : forall m n : nat, m = n -> nring (R:=R1) m [=] nring (R:=R1) n. Proof. intros. rewrite H. apply eq_reflexive_unfolded. Qed. - + Lemma nring_leEq : forall (OF : COrdField) m n, - m <= n -> nring (R:=OF) m [<=] nring (R:=OF) n. + m <= n -> nring (R:=OF) m [<=] nring (R:=OF) n. Proof. intros. - induction m as [| m Hrecm]. - simpl in |- *. - case n. - simpl in |- *. - apply leEq_reflexive. - intro. - apply less_leEq. - apply pos_nring_S. + induction m as [| m Hrecm]. + simpl in |- *. + case n. + simpl in |- *. + apply leEq_reflexive. + intro. + apply less_leEq. + apply pos_nring_S. case (le_lt_eq_dec (S m) n H). - intro. - apply less_leEq. - apply nring_less. - assumption. + intro. + apply less_leEq. + apply nring_less. + assumption. intro. rewrite e. apply leEq_reflexive. @@ -210,74 +209,63 @@ Lemma zring_strext : forall m n : Z_as_CRing, Proof. intros m n. case m. + case n. + intro H. + elimtype False. + cut (Zero [=] (Zero:R1)). + change (~ (Zero [=] (Zero:R1))) in |- *. + apply ap_imp_neq. + simpl in H. + assumption. + apply eq_reflexive_unfolded. + intros. + simpl in |- *. + red in |- *. + discriminate. + intros. + simpl in |- *. + red in |- *. + discriminate. + case n. + intros. + simpl in |- *. + red in |- *. + discriminate. + intros. + simpl in |- *. + intro. + cut (Not (zring (R:=R1) (BinInt.Zpos p0) [#] zring (R:=R1) (BinInt.Zpos p))). + intro H1. + elim H1. + assumption. + apply eq_imp_not_ap. + rewrite H. + apply eq_reflexive_unfolded. + intros. + simpl in |- *. + red in |- *. + discriminate. case n. - - intro H. - elimtype False. - cut (Zero [=] (Zero:R1)). - change (~ (Zero [=] (Zero:R1))) in |- *. - apply ap_imp_neq. - simpl in H. - assumption. - apply eq_reflexive_unfolded. - - intros. - simpl in |- *. - red in |- *. - discriminate. - - intros. - simpl in |- *. - red in |- *. - discriminate. - - case n. - - intros. - simpl in |- *. - red in |- *. - discriminate. - - intros. - simpl in |- *. - intro. - cut (Not (zring (R:=R1) (BinInt.Zpos p0) [#] zring (R:=R1) (BinInt.Zpos p))). - intro H1. - elim H1. - assumption. - apply eq_imp_not_ap. - rewrite H. - apply eq_reflexive_unfolded. - - intros. - simpl in |- *. - red in |- *. - discriminate. - - case n. - - intros. - simpl in |- *. - red in |- *. - discriminate. - - intros. - simpl in |- *. - red in |- *. - discriminate. - + intros. + simpl in |- *. + red in |- *. + discriminate. + intros. + simpl in |- *. + red in |- *. + discriminate. intros. simpl in |- *. intro. cut (Not (zring (R:=R1) (Zneg p0) [#] zring (R:=R1) (Zneg p))). - intro H1. - elim H1. - assumption. + intro H1. + elim H1. + assumption. apply eq_imp_not_ap. rewrite H. apply eq_reflexive_unfolded. Qed. - + Lemma zring_wd : forall m n : Z_as_CRing, (m [=] n) -> zring (R:=R1) m [=] zring (R:=R1) n. Proof. @@ -292,96 +280,86 @@ Lemma zring_less : forall m n : Z_as_CRing, Proof. intros m n. case m. + case n. + intro. + apply False_rect. + generalize H. + change (~ (0 < 0)%Z) in |- *. + apply Zlt_irrefl. + intros. + simpl in |- *. + astepl (nring (R:=R1) 0). + astepr (nring (R:=R1) (nat_of_P p)). + apply nring_less. + case (ZL4' p). + intro a. + intro H0. + rewrite H0. + apply lt_O_Sn. + intros. + apply False_rect. + generalize H. + change (~ (0 < Zneg p)%Z) in |- *. + apply Zlt_asym. + constructor. + case n. + intros. + apply False_rect. + generalize H. + change (~ (BinInt.Zpos p < 0)%Z) in |- *. + apply Zlt_asym. + constructor. + intros p1 p2. + intro. + simpl in |- *. + astepl (nring (R:=R1) (nat_of_P p2)). + astepr (nring (R:=R1) (nat_of_P p1)). + apply nring_less. + apply nat_of_P_lt_Lt_compare_morphism. + red in H. + simpl in H. + assumption. + intros p1 p2. + intro. + apply False_rect. + generalize H. + change (~ (BinInt.Zpos p2 < Zneg p1)%Z) in |- *. + apply Zlt_asym. + constructor. case n. - - intro. - apply False_rect. - generalize H. - change (~ (0 < 0)%Z) in |- *. - apply Zlt_irrefl. - - intros. - simpl in |- *. - astepl (nring (R:=R1) 0). - astepr (nring (R:=R1) (nat_of_P p)). - apply nring_less. - case (ZL4' p). - intro a. - intro H0. - rewrite H0. - apply lt_O_Sn. - - intros. - apply False_rect. - generalize H. - change (~ (0 < Zneg p)%Z) in |- *. - apply Zlt_asym. - constructor. - - case n. - - intros. - apply False_rect. - generalize H. - change (~ (BinInt.Zpos p < 0)%Z) in |- *. - apply Zlt_asym. - constructor. - - intros p1 p2. - intro. - simpl in |- *. - astepl (nring (R:=R1) (nat_of_P p2)). - astepr (nring (R:=R1) (nat_of_P p1)). - apply nring_less. - apply nat_of_P_lt_Lt_compare_morphism. - red in H. - simpl in H. - assumption. - - intros p1 p2. - intro. - apply False_rect. - generalize H. - change (~ (BinInt.Zpos p2 < Zneg p1)%Z) in |- *. - apply Zlt_asym. - constructor. - - case n. - intros. - simpl in |- *. - astepl [--](nring (R:=R1) (nat_of_P p)). - astepr (Zero:R1). - apply inv_cancel_less. - astepl (Zero:R1). - astepr (nring (R:=R1) (nat_of_P p)). - case (ZL4' p). - intro h. - intros H0. - rewrite H0. - apply pos_nring_S. - + intros. + simpl in |- *. + astepl [--](nring (R:=R1) (nat_of_P p)). + astepr (Zero:R1). + apply inv_cancel_less. + astepl (Zero:R1). + astepr (nring (R:=R1) (nat_of_P p)). + case (ZL4' p). + intro h. + intros H0. + rewrite H0. + apply pos_nring_S. + intros p1 p2. + intro. + simpl in |- *. + case (ZL4' p1). + intro h1. + case (ZL4' p2). + intro h2. + intros. + apply less_transitive_unfolded with (y := Zero:R1). + astepl [--](nring (R:=R1) (nat_of_P p2)). + apply inv_cancel_less. + astepl (Zero:R1). + astepr (nring (R:=R1) (nat_of_P p2)). + rewrite e. + apply pos_nring_S. + astepr (nring (R:=R1) p1). + rewrite e0. + apply pos_nring_S. intros p1 p2. intro. simpl in |- *. - case (ZL4' p1). - intro h1. - case (ZL4' p2). - intro h2. - intros. - apply less_transitive_unfolded with (y := Zero:R1). - astepl [--](nring (R:=R1) (nat_of_P p2)). - apply inv_cancel_less. - astepl (Zero:R1). - astepr (nring (R:=R1) (nat_of_P p2)). - rewrite e. - apply pos_nring_S. - astepr (nring (R:=R1) p1). - rewrite e0. - apply pos_nring_S. - - intros p1 p2. - intro. - simpl in |- *. astepl [--](nring (R:=R1) (nat_of_P p2)). astepr [--](nring (R:=R1) (nat_of_P p1)). apply inv_resp_less. @@ -399,7 +377,7 @@ Lemma inj_Q_strext : forall q1 q2, (inj_Q q1 [#] inj_Q q2) -> q1 [#] q2. Proof. intros q1 q2. generalize (den_is_nonzero q1). - generalize (den_is_nonzero q2). + generalize (den_is_nonzero q2). case q1. intros n1 d1. case q2. @@ -412,46 +390,43 @@ Proof. unfold Qeq in |- *. unfold Qnum in |- *. unfold Qden in |- *. - intro. - cut (~ (inj_Q (Qmake n1 d1) [=] inj_Q (Qmake n2 d2))). - intro. - elim H3. - simpl in |- *. - apply mult_cancel_lft with (z := nring (R:=R1) d1[*]nring (R:=R1) d2). - - apply mult_resp_ap_zero. - assumption. - assumption. - rstepl (zring (R:=R1) n1[*]nring (R:=R1) d2). - rstepr (zring (R:=R1) n2[*]nring (R:=R1) d1). - astepr (zring (R:=R1) (n1 * d2)). - astepr (zring (R:=R1) n1[*]zring (R:=R1) d2). - apply mult_wdr. - astepl (zring (R:=R1) (Z_of_nat (nat_of_P d2))). - rewrite inject_nat_convert. - algebra. - rewrite H2. - astepl (zring (R:=R1) n2[*]zring (R:=R1) d1). - apply mult_wdr. - astepr (zring (R:=R1) (Z_of_nat (nat_of_P d1))). - rewrite inject_nat_convert. - algebra. - change (inj_Q (Qmake n1 d1)[~=]inj_Q (Qmake n2 d2)) in |- *. + intro. + elim H3. + simpl in |- *. + apply mult_cancel_lft with (z := nring (R:=R1) d1[*]nring (R:=R1) d2). + apply mult_resp_ap_zero. + assumption. + assumption. + rstepl (zring (R:=R1) n1[*]nring (R:=R1) d2). + rstepr (zring (R:=R1) n2[*]nring (R:=R1) d1). + astepr (zring (R:=R1) (n1 * d2)). + astepr (zring (R:=R1) n1[*]zring (R:=R1) d2). + apply mult_wdr. + astepl (zring (R:=R1) (Z_of_nat (nat_of_P d2))). + rewrite inject_nat_convert. + algebra. + rewrite H2. + astepl (zring (R:=R1) n2[*]zring (R:=R1) d1). + apply mult_wdr. + astepr (zring (R:=R1) (Z_of_nat (nat_of_P d1))). + rewrite inject_nat_convert. + algebra. + change (inj_Q (Qmake n1 d1)[~=]inj_Q (Qmake n2 d2)) in |- *. apply ap_imp_neq. assumption. Qed. Lemma inj_Q_wd : forall q1 q2, (q1 [=] q2) -> inj_Q q1 [=] inj_Q q2. Proof. - intros. + intros. apply not_ap_imp_eq. intro. cut (~ (q1 [=] q2)). - intro H1. - apply H1. - assumption. + intro H1. + apply H1. + assumption. change (q1[~=]q2) in |- *. apply ap_imp_neq. apply inj_Q_strext. @@ -469,31 +444,26 @@ Proof. intros n2 d2. simpl in |- *. intros. - apply mult_cancel_lft with (z := nring (R:=R1) d1[*]nring (R:=R1) d2). - apply mult_resp_ap_zero. - assumption. - assumption. - + apply mult_resp_ap_zero. + assumption. + assumption. astepr (zring (R:=R1) (n1 * d2 + n2 * d1)). - astepr - (nring (R:=R1) (d1 * d2)%positive[*] - (zring (R:=R1) (n1 * d2 + n2 * d1)[/]nring (R:=R1) (d1 * d2)%positive[//] - den_is_nonzero (Qmake (n1 * d2 + n2 * d1)%Z (d1 * d2)%positive))). - apply mult_wdl. - rewrite nat_of_P_mult_morphism. - algebra. - - astepr - (zring (R:=R1) n1[*]nring (R:=R1) d2[+]zring (R:=R1) n2[*]nring (R:=R1) d1). - astepl (zring (R:=R1) (n1 * d2)[+]zring (R:=R1) (n2 * d1)). - apply bin_op_wd_unfolded. - astepr (zring (R:=R1) n1[*]zring (R:=R1) (Z_of_nat (nat_of_P d2))). - rewrite inject_nat_convert. - algebra. - astepr (zring (R:=R1) n2[*]zring (R:=R1) (Z_of_nat (nat_of_P d1))). - rewrite inject_nat_convert. - algebra. + astepr (nring (R:=R1) (d1 * d2)%positive[*] + (zring (R:=R1) (n1 * d2 + n2 * d1)[/]nring (R:=R1) (d1 * d2)%positive[//] + den_is_nonzero (Qmake (n1 * d2 + n2 * d1)%Z (d1 * d2)%positive))). + apply mult_wdl. + rewrite nat_of_P_mult_morphism. + algebra. + astepr (zring (R:=R1) n1[*]nring (R:=R1) d2[+]zring (R:=R1) n2[*]nring (R:=R1) d1). + astepl (zring (R:=R1) (n1 * d2)[+]zring (R:=R1) (n2 * d1)). + apply bin_op_wd_unfolded. + astepr (zring (R:=R1) n1[*]zring (R:=R1) (Z_of_nat (nat_of_P d2))). + rewrite inject_nat_convert. + algebra. + astepr (zring (R:=R1) n2[*]zring (R:=R1) (Z_of_nat (nat_of_P d1))). + rewrite inject_nat_convert. + algebra. rational. Qed. @@ -508,24 +478,19 @@ Proof. intros n2 d2. simpl in |- *. intros. - apply mult_cancel_lft with (z := nring (R:=R1) d1[*]nring (R:=R1) d2). - apply mult_resp_ap_zero. - assumption. - trivial. - + apply mult_resp_ap_zero. + assumption. + trivial. astepr (zring (R:=R1) (n1 * n2)). - astepr - (nring (R:=R1) (d1 * d2)%positive[*] - (zring (R:=R1) (n1 * n2)[/]nring (R:=R1) (d1 * d2)%positive[//] - den_is_nonzero (Qmake (n1 * n2)%Z (d1 * d2)%positive))). - - apply mult_wdl. - rewrite nat_of_P_mult_morphism. - algebra. - + astepr (nring (R:=R1) (d1 * d2)%positive[*] + (zring (R:=R1) (n1 * n2)[/]nring (R:=R1) (d1 * d2)%positive[//] + den_is_nonzero (Qmake (n1 * n2)%Z (d1 * d2)%positive))). + apply mult_wdl. + rewrite nat_of_P_mult_morphism. + algebra. astepr (zring (R:=R1) n1[*]zring (R:=R1) n2). - apply zring_mult. + apply zring_mult. rational. Qed. @@ -541,30 +506,28 @@ Proof. unfold Qlt in H. simpl in H. simpl in |- *. - apply mult_cancel_less with (z := nring (R:=R1) d1[*]nring (R:=R1) d2). - apply mult_resp_pos. - elim (ZL4' d1); intros. - rewrite p. - apply pos_nring_S. - elim (ZL4' d2); intros. - rewrite p. - apply pos_nring_S. - + apply mult_resp_pos. + elim (ZL4' d1); intros. + rewrite p. + apply pos_nring_S. + elim (ZL4' d2); intros. + rewrite p. + apply pos_nring_S. rstepl (zring (R:=R1) n1[*]nring (R:=R1) d2). rstepr (zring (R:=R1) n2[*]nring (R:=R1) d1). apply less_wdl with (x := zring (R:=R1) n1[*]zring (R:=R1) (Z_of_nat d2)). - apply less_wdr with (y := zring (R:=R1) n2[*]zring (R:=R1) (Z_of_nat d1)). - apply less_wdl with (x := zring (R:=R1) (n1 * d2)). - apply less_wdr with (y := zring (R:=R1) (n2 * d1)). - apply zring_less. - apply CZlt_to. - assumption. - rewrite inject_nat_convert. - apply zring_mult. - rewrite inject_nat_convert. - apply zring_mult. - algebra. + apply less_wdr with (y := zring (R:=R1) n2[*]zring (R:=R1) (Z_of_nat d1)). + apply less_wdl with (x := zring (R:=R1) (n1 * d2)). + apply less_wdr with (y := zring (R:=R1) (n2 * d1)). + apply zring_less. + apply CZlt_to. + assumption. + rewrite inject_nat_convert. + apply zring_mult. + rewrite inject_nat_convert. + apply zring_mult. + algebra. algebra. Qed. @@ -572,18 +535,18 @@ Lemma less_inj_Q : forall q1 q2, (inj_Q q1 [<] inj_Q q2) -> q1 [<] q2. Proof. intros. cut (q1 [#] q2). - intro H0. - case (ap_imp_less _ q1 q2 H0). - intro. - assumption. - intro. - elimtype False. - cut (inj_Q q2 [<] inj_Q q1). - change (Not (inj_Q q2 [<] inj_Q q1)) in |- *. - apply less_antisymmetric_unfolded. - assumption. - apply inj_Q_less. - assumption. + intro H0. + case (ap_imp_less _ q1 q2 H0). + intro. + assumption. + intro. + elimtype False. + cut (inj_Q q2 [<] inj_Q q1). + change (Not (inj_Q q2 [<] inj_Q q1)) in |- *. + apply less_antisymmetric_unfolded. + assumption. + apply inj_Q_less. + assumption. apply inj_Q_strext. apply less_imp_ap. assumption. @@ -591,26 +554,26 @@ Qed. Lemma inj_Q_ap : forall q1 q2, (q1 [#] q2) -> inj_Q q1 [#] inj_Q q2. Proof. -intros q1 q2 H. -destruct (ap_imp_less _ _ _ H); - [apply less_imp_ap|apply Greater_imp_ap]; - apply inj_Q_less; assumption. + intros q1 q2 H. + destruct (ap_imp_less _ _ _ H); [apply less_imp_ap|apply Greater_imp_ap]; + apply inj_Q_less; assumption. Qed. Lemma leEq_inj_Q : forall q1 q2, (inj_Q q1 [<=] inj_Q q2) -> q1 [<=] q2. -intros. -rewrite leEq_def; intro. -apply less_irreflexive_unfolded with (x := inj_Q q2). -eapply less_leEq_trans. -2: apply H. -apply inj_Q_less. -auto. +Proof. + intros. + rewrite leEq_def; intro. + apply less_irreflexive_unfolded with (x := inj_Q q2). + eapply less_leEq_trans. + 2: apply H. + apply inj_Q_less. + auto. Qed. Lemma inj_Q_leEq : forall q1 q2, (q1 [<=] q2) -> inj_Q q1 [<=] inj_Q q2. Proof. intros. - rewrite leEq_def; intro. + rewrite leEq_def; intro. rewrite -> leEq_def in H; apply H. apply less_inj_Q. assumption. @@ -621,28 +584,28 @@ Proof. intro. apply cg_cancel_lft with (x := inj_Q q1). astepr (inj_Q (q1[+][--]q1)). - apply eq_symmetric_unfolded. - apply inj_Q_plus. + apply eq_symmetric_unfolded. + apply inj_Q_plus. astepr (inj_Q Zero). - apply inj_Q_wd. - algebra. + apply inj_Q_wd. + algebra. simpl in |- *. rstepl (Zero:R1). algebra. Qed. -Lemma inj_Q_minus : forall q1 q2, inj_Q (q1[-]q2) [=] inj_Q q1[-]inj_Q q2. +Lemma inj_Q_minus : forall q1 q2, inj_Q (q1[-]q2) [=] inj_Q q1[-]inj_Q q2. Proof. intros. astepl (inj_Q (q1[+][--]q2)). astepr (inj_Q q1[+]inj_Q [--]q2). - apply inj_Q_plus. + apply inj_Q_plus. astepr (inj_Q q1[+][--](inj_Q q2)). apply plus_resp_eq. apply inj_Q_inv. Qed. -Lemma inj_Q_div : forall q1 q2 H, inj_Q (q1/q2)%Q [=] (inj_Q q1[/]inj_Q q2[//]H). +Lemma inj_Q_div : forall q1 q2 H, inj_Q (q1/q2)%Q [=] (inj_Q q1[/]inj_Q q2[//]H). Proof. intros. apply mult_cancel_rht with (inj_Q q2);[apply H|]. @@ -654,7 +617,7 @@ Proof. field. apply inj_Q_strext. stepr (Zero:R1). - apply H. + apply H. rstepl (inj_Q q1[-]inj_Q q1). apply eq_symmetric. eapply eq_transitive;[|apply inj_Q_minus]. @@ -677,13 +640,13 @@ Proof. elim H. intros. split. - astepl (inj_Q [--]q1). - apply inj_Q_leEq. - assumption. + astepl (inj_Q [--]q1). + apply inj_Q_leEq. + assumption. apply inj_Q_leEq. assumption. Qed. - + Lemma AbsSmall_inj_Q : forall q e, AbsSmall (inj_Q e) (inj_Q q) -> AbsSmall e q. Proof. @@ -691,12 +654,12 @@ Proof. elim H. intros. split. + apply leEq_inj_Q. + apply leEq_wdl with (x := [--](inj_Q e)). + assumption. + apply eq_symmetric_unfolded. + apply inj_Q_inv. apply leEq_inj_Q. - apply leEq_wdl with (x := [--](inj_Q e)). - assumption. - apply eq_symmetric_unfolded. - apply inj_Q_inv. - apply leEq_inj_Q. assumption. Qed. @@ -716,53 +679,45 @@ Proof. simpl in |- *. red in |- *. intros e H. - cut {n : nat | (One[/]e[//]Greater_imp_ap _ e Zero H) [<] nring (R:=R1) n}. - intro H0. - case H0. - intros N1 H1. - unfold Cauchy_prop in pg. - cut - {N : nat | - forall m : nat, - N <= m -> - AbsSmall (R:=Q_as_COrdField) (Qmake 1%Z (P_of_succ_nat N1)) (g_ m[-]g_ N)}. - intro H2. - case H2. - intro N. - intro. - exists N. - intros. - apply AbsSmall_leEq_trans with (e1 := inj_Q (Qmake 1%Z (P_of_succ_nat N1))). - apply less_leEq. - apply - mult_cancel_less - with (z := nring (R:=R1) (S N1)[*](One[/]e[//]Greater_imp_ap _ e Zero H)). - apply mult_resp_pos. - apply pos_nring_S. - apply div_resp_pos. - assumption. - apply pos_one. - unfold inj_Q in |- *. - rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ with N1. - rstepl (One[/]e[//]Greater_imp_ap _ e Zero H). - rstepr (nring (R:=R1) (P_of_succ_nat N1)). - apply less_transitive_unfolded with (y := nring (R:=R1) N1). - assumption. - apply nring_less. - rewrite nat_of_P_o_P_of_succ_nat_eq_succ. - apply lt_n_Sn. - astepr (inj_Q (g_ m[-]g_ N)). - apply inj_Q_AbsSmall. - apply a. - assumption. - - apply pg. - simpl in |- *. - red in |- *. - simpl in |- *. - constructor. - + intro H0. + case H0. + intros N1 H1. + unfold Cauchy_prop in pg. + cut {N : nat | forall m : nat, N <= m -> + AbsSmall (R:=Q_as_COrdField) (Qmake 1%Z (P_of_succ_nat N1)) (g_ m[-]g_ N)}. + intro H2. + case H2. + intro N. + intro. + exists N. + intros. + apply AbsSmall_leEq_trans with (e1 := inj_Q (Qmake 1%Z (P_of_succ_nat N1))). + apply less_leEq. + apply mult_cancel_less with (z := nring (R:=R1) (S N1)[*](One[/]e[//]Greater_imp_ap _ e Zero H)). + apply mult_resp_pos. + apply pos_nring_S. + apply div_resp_pos. + assumption. + apply pos_one. + unfold inj_Q in |- *. + rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ with N1. + rstepl (One[/]e[//]Greater_imp_ap _ e Zero H). + rstepr (nring (R:=R1) (P_of_succ_nat N1)). + apply less_transitive_unfolded with (y := nring (R:=R1) N1). + assumption. + apply nring_less. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + apply lt_n_Sn. + astepr (inj_Q (g_ m[-]g_ N)). + apply inj_Q_AbsSmall. + apply a. + assumption. + apply pg. + simpl in |- *. + red in |- *. + simpl in |- *. + constructor. apply Archimedes'. Qed. @@ -775,116 +730,118 @@ Proof. intro. simpl in |- *. induction n as [| n Hrecn]. - simpl in |- *. - rational. + simpl in |- *. + rational. change (inj_Q (nring n[+]One) [=] nring (R:=R1) n[+]One) in |- *. astepr (inj_Q (nring n)[+]inj_Q One). - apply inj_Q_plus. + apply inj_Q_plus. apply bin_op_wd_unfolded. - assumption. + assumption. simpl in |- *. unfold pring in |- *; simpl in |- *. rational. Qed. Lemma inj_Q_pring : forall n, inj_Q (pring _ n) [=] pring R1 n. -intros n. -change (inj_Q (zring n)[=]zring n). -stepr (inj_Q (nring n)). - apply inj_Q_wd. +Proof. + intros n. + change (inj_Q (zring n)[=]zring n). + stepr (inj_Q (nring n)). + apply inj_Q_wd. + rewrite <- inject_nat_convert. + apply zring_plus_nat. + stepr (nring n:R1). + apply inj_Q_nring. + apply eq_symmetric. rewrite <- inject_nat_convert. apply zring_plus_nat. -stepr (nring n:R1). - apply inj_Q_nring. -apply eq_symmetric. -rewrite <- inject_nat_convert. -apply zring_plus_nat. Qed. Lemma inj_Q_zring : forall n, inj_Q (zring n) [=] zring (R:=R1) n. Proof. -intros [|n|n]. + intros [|n|n]. + simpl. + rational. simpl. - rational. - simpl. - apply inj_Q_pring. -change (inj_Q ([--](pring _ n))[=][--](pring _ n)). -stepl ([--](inj_Q (zring (R:=Q_as_COrdField) n))). - apply un_op_wd_unfolded. - simpl. - apply inj_Q_pring. -apply eq_symmetric. -apply inj_Q_inv. + apply inj_Q_pring. + change (inj_Q ([--](pring _ n))[=][--](pring _ n)). + stepl ([--](inj_Q (zring (R:=Q_as_COrdField) n))). + apply un_op_wd_unfolded. + simpl. + apply inj_Q_pring. + apply eq_symmetric. + apply inj_Q_inv. Qed. Lemma inj_Q_One : inj_Q One [=] One. Proof. -rstepr ((nring 1):R1). -apply (inj_Q_nring 1). + rstepr ((nring 1):R1). + apply (inj_Q_nring 1). Qed. Lemma inj_Q_Zero : inj_Q Zero [=] Zero. Proof. -rstepr ((nring 0):R1). -apply (inj_Q_nring 0). + rstepr ((nring 0):R1). + apply (inj_Q_nring 0). Qed. Hint Resolve inj_Q_nring inj_Q_pring inj_Q_zring inj_Q_One inj_Q_Zero : algebra. Definition inj_Q_hom : RingHom Q_as_CRing R1. -exists (Build_CSetoid_fun _ _ _ inj_Q_strext). - refine inj_Q_plus. - refine inj_Q_mult. -refine inj_Q_One. +Proof. + exists (Build_CSetoid_fun _ _ _ inj_Q_strext). + refine inj_Q_plus. + refine inj_Q_mult. + refine inj_Q_One. Defined. -Lemma inj_Q_power : forall q1 (n:nat), inj_Q (q1^n)%Q [=] (inj_Q q1[^]n). +Lemma inj_Q_power : forall q1 (n:nat), inj_Q (q1^n)%Q [=] (inj_Q q1[^]n). Proof. -intros q. -induction n. - apply inj_Q_One. -rewrite inj_S. -unfold Zsucc. -stepr (inj_Q (q^n*q)%Q). - apply inj_Q_wd. + intros q. + induction n. + apply inj_Q_One. + rewrite inj_S. + unfold Zsucc. + stepr (inj_Q (q^n*q)%Q). + apply inj_Q_wd. + simpl. + apply Qpower_plus'. + auto with *. + stepr (inj_Q (q^n)%Q[*]inj_Q q). + apply inj_Q_mult. simpl. - apply Qpower_plus'. - auto with *. -stepr (inj_Q (q^n)%Q[*]inj_Q q). - apply inj_Q_mult. -simpl. -apply mult_wdl. -assumption. + apply mult_wdl. + assumption. Qed. -Lemma inj_Q_power_Z : forall q1 (n:Z) H, inj_Q (q1^n)%Q [=] ((inj_Q q1)[//]H)[^^]n. +Lemma inj_Q_power_Z : forall q1 (n:Z) H, inj_Q (q1^n)%Q [=] ((inj_Q q1)[//]H)[^^]n. Proof. -intros q [|n|n] H. - change (inj_Q (q ^ 0)%Q[=]One). - apply inj_Q_One. - simpl. - change (inj_Q (q ^ n)%Q[=]inj_Q q[^]n). - csetoid_rewrite_rev (inj_Q_power q n). - rewrite inject_nat_convert. - apply eq_reflexive. -change ((inj_Q (/q ^ n))%Q[=](One[/]inj_Q q[//]H)[^]n). -stepl (inj_Q ((1/q)^n)%Q). - stepr ((inj_Q (1/q)%Q)[^]n). - csetoid_rewrite_rev (inj_Q_power (1/q)%Q n). + intros q [|n|n] H. + change (inj_Q (q ^ 0)%Q[=]One). + apply inj_Q_One. + simpl. + change (inj_Q (q ^ n)%Q[=]inj_Q q[^]n). + csetoid_rewrite_rev (inj_Q_power q n). rewrite inject_nat_convert. apply eq_reflexive. - apply nexp_wd. - stepr (inj_Q 1%Q[/]_[//]H). - apply inj_Q_div. - apply div_wd. - rstepr (nring 1:R1). - apply (inj_Q_nring 1). - apply eq_reflexive. -apply inj_Q_wd. -change (((1 * / q) ^ n)%Q==(/ q ^ n))%Q. -rewrite <- Qinv_power. -rewrite Qmult_1_l. -reflexivity. + change ((inj_Q (/q ^ n))%Q[=](One[/]inj_Q q[//]H)[^]n). + stepl (inj_Q ((1/q)^n)%Q). + stepr ((inj_Q (1/q)%Q)[^]n). + csetoid_rewrite_rev (inj_Q_power (1/q)%Q n). + rewrite inject_nat_convert. + apply eq_reflexive. + apply nexp_wd. + stepr (inj_Q 1%Q[/]_[//]H). + apply inj_Q_div. + apply div_wd. + rstepr (nring 1:R1). + apply (inj_Q_nring 1). + apply eq_reflexive. + apply inj_Q_wd. + change (((1 * / q) ^ n)%Q==(/ q ^ n))%Q. + rewrite <- Qinv_power. + rewrite Qmult_1_l. + reflexivity. Qed. Hint Resolve inj_Q_power inj_Q_power_Z : algebra. @@ -906,30 +863,28 @@ Theorem start_of_sequence : forall x : R1, Proof. intros. cut {n : nat | x [<] nring (R:=R1) n}. - intro H. - cut {n : nat | [--]x [<] nring (R:=R1) n}. - intro H0. - case H. - intro n2. - intro. - case H0. - intro n1. - intro. - exists (Qmake (- n1) 1). - exists (Qmake n2 1). - simpl in |- *. - rstepl (zring (R:=R1) (- Z_of_nat n1)). - astepl [--](nring (R:=R1) n1). - apply inv_cancel_less. - astepr (nring (R:=R1) n1). - assumption. - - simpl in |- *. - rstepr (zring (R:=R1) (Z_of_nat n2)). - astepr (nring (R:=R1) n2). - assumption. - - apply Archimedes'. + intro H. + cut {n : nat | [--]x [<] nring (R:=R1) n}. + intro H0. + case H. + intro n2. + intro. + case H0. + intro n1. + intro. + exists (Qmake (- n1) 1). + exists (Qmake n2 1). + simpl in |- *. + rstepl (zring (R:=R1) (- Z_of_nat n1)). + astepl [--](nring (R:=R1) n1). + apply inv_cancel_less. + astepr (nring (R:=R1) n1). + assumption. + simpl in |- *. + rstepr (zring (R:=R1) (Z_of_nat n2)). + astepr (nring (R:=R1) n2). + assumption. + apply Archimedes'. apply Archimedes'. Qed. @@ -943,40 +898,34 @@ Lemma Q_dense_in_CReals : forall e : R1, Proof. intros e H. cut {n : nat | (One[/] e[//]Greater_imp_ap _ e Zero H) [<] nring (R:=R1) n}. - intro H0. - case H0. - intro N. - intros. - exists (Qmake 1 (P_of_succ_nat N)). - simpl in |- *. - unfold pring in |- *; simpl in |- *. - apply mult_cancel_less with (z := nring (R:=R1) N[+]One). - change (Zero [<] nring (R:=R1) (S N)) in |- *. - apply pos_nring_S. - astepl (Zero:R1). - astepr - ((Zero[+]One[-]Zero[/] nring (P_of_succ_nat N)[//] - den_is_nonzero (Qmake 1%positive (P_of_succ_nat N)))[*] - nring (S N)). - - rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ with N. - - rstepr (One:R1). - apply pos_one. - - apply bin_op_wd_unfolded. - rational. - algebra. - + intro H0. + case H0. + intro N. + intros. + exists (Qmake 1 (P_of_succ_nat N)). + simpl in |- *. + unfold pring in |- *; simpl in |- *. + apply mult_cancel_less with (z := nring (R:=R1) N[+]One). + change (Zero [<] nring (R:=R1) (S N)) in |- *. + apply pos_nring_S. + astepl (Zero:R1). + astepr ((Zero[+]One[-]Zero[/] nring (P_of_succ_nat N)[//] + den_is_nonzero (Qmake 1%positive (P_of_succ_nat N)))[*] nring (S N)). + rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ with N. + rstepr (One:R1). + apply pos_one. + apply bin_op_wd_unfolded. + rational. + algebra. simpl in |- *. apply swap_div with (z_ := Greater_imp_ap _ e Zero H). - rewrite nat_of_P_o_P_of_succ_nat_eq_succ. - apply pos_nring_S. - assumption. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + apply pos_nring_S. + assumption. unfold pring in |- *; simpl in |- *. rstepl (One[/] e[//]Greater_imp_ap _ e Zero H). apply less_transitive_unfolded with (y := nring (R:=R1) N). - assumption. + assumption. rewrite nat_of_P_o_P_of_succ_nat_eq_succ. apply nring_less_succ. apply Archimedes'. @@ -985,61 +934,58 @@ Qed. Lemma Q_dense_in_CReals' : forall a b : R1, a [<] b -> {q : Q_as_COrdField | a [<] inj_Q q | inj_Q q [<] b}. Proof. -cut (forall a b : R1, Zero[<]b -> a[<]b -> {q : Q_as_COrdField | a[<]inj_Q q | inj_Q q[<]b}). -intros H a b Hab. -destruct (less_cotransitive_unfolded _ _ _ Hab Zero);[|apply H;assumption]. -assert (X:Zero[<][--]a). - rstepl ([--]Zero:R1). - apply inv_resp_less. - assumption. -assert (Y:=inv_resp_less _ _ _ Hab). - destruct (H _ _ X Y) as [q Hqa Hqb]. -exists (-q)%Q. - stepr ([--](inj_Q q)). - apply inv_cancel_less. - stepl (inj_Q q);[assumption|apply eq_symmetric; apply cg_inv_inv]. - apply eq_symmetric; apply inj_Q_inv. -stepl ([--](inj_Q q)). -apply inv_cancel_less. - stepr (inj_Q q);[assumption|apply eq_symmetric; apply cg_inv_inv]. -apply eq_symmetric; apply inj_Q_inv. - -cut (forall a b : R1, -Zero[<]b -> (a[+]One)[<]b -> {n : nat | a[<]nring n | nring n[<]b}). -intros H a b Hb Hab. -destruct (Q_dense_in_CReals _ (shift_zero_less_minus _ _ _ Hab)) as [q Haq Hbq]. -assert (X0 := pos_ap_zero _ _ Haq). -assert (X1 : Zero[<](b[/]inj_Q q[//]X0)). - apply div_resp_pos; assumption. -assert (X2 : (a[/]inj_Q q[//]X0)[+]One[<](b[/]inj_Q q[//]X0)). - apply shift_plus_less'. - rstepr ((b[-]a)[/]inj_Q q[//]X0). - apply shift_less_div. - assumption. - rstepl (inj_Q q). - assumption. -destruct (H _ _ X1 X2) as [r Hra Hrb]. -exists ((nring r)[*]q)%Q; csetoid_rewrite (inj_Q_mult (nring r) q). - eapply shift_less_mult. - assumption. - stepr (nring (R:=R1) r) by (apply eq_symmetric; apply inj_Q_nring). - apply Hra. -eapply shift_mult_less. - assumption. -stepl (nring (R:=R1) r) by (apply eq_symmetric; apply inj_Q_nring). -apply Hrb. - -intros a b Hb Hab. -destruct (Archimedes' a) as [n Hn]. -induction n. - exists 0; try assumption. -destruct (less_cotransitive_unfolded _ _ _ Hab (nring (R:=R1) (S n))). - apply IHn. - apply plus_cancel_less with One. - apply c. -exists (S n); assumption. + cut (forall a b : R1, Zero[<]b -> a[<]b -> {q : Q_as_COrdField | a[<]inj_Q q | inj_Q q[<]b}). + intros H a b Hab. + destruct (less_cotransitive_unfolded _ _ _ Hab Zero);[|apply H;assumption]. + assert (X:Zero[<][--]a). + rstepl ([--]Zero:R1). + apply inv_resp_less. + assumption. + assert (Y:=inv_resp_less _ _ _ Hab). + destruct (H _ _ X Y) as [q Hqa Hqb]. + exists (-q)%Q. + stepr ([--](inj_Q q)). + apply inv_cancel_less. + stepl (inj_Q q);[assumption|apply eq_symmetric; apply cg_inv_inv]. + apply eq_symmetric; apply inj_Q_inv. + stepl ([--](inj_Q q)). + apply inv_cancel_less. + stepr (inj_Q q);[assumption|apply eq_symmetric; apply cg_inv_inv]. + apply eq_symmetric; apply inj_Q_inv. + cut (forall a b : R1, Zero[<]b -> (a[+]One)[<]b -> {n : nat | a[<]nring n | nring n[<]b}). + intros H a b Hb Hab. + destruct (Q_dense_in_CReals _ (shift_zero_less_minus _ _ _ Hab)) as [q Haq Hbq]. + assert (X0 := pos_ap_zero _ _ Haq). + assert (X1 : Zero[<](b[/]inj_Q q[//]X0)). + apply div_resp_pos; assumption. + assert (X2 : (a[/]inj_Q q[//]X0)[+]One[<](b[/]inj_Q q[//]X0)). + apply shift_plus_less'. + rstepr ((b[-]a)[/]inj_Q q[//]X0). + apply shift_less_div. + assumption. + rstepl (inj_Q q). + assumption. + destruct (H _ _ X1 X2) as [r Hra Hrb]. + exists ((nring r)[*]q)%Q; csetoid_rewrite (inj_Q_mult (nring r) q). + eapply shift_less_mult. + assumption. + stepr (nring (R:=R1) r) by (apply eq_symmetric; apply inj_Q_nring). + apply Hra. + eapply shift_mult_less. + assumption. + stepl (nring (R:=R1) r) by (apply eq_symmetric; apply inj_Q_nring). + apply Hrb. + intros a b Hb Hab. + destruct (Archimedes' a) as [n Hn]. + induction n. + exists 0; try assumption. + destruct (less_cotransitive_unfolded _ _ _ Hab (nring (R:=R1) (S n))). + apply IHn. + apply plus_cancel_less with One. + apply c. + exists (S n); assumption. Qed. - + End Rational_sequence_prelogue. Hint Resolve inj_Q_plus inj_Q_mult inj_Q_inv inj_Q_minus inj_Q_div : algebra. diff --git a/reals/R_morphism.v b/reals/R_morphism.v index a65373502..ca04cfed2 100644 --- a/reals/R_morphism.v +++ b/reals/R_morphism.v @@ -18,30 +18,30 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) -(* In this file a notion of morphism between two arbitrary real number - structures, is introduced together with te proofs that this notion of - morphism preserves the basic algebraic structure. *) +(* In this file a notion of morphism between two arbitrary real number + structures, is introduced together with te proofs that this notion of + morphism preserves the basic algebraic structure. *) Require Import CReals. (* This comes from CReals1.v *) -Definition Cauchy_Lim_prop2 (IR : CReals) (seq : nat -> IR) +Definition Cauchy_Lim_prop2 (IR : CReals) (seq : nat -> IR) (y : IR) := forall eps : IR, Zero[<]eps -> @@ -58,7 +58,7 @@ Variable phi : R1 -> R2. Variable p1 : R1 -> R1 -> CProp. Variable p2 : R2 -> R2 -> CProp. Variable f1 : R1 -> R1. -Variable f2 : R2 -> R2. +Variable f2 : R2 -> R2. Variable g1 : R1 -> R1 -> R1. Variable g2 : R2 -> R2 -> R2. @@ -77,13 +77,13 @@ Definition fun_pres_partial_fun:=(x:R1;H1:x[#]Zero;H2:(phi x)[#]Zero) Definition fun_pres_Lim := forall (a : nat -> R1) (l_a : R1), Cauchy_Lim_prop2 R1 a l_a -> - Cauchy_Lim_prop2 R2 (fun n : nat => phi (a n)) (phi l_a). + Cauchy_Lim_prop2 R2 (fun n : nat => phi (a n)) (phi l_a). End morphism_details. -Record Homomorphism : Type := +Record Homomorphism : Type := {map :> R1 -> R2; map_strext : fun_strext map; map_pres_less : @@ -95,10 +95,10 @@ Record Homomorphism : Type := -(* This might be useful later... +(* This might be useful later... Definition Homo_as_CSetoid_fun:= [f:Homomorphism] - (Build_CSetoid_fun R1 R2 f + (Build_CSetoid_fun R1 R2 f (fun_strext_imp_wd R1 R2 f (!map_strext f)) (!map_strext f) ). @@ -122,10 +122,10 @@ Proof. apply not_ap_imp_eq. intro H0. cut (Not (x[#]y)). - intro H1. - apply H1. - apply map_strext_unfolded with (f := f). - exact H0. + intro H1. + apply H1. + apply map_strext_unfolded with (f := f). + exact H0. apply eq_imp_not_ap. exact H. Qed. @@ -136,7 +136,7 @@ Proof. intro f. case f. intros. rename X into H. - apply map_pres_less. + apply map_pres_less. exact H. Qed. @@ -165,15 +165,16 @@ Proof. intros. apply cg_cancel_lft with (x := f Zero). apply eq_transitive_unfolded with (f Zero). - apply eq_transitive_unfolded with (f (Zero[+]Zero)). - apply eq_symmetric_unfolded. - apply map_pres_plus_unfolded. - apply map_wd_unfolded with (f := f). - algebra. + apply eq_transitive_unfolded with (f (Zero[+]Zero)). + apply eq_symmetric_unfolded. + apply map_pres_plus_unfolded. + apply map_wd_unfolded with (f := f). + algebra. algebra. Qed. Lemma map_pres_zero_unfolded : forall f : Homomorphism, f Zero[=]Zero. +Proof. intro. apply map_pres_zero. Qed. @@ -188,16 +189,16 @@ Proof. apply cg_cancel_lft with (x := f x). astepr (Zero:R2). apply eq_transitive_unfolded with (f (x[+][--]x)). - apply eq_symmetric_unfolded. - apply map_pres_plus_unfolded. + apply eq_symmetric_unfolded. + apply map_pres_plus_unfolded. astepl (f Zero). - apply map_pres_zero_unfolded. + apply map_pres_zero_unfolded. apply map_wd_unfolded. algebra. Qed. - + Lemma map_pres_minus_unfolded : - forall (f : Homomorphism) (x : R1), f [--]x[=][--](f x). + forall (f : Homomorphism) (x : R1), f [--]x[=][--](f x). Proof. exact map_pres_minus. Qed. @@ -207,16 +208,16 @@ Lemma map_pres_apartness : Proof. intros f x y H. cut (x[<]y or y[<]x). - intro H0. - case H0. - intro. - apply less_imp_ap. - apply map_pres_less_unfolded. - assumption. - intro H1. - apply Greater_imp_ap. - apply map_pres_less_unfolded. - exact H1. + intro H0. + case H0. + intro. + apply less_imp_ap. + apply map_pres_less_unfolded. + assumption. + intro H1. + apply Greater_imp_ap. + apply map_pres_less_unfolded. + exact H1. apply ap_imp_less. exact H. Qed. @@ -227,8 +228,8 @@ Lemma map_pres_ap_zero : Proof. intros. rename X into H. apply ap_wdr_unfolded with (y := f Zero). - apply map_pres_apartness with (y := Zero:R1). - exact H. + apply map_pres_apartness with (y := Zero:R1). + exact H. apply map_pres_zero_unfolded. Qed. @@ -237,16 +238,17 @@ Proof. intros. apply eq_symmetric_unfolded. apply mult_cancel_lft with (z := f One). - apply map_pres_ap_zero. - apply ring_non_triv. + apply map_pres_ap_zero. + apply ring_non_triv. astepl (f One). - astepl (f (One[*]One)). - apply map_pres_mult_unfolded. + astepl (f (One[*]One)). + apply map_pres_mult_unfolded. apply map_wd_unfolded with (f := f). algebra. Qed. Lemma map_pres_one_unfolded : forall f : Homomorphism, f One[=]One. +Proof. intro. apply map_pres_one. Qed. @@ -259,13 +261,13 @@ Lemma map_pres_inv_unfolded : Proof. intros. apply mult_cancel_lft with (z := f x). - apply map_pres_ap_zero. - assumption. + apply map_pres_ap_zero. + assumption. rstepr (One:R2). astepl (f One). - apply map_pres_one_unfolded. + apply map_pres_one_unfolded. astepl (f (x[*](One[/] x[//]H))). - apply map_pres_mult_unfolded. + apply map_pres_mult_unfolded. apply map_wd_unfolded. rational. Qed. @@ -311,7 +313,7 @@ Proof. intros g_1 g_2 g_3 g_4. intros. simpl in |- *. - apply g_2. + apply g_2. apply f_2. assumption. Qed. @@ -324,18 +326,18 @@ Proof. case f. intro f_. intros f_1 f_2 f_3 f_4. - cut (fun_wd g). - case g. - intro g_. - intros g_1 g_2 g_3 g_4. - intros. - simpl in H. - simpl in |- *. - astepl (g_ (f_ x[+]f_ y)). - apply g_3. + cut (fun_wd g). + case g. + intro g_. + intros g_1 g_2 g_3 g_4. + intros. + simpl in H. + simpl in |- *. + astepl (g_ (f_ x[+]f_ y)). + apply g_3. red in |- *. intros. - apply map_wd_unfolded. + apply map_wd_unfolded. assumption. Qed. @@ -347,36 +349,33 @@ Proof. case f. intro f_. intros f_1 f_2 f_3 f_4. - cut (fun_wd g). - case g. - intro g_. - intros g_1 g_2 g_3 g_4. - intros. - simpl in H. - simpl in |- *. - astepl (g_ (f_ x[*]f_ y)). - apply g_4. + cut (fun_wd g). + case g. + intro g_. + intros g_1 g_2 g_3 g_4. + intros. + simpl in H. + simpl in |- *. + astepl (g_ (f_ x[*]f_ y)). + apply g_4. red in |- *. intros. - apply map_wd_unfolded. + apply map_wd_unfolded. assumption. -Qed. +Qed. Lemma compose_pres_Lim : fun_pres_Lim R1 R3 compose. -Proof. +Proof. red in |- *. unfold compose in |- *. case f. intro f_. intros f_1 f_2 f_3 f_4 f_5. - case g. intro g_. intros g_1 g_2 g_3 g_4 g_5. intros. - simpl in |- *. - apply g_5 with (a := fun n : nat => f_ (a n)). apply f_5. assumption. @@ -387,9 +386,9 @@ Definition Compose := Build_Homomorphism R1 R3 compose compose_strext compose_pres_less compose_pres_plus compose_pres_mult compose_pres_Lim. - -End composition. + +End composition. Section isomorphism. @@ -405,7 +404,7 @@ Definition map_is_id := forall x : R3, f x[=]x. End identity_map. -Record Isomorphism : Type := +Record Isomorphism : Type := {iso_map_lft : Homomorphism R1 R2; iso_map_rht : Homomorphism R2 R1; inversity_lft : map_is_id R2 (Compose R2 R1 R2 iso_map_rht iso_map_lft); @@ -436,11 +435,11 @@ Proof. apply not_ap_imp_eq. intro. cut (Not (x[#]y)). - intro H2. - apply H2. - red in H1. - apply H1. - assumption. + intro H2. + apply H2. + red in H1. + apply H1. + assumption. apply eq_imp_not_ap. assumption. Qed. @@ -454,52 +453,54 @@ Lemma less_pres_f : forall x y : R1, f x[<]f y -> x[<]y. Proof. intros. case (ap_imp_less R1 x y). - red in H1. - apply H1. - apply less_imp_ap. - assumption. - intro. - assumption. + red in H1. + apply H1. + apply less_imp_ap. + assumption. + intro. + assumption. intro. elimtype False. cut (f y[<]f x). - change (Not (f y[<]f x)) in |- *. - apply less_antisymmetric_unfolded. - assumption. + change (Not (f y[<]f x)) in |- *. + apply less_antisymmetric_unfolded. + assumption. red in H2. apply H2. assumption. Qed. - + Lemma leEq_pres_f : forall x y : R1, f x[<=]f y -> x[<=]y. -intros; rewrite leEq_def; intro. -apply less_irreflexive_unfolded with (x := f x). -apply leEq_less_trans with (f y); auto. +Proof. + intros; rewrite leEq_def; intro. + apply less_irreflexive_unfolded with (x := f x). + apply leEq_less_trans with (f y); auto. Qed. Lemma f_pres_leEq : forall x y : R1, x[<=]y -> f x[<=]f y. -intros; rewrite leEq_def; intro. -apply less_irreflexive_unfolded with (x := x). -apply leEq_less_trans with y; auto. -apply less_pres_f; auto. +Proof. + intros; rewrite leEq_def; intro. + apply less_irreflexive_unfolded with (x := x). + apply leEq_less_trans with y; auto. + apply less_pres_f; auto. Qed. Lemma f_pres_apartness : forall x y : R1, x[#]y -> f x[#]f y. Proof. intros. cut (x[<]y or y[<]x). - intro H0. - case H0. - intro. - apply less_imp_ap. - red in H2. - apply H2. - assumption. - intro. - apply Greater_imp_ap. - red in H2. - apply H2. - assumption. + intro H0. + case H0. + intro. + apply less_imp_ap. + red in H2. + apply H2. + assumption. + intro. + apply Greater_imp_ap. + red in H2. + apply H2. + assumption. apply ap_imp_less. assumption. Qed. @@ -524,14 +525,14 @@ Qed. Lemma f_pres_minus : forall x : R1, f [--]x[=][--](f x). Proof. - intro. + intro. apply cg_cancel_lft with (x := f x). astepr (Zero:R2). - astepl (f (x[+][--]x)). + astepl (f (x[+][--]x)). astepr (f Zero). - apply f_well_def. - algebra. - apply f_pres_Zero. + apply f_well_def. + algebra. + apply f_pres_Zero. Qed. @@ -539,14 +540,14 @@ Lemma f_pres_min : forall x y : R1, f (x[-]y)[=]f x[-]f y. Proof. intros. astepr (f (x[+][--]y)). - apply f_well_def. - algebra. + apply f_well_def. + algebra. astepr (f x[+][--](f y)). red in H3. astepr (f x[+]f [--]y). - apply H3. + apply H3. apply bin_op_wd_unfolded. - apply eq_reflexive_unfolded. + apply eq_reflexive_unfolded. apply f_pres_minus. Qed. @@ -563,13 +564,13 @@ Lemma f_pres_ap_zero : forall x : R1, x[#]Zero -> f x[#]Zero. Proof. intros. apply ap_wdr_unfolded with (y := f Zero). - apply f_pres_apartness with (y := Zero:R1). - assumption. - assumption. - apply f_pres_Zero. + apply f_pres_apartness with (y := Zero:R1). + assumption. + assumption. + apply f_pres_Zero. assumption. Qed. - + Section surjectivity_helps. Hypothesis f_surj : map_is_surjective R1 R2 f. @@ -582,48 +583,48 @@ Proof. red in f_surj. unfold Cauchy_Lim_prop2 in H. cut {x : R1 | e2[=]f x}. - intro H4. - case H4. - intros e1 H5. - cut {N : nat | forall m : nat, N <= m -> AbsSmall e1 (a m[-]l_a)}. - intro H6. - case H6. - intro N. - intros. - exists N. - intros. - cut (AbsSmall e1 (a m[-]l_a)). - intro. - elim H8. - intros. - astepl (f e1). - astepr (f (a m[-]l_a)). - split. - astepl (f [--]e1). - apply f_pres_leEq. - assumption. - assumption. - apply f_pres_minus. - assumption. - apply f_pres_leEq. - assumption. - assumption. - apply f_pres_min. - assumption. - apply a0. - assumption. - apply H. - apply less_pres_f. - assumption. - astepl (Zero:R2). - astepr e2. - assumption. - apply eq_symmetric_unfolded. - apply f_pres_Zero. - assumption. + intro H4. + case H4. + intros e1 H5. + cut {N : nat | forall m : nat, N <= m -> AbsSmall e1 (a m[-]l_a)}. + intro H6. + case H6. + intro N. + intros. + exists N. + intros. + cut (AbsSmall e1 (a m[-]l_a)). + intro. + elim H8. + intros. + astepl (f e1). + astepr (f (a m[-]l_a)). + split. + astepl (f [--]e1). + apply f_pres_leEq. + assumption. + assumption. + apply f_pres_minus. + assumption. + apply f_pres_leEq. + assumption. + assumption. + apply f_pres_min. + assumption. + apply a0. + assumption. + apply H. + apply less_pres_f. + assumption. + astepl (Zero:R2). + astepr e2. + assumption. + apply eq_symmetric_unfolded. + apply f_pres_Zero. + assumption. apply f_surj. Qed. - + End surjectivity_helps. Section with_mult_plus_less. @@ -635,28 +636,28 @@ Proof. intros. apply eq_symmetric_unfolded. apply mult_cancel_lft with (z := f One). - apply f_pres_ap_zero. - apply ring_non_triv. + apply f_pres_ap_zero. + apply ring_non_triv. astepl (f One). - astepr (f (One[*]One)). + astepr (f (One[*]One)). apply f_well_def. algebra. Qed. - + Lemma f_pres_inv : forall (x : R1) (H : x[#]Zero), f (One[/] x[//]H)[=](One[/] f x[//]f_pres_ap_zero x H). Proof. intros. apply mult_cancel_lft with (z := f x). - apply f_pres_ap_zero. - assumption. + apply f_pres_ap_zero. + assumption. rstepr (One:R2). astepr (f One). - astepl (f (x[*](One[/] x[//]H))). - apply eq_symmetric_unfolded. - apply f_well_def. - rational. + astepl (f (x[*](One[/] x[//]H))). + apply eq_symmetric_unfolded. + apply f_well_def. + rational. apply f_pres_one. Qed. diff --git a/reals/RealCount.v b/reals/RealCount.v index 7e68be705..df781b954 100644 --- a/reals/RealCount.v +++ b/reals/RealCount.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CReals1. (* Consider Reals are enumerated by function f *) @@ -41,101 +41,110 @@ Section IntervalSequence. Variable f : nat -> IR. -Record interv : Type := +Record interv : Type := {interv_lft : IR; interv_rht : IR; interv_lft_rht : interv_lft [<] interv_rht}. -Lemma interv_0_correct: +Lemma interv_0_correct: f 0[+]One[<]f 0[+]Two. -apply plus_resp_less_lft. -apply one_less_two. -Qed. +Proof. + apply plus_resp_less_lft. + apply one_less_two. +Qed. Let interv_0 := (Build_interv (f 0 [+] One) (f 0[+]Two) interv_0_correct). -(* FIXME: Reuse this code from IVT -----------------------------------*) +(* FIXME: Reuse this code from IVT -----------------------------------*) Let Small : IR := Two [/]ThreeNZ. Let lft (a b : IR) := (Two[*]a[+]b) [/]ThreeNZ. Let rht (a b : IR) := (a[+]Two[*]b) [/]ThreeNZ. Lemma less_pres_lft : forall a b :IR, a[<] b -> a [<] lft a b. -intros. -unfold lft in |- *. -apply shift_less_div. -apply pos_three. -rstepl (Two[*]a[+]a). -apply plus_resp_less_lft. -auto. +Proof. + intros. + unfold lft in |- *. + apply shift_less_div. + apply pos_three. + rstepl (Two[*]a[+]a). + apply plus_resp_less_lft. + auto. Qed. Lemma less_pres_rht : forall a b :IR, a[<] b -> rht a b [<] b. -intros. -unfold rht in |- *. -apply shift_div_less. -apply pos_three. -rstepr (b[+]Two[*]b). -apply plus_resp_less_rht. -auto. +Proof. + intros. + unfold rht in |- *. + apply shift_div_less. + apply pos_three. + rstepr (b[+]Two[*]b). + apply plus_resp_less_rht. + auto. Qed. Lemma less_pres_lft_rht : forall a b :IR, a[<] b -> lft a b [<] rht a b. -intros. -unfold lft in |- *. unfold rht in |- *. -apply div_resp_less_rht. -rstepl (a[+]b[+]a). -rstepr (a[+]b[+]b). -apply plus_resp_less_lft. -auto. -apply pos_three. +Proof. + intros. + unfold lft in |- *. unfold rht in |- *. + apply div_resp_less_rht. + rstepl (a[+]b[+]a). + rstepr (a[+]b[+]b). + apply plus_resp_less_lft. + auto. + apply pos_three. Qed. Lemma smaller_rht : forall (a b : IR), rht a b[-]a [=] Small[*] (b[-]a). -intros. -unfold Small in |- *. unfold rht in |- *. -rational. +Proof. + intros. + unfold Small in |- *. unfold rht in |- *. + rational. Qed. Lemma smaller_lft : forall (a b : IR), b[-]lft a b [=] Small[*] (b[-]a). -intros. -unfold Small in |- *. unfold lft in |- *. -rational. +Proof. + intros. + unfold Small in |- *. unfold lft in |- *. + rational. Qed. Hint Resolve smaller_lft smaller_rht: algebra. Lemma small_greater_zero : Zero [<=] Small. -unfold Small. -assert (Zero[<](Two[/]ThreeNZ:IR)). -apply pos_div_three; auto. -apply pos_two; auto. -apply less_leEq; auto. +Proof. + unfold Small. + assert (Zero[<](Two[/]ThreeNZ:IR)). + apply pos_div_three; auto. + apply pos_two; auto. + apply less_leEq; auto. Qed. Lemma small_less_one : Small [<] One. -unfold Small. -apply mult_cancel_less with (Three:IR). -apply pos_three. -astepl (Two:IR). -astepr (Three:IR). -apply two_less_three. +Proof. + unfold Small. + apply mult_cancel_less with (Three:IR). + apply pos_three. + astepl (Two:IR). + astepr (Three:IR). + apply two_less_three. Qed. (* -------------------------------------------------------------- *) Definition seq_fun (I : interv) (n:nat) : interv. -intros I n. -case (less_cotransitive_unfolded IR _ _ (less_pres_lft_rht _ _ (interv_lft_rht I)) (f n)). -intro H1. -apply (Build_interv (interv_lft I) (lft (interv_lft I) (interv_rht I))). -apply less_pres_lft. -apply interv_lft_rht. -intro H2. -apply (Build_interv (rht (interv_lft I) (interv_rht I)) (interv_rht I)). -apply less_pres_rht. -apply interv_lft_rht. +Proof. + intros I n. + case (less_cotransitive_unfolded IR _ _ (less_pres_lft_rht _ _ (interv_lft_rht I)) (f n)). + intro H1. + apply (Build_interv (interv_lft I) (lft (interv_lft I) (interv_rht I))). + apply less_pres_lft. + apply interv_lft_rht. + intro H2. + apply (Build_interv (rht (interv_lft I) (interv_rht I)) (interv_rht I)). + apply less_pres_rht. + apply interv_lft_rht. Defined. Fixpoint seq1 (n:nat):interv := @@ -150,203 +159,211 @@ Definition seq1_rht := fun n:nat => interv_rht (seq1 n). Lemma next_smaller : forall (I : interv) (n : nat), seq1_rht (S n)[-]seq1_lft (S n) [<=] Small [*](seq1_rht n[-]seq1_lft n). -intros. -unfold seq1_lft. unfold seq1_rht. -astepl (interv_rht (seq_fun (seq1 n) (S n))[-]interv_lft (seq_fun (seq1 n) (S n))). -unfold seq_fun. -case (less_cotransitive_unfolded IR _ _ (less_pres_lft_rht _ _ (interv_lft_rht (seq1 n))) (f (S n))). - -intros. -simpl. -apply leEq_transitive with (rht (interv_lft (seq1 n)) (interv_rht (seq1 n))[-]interv_lft (seq1 n)). -apply minus_resp_leEq. -apply less_leEq. -apply less_pres_lft_rht. -apply interv_lft_rht. -apply eq_imp_leEq. -apply smaller_rht. - -intros. -simpl. -apply leEq_transitive with (interv_rht (seq1 n)[-]lft (interv_lft (seq1 n)) (interv_rht (seq1 n))). -apply minus_resp_leEq_rht. -apply less_leEq. -apply less_pres_lft_rht. -apply interv_lft_rht. -apply eq_imp_leEq. -apply smaller_lft. +Proof. + intros. + unfold seq1_lft. unfold seq1_rht. + astepl (interv_rht (seq_fun (seq1 n) (S n))[-]interv_lft (seq_fun (seq1 n) (S n))). + unfold seq_fun. + case (less_cotransitive_unfolded IR _ _ (less_pres_lft_rht _ _ (interv_lft_rht (seq1 n))) (f (S n))). + intros. + simpl. + apply leEq_transitive with (rht (interv_lft (seq1 n)) (interv_rht (seq1 n))[-]interv_lft (seq1 n)). + apply minus_resp_leEq. + apply less_leEq. + apply less_pres_lft_rht. + apply interv_lft_rht. + apply eq_imp_leEq. + apply smaller_rht. + intros. + simpl. + apply leEq_transitive with (interv_rht (seq1 n)[-]lft (interv_lft (seq1 n)) (interv_rht (seq1 n))). + apply minus_resp_leEq_rht. + apply less_leEq. + apply less_pres_lft_rht. + apply interv_lft_rht. + apply eq_imp_leEq. + apply smaller_lft. Qed. Lemma intervals_smaller : forall N : nat, -seq1_rht N[-]seq1_lft N [<=]Small[^]N. -intros. -induction N. -astepl ((One[-]Zero):IR). -astepr (One:IR). -astepl (One:IR). -apply leEq_reflexive. -unfold seq1_lft. -unfold seq1_rht. -simpl. -astepr ((Two [-] One):IR); rational. -apply leEq_transitive with (Small[*](seq1_rht N[-]seq1_lft N)); auto. -apply next_smaller; auto. -astepr (Small[*]Small[^]N). -apply mult_resp_leEq_lft; auto. -apply small_greater_zero. +seq1_rht N[-]seq1_lft N [<=]Small[^]N. +Proof. + intros. + induction N. + astepl ((One[-]Zero):IR). + astepr (One:IR). + astepl (One:IR). + apply leEq_reflexive. + unfold seq1_lft. + unfold seq1_rht. + simpl. + astepr ((Two [-] One):IR); rational. + apply leEq_transitive with (Small[*](seq1_rht N[-]seq1_lft N)); auto. + apply next_smaller; auto. + astepr (Small[*]Small[^]N). + apply mult_resp_leEq_lft; auto. + apply small_greater_zero. Qed. Lemma grow_lft : forall N m : nat, N <= m -> interv_lft (seq1 N) [<=] interv_lft (seq1 m). -intros. -induction m. destruct N; auto. -apply leEq_reflexive. -assert (S N = 0); auto with arith. -elim H0. -apply leEq_reflexive. -elim H. -apply leEq_reflexive. -clear IHm. clear H. clear m. -intros. -apply leEq_transitive with (interv_lft (seq1 m)); auto. -astepr (interv_lft (seq_fun (seq1 m) (S m))). -unfold seq_fun. -case (less_cotransitive_unfolded IR _ _ (less_pres_lft_rht _ _ (interv_lft_rht (seq1 m))) (f (S m))). -intros. simpl. apply leEq_reflexive. -intros. simpl. -apply less_leEq. -apply less_transitive_unfolded with (lft (interv_lft (seq1 m)) (interv_rht (seq1 m))). -apply less_pres_lft. -apply interv_lft_rht. -apply less_pres_lft_rht. -apply interv_lft_rht. +Proof. + intros. + induction m. destruct N; auto. + apply leEq_reflexive. + assert (S N = 0); auto with arith. + elim H0. + apply leEq_reflexive. + elim H. + apply leEq_reflexive. + clear IHm. clear H. clear m. + intros. + apply leEq_transitive with (interv_lft (seq1 m)); auto. + astepr (interv_lft (seq_fun (seq1 m) (S m))). + unfold seq_fun. + case (less_cotransitive_unfolded IR _ _ (less_pres_lft_rht _ _ (interv_lft_rht (seq1 m))) (f (S m))). + intros. simpl. apply leEq_reflexive. + intros. simpl. + apply less_leEq. + apply less_transitive_unfolded with (lft (interv_lft (seq1 m)) (interv_rht (seq1 m))). + apply less_pres_lft. + apply interv_lft_rht. + apply less_pres_lft_rht. + apply interv_lft_rht. Qed. Lemma grow_rht : forall N m : nat, N <= m -> interv_rht (seq1 m) [<=] interv_rht (seq1 N). -intros. -induction m. destruct N; auto. -apply leEq_reflexive. -assert (S N = 0); auto with arith. -elim H0. -apply leEq_reflexive. -elim H. -apply leEq_reflexive. -clear IHm. clear H. clear m. -intros. -apply leEq_transitive with (interv_rht (seq1 m)); auto. -astepl (interv_rht (seq_fun (seq1 m) (S m))). -unfold seq_fun. -case (less_cotransitive_unfolded IR _ _ (less_pres_lft_rht _ _ (interv_lft_rht (seq1 m))) (f (S m))). -simpl. intros. -apply less_leEq. -apply less_transitive_unfolded with (rht (interv_lft (seq1 m)) (interv_rht (seq1 m))). -apply less_pres_lft_rht. -apply interv_lft_rht. -apply less_pres_rht. -apply interv_lft_rht. -simpl. intros. -apply leEq_reflexive. +Proof. + intros. + induction m. destruct N; auto. + apply leEq_reflexive. + assert (S N = 0); auto with arith. + elim H0. + apply leEq_reflexive. + elim H. + apply leEq_reflexive. + clear IHm. clear H. clear m. + intros. + apply leEq_transitive with (interv_rht (seq1 m)); auto. + astepl (interv_rht (seq_fun (seq1 m) (S m))). + unfold seq_fun. + case (less_cotransitive_unfolded IR _ _ (less_pres_lft_rht _ _ (interv_lft_rht (seq1 m))) (f (S m))). + simpl. intros. + apply less_leEq. + apply less_transitive_unfolded with (rht (interv_lft (seq1 m)) (interv_rht (seq1 m))). + apply less_pres_lft_rht. + apply interv_lft_rht. + apply less_pres_rht. + apply interv_lft_rht. + simpl. intros. + apply leEq_reflexive. Qed. Lemma intervals_embed : forall N m : nat, N <= m -> AbsSmall (R:=IR) (seq1_rht N[-]seq1_lft N) (seq1_lft m[-]seq1_lft N). -intros. -unfold seq1_rht. unfold seq1_lft. -unfold AbsSmall. split. -apply leEq_transitive with (Zero:IR). -astepr ([--]Zero:IR). -apply inv_resp_leEq. -apply shift_leEq_lft. -apply less_leEq. -apply interv_lft_rht. -apply shift_leEq_lft. -2: apply minus_resp_leEq. -apply grow_lft; auto. -apply leEq_transitive with (interv_rht (seq1 m)). -apply less_leEq. apply interv_lft_rht. -apply grow_rht; auto. +Proof. + intros. + unfold seq1_rht. unfold seq1_lft. + unfold AbsSmall. split. + apply leEq_transitive with (Zero:IR). + astepr ([--]Zero:IR). + apply inv_resp_leEq. + apply shift_leEq_lft. + apply less_leEq. + apply interv_lft_rht. + apply shift_leEq_lft. + 2: apply minus_resp_leEq. + apply grow_lft; auto. + apply leEq_transitive with (interv_rht (seq1 m)). + apply less_leEq. apply interv_lft_rht. + apply grow_rht; auto. Qed. Lemma Cauchy_seq1_lft : Cauchy_prop seq1_lft. -unfold Cauchy_prop in |- *. -intro eps. intros H. -assert ({ N : nat | Small[^]N[<=]eps}). -apply (qi_yields_zero (Two[/]ThreeNZ) small_greater_zero small_less_one eps); auto. -destruct X as [N H1]. -exists N. intros. -apply AbsSmall_leEq_trans with (seq1_rht N[-]seq1_lft N); auto. -apply leEq_transitive with (Small[^]N); auto. -apply intervals_smaller; auto. -apply intervals_embed; auto. +Proof. + unfold Cauchy_prop in |- *. + intro eps. intros H. + assert ({ N : nat | Small[^]N[<=]eps}). + apply (qi_yields_zero (Two[/]ThreeNZ) small_greater_zero small_less_one eps); auto. + destruct X as [N H1]. + exists N. intros. + apply AbsSmall_leEq_trans with (seq1_rht N[-]seq1_lft N); auto. + apply leEq_transitive with (Small[^]N); auto. + apply intervals_smaller; auto. + apply intervals_embed; auto. Qed. Definition f_lim := Lim (Build_CauchySeq _ seq1_lft Cauchy_seq1_lft). -Lemma lim_smaller: +Lemma lim_smaller: forall (n : nat), f_lim [<=] (seq1_rht n). -intros. unfold f_lim. -apply str_seq_leEq_so_Lim_leEq. -exists n. intros. simpl. -unfold seq1_lft. unfold seq1_rht. -apply leEq_transitive with (interv_rht (seq1 i)). -apply less_leEq. apply interv_lft_rht. -apply grow_rht. auto. +Proof. + intros. unfold f_lim. + apply str_seq_leEq_so_Lim_leEq. + exists n. intros. simpl. + unfold seq1_lft. unfold seq1_rht. + apply leEq_transitive with (interv_rht (seq1 i)). + apply less_leEq. apply interv_lft_rht. + apply grow_rht. auto. Qed. -Lemma lim_bigger: +Lemma lim_bigger: forall (n : nat), (seq1_lft n) [<=] f_lim. -intros. -unfold f_lim. -apply str_leEq_seq_so_leEq_Lim. -exists n. intros. simpl. -unfold seq1_lft. unfold seq1_rht. -apply grow_lft; auto. +Proof. + intros. + unfold f_lim. + apply str_leEq_seq_so_leEq_Lim. + exists n. intros. simpl. + unfold seq1_lft. unfold seq1_rht. + apply grow_lft; auto. Qed. -Lemma f_n_not_in_int : +Lemma f_n_not_in_int : forall (n : nat), (f n) [<] (seq1_lft n) or (seq1_rht n) [<] (f n). -intros. -unfold seq1_lft. unfold seq1_rht. -induction n. -simpl. left. -apply less_plusOne. - -cut (f (S n)[<]interv_lft (seq_fun (seq1 n) (S n)) or interv_rht (seq_fun (seq1 n) (S n))[<]f (S n)); auto. -unfold seq_fun. -elim less_cotransitive_unfolded. -intros. -simpl in |- *. -right. -auto. -intros. -simpl in |- *. -left. -auto. +Proof. + intros. + unfold seq1_lft. unfold seq1_rht. + induction n. + simpl. left. + apply less_plusOne. + cut (f (S n)[<]interv_lft (seq_fun (seq1 n) (S n)) or interv_rht (seq_fun (seq1 n) (S n))[<]f (S n)); auto. + unfold seq_fun. + elim less_cotransitive_unfolded. + intros. + simpl in |- *. + right. + auto. + intros. + simpl in |- *. + left. + auto. Qed. Lemma lim_not_in_ranf : -forall (n : nat), f_lim [#] (f n). -intros. -elim (f_n_not_in_int n); intros. -assert (f n [<] f_lim). -apply less_leEq_trans with (seq1_lft n); auto. -apply lim_bigger. -apply ap_symmetric. -apply less_imp_ap; auto. -assert (f_lim [<] f n). -apply leEq_less_trans with (seq1_rht n); auto. -apply lim_smaller. -apply less_imp_ap; auto. +forall (n : nat), f_lim [#] (f n). +Proof. + intros. + elim (f_n_not_in_int n); intros. + assert (f n [<] f_lim). + apply less_leEq_trans with (seq1_lft n); auto. + apply lim_bigger. + apply ap_symmetric. + apply less_imp_ap; auto. + assert (f_lim [<] f n). + apply leEq_less_trans with (seq1_rht n); auto. + apply lim_smaller. + apply less_imp_ap; auto. Qed. End IntervalSequence. -Theorem reals_not_countable : +Theorem reals_not_countable : forall (f : nat -> IR),{x :IR | forall n : nat, x [#] (f n)}. -intros. -exists (f_lim f). -intros. -apply lim_not_in_ranf. +Proof. + intros. + exists (f_lim f). + intros. + apply lim_not_in_ranf. Qed. diff --git a/reals/RealFuncts.v b/reals/RealFuncts.v index c2445bc66..c1b90c664 100644 --- a/reals/RealFuncts.v +++ b/reals/RealFuncts.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CReals1. @@ -77,7 +77,7 @@ Definition Intcr (b x : IR) : Prop := x [<=] b. (** The limit of [f(x)] as [x] goes to [p = l], for both unary and binary functions: -The limit of [f] in [p] is [l] if +The limit of [f] in [p] is [l] if [[ forall e [>] Zero, exists d [>] Zero, forall (x : IR) ( [--]d [<] p[-]x [<] d) -> ( [--]e [<] [--]f(x) [<] e) diff --git a/reals/RealLists.v b/reals/RealLists.v index 1fc667c60..b1118d68f 100644 --- a/reals/RealLists.v +++ b/reals/RealLists.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export CReals1. @@ -82,352 +82,357 @@ Implicit Arguments map [A B]. Lemma map_pres_length : forall (A B : Set) (l : list A) (f : A -> B), length l = length (map f l). -intros. -induction l as [| a l Hrecl]. -auto. -simpl in |- *; auto. +Proof. + intros. + induction l as [| a l Hrecl]. + auto. + simpl in |- *; auto. Qed. -(** +(** Often we want to map partial functions through a list; this next operator provides a way to do that, and is proved to be correct. *) Implicit Arguments cons [A]. Definition map2 (F : PartIR) (l : list IR) : (forall y, member y l -> Dom F y) -> list IR. -intros F l H. -induction l as [| a l Hrecl]. -apply (@nil IR). -apply cons. -cut (member a (cons a l)); [ intro | right; algebra ]; rename X into H0. -apply (Part F a (H a H0)). -cut (forall y : IR, member y l -> Dom F y); intros; rename X into H0. -2: apply H; left; assumption. -apply (Hrecl H0). +Proof. + intros F l H. + induction l as [| a l Hrecl]. + apply (@nil IR). + apply cons. + cut (member a (cons a l)); [ intro | right; algebra ]; rename X into H0. + apply (Part F a (H a H0)). + cut (forall y : IR, member y l -> Dom F y); intros; rename X into H0. + 2: apply H; left; assumption. + apply (Hrecl H0). Defined. Lemma map2_wd : forall F l H H' x, member x (map2 F l H) -> member x (map2 F l H'). -intros. rename X into H0. -induction l as [| a l Hrecl]. -simpl in |- *; simpl in H0; assumption. -simpl in H0; inversion_clear H0. rename X into H0. -simpl in |- *; left. -apply - Hrecl - with - (fun (y : IR) (H0 : member y l) => H y (Cinleft (member y l) (y [=] a) H0)). -assumption. -right. -eapply eq_transitive_unfolded. -apply H1. -simpl in |- *; apply pfwdef; algebra. +Proof. + intros. rename X into H0. + induction l as [| a l Hrecl]. + simpl in |- *; simpl in H0; assumption. + simpl in H0; inversion_clear H0. rename X into H0. + simpl in |- *; left. + apply Hrecl with (fun (y : IR) (H0 : member y l) => H y (Cinleft (member y l) (y [=] a) H0)). + assumption. + right. + eapply eq_transitive_unfolded. + apply H1. + simpl in |- *; apply pfwdef; algebra. Qed. Lemma map2_pres_member : forall (F : PartIR) x Hx l H, member x l -> member (F x Hx) (map2 F l H). -intros. rename X into H0. -induction l as [| a l Hrecl]. -simpl in |- *; simpl in H; assumption. -simpl in |- *. -elim H0. -intro; left; apply Hrecl; assumption. -intro; right. -apply pfwdef; assumption. +Proof. + intros. rename X into H0. + induction l as [| a l Hrecl]. + simpl in |- *; simpl in H; assumption. + simpl in |- *. + elim H0. + intro; left; apply Hrecl; assumption. + intro; right. + apply pfwdef; assumption. Qed. (** As [maxlist] and [minlist] are generalizations of [Max] and [Min] to finite sets of real numbers, they have the expected properties: *) Lemma maxlist_greater : forall l x, member x l -> x [<=] maxlist l. -intros l x H. -induction l as [| a l Hrecl]. -elimtype CFalse; assumption. -simpl in |- *. -induction l as [| a0 l Hrecl0]. -simpl in H; elim H. -intro; tauto. -intro; apply eq_imp_leEq. -auto. -simpl in H. -elim H. -intro. -apply leEq_transitive with (maxlist (cons a0 l)). -apply Hrecl; assumption. -apply rht_leEq_Max. -intro; astepl a; apply lft_leEq_Max. +Proof. + intros l x H. + induction l as [| a l Hrecl]. + elimtype CFalse; assumption. + simpl in |- *. + induction l as [| a0 l Hrecl0]. + simpl in H; elim H. + intro; tauto. + intro; apply eq_imp_leEq. + auto. + simpl in H. + elim H. + intro. + apply leEq_transitive with (maxlist (cons a0 l)). + apply Hrecl; assumption. + apply rht_leEq_Max. + intro; astepl a; apply lft_leEq_Max. Qed. (* begin hide *) Let maxlist_aux : forall (a b : IR) (l : list IR), maxlist (cons a (cons b l)) [=] maxlist (cons b (cons a l)). -intros. -case l. -simpl in |- *; apply Max_comm. -intros c m. -astepl (Max a (Max b (maxlist (cons c m)))). -astepr (Max b (Max a (maxlist (cons c m)))). -apply leEq_imp_eq; apply Max_leEq. -eapply leEq_transitive. -2: apply rht_leEq_Max. -apply lft_leEq_Max. -apply Max_leEq. -apply lft_leEq_Max. -eapply leEq_transitive. -2: apply rht_leEq_Max. -apply rht_leEq_Max. -eapply leEq_transitive. -2: apply rht_leEq_Max. -apply lft_leEq_Max. -apply Max_leEq. -apply lft_leEq_Max. -eapply leEq_transitive. -2: apply rht_leEq_Max. -apply rht_leEq_Max. +Proof. + intros. + case l. + simpl in |- *; apply Max_comm. + intros c m. + astepl (Max a (Max b (maxlist (cons c m)))). + astepr (Max b (Max a (maxlist (cons c m)))). + apply leEq_imp_eq; apply Max_leEq. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + apply lft_leEq_Max. + apply Max_leEq. + apply lft_leEq_Max. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + apply rht_leEq_Max. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + apply lft_leEq_Max. + apply Max_leEq. + apply lft_leEq_Max. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + apply rht_leEq_Max. Qed. (* end hide *) Lemma maxlist_leEq_eps : forall l : list IR, {x : IR | member x l} -> forall e, Zero [<] e -> {x : IR | member x l | maxlist l[-]e [<=] x}. -intro l; induction l as [| a l Hrecl]. - intro H; simpl in H; inversion H; rename X into H0; inversion H0. -clear Hrecl. -intro H; induction l as [| a0 l Hrecl]; intros e H0. - simpl in |- *; exists a. - right; algebra. - apply less_leEq; apply shift_minus_less; apply shift_less_plus'. - astepl ZeroR; assumption. -cut - ({Max a0 (maxlist (cons a l)) [-]e [/]TwoNZ [<=] a0} + - {Max a0 (maxlist (cons a l)) [-]e [/]TwoNZ [<=] maxlist (cons a l)}). - 2: apply Max_minus_eps_leEq; apply pos_div_two; assumption. -intro H1. -elim H1; intro H2. - exists a0. - simpl in |- *; left; right; algebra. - apply leEq_transitive with (Max a (maxlist (cons a0 l)) [-]e [/]TwoNZ). - astepl (Max a (maxlist (cons a0 l)) [-]e). - apply shift_leEq_minus; apply shift_plus_leEq'. - rstepr e. - apply less_leEq; apply pos_div_two'; assumption. - apply shift_minus_leEq. - astepl (maxlist (cons a (cons a0 l))). - eapply leEq_wdl. - 2: apply maxlist_aux. - astepl (Max a0 (maxlist (cons a l))). - apply shift_leEq_plus; assumption. -elim Hrecl with (e [/]TwoNZ). - intros x p q. - exists x. - elim p; intro H3. - left; left; assumption. - right; assumption. - apply shift_minus_leEq; eapply leEq_wdl. +Proof. + intro l; induction l as [| a l Hrecl]. + intro H; simpl in H; inversion H; rename X into H0; inversion H0. + clear Hrecl. + intro H; induction l as [| a0 l Hrecl]; intros e H0. + simpl in |- *; exists a. + right; algebra. + apply less_leEq; apply shift_minus_less; apply shift_less_plus'. + astepl ZeroR; assumption. + cut ({Max a0 (maxlist (cons a l)) [-]e [/]TwoNZ [<=] a0} + + {Max a0 (maxlist (cons a l)) [-]e [/]TwoNZ [<=] maxlist (cons a l)}). + 2: apply Max_minus_eps_leEq; apply pos_div_two; assumption. + intro H1. + elim H1; intro H2. + exists a0. + simpl in |- *; left; right; algebra. + apply leEq_transitive with (Max a (maxlist (cons a0 l)) [-]e [/]TwoNZ). + astepl (Max a (maxlist (cons a0 l)) [-]e). + apply shift_leEq_minus; apply shift_plus_leEq'. + rstepr e. + apply less_leEq; apply pos_div_two'; assumption. + apply shift_minus_leEq. + astepl (maxlist (cons a (cons a0 l))). + eapply leEq_wdl. 2: apply maxlist_aux. - apply shift_leEq_plus. - astepl (Max a0 (maxlist (cons a l)) [-]e). - rstepl (Max a0 (maxlist (cons a l)) [-]e [/]TwoNZ[-]e [/]TwoNZ). - apply leEq_transitive with (maxlist (cons a l) [-]e [/]TwoNZ). - apply minus_resp_leEq; assumption. - assumption. - exists a; right; algebra. -apply pos_div_two; assumption. + astepl (Max a0 (maxlist (cons a l))). + apply shift_leEq_plus; assumption. + elim Hrecl with (e [/]TwoNZ). + intros x p q. + exists x. + elim p; intro H3. + left; left; assumption. + right; assumption. + apply shift_minus_leEq; eapply leEq_wdl. + 2: apply maxlist_aux. + apply shift_leEq_plus. + astepl (Max a0 (maxlist (cons a l)) [-]e). + rstepl (Max a0 (maxlist (cons a l)) [-]e [/]TwoNZ[-]e [/]TwoNZ). + apply leEq_transitive with (maxlist (cons a l) [-]e [/]TwoNZ). + apply minus_resp_leEq; assumption. + assumption. + exists a; right; algebra. + apply pos_div_two; assumption. Qed. Lemma maxlist_less : forall x l, 0 < length l -> (forall y, member y l -> y [<] x) -> maxlist l [<] x. -simple induction l. -simpl in |- *; intros; elimtype False; inversion H. -clear l. -do 2 intro. intro H. -clear H; induction l as [| a0 l Hrecl]. -simpl in |- *; intros H H0. -apply H0; right; algebra. -generalize l a0 Hrecl; clear Hrecl l a0. -intros l b; intros. rename X into H0. -eapply less_wdl. -2: apply maxlist_aux. -astepl (Max b (maxlist (cons a l))). -apply Max_less. -apply H0; left; right; algebra. -apply Hrecl. -simpl in |- *; apply lt_O_Sn. -intros y H1. apply H0. -inversion_clear H1. -left; left; assumption. -right; assumption. +Proof. + simple induction l. + simpl in |- *; intros; elimtype False; inversion H. + clear l. + do 2 intro. intro H. + clear H; induction l as [| a0 l Hrecl]. + simpl in |- *; intros H H0. + apply H0; right; algebra. + generalize l a0 Hrecl; clear Hrecl l a0. + intros l b; intros. rename X into H0. + eapply less_wdl. + 2: apply maxlist_aux. + astepl (Max b (maxlist (cons a l))). + apply Max_less. + apply H0; left; right; algebra. + apply Hrecl. + simpl in |- *; apply lt_O_Sn. + intros y H1. apply H0. + inversion_clear H1. + left; left; assumption. + right; assumption. Qed. Lemma maxlist_leEq : forall y l, 0 < length l -> (forall x, member x l -> x [<=] y) -> maxlist l [<=] y. -simple induction l. -simpl in |- *; intros; elimtype False; inversion H. -clear l. -do 3 intro. -clear H; induction l as [| a0 l Hrecl]. -simpl in |- *; intros. -apply H0; right; algebra. -generalize l a0 Hrecl; clear Hrecl l a0. -intros l b; intros. -eapply leEq_wdl. -2: apply maxlist_aux. -astepl (Max b (maxlist (cons a l))). -apply Max_leEq. -apply H0; left; right; algebra. -apply Hrecl. -simpl in |- *; auto with arith. -intros x H1. apply H0. -inversion_clear H1. -left; left; assumption. -right; assumption. +Proof. + simple induction l. + simpl in |- *; intros; elimtype False; inversion H. + clear l. + do 3 intro. + clear H; induction l as [| a0 l Hrecl]. + simpl in |- *; intros. + apply H0; right; algebra. + generalize l a0 Hrecl; clear Hrecl l a0. + intros l b; intros. + eapply leEq_wdl. + 2: apply maxlist_aux. + astepl (Max b (maxlist (cons a l))). + apply Max_leEq. + apply H0; left; right; algebra. + apply Hrecl. + simpl in |- *; auto with arith. + intros x H1. apply H0. + inversion_clear H1. + left; left; assumption. + right; assumption. Qed. Lemma minlist_smaller : forall l x, member x l -> minlist l [<=] x. -intros l x H. -induction l as [| a l Hrecl]. -elimtype CFalse; assumption. -simpl in |- *. -astepl match l with - | nil => a - | cons _ _ => Min a (minlist l) - end. -induction l as [| a0 l Hrecl0]. -simpl in H; elim H. -intro; tauto. -intro; cut (a [=] x); - [ apply eq_imp_leEq | apply eq_symmetric_unfolded; assumption ]. -simpl in H. -elim H. -intro. -apply leEq_transitive with (minlist (cons a0 l)). -apply Min_leEq_rht. -apply Hrecl; assumption. -intro; astepr a; apply Min_leEq_lft. +Proof. + intros l x H. + induction l as [| a l Hrecl]. + elimtype CFalse; assumption. + simpl in |- *. + astepl match l with | nil => a | cons _ _ => Min a (minlist l) end. + induction l as [| a0 l Hrecl0]. + simpl in H; elim H. + intro; tauto. + intro; cut (a [=] x); [ apply eq_imp_leEq | apply eq_symmetric_unfolded; assumption ]. + simpl in H. + elim H. + intro. + apply leEq_transitive with (minlist (cons a0 l)). + apply Min_leEq_rht. + apply Hrecl; assumption. + intro; astepr a; apply Min_leEq_lft. Qed. (* begin hide *) Let minlist_aux : forall (a b : IR) (l : list IR), minlist (cons a (cons b l)) [=] minlist (cons b (cons a l)). -intros. -case l. -astepl (Min a b); astepr (Min b a); apply Min_comm. -intros c m. -astepl (Min a (Min b (minlist (cons c m)))). -astepr (Min b (Min a (minlist (cons c m)))). -apply leEq_imp_eq; apply leEq_Min. -eapply leEq_transitive. -apply Min_leEq_rht. -apply Min_leEq_lft. -apply leEq_Min. -apply Min_leEq_lft. -eapply leEq_transitive. -apply Min_leEq_rht. -apply Min_leEq_rht. -eapply leEq_transitive. -apply Min_leEq_rht. -apply Min_leEq_lft. -apply leEq_Min. -apply Min_leEq_lft. -eapply leEq_transitive. -apply Min_leEq_rht. -apply Min_leEq_rht. +Proof. + intros. + case l. + astepl (Min a b); astepr (Min b a); apply Min_comm. + intros c m. + astepl (Min a (Min b (minlist (cons c m)))). + astepr (Min b (Min a (minlist (cons c m)))). + apply leEq_imp_eq; apply leEq_Min. + eapply leEq_transitive. + apply Min_leEq_rht. + apply Min_leEq_lft. + apply leEq_Min. + apply Min_leEq_lft. + eapply leEq_transitive. + apply Min_leEq_rht. + apply Min_leEq_rht. + eapply leEq_transitive. + apply Min_leEq_rht. + apply Min_leEq_lft. + apply leEq_Min. + apply Min_leEq_lft. + eapply leEq_transitive. + apply Min_leEq_rht. + apply Min_leEq_rht. Qed. (* end hide *) Lemma minlist_leEq_eps : forall l : list IR, {x : IR | member x l} -> forall e, Zero [<] e -> {x : IR | member x l | x [<=] minlist l[+]e}. -intro l; induction l as [| a l Hrecl]. - intro H; simpl in H; inversion H; rename X into H0; inversion H0. -clear Hrecl. -intro H; induction l as [| a0 l Hrecl]; intros e He. - simpl in |- *; exists a. - right; algebra. - apply less_leEq; apply shift_less_plus'. - astepl ZeroR; assumption. -cut - ({a0 [<=] Min a0 (minlist (cons a l)) [+]e [/]TwoNZ} + - {minlist (cons a l) [<=] Min a0 (minlist (cons a l)) [+]e [/]TwoNZ}). - 2: apply leEq_Min_plus_eps; apply pos_div_two; assumption. -intro H1. -elim H1; intro H2. - exists a0. - simpl in |- *; left; right; algebra. - apply leEq_transitive with (Min a (minlist (cons a0 l)) [+]e [/]TwoNZ). - apply shift_leEq_plus. - astepr (minlist (cons a (cons a0 l))). - eapply leEq_wdr. - 2: apply minlist_aux. - astepr (Min a0 (minlist (cons a l))). - apply shift_minus_leEq; assumption. - astepr (Min a (minlist (cons a0 l)) [+]e). - apply plus_resp_leEq_lft. - apply less_leEq; apply pos_div_two'; assumption. -elim Hrecl with (e [/]TwoNZ). - intros x p q. - exists x. - elim p; intro H3. - left; left; assumption. - right; assumption. - apply shift_leEq_plus; eapply leEq_wdr. - 2: apply minlist_aux. - apply shift_minus_leEq. - astepr (Min a0 (minlist (cons a l)) [+]e). - rstepr (Min a0 (minlist (cons a l)) [+]e [/]TwoNZ[+]e [/]TwoNZ). - apply leEq_transitive with (minlist (cons a l) [+]e [/]TwoNZ). - assumption. - apply plus_resp_leEq; assumption. - exists a; right; algebra. -apply pos_div_two; assumption. +Proof. + intro l; induction l as [| a l Hrecl]. + intro H; simpl in H; inversion H; rename X into H0; inversion H0. + clear Hrecl. + intro H; induction l as [| a0 l Hrecl]; intros e He. + simpl in |- *; exists a. + right; algebra. + apply less_leEq; apply shift_less_plus'. + astepl ZeroR; assumption. + cut ({a0 [<=] Min a0 (minlist (cons a l)) [+]e [/]TwoNZ} + + {minlist (cons a l) [<=] Min a0 (minlist (cons a l)) [+]e [/]TwoNZ}). + 2: apply leEq_Min_plus_eps; apply pos_div_two; assumption. + intro H1. + elim H1; intro H2. + exists a0. + simpl in |- *; left; right; algebra. + apply leEq_transitive with (Min a (minlist (cons a0 l)) [+]e [/]TwoNZ). + apply shift_leEq_plus. + astepr (minlist (cons a (cons a0 l))). + eapply leEq_wdr. + 2: apply minlist_aux. + astepr (Min a0 (minlist (cons a l))). + apply shift_minus_leEq; assumption. + astepr (Min a (minlist (cons a0 l)) [+]e). + apply plus_resp_leEq_lft. + apply less_leEq; apply pos_div_two'; assumption. + elim Hrecl with (e [/]TwoNZ). + intros x p q. + exists x. + elim p; intro H3. + left; left; assumption. + right; assumption. + apply shift_leEq_plus; eapply leEq_wdr. + 2: apply minlist_aux. + apply shift_minus_leEq. + astepr (Min a0 (minlist (cons a l)) [+]e). + rstepr (Min a0 (minlist (cons a l)) [+]e [/]TwoNZ[+]e [/]TwoNZ). + apply leEq_transitive with (minlist (cons a l) [+]e [/]TwoNZ). + assumption. + apply plus_resp_leEq; assumption. + exists a; right; algebra. + apply pos_div_two; assumption. Qed. Lemma less_minlist : forall x l, 0 < length l -> (forall y, member y l -> x [<] y) -> x [<] minlist l. -simple induction l. -simpl in |- *; intros; elimtype False; inversion H. -clear l. -do 2 intro. intro H. -clear H; induction l as [| a0 l Hrecl]. -simpl in |- *; intros H H0. -apply H0; right; algebra. -generalize l a0 Hrecl; clear Hrecl l a0. -intros l b; intros. rename X into H0. -eapply less_wdr. -2: apply minlist_aux. -astepr (Min b (minlist (cons a l))). -apply less_Min. -apply H0; left; right; algebra. -apply Hrecl. -simpl in |- *; auto with arith. -intros y H1; apply H0. -inversion_clear H1. -left; left; assumption. -right; assumption. +Proof. + simple induction l. + simpl in |- *; intros; elimtype False; inversion H. + clear l. + do 2 intro. intro H. + clear H; induction l as [| a0 l Hrecl]. + simpl in |- *; intros H H0. + apply H0; right; algebra. + generalize l a0 Hrecl; clear Hrecl l a0. + intros l b; intros. rename X into H0. + eapply less_wdr. + 2: apply minlist_aux. + astepr (Min b (minlist (cons a l))). + apply less_Min. + apply H0; left; right; algebra. + apply Hrecl. + simpl in |- *; auto with arith. + intros y H1; apply H0. + inversion_clear H1. + left; left; assumption. + right; assumption. Qed. Lemma leEq_minlist : forall x l, 0 < length l -> (forall y, member y l -> x [<=] y) -> x [<=] minlist l. -simple induction l. -simpl in |- *; intros; elimtype False; inversion H. -clear l. -do 3 intro. -clear H; induction l as [| a0 l Hrecl]. -simpl in |- *; intros. -apply H0; right; algebra. -generalize l a0 Hrecl; clear Hrecl l a0. -intros l b; intros. -eapply leEq_wdr. -2: apply minlist_aux. -astepr (Min b (minlist (cons a l))). -apply leEq_Min. -apply H0; left; right; algebra. -apply Hrecl. -simpl in |- *; auto with arith. -intros y H1; apply H0. -inversion_clear H1. -left; left; assumption. -right; assumption. +Proof. + simple induction l. + simpl in |- *; intros; elimtype False; inversion H. + clear l. + do 3 intro. + clear H; induction l as [| a0 l Hrecl]. + simpl in |- *; intros. + apply H0; right; algebra. + generalize l a0 Hrecl; clear Hrecl l a0. + intros l b; intros. + eapply leEq_wdr. + 2: apply minlist_aux. + astepr (Min b (minlist (cons a l))). + apply leEq_Min. + apply H0; left; right; algebra. + apply Hrecl. + simpl in |- *; auto with arith. + intros y H1; apply H0. + inversion_clear H1. + left; left; assumption. + right; assumption. Qed. End Lists. diff --git a/reals/Series.v b/reals/Series.v index 3be836673..6b89f5eef 100644 --- a/reals/Series.v +++ b/reals/Series.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing seq_part_sum %\ensuremath{\sum^n}% #∑n# *) (** printing series_sum %\ensuremath{\sum_0^{\infty}}% #∑0∞# *) @@ -48,7 +48,7 @@ Section Definitions. In this file we develop a theory of series of real numbers. ** Definitions -A series is simply a sequence from the natural numbers into the reals. +A series is simply a sequence from the natural numbers into the reals. To each such sequence we can assign a sequence of partial sums. %\begin{convention}% Let [x:nat->IR]. @@ -59,7 +59,7 @@ Variable x : nat -> IR. Definition seq_part_sum (n : nat) := Sum0 n x. -(** +(** For subsequent purposes it will be very useful to be able to write the difference between two arbitrary elements of the sequence of partial sums as a sum of elements of the original sequence. @@ -67,16 +67,17 @@ sums as a sum of elements of the original sequence. Lemma seq_part_sum_n : forall m n, 0 < n -> m <= n -> seq_part_sum n[-]seq_part_sum m [=] Sum m (pred n) x. -intros. -elim (le_lt_eq_dec _ _ H0); intro. -unfold seq_part_sum in |- *. -unfold Sum, Sum1 in |- *. -rewrite <- S_pred with n 0; auto. -algebra. -rewrite b. -astepl ZeroR. -apply eq_symmetric_unfolded; apply Sum_empty. -assumption. +Proof. + intros. + elim (le_lt_eq_dec _ _ H0); intro. + unfold seq_part_sum in |- *. + unfold Sum, Sum1 in |- *. + rewrite <- S_pred with n 0; auto. + algebra. + rewrite b. + astepl ZeroR. + apply eq_symmetric_unfolded; apply Sum_empty. + assumption. Qed. (** A series is convergent iff its sequence of partial Sums is a @@ -87,8 +88,8 @@ Definition convergent := Cauchy_prop seq_part_sum. Definition series_sum (H : convergent) := Lim (Build_CauchySeq _ _ H). -(** Divergence can be characterized in a positive way, which will sometimes -be useful. We thus define divergence of sequences and series and prove the +(** Divergence can be characterized in a positive way, which will sometimes +be useful. We thus define divergence of sequences and series and prove the obvious fact that no sequence can be both convergent and divergent, whether considered either as a sequence or as a series. *) @@ -99,84 +100,87 @@ Definition divergent_seq (a : nat -> IR) := {e : IR | Zero [<] e | Definition divergent := divergent_seq seq_part_sum. Lemma conv_imp_not_div : forall a, Cauchy_prop a -> Not (divergent_seq a). -intros a Hconv. -intro Hdiv. -red in Hconv, Hdiv. -elim Hdiv; clear Hdiv; intros e He He'. -elim (Hconv _ (pos_div_three _ _ He)); clear Hconv; intros N HN. -elim (He' N); clear He'; intros m Hm. -elim Hm; clear Hm; intros n Hm'. -elim Hm'; clear Hm'; intros Hm Hn. -elim Hn; clear Hn; intros Hn Hmn. -rewrite -> leEq_def in Hmn; apply Hmn. -rstepr (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ). -apply leEq_less_trans with (AbsIR (a m[-]a N) [+]AbsIR (a N[-]a n)). -eapply leEq_wdl. -apply triangle_IR. -apply AbsIR_wd; rational. -astepl (Zero[+]AbsIR (a m[-]a N) [+]AbsIR (a N[-]a n)). -repeat apply plus_resp_less_leEq; try apply AbsSmall_imp_AbsIR; - try exact (pos_div_three _ _ He). -auto. -apply AbsSmall_minus; auto. +Proof. + intros a Hconv. + intro Hdiv. + red in Hconv, Hdiv. + elim Hdiv; clear Hdiv; intros e He He'. + elim (Hconv _ (pos_div_three _ _ He)); clear Hconv; intros N HN. + elim (He' N); clear He'; intros m Hm. + elim Hm; clear Hm; intros n Hm'. + elim Hm'; clear Hm'; intros Hm Hn. + elim Hn; clear Hn; intros Hn Hmn. + rewrite -> leEq_def in Hmn; apply Hmn. + rstepr (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ). + apply leEq_less_trans with (AbsIR (a m[-]a N) [+]AbsIR (a N[-]a n)). + eapply leEq_wdl. + apply triangle_IR. + apply AbsIR_wd; rational. + astepl (Zero[+]AbsIR (a m[-]a N) [+]AbsIR (a N[-]a n)). + repeat apply plus_resp_less_leEq; try apply AbsSmall_imp_AbsIR; try exact (pos_div_three _ _ He). + auto. + apply AbsSmall_minus; auto. Qed. Lemma div_imp_not_conv : forall a, divergent_seq a -> Not (Cauchy_prop a). -intros a H. -red in |- *; intro H0. -generalize H; generalize H0. -apply conv_imp_not_div. +Proof. + intros a H. + red in |- *; intro H0. + generalize H; generalize H0. + apply conv_imp_not_div. Qed. Lemma convergent_imp_not_divergent : convergent -> Not divergent. -intro H. -intro H0. -red in H, H0. -generalize H0; apply conv_imp_not_div. -assumption. +Proof. + intro H. + intro H0. + red in H, H0. + generalize H0; apply conv_imp_not_div. + assumption. Qed. Lemma divergent_imp_not_convergent : divergent -> Not convergent. -intro H. -intro H0. -red in H, H0. -generalize H0; apply div_imp_not_conv. -assumption. +Proof. + intro H. + intro H0. + red in H, H0. + generalize H0; apply div_imp_not_conv. + assumption. Qed. -(** Finally we have the well known fact that every convergent series converges +(** Finally we have the well known fact that every convergent series converges to zero as a sequence. *) Lemma series_seq_Lim : convergent -> Cauchy_Lim_prop2 x Zero. -intros H. -red in |- *. intros eps H0. -red in H. -red in H. -elim (H _ (pos_div_two _ _ H0)). -intros N HN. -exists (max N 1); intros. -apply AbsSmall_wdr_unfolded with (seq_part_sum (S m) [-]seq_part_sum m). -apply - AbsSmall_wdr_unfolded - with +Proof. + intros H. + red in |- *. intros eps H0. + red in H. + red in H. + elim (H _ (pos_div_two _ _ H0)). + intros N HN. + exists (max N 1); intros. + apply AbsSmall_wdr_unfolded with (seq_part_sum (S m) [-]seq_part_sum m). + apply AbsSmall_wdr_unfolded with (seq_part_sum (S m) [-]seq_part_sum N[+] (seq_part_sum N[-]seq_part_sum m)). -rstepl (eps [/]TwoNZ[+]eps [/]TwoNZ). -apply AbsSmall_plus. -apply HN. -apply le_trans with (max N 1); auto with arith. -apply AbsSmall_minus; apply HN. -apply le_trans with (max N 1); auto with arith. -rational. -eapply eq_transitive_unfolded. -apply seq_part_sum_n; auto with arith. -simpl in |- *; astepr (x m); apply Sum_one. + rstepl (eps [/]TwoNZ[+]eps [/]TwoNZ). + apply AbsSmall_plus. + apply HN. + apply le_trans with (max N 1); auto with arith. + apply AbsSmall_minus; apply HN. + apply le_trans with (max N 1); auto with arith. + rational. + eapply eq_transitive_unfolded. + apply seq_part_sum_n; auto with arith. + simpl in |- *; astepr (x m); apply Sum_one. Qed. Lemma series_seq_Lim' : convergent -> forall H, Lim (Build_CauchySeq _ x H) [=] Zero. -intros. -apply eq_symmetric_unfolded; apply Limits_unique. -apply series_seq_Lim; auto. +Proof. + intros. + apply eq_symmetric_unfolded; apply Limits_unique. + apply series_seq_Lim; auto. Qed. End Definitions. @@ -214,96 +218,100 @@ Variable c : IR. Hypothesis Hc : AbsIR c [<] One. Lemma c_exp_Lim : Cauchy_Lim_prop2 (power_series c) Zero. -red in |- *; intros eps H. -elim (qi_yields_zero (AbsIR c) (AbsIR_nonneg _) Hc eps H). -intros N Hn. -exists N; intros. -unfold power_series in |- *. -astepr (c[^]m). -apply AbsSmall_transitive with (c[^]N). -apply AbsIR_imp_AbsSmall. -eapply leEq_wdl. -apply Hn. -apply eq_symmetric_unfolded; apply (AbsIR_nexp c N). -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply (AbsIR_nexp c m). -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply (AbsIR_nexp c N). -change ((AbsIR c)[^]m[<=](AbsIR c)[^]N). -apply nexp_resp_le'. -apply AbsIR_nonneg. -apply less_leEq; assumption. -assumption. +Proof. + red in |- *; intros eps H. + elim (qi_yields_zero (AbsIR c) (AbsIR_nonneg _) Hc eps H). + intros N Hn. + exists N; intros. + unfold power_series in |- *. + astepr (c[^]m). + apply AbsSmall_transitive with (c[^]N). + apply AbsIR_imp_AbsSmall. + eapply leEq_wdl. + apply Hn. + apply eq_symmetric_unfolded; apply (AbsIR_nexp c N). + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply (AbsIR_nexp c m). + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply (AbsIR_nexp c N). + change ((AbsIR c)[^]m[<=](AbsIR c)[^]N). + apply nexp_resp_le'. + apply AbsIR_nonneg. + apply less_leEq; assumption. + assumption. Qed. Lemma power_series_Lim1 : forall H : One[-]c [#] Zero, Cauchy_Lim_prop2 (seq_part_sum (power_series c)) (One[/] _[//]H). -intro. -red in |- *. -intros. -unfold power_series in |- *; unfold seq_part_sum in |- *. -cut ({N : nat | (AbsIR c)[^]N [<=] eps[*]AbsIR (One[-]c)}). -intro H1. -elim H1; clear H1; intros N HN. -exists N; intros. -apply AbsSmall_wdr_unfolded with ( [--] (c[^]m[/] _[//]H)). -apply inv_resp_AbsSmall. -apply AbsIR_imp_AbsSmall. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded. -2: apply (AbsIR_division (c[^]m) (One[-]c) H (AbsIR_resp_ap_zero _ H)). -apply shift_div_leEq. -apply AbsIR_pos; assumption. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_nexp_op. -eapply leEq_transitive. -2: apply HN. -apply nexp_resp_le'; auto. -apply AbsIR_nonneg. -apply less_leEq; auto. -astepl ( [--] (c[^]m[/] _[//]H) [+] (One[/] _[//]H) [-] (One[/] _[//]H)). -apply cg_minus_wd. -2: algebra. -cut (c[-]One [#] Zero). intros H2. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -apply Sum0_c_exp with (H := H2). -rational. -apply minus_ap_zero. -apply ap_symmetric. -apply zero_minus_apart. -assumption. -apply qi_yields_zero. -apply AbsIR_nonneg. -assumption. -apply less_wdl with (Zero[*]AbsIR (One[-]c)). -apply mult_resp_less. -assumption. -apply AbsIR_pos. -assumption. -apply cring_mult_zero_op. +Proof. + intro. + red in |- *. + intros. + unfold power_series in |- *; unfold seq_part_sum in |- *. + cut ({N : nat | (AbsIR c)[^]N [<=] eps[*]AbsIR (One[-]c)}). + intro H1. + elim H1; clear H1; intros N HN. + exists N; intros. + apply AbsSmall_wdr_unfolded with ( [--] (c[^]m[/] _[//]H)). + apply inv_resp_AbsSmall. + apply AbsIR_imp_AbsSmall. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded. + 2: apply (AbsIR_division (c[^]m) (One[-]c) H (AbsIR_resp_ap_zero _ H)). + apply shift_div_leEq. + apply AbsIR_pos; assumption. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_nexp_op. + eapply leEq_transitive. + 2: apply HN. + apply nexp_resp_le'; auto. + apply AbsIR_nonneg. + apply less_leEq; auto. + astepl ( [--] (c[^]m[/] _[//]H) [+] (One[/] _[//]H) [-] (One[/] _[//]H)). + apply cg_minus_wd. + 2: algebra. + cut (c[-]One [#] Zero). intros H2. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + apply Sum0_c_exp with (H := H2). + rational. + apply minus_ap_zero. + apply ap_symmetric. + apply zero_minus_apart. + assumption. + apply qi_yields_zero. + apply AbsIR_nonneg. + assumption. + apply less_wdl with (Zero[*]AbsIR (One[-]c)). + apply mult_resp_less. + assumption. + apply AbsIR_pos. + assumption. + apply cring_mult_zero_op. Qed. Lemma power_series_conv : convergent (power_series c). -intros. -red in |- *. -apply Cauchy_prop2_prop. -cut (One[-]c [#] Zero). -intro H. -exists (One[/] _[//]H). -apply power_series_Lim1. -apply minus_ap_zero. -apply Greater_imp_ap. -eapply leEq_less_trans. -apply leEq_AbsIR. -assumption. +Proof. + intros. + red in |- *. + apply Cauchy_prop2_prop. + cut (One[-]c [#] Zero). + intro H. + exists (One[/] _[//]H). + apply power_series_Lim1. + apply minus_ap_zero. + apply Greater_imp_ap. + eapply leEq_less_trans. + apply leEq_AbsIR. + assumption. Qed. Lemma power_series_sum : forall H Hc, series_sum (power_series c) Hc [=] (One[/] One[-]c[//]H). -intros. -unfold series_sum in |- *. -apply eq_symmetric_unfolded; apply Limits_unique. -apply power_series_Lim1. +Proof. + intros. + unfold series_sum in |- *. + apply eq_symmetric_unfolded; apply Limits_unique. + apply power_series_Lim1. Qed. End Power_Series. @@ -313,44 +321,46 @@ Section Operations. (** ** Operations -Some operations with series preserve convergence. We start by defining +Some operations with series preserve convergence. We start by defining the series that is zero everywhere. *) Lemma conv_zero_series : convergent (fun n => Zero). -exists 0. -intros. -simpl in |- *. -eapply AbsSmall_wdr_unfolded. -apply zero_AbsSmall; apply less_leEq; assumption. -unfold seq_part_sum in |- *. -induction m as [| m Hrecm]. -simpl in |- *; algebra. -simpl in |- *. -eapply eq_transitive_unfolded. -apply Hrecm; auto with arith. -rational. +Proof. + exists 0. + intros. + simpl in |- *. + eapply AbsSmall_wdr_unfolded. + apply zero_AbsSmall; apply less_leEq; assumption. + unfold seq_part_sum in |- *. + induction m as [| m Hrecm]. + simpl in |- *; algebra. + simpl in |- *. + eapply eq_transitive_unfolded. + apply Hrecm; auto with arith. + rational. Qed. Lemma series_sum_zero : forall H : convergent (fun n => Zero), series_sum _ H [=] Zero. -intro. -unfold series_sum in |- *. -apply eq_symmetric_unfolded; apply Limits_unique. -exists 0. -intros. -simpl in |- *. -eapply AbsSmall_wdr_unfolded. -apply zero_AbsSmall; apply less_leEq; assumption. -unfold seq_part_sum in |- *. -induction m as [| m Hrecm]. -simpl in |- *; algebra. -simpl in |- *. -eapply eq_transitive_unfolded. -apply Hrecm; auto with arith. -rational. +Proof. + intro. + unfold series_sum in |- *. + apply eq_symmetric_unfolded; apply Limits_unique. + exists 0. + intros. + simpl in |- *. + eapply AbsSmall_wdr_unfolded. + apply zero_AbsSmall; apply less_leEq; assumption. + unfold seq_part_sum in |- *. + induction m as [| m Hrecm]. + simpl in |- *; algebra. + simpl in |- *. + eapply eq_transitive_unfolded. + apply Hrecm; auto with arith. + rational. Qed. -(** Next we consider extensionality, as well as the sum and difference +(** Next we consider extensionality, as well as the sum and difference of two convergent series. %\begin{convention}% Let [x,y:nat->IR] be convergent series. @@ -363,87 +373,85 @@ Hypothesis convX : convergent x. Hypothesis convY : convergent y. Lemma convergent_wd : (forall n, x n [=] y n) -> convergent x -> convergent y. -intros H H0. -red in |- *; red in H0. -apply Cauchy_prop_wd with (seq_part_sum x). -assumption. -intro. -unfold seq_part_sum in |- *. -apply Sum0_wd. -assumption. +Proof. + intros H H0. + red in |- *; red in H0. + apply Cauchy_prop_wd with (seq_part_sum x). + assumption. + intro. + unfold seq_part_sum in |- *. + apply Sum0_wd. + assumption. Qed. Lemma series_sum_wd : (forall n, x n [=] y n) -> series_sum _ convX [=] series_sum _ convY. -intros. -unfold series_sum in |- *. -apply Lim_wd'. -intro; simpl in |- *. -unfold seq_part_sum in |- *. -apply Sum0_wd; assumption. +Proof. + intros. + unfold series_sum in |- *. + apply Lim_wd'. + intro; simpl in |- *. + unfold seq_part_sum in |- *. + apply Sum0_wd; assumption. Qed. Lemma conv_series_plus : convergent (fun n => x n[+]y n). -red in |- *. -red in convX, convY. -eapply Cauchy_prop_wd. -apply - Cauchy_plus - with - (seq1 := Build_CauchySeq _ _ convX) - (seq2 := Build_CauchySeq _ _ convY). -simpl in |- *. -unfold seq_part_sum in |- *. -intro. -apply eq_symmetric_unfolded; apply Sum0_plus_Sum0. +Proof. + red in |- *. + red in convX, convY. + eapply Cauchy_prop_wd. + apply Cauchy_plus with (seq1 := Build_CauchySeq _ _ convX) (seq2 := Build_CauchySeq _ _ convY). + simpl in |- *. + unfold seq_part_sum in |- *. + intro. + apply eq_symmetric_unfolded; apply Sum0_plus_Sum0. Qed. Lemma series_sum_plus : forall H : convergent (fun n => x n[+]y n), series_sum _ H [=] series_sum _ convX[+]series_sum _ convY. -intros. -unfold series_sum in |- *. -eapply eq_transitive_unfolded. -2: apply Lim_plus. -apply Lim_wd'. -intro; simpl in |- *. -unfold seq_part_sum in |- *. -apply Sum0_plus_Sum0. +Proof. + intros. + unfold series_sum in |- *. + eapply eq_transitive_unfolded. + 2: apply Lim_plus. + apply Lim_wd'. + intro; simpl in |- *. + unfold seq_part_sum in |- *. + apply Sum0_plus_Sum0. Qed. Lemma conv_series_minus : convergent (fun n => x n[-]y n). -red in |- *. -red in convX, convY. -eapply Cauchy_prop_wd. -apply - Cauchy_minus - with - (seq1 := Build_CauchySeq _ _ convX) - (seq2 := Build_CauchySeq _ _ convY). -simpl in |- *. -unfold seq_part_sum in |- *. -intro. -apply eq_symmetric_unfolded; unfold cg_minus in |- *. -eapply eq_transitive_unfolded. -apply Sum0_plus_Sum0 with (g := fun n : nat => [--] (y n)). -apply bin_op_wd_unfolded. -algebra. -apply inv_Sum0. +Proof. + red in |- *. + red in convX, convY. + eapply Cauchy_prop_wd. + apply Cauchy_minus with (seq1 := Build_CauchySeq _ _ convX) (seq2 := Build_CauchySeq _ _ convY). + simpl in |- *. + unfold seq_part_sum in |- *. + intro. + apply eq_symmetric_unfolded; unfold cg_minus in |- *. + eapply eq_transitive_unfolded. + apply Sum0_plus_Sum0 with (g := fun n : nat => [--] (y n)). + apply bin_op_wd_unfolded. + algebra. + apply inv_Sum0. Qed. Lemma series_sum_minus : forall H : convergent (fun n => x n[-]y n), series_sum _ H [=] series_sum _ convX[-]series_sum _ convY. -intros. -unfold series_sum in |- *. -eapply eq_transitive_unfolded. -2: apply Lim_minus. -apply Lim_wd'. -intro; simpl in |- *. -unfold seq_part_sum in |- *. -unfold cg_minus in |- *. -eapply eq_transitive_unfolded. -apply Sum0_plus_Sum0 with (g := fun n : nat => [--] (y n)). -apply bin_op_wd_unfolded. -algebra. -apply inv_Sum0. +Proof. + intros. + unfold series_sum in |- *. + eapply eq_transitive_unfolded. + 2: apply Lim_minus. + apply Lim_wd'. + intro; simpl in |- *. + unfold seq_part_sum in |- *. + unfold cg_minus in |- *. + eapply eq_transitive_unfolded. + apply Sum0_plus_Sum0 with (g := fun n : nat => [--] (y n)). + apply bin_op_wd_unfolded. + algebra. + apply inv_Sum0. Qed. (** Multiplication by a scalar [c] is also permitted. *) @@ -451,33 +459,31 @@ Qed. Variable c : IR. Lemma conv_series_mult_scal : convergent (fun n => c[*]x n). -red in |- *. -red in convX. -eapply Cauchy_prop_wd. -apply - Cauchy_mult - with (seq2 := Build_CauchySeq _ _ convX) (seq1 := Cauchy_const c). -simpl in |- *. -unfold seq_part_sum in |- *. -intro. -apply eq_symmetric_unfolded. -apply Sum0_comm_scal'. +Proof. + red in |- *. + red in convX. + eapply Cauchy_prop_wd. + apply Cauchy_mult with (seq2 := Build_CauchySeq _ _ convX) (seq1 := Cauchy_const c). + simpl in |- *. + unfold seq_part_sum in |- *. + intro. + apply eq_symmetric_unfolded. + apply Sum0_comm_scal'. Qed. Lemma series_sum_mult_scal : forall H : convergent (fun n => c[*]x n), series_sum _ H [=] c[*]series_sum _ convX. -intros. -unfold series_sum in |- *. -apply - eq_transitive_unfolded - with (Lim (Cauchy_const c) [*]Lim (Build_CauchySeq _ _ convX)). -2: apply mult_wdl; apply eq_symmetric_unfolded; apply Lim_const. -eapply eq_transitive_unfolded. -2: apply Lim_mult. -apply Lim_wd'. -intro; simpl in |- *. -unfold seq_part_sum in |- *. -apply Sum0_comm_scal'. +Proof. + intros. + unfold series_sum in |- *. + apply eq_transitive_unfolded with (Lim (Cauchy_const c) [*]Lim (Build_CauchySeq _ _ convX)). + 2: apply mult_wdl; apply eq_symmetric_unfolded; apply Lim_const. + eapply eq_transitive_unfolded. + 2: apply Lim_mult. + apply Lim_wd'. + intro; simpl in |- *. + unfold seq_part_sum in |- *. + apply Sum0_comm_scal'. Qed. End Operations. @@ -490,41 +496,37 @@ Hypothesis convX : convergent x. (** As a corollary, we get the series of the inverses. *) Lemma conv_series_inv : convergent (fun n => [--] (x n)). -red in |- *. -red in convX. -eapply Cauchy_prop_wd. -apply - Cauchy_minus - with (seq1 := Cauchy_const Zero) (seq2 := Build_CauchySeq _ _ convX). -simpl in |- *. -unfold seq_part_sum in |- *. -intro. -apply eq_symmetric_unfolded; - apply eq_transitive_unfolded with (Zero[+]Sum0 n (fun n : nat => [--] (x n))). -algebra. -unfold cg_minus in |- *; apply bin_op_wd_unfolded. -algebra. -apply inv_Sum0. +Proof. + red in |- *. + red in convX. + eapply Cauchy_prop_wd. + apply Cauchy_minus with (seq1 := Cauchy_const Zero) (seq2 := Build_CauchySeq _ _ convX). + simpl in |- *. + unfold seq_part_sum in |- *. + intro. + apply eq_symmetric_unfolded; + apply eq_transitive_unfolded with (Zero[+]Sum0 n (fun n : nat => [--] (x n))). + algebra. + unfold cg_minus in |- *; apply bin_op_wd_unfolded. + algebra. + apply inv_Sum0. Qed. Lemma series_sum_inv : forall H : convergent (fun n => [--] (x n)), series_sum _ H [=] [--] (series_sum _ convX). -intros. -set (y := Cauchy_const Zero) in *. -cut (convergent y). intros H0. -eapply eq_transitive_unfolded. -apply - series_sum_wd - with - (y := fun n : nat => y n[-]x n) - (convY := conv_series_minus _ _ H0 convX). -intro; unfold y in |- *; simpl in |- *; algebra. -cut (series_sum y H0 [=] Zero); intros. -astepr (Zero[-]series_sum x convX). -astepr (series_sum y H0[-]series_sum x convX). -apply series_sum_minus. -apply series_sum_zero. -apply conv_zero_series. +Proof. + intros. + set (y := Cauchy_const Zero) in *. + cut (convergent y). intros H0. + eapply eq_transitive_unfolded. + apply series_sum_wd with (y := fun n : nat => y n[-]x n) (convY := conv_series_minus _ _ H0 convX). + intro; unfold y in |- *; simpl in |- *; algebra. + cut (series_sum y H0 [=] Zero); intros. + astepr (Zero[-]series_sum x convX). + astepr (series_sum y H0[-]series_sum x convX). + apply series_sum_minus. + apply series_sum_zero. + apply conv_zero_series. Qed. End More_Operations. @@ -534,7 +536,7 @@ Section Almost_Everywhere. (** ** Almost Everywhere -In this section we strengthen some of the convergence results for sequences +In this section we strengthen some of the convergence results for sequences and derive an important corollary for series. Let [x,y : nat->IR] be equal after some natural number. @@ -547,70 +549,71 @@ Definition aew_eq := {n : nat | forall k, n <= k -> x k [=] y k}. Hypothesis aew_equal : aew_eq. Lemma aew_Cauchy : Cauchy_prop x -> Cauchy_prop y. -intro H. -red in |- *; intros e H0. -elim (H _ (pos_div_two _ _ H0)). -intros N HN. -elim aew_equal; intros n Hn. -exists (max n N). -intros. -apply AbsSmall_wdr_unfolded with (x m[-]x (max n N)). -rstepr (x m[-]x N[+] (x N[-]x (max n N))). -rstepl (e [/]TwoNZ[+]e [/]TwoNZ). -apply AbsSmall_plus. -apply HN; apply le_trans with (max n N); auto with arith. -apply AbsSmall_minus; apply HN; apply le_trans with (max n N); - auto with arith. -apply cg_minus_wd; apply Hn. -apply le_trans with (max n N); auto with arith. -apply le_max_l. +Proof. + intro H. + red in |- *; intros e H0. + elim (H _ (pos_div_two _ _ H0)). + intros N HN. + elim aew_equal; intros n Hn. + exists (max n N). + intros. + apply AbsSmall_wdr_unfolded with (x m[-]x (max n N)). + rstepr (x m[-]x N[+] (x N[-]x (max n N))). + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_plus. + apply HN; apply le_trans with (max n N); auto with arith. + apply AbsSmall_minus; apply HN; apply le_trans with (max n N); auto with arith. + apply cg_minus_wd; apply Hn. + apply le_trans with (max n N); auto with arith. + apply le_max_l. Qed. Lemma aew_Cauchy2 : forall c, Cauchy_Lim_prop2 x c -> Cauchy_Lim_prop2 y c. -intros c H. -red in |- *; intros eps H0. -elim (H eps H0). -intros N HN. -elim aew_equal; intros n Hn. -exists (max n N). -intros. -apply AbsSmall_wdr_unfolded with (x m[-]c). -apply HN; apply le_trans with (max n N); auto with arith. -apply cg_minus_wd; [ apply Hn | algebra ]. -apply le_trans with (max n N); auto with arith. +Proof. + intros c H. + red in |- *; intros eps H0. + elim (H eps H0). + intros N HN. + elim aew_equal; intros n Hn. + exists (max n N). + intros. + apply AbsSmall_wdr_unfolded with (x m[-]c). + apply HN; apply le_trans with (max n N); auto with arith. + apply cg_minus_wd; [ apply Hn | algebra ]. + apply le_trans with (max n N); auto with arith. Qed. Lemma aew_series_conv : convergent x -> convergent y. -intro H. -red in |- *; red in |- *; intros. rename X into H0. -elim (H _ (pos_div_two _ _ H0)); intros N HN. -elim aew_equal; intros n Hn. -set (k := max (max n N) 1) in *. -exists k; intros. -apply AbsSmall_wdr_unfolded with (seq_part_sum x m[-]seq_part_sum x k). -rstepr - (seq_part_sum x m[-]seq_part_sum x N[+] (seq_part_sum x N[-]seq_part_sum x k)). -rstepl (e [/]TwoNZ[+]e [/]TwoNZ). -apply AbsSmall_plus. -apply HN; cut (N <= k). -omega. -apply le_trans with (max n N); unfold k in |- *; auto with arith. -apply AbsSmall_minus; apply HN; auto. -apply le_trans with (max n N); unfold k in |- *; auto with arith. -cut (1 <= k); intros. -eapply eq_transitive_unfolded. -apply seq_part_sum_n; auto. -apply lt_le_trans with k; auto. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply seq_part_sum_n; auto. -2: apply lt_le_trans with k; auto. -apply Sum_wd'. -rewrite <- S_pred with m 0; auto with arith. -apply lt_le_trans with k; auto. -intros; apply Hn. -apply le_trans with (max n N); auto with arith. -apply le_trans with k; unfold k in |- *; auto with arith. -unfold k in |- *; apply le_max_r. +Proof. + intro H. + red in |- *; red in |- *; intros. rename X into H0. + elim (H _ (pos_div_two _ _ H0)); intros N HN. + elim aew_equal; intros n Hn. + set (k := max (max n N) 1) in *. + exists k; intros. + apply AbsSmall_wdr_unfolded with (seq_part_sum x m[-]seq_part_sum x k). + rstepr (seq_part_sum x m[-]seq_part_sum x N[+] (seq_part_sum x N[-]seq_part_sum x k)). + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_plus. + apply HN; cut (N <= k). + omega. + apply le_trans with (max n N); unfold k in |- *; auto with arith. + apply AbsSmall_minus; apply HN; auto. + apply le_trans with (max n N); unfold k in |- *; auto with arith. + cut (1 <= k); intros. + eapply eq_transitive_unfolded. + apply seq_part_sum_n; auto. + apply lt_le_trans with k; auto. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply seq_part_sum_n; auto. + 2: apply lt_le_trans with k; auto. + apply Sum_wd'. + rewrite <- S_pred with m 0; auto with arith. + apply lt_le_trans with k; auto. + intros; apply Hn. + apply le_trans with (max n N); auto with arith. + apply le_trans with k; unfold k in |- *; auto with arith. + unfold k in |- *; apply le_max_r. Qed. End Almost_Everywhere. @@ -624,15 +627,16 @@ Variables x y : CauchySeq IR. Hypothesis aew_equal : aew_eq x y. Lemma aew_Lim : Lim x [=] Lim y. -intros. -cut (Cauchy_Lim_prop2 x (Lim y)). -intro. -apply eq_symmetric_unfolded. -apply Limits_unique; assumption. -apply aew_Cauchy2 with (y:nat -> IR). -elim aew_equal; intros n Hn; exists n; intros. -apply eq_symmetric_unfolded; apply Hn; auto. -apply Cauchy_complete. +Proof. + intros. + cut (Cauchy_Lim_prop2 x (Lim y)). + intro. + apply eq_symmetric_unfolded. + apply Limits_unique; assumption. + apply aew_Cauchy2 with (y:nat -> IR). + elim aew_equal; intros n Hn; exists n; intros. + apply eq_symmetric_unfolded; apply Hn; auto. + apply Cauchy_complete. Qed. End Cauchy_Almost_Everywhere. @@ -648,198 +652,192 @@ Section Convergence_Criteria. Variable x : nat -> IR. -(** We include the comparison test for series, both in a strong and in a less +(** We include the comparison test for series, both in a strong and in a less general (but simpler) form. *) Lemma str_comparison : forall y, convergent y -> {k : nat | forall n, k <= n -> AbsIR (x n) [<=] y n} -> convergent x. -intros y H H0. -elim H0; intros k Hk. -red in |- *; red in |- *; intros. -cut - {N : nat | - k < N /\ - (forall m : nat, N <= m -> AbsSmall e (seq_part_sum y m[-]seq_part_sum y N))}. intros H2. -elim H2; clear H2. -intros N HN; elim HN; clear HN; intros HN' HN. -exists N; intros. -apply AbsIR_imp_AbsSmall. -apply leEq_transitive with (seq_part_sum y m[-]seq_part_sum y N). -apply leEq_transitive with (Sum N (pred m) (fun n : nat => AbsIR (x n))). -apply leEq_wdl with (AbsIR (Sum N (pred m) x)). -2: apply AbsIR_wd; apply eq_symmetric_unfolded; apply seq_part_sum_n; auto. -2: apply lt_le_trans with N; auto; apply le_lt_trans with k; auto with arith. -apply triangle_SumIR. -rewrite <- (S_pred m k); auto with arith. -apply lt_le_trans with N; auto. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply seq_part_sum_n; auto. -2: apply le_lt_trans with k; auto with arith; apply lt_le_trans with N; auto. -apply Sum_resp_leEq. -rewrite <- (S_pred m k); auto with arith. -apply lt_le_trans with N; auto. -intros. -apply Hk; apply le_trans with N; auto with arith. -eapply leEq_transitive. -apply leEq_AbsIR. -apply AbsSmall_imp_AbsIR. -apply HN; assumption. rename X into H1. -elim (H _ (pos_div_two _ _ H1)). -intros N HN; exists (S (max N k)). -cut (N <= max N k); [ intro | apply le_max_l ]. -cut (k <= max N k); [ intro | apply le_max_r ]. -split. -auto with arith. -intros. -rstepr - (seq_part_sum y m[-]seq_part_sum y N[+] - (seq_part_sum y N[-]seq_part_sum y (S (max N k)))). -rstepl (e [/]TwoNZ[+]e [/]TwoNZ). -apply AbsSmall_plus. -apply HN; apply le_trans with (max N k); auto with arith. -apply AbsSmall_minus; apply HN; auto with arith. +Proof. + intros y H H0. + elim H0; intros k Hk. + red in |- *; red in |- *; intros. + cut {N : nat | k < N /\ + (forall m : nat, N <= m -> AbsSmall e (seq_part_sum y m[-]seq_part_sum y N))}. intros H2. + elim H2; clear H2. + intros N HN; elim HN; clear HN; intros HN' HN. + exists N; intros. + apply AbsIR_imp_AbsSmall. + apply leEq_transitive with (seq_part_sum y m[-]seq_part_sum y N). + apply leEq_transitive with (Sum N (pred m) (fun n : nat => AbsIR (x n))). + apply leEq_wdl with (AbsIR (Sum N (pred m) x)). + 2: apply AbsIR_wd; apply eq_symmetric_unfolded; apply seq_part_sum_n; auto. + 2: apply lt_le_trans with N; auto; apply le_lt_trans with k; auto with arith. + apply triangle_SumIR. + rewrite <- (S_pred m k); auto with arith. + apply lt_le_trans with N; auto. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply seq_part_sum_n; auto. + 2: apply le_lt_trans with k; auto with arith; apply lt_le_trans with N; auto. + apply Sum_resp_leEq. + rewrite <- (S_pred m k); auto with arith. + apply lt_le_trans with N; auto. + intros. + apply Hk; apply le_trans with N; auto with arith. + eapply leEq_transitive. + apply leEq_AbsIR. + apply AbsSmall_imp_AbsIR. + apply HN; assumption. rename X into H1. + elim (H _ (pos_div_two _ _ H1)). + intros N HN; exists (S (max N k)). + cut (N <= max N k); [ intro | apply le_max_l ]. + cut (k <= max N k); [ intro | apply le_max_r ]. + split. + auto with arith. + intros. + rstepr (seq_part_sum y m[-]seq_part_sum y N[+] (seq_part_sum y N[-]seq_part_sum y (S (max N k)))). + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_plus. + apply HN; apply le_trans with (max N k); auto with arith. + apply AbsSmall_minus; apply HN; auto with arith. Qed. Lemma comparison : forall y, convergent y -> (forall n, AbsIR (x n) [<=] y n) -> convergent x. -intros y H H0. -apply str_comparison with y. -assumption. -exists 0; intros; apply H0. +Proof. + intros y H H0. + apply str_comparison with y. + assumption. + exists 0; intros; apply H0. Qed. (** As a corollary, we get that every absolutely convergent series converges. *) Lemma abs_imp_conv : abs_convergent x -> convergent x. -intros H. -apply Convergence_Criteria.comparison with (fun n : nat => AbsIR (x n)). -apply H. -intro; apply leEq_reflexive. +Proof. + intros H. + apply Convergence_Criteria.comparison with (fun n : nat => AbsIR (x n)). + apply H. + intro; apply leEq_reflexive. Qed. (** Next we have the ratio test, both as a positive and negative result. *) Lemma divergent_crit : {r : IR | Zero [<] r | forall n, {m : nat | n <= m | r [<=] AbsIR (x m)}} -> divergent x. -intro H. -elim H; clear H; intros r Hr H. -exists r. -assumption. -intro. -elim (H k); clear H; intros m Hm Hrm. -exists (S m). -exists m. -split. -auto. -split. -assumption. -eapply leEq_wdr. -apply Hrm. -apply AbsIR_wd. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -apply seq_part_sum_n; auto with arith. -apply Sum_one. +Proof. + intro H. + elim H; clear H; intros r Hr H. + exists r. + assumption. + intro. + elim (H k); clear H; intros m Hm Hrm. + exists (S m). + exists m. + split. + auto. + split. + assumption. + eapply leEq_wdr. + apply Hrm. + apply AbsIR_wd. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply seq_part_sum_n; auto with arith. + apply Sum_one. Qed. Lemma tail_series : forall y, convergent y -> {k : nat | {N : nat | forall n, N <= n -> x n [=] y (n + k)}} -> convergent x. -red in |- *. intros y H H0. -elim H0; intros k Hk. -elim Hk; intros N HN. -clear Hk H0. -red in |- *. intros e H0. -elim (H (e [/]TwoNZ) (pos_div_two _ _ H0)); intros M HM. -exists (S (max N M)); intros. -rstepl (e [/]TwoNZ[+]e [/]TwoNZ). -apply - AbsSmall_wdr_unfolded - with (seq_part_sum y (m + k) [-]seq_part_sum y (S (max N M) + k)). -rstepr - (seq_part_sum y (m + k) [-]seq_part_sum y M[+] - (seq_part_sum y M[-]seq_part_sum y (S (max N M) + k))). -apply AbsSmall_plus. -apply HM. -apply le_trans with (max N M); auto with arith. -apply AbsSmall_minus. -apply HM. -auto with arith. -unfold seq_part_sum in |- *. -apply eq_transitive_unfolded with (Sum (S (max N M) + k) (pred (m + k)) y). -unfold Sum, Sum1 in |- *. -rewrite <- S_pred with (m := 0). -algebra. -apply lt_le_trans with (S (max N M)); auto with arith. -astepr (Sum (S (max N M)) (pred m) x). -2: unfold Sum, Sum1 in |- *. -2: rewrite <- S_pred with (m := 0). -2: algebra. -2: apply lt_le_trans with (S (max N M)); auto with arith. -replace (pred (m + k)) with (pred m + k). -apply eq_symmetric_unfolded; apply Sum_big_shift. -intros; apply HN. -apply le_trans with (max N M); auto with arith. -rewrite <- S_pred with (m := 0); auto. -apply lt_le_trans with (S (max N M)); auto with arith. -omega. +Proof. + red in |- *. intros y H H0. + elim H0; intros k Hk. + elim Hk; intros N HN. + clear Hk H0. + red in |- *. intros e H0. + elim (H (e [/]TwoNZ) (pos_div_two _ _ H0)); intros M HM. + exists (S (max N M)); intros. + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_wdr_unfolded with (seq_part_sum y (m + k) [-]seq_part_sum y (S (max N M) + k)). + rstepr (seq_part_sum y (m + k) [-]seq_part_sum y M[+] + (seq_part_sum y M[-]seq_part_sum y (S (max N M) + k))). + apply AbsSmall_plus. + apply HM. + apply le_trans with (max N M); auto with arith. + apply AbsSmall_minus. + apply HM. + auto with arith. + unfold seq_part_sum in |- *. + apply eq_transitive_unfolded with (Sum (S (max N M) + k) (pred (m + k)) y). + unfold Sum, Sum1 in |- *. + rewrite <- S_pred with (m := 0). + algebra. + apply lt_le_trans with (S (max N M)); auto with arith. + astepr (Sum (S (max N M)) (pred m) x). + 2: unfold Sum, Sum1 in |- *. + 2: rewrite <- S_pred with (m := 0). + 2: algebra. + 2: apply lt_le_trans with (S (max N M)); auto with arith. + replace (pred (m + k)) with (pred m + k). + apply eq_symmetric_unfolded; apply Sum_big_shift. + intros; apply HN. + apply le_trans with (max N M); auto with arith. + rewrite <- S_pred with (m := 0); auto. + apply lt_le_trans with (S (max N M)); auto with arith. + omega. Qed. Lemma join_series : convergent x -> forall y, {k : nat | {N : nat | forall n, N <= n -> x n [=] y (n + k)}} -> convergent y. -red in |- *; intros H y H0. -elim H0; intros k Hk. -elim Hk; intros N HN. -clear Hk H0. -red in |- *; intros e H0. -elim (H (e [/]TwoNZ) (pos_div_two _ _ H0)); intros M HM. -exists (S (max N M + k)); intros. -rstepl (e [/]TwoNZ[+]e [/]TwoNZ). -apply - AbsSmall_wdr_unfolded - with (seq_part_sum x (m - k) [-]seq_part_sum x (S (max N M + k) - k)). -rstepr - (seq_part_sum x (m - k) [-]seq_part_sum x M[+] - (seq_part_sum x M[-]seq_part_sum x (S (max N M + k) - k))). -apply AbsSmall_plus. -apply HM. -apply (fun p n m : nat => plus_le_reg_l n m p) with k. -rewrite <- le_plus_minus. -apply le_trans with (max N M + k); auto with arith. -rewrite plus_comm; auto with arith. -apply le_trans with (S (max N M + k)); auto with arith. -apply AbsSmall_minus. -apply HM. -apply (fun p n m : nat => plus_le_reg_l n m p) with k. -rewrite <- le_plus_minus. -apply le_trans with (max N M + k); auto. -rewrite plus_comm; auto with arith. -apply le_trans with (S (max N M + k)); auto with arith. -unfold seq_part_sum in |- *. -apply - eq_transitive_unfolded with (Sum (S (max N M + k) - k) (pred (m - k)) x). -unfold Sum, Sum1 in |- *. -rewrite <- S_pred with (m := 0). -algebra. -omega. -astepr (Sum (S (max N M + k)) (pred m) y). -2: unfold Sum, Sum1 in |- *. -2: rewrite <- S_pred with (m := 0). -2: algebra. -2: omega. -replace (pred m) with (pred (m - k) + k). -2: omega. -pattern (S (max N M + k)) at 2 in |- *; - replace (S (max N M + k)) with (S (max N M + k) - k + k). -2: omega. -apply Sum_big_shift. -intros; apply HN. -apply le_trans with (max N M); auto with arith. -omega. -rewrite <- S_pred with (m := 0); auto. -omega. -apply lt_le_trans with (S (max N M)); auto with arith. -omega. +Proof. + red in |- *; intros H y H0. + elim H0; intros k Hk. + elim Hk; intros N HN. + clear Hk H0. + red in |- *; intros e H0. + elim (H (e [/]TwoNZ) (pos_div_two _ _ H0)); intros M HM. + exists (S (max N M + k)); intros. + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_wdr_unfolded with (seq_part_sum x (m - k) [-]seq_part_sum x (S (max N M + k) - k)). + rstepr (seq_part_sum x (m - k) [-]seq_part_sum x M[+] + (seq_part_sum x M[-]seq_part_sum x (S (max N M + k) - k))). + apply AbsSmall_plus. + apply HM. + apply (fun p n m : nat => plus_le_reg_l n m p) with k. + rewrite <- le_plus_minus. + apply le_trans with (max N M + k); auto with arith. + rewrite plus_comm; auto with arith. + apply le_trans with (S (max N M + k)); auto with arith. + apply AbsSmall_minus. + apply HM. + apply (fun p n m : nat => plus_le_reg_l n m p) with k. + rewrite <- le_plus_minus. + apply le_trans with (max N M + k); auto. + rewrite plus_comm; auto with arith. + apply le_trans with (S (max N M + k)); auto with arith. + unfold seq_part_sum in |- *. + apply eq_transitive_unfolded with (Sum (S (max N M + k) - k) (pred (m - k)) x). + unfold Sum, Sum1 in |- *. + rewrite <- S_pred with (m := 0). + algebra. + omega. + astepr (Sum (S (max N M + k)) (pred m) y). + 2: unfold Sum, Sum1 in |- *. + 2: rewrite <- S_pred with (m := 0). + 2: algebra. + 2: omega. + replace (pred m) with (pred (m - k) + k). + 2: omega. + pattern (S (max N M + k)) at 2 in |- *; replace (S (max N M + k)) with (S (max N M + k) - k + k). + 2: omega. + apply Sum_big_shift. + intros; apply HN. + apply le_trans with (max N M); auto with arith. + omega. + rewrite <- S_pred with (m := 0); auto. + omega. + apply lt_le_trans with (S (max N M)); auto with arith. + omega. Qed. End Convergence_Criteria. @@ -851,95 +849,95 @@ Variable x : nat -> IR. Lemma ratio_test_conv : {N : nat | {c : IR | c [<] One | Zero [<=] c /\ (forall n, N <= n -> AbsIR (x (S n)) [<=] c[*]AbsIR (x n))}} -> convergent x. -intro H. -elim H; clear H; intros N H. -elim H; clear H; intros c Hc1 H. -elim H; clear H; intros H0c H. -cut (forall n : nat, N <= n -> AbsIR (x n) [<=] AbsIR (x N) [*]c[^] (n - N)). -intro. -apply str_comparison with (fun n : nat => AbsIR (x N) [*]c[^] (n - N)). -2: exists N; assumption. -apply conv_series_mult_scal with (x := fun n : nat => c[^] (n - N)). -apply join_series with (power_series c). -apply power_series_conv. -apply AbsIR_less. -assumption. -apply less_leEq_trans with Zero. -rstepr ([--]Zero:IR). -apply inv_resp_less. -apply pos_one. -assumption. -exists N. -exists 0. -intro. -rewrite plus_comm; rewrite Minus.minus_plus. -algebra. -simple induction n. -intro. -cut (N = 0); [ intro | auto with arith ]. -rewrite H1. -apply eq_imp_leEq. -simpl in |- *; algebra. -clear n; intros. -cut ({N < S n} + {N = S n}). -2: apply le_lt_eq_dec; assumption. -intro; inversion_clear H2. -apply leEq_transitive with (c[*]AbsIR (x n)). -apply H; auto with arith. -rewrite <- minus_Sn_m. -astepr (AbsIR (x N) [*] (c[*]c[^] (n - N))). -rstepr (c[*] (AbsIR (x N) [*]c[^] (n - N))). -apply mult_resp_leEq_lft. -apply H0; auto with arith. -assumption. -auto with arith. -rewrite H3. -rewrite <- minus_n_n. -apply eq_imp_leEq. -simpl in |- *; algebra. +Proof. + intro H. + elim H; clear H; intros N H. + elim H; clear H; intros c Hc1 H. + elim H; clear H; intros H0c H. + cut (forall n : nat, N <= n -> AbsIR (x n) [<=] AbsIR (x N) [*]c[^] (n - N)). + intro. + apply str_comparison with (fun n : nat => AbsIR (x N) [*]c[^] (n - N)). + 2: exists N; assumption. + apply conv_series_mult_scal with (x := fun n : nat => c[^] (n - N)). + apply join_series with (power_series c). + apply power_series_conv. + apply AbsIR_less. + assumption. + apply less_leEq_trans with Zero. + rstepr ([--]Zero:IR). + apply inv_resp_less. + apply pos_one. + assumption. + exists N. + exists 0. + intro. + rewrite plus_comm; rewrite Minus.minus_plus. + algebra. + simple induction n. + intro. + cut (N = 0); [ intro | auto with arith ]. + rewrite H1. + apply eq_imp_leEq. + simpl in |- *; algebra. + clear n; intros. + cut ({N < S n} + {N = S n}). + 2: apply le_lt_eq_dec; assumption. + intro; inversion_clear H2. + apply leEq_transitive with (c[*]AbsIR (x n)). + apply H; auto with arith. + rewrite <- minus_Sn_m. + astepr (AbsIR (x N) [*] (c[*]c[^] (n - N))). + rstepr (c[*] (AbsIR (x N) [*]c[^] (n - N))). + apply mult_resp_leEq_lft. + apply H0; auto with arith. + assumption. + auto with arith. + rewrite H3. + rewrite <- minus_n_n. + apply eq_imp_leEq. + simpl in |- *; algebra. Qed. Lemma ratio_test_div : {N : nat | - {c : IR | One [<=] c | forall n, N <= n -> c[*]AbsIR (x n) [<] AbsIR (x (S n))}} -> + {c : IR | One [<=] c | forall n, N <= n -> c[*]AbsIR (x n) [<] AbsIR (x (S n))}} -> divergent x. -intros H. -elim H; clear H; intros N H. -elim H; clear H; intros c Hc Hn. -apply divergent_crit. -exists (AbsIR (x (S N))). -apply leEq_less_trans with (c[*]AbsIR (x N)). -astepl (c[*]Zero); apply mult_resp_leEq_lft. -apply AbsIR_nonneg. -apply less_leEq; eapply less_leEq_trans; [ apply pos_one | assumption ]. -apply Hn; auto with arith. -cut - (forall n : nat, - S N <= n -> {m : nat | n <= m /\ AbsIR (x (S N)) [<=] AbsIR (x m)}). -intro H. -clear Hn. -intro n. -cut (S N <= max (S N) n); [ intro | apply le_max_l ]. -elim (H _ H0); intros m Hm; elim Hm; clear H Hm; intros Hm H; exists m. -apply le_trans with (max (S N) n); auto with arith. -assumption. -intros; exists n. -split. -auto. -induction n as [| n Hrecn]. -inversion H. -clear Hrecn; induction n as [| n Hrecn]. -inversion H. -rewrite <- H1; apply eq_imp_leEq; algebra. -inversion H1. -elim (le_lt_eq_dec _ _ H); intro. -apply leEq_transitive with (AbsIR (x (S n))). -apply Hrecn; auto with arith. -apply less_leEq; apply leEq_less_trans with (c[*]AbsIR (x (S n))). -astepl (One[*]AbsIR (x (S n))); apply mult_resp_leEq_rht. -assumption. -apply AbsIR_nonneg. -apply Hn; auto with arith. -rewrite b; apply eq_imp_leEq; algebra. +Proof. + intros H. + elim H; clear H; intros N H. + elim H; clear H; intros c Hc Hn. + apply divergent_crit. + exists (AbsIR (x (S N))). + apply leEq_less_trans with (c[*]AbsIR (x N)). + astepl (c[*]Zero); apply mult_resp_leEq_lft. + apply AbsIR_nonneg. + apply less_leEq; eapply less_leEq_trans; [ apply pos_one | assumption ]. + apply Hn; auto with arith. + cut (forall n : nat, S N <= n -> {m : nat | n <= m /\ AbsIR (x (S N)) [<=] AbsIR (x m)}). + intro H. + clear Hn. + intro n. + cut (S N <= max (S N) n); [ intro | apply le_max_l ]. + elim (H _ H0); intros m Hm; elim Hm; clear H Hm; intros Hm H; exists m. + apply le_trans with (max (S N) n); auto with arith. + assumption. + intros; exists n. + split. + auto. + induction n as [| n Hrecn]. + inversion H. + clear Hrecn; induction n as [| n Hrecn]. + inversion H. + rewrite <- H1; apply eq_imp_leEq; algebra. + inversion H1. + elim (le_lt_eq_dec _ _ H); intro. + apply leEq_transitive with (AbsIR (x (S n))). + apply Hrecn; auto with arith. + apply less_leEq; apply leEq_less_trans with (c[*]AbsIR (x (S n))). + astepl (One[*]AbsIR (x (S n))); apply mult_resp_leEq_rht. + assumption. + apply AbsIR_nonneg. + apply Hn; auto with arith. + rewrite b; apply eq_imp_leEq; algebra. Qed. End More_CC. @@ -949,7 +947,7 @@ Section Alternate_Series. (** ** Alternate Series -Alternate series are a special case. Suppose that [x] is nonnegative and +Alternate series are a special case. Suppose that [x] is nonnegative and decreasing convergent to 0. *) @@ -964,331 +962,307 @@ Let y (n : nat) := [--]One[^]n[*]x n. Let alternate_lemma1 : forall n m : nat, [--]One[^]n[*]Sum n (n + (m + m)) y [<=] x n. -intros; induction m as [| m Hrecm]. -cut (n = n + (0 + 0)); [ intro | auto with arith ]. -rewrite <- H. -apply eq_imp_leEq. -cut (Sum n n y [=] y n); [ intro | apply Sum_one ]. -astepl ( [--]One[^]n[*]y n). -unfold y in |- *; simpl in |- *. -apply eq_transitive_unfolded with ( [--]OneR[^] (n + n) [*]x n). -astepl ( [--]One[^]n[*][--]One[^]n[*]x n). -apply mult_wdl. -apply nexp_plus. -astepr (One[*]x n). -apply mult_wdl. -apply inv_one_even_nexp. -auto with arith. -cut (n + (S m + S m) = S (S (n + (m + m)))); - [ intro | simpl in |- *; repeat rewrite plus_n_Sm; auto ]. -rewrite H. -apply - leEq_wdl - with - ( [--]One[^]n[*]Sum n (n + (m + m)) y[+] - [--]One[^]n[*] (y (S (n + (m + m))) [+]y (S (S (n + (m + m)))))). -apply - leEq_transitive - with (x n[+][--]One[^]n[*] (y (S (n + (m + m))) [+]y (S (S (n + (m + m)))))). -apply plus_resp_leEq. -apply Hrecm. -apply shift_plus_leEq'; astepr ZeroR. -unfold y in |- *. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. -apply leEq_wdl with ( [--] (x (S (n + (m + m)))) [+]x (S (S (n + (m + m))))). -apply shift_plus_leEq'; rstepr (x (S (n + (m + m)))). -apply mon_x. -apply bin_op_wd_unfolded. -rstepl ( [--]One[*]x (S (n + (m + m)))). -rstepr ( [--]One[^]n[*][--]One[^]S (n + (m + m)) [*]x (S (n + (m + m)))). -apply mult_wdl. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -apply nexp_plus. -apply inv_one_odd_nexp. -cut (n + S (n + (m + m)) = S (n + n + (m + m))); - [ intro | rewrite <- plus_n_Sm; auto with arith ]. -rewrite H0. -auto with arith. -astepl (One[*]x (S (S (n + (m + m))))). -rstepr - ( [--]One[^]n[*][--]One[^]S (S (n + (m + m))) [*]x (S (S (n + (m + m))))). -apply mult_wdl. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -apply nexp_plus. -apply inv_one_even_nexp. -cut (n + S (S (n + (m + m))) = S (S (n + n + (m + m)))); [ intro | omega ]. -rewrite H0. -auto with arith. -unfold Sum in |- *; simpl in |- *. -unfold Sum1 in |- *; simpl in |- *. -rational. +Proof. + intros; induction m as [| m Hrecm]. + cut (n = n + (0 + 0)); [ intro | auto with arith ]. + rewrite <- H. + apply eq_imp_leEq. + cut (Sum n n y [=] y n); [ intro | apply Sum_one ]. + astepl ( [--]One[^]n[*]y n). + unfold y in |- *; simpl in |- *. + apply eq_transitive_unfolded with ( [--]OneR[^] (n + n) [*]x n). + astepl ( [--]One[^]n[*][--]One[^]n[*]x n). + apply mult_wdl. + apply nexp_plus. + astepr (One[*]x n). + apply mult_wdl. + apply inv_one_even_nexp. + auto with arith. + cut (n + (S m + S m) = S (S (n + (m + m)))); + [ intro | simpl in |- *; repeat rewrite plus_n_Sm; auto ]. + rewrite H. + apply leEq_wdl with ( [--]One[^]n[*]Sum n (n + (m + m)) y[+] + [--]One[^]n[*] (y (S (n + (m + m))) [+]y (S (S (n + (m + m)))))). + apply leEq_transitive with (x n[+][--]One[^]n[*] (y (S (n + (m + m))) [+]y (S (S (n + (m + m)))))). + apply plus_resp_leEq. + apply Hrecm. + apply shift_plus_leEq'; astepr ZeroR. + unfold y in |- *. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. + apply leEq_wdl with ( [--] (x (S (n + (m + m)))) [+]x (S (S (n + (m + m))))). + apply shift_plus_leEq'; rstepr (x (S (n + (m + m)))). + apply mon_x. + apply bin_op_wd_unfolded. + rstepl ( [--]One[*]x (S (n + (m + m)))). + rstepr ( [--]One[^]n[*][--]One[^]S (n + (m + m)) [*]x (S (n + (m + m)))). + apply mult_wdl. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply nexp_plus. + apply inv_one_odd_nexp. + cut (n + S (n + (m + m)) = S (n + n + (m + m))); [ intro | rewrite <- plus_n_Sm; auto with arith ]. + rewrite H0. + auto with arith. + astepl (One[*]x (S (S (n + (m + m))))). + rstepr ( [--]One[^]n[*][--]One[^]S (S (n + (m + m))) [*]x (S (S (n + (m + m))))). + apply mult_wdl. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply nexp_plus. + apply inv_one_even_nexp. + cut (n + S (S (n + (m + m))) = S (S (n + n + (m + m)))); [ intro | omega ]. + rewrite H0. + auto with arith. + unfold Sum in |- *; simpl in |- *. + unfold Sum1 in |- *; simpl in |- *. + rational. Qed. Let alternate_lemma2 : forall n m : nat, [--]One[^]n[*]Sum n (n + S (m + m)) y [<=] x n. -intros. -cut (n + S (m + m) = S (n + (m + m))); [ intro | auto with arith ]. -rewrite H. -apply - leEq_wdl - with - ( [--]One[^]n[*]Sum n (n + (m + m)) y[+][--]One[^]n[*]y (S (n + (m + m)))). -apply leEq_transitive with (x n[+][--]One[^]n[*]y (S (n + (m + m)))). -apply plus_resp_leEq. -apply alternate_lemma1. -apply shift_plus_leEq'; rstepr (ZeroR[*]x (S (n + (m + m)))). -unfold y in |- *. -rstepl ( [--]One[^]n[*][--]One[^]S (n + (m + m)) [*]x (S (n + (m + m)))). -apply mult_resp_leEq_rht. -apply leEq_wdl with ( [--]OneR). -astepr ( [--]ZeroR); apply less_leEq; apply inv_resp_less; apply pos_one. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -apply nexp_plus. -apply inv_one_odd_nexp. -cut (n + S (n + (m + m)) = S (n + n + (m + m))); - [ intro | rewrite <- plus_n_Sm; auto with arith ]. -rewrite H0. -auto with arith. -apply pos_x. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply ring_dist_unfolded. -apply mult_wdr. -unfold Sum in |- *; unfold Sum1 in |- *; simpl in |- *; rational. +Proof. + intros. + cut (n + S (m + m) = S (n + (m + m))); [ intro | auto with arith ]. + rewrite H. + apply leEq_wdl with ( [--]One[^]n[*]Sum n (n + (m + m)) y[+][--]One[^]n[*]y (S (n + (m + m)))). + apply leEq_transitive with (x n[+][--]One[^]n[*]y (S (n + (m + m)))). + apply plus_resp_leEq. + apply alternate_lemma1. + apply shift_plus_leEq'; rstepr (ZeroR[*]x (S (n + (m + m)))). + unfold y in |- *. + rstepl ( [--]One[^]n[*][--]One[^]S (n + (m + m)) [*]x (S (n + (m + m)))). + apply mult_resp_leEq_rht. + apply leEq_wdl with ( [--]OneR). + astepr ( [--]ZeroR); apply less_leEq; apply inv_resp_less; apply pos_one. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + apply nexp_plus. + apply inv_one_odd_nexp. + cut (n + S (n + (m + m)) = S (n + n + (m + m))); [ intro | rewrite <- plus_n_Sm; auto with arith ]. + rewrite H0. + auto with arith. + apply pos_x. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply ring_dist_unfolded. + apply mult_wdr. + unfold Sum in |- *; unfold Sum1 in |- *; simpl in |- *; rational. Qed. Let alternate_lemma3 : forall n m : nat, Zero [<=] [--]One[^]n[*]Sum n (n + S (m + m)) y. -intros; induction m as [| m Hrecm]. -cut (S n = n + S (0 + 0)); [ intro | rewrite <- plus_n_Sm; auto ]. -rewrite <- H. -cut (Sum n (S n) y [=] y n[+]y (S n)). -intro; astepr ( [--]One[^]n[*] (y n[+]y (S n))). -unfold y in |- *. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. -apply leEq_wdr with (x n[-]x (S n)). -apply shift_leEq_minus; astepl (x (S n)). -apply mon_x. -unfold cg_minus in |- *; apply bin_op_wd_unfolded. -astepl (One[*]x n). -astepr ( [--]One[^]n[*][--]One[^]n[*]x n). -apply mult_wdl. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -apply nexp_plus. -apply inv_one_even_nexp. -auto with arith. -rstepl ( [--]One[*]x (S n)). -astepr ( [--]One[^]n[*][--]One[^]S n[*]x (S n)). -apply mult_wdl. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -apply nexp_plus. -apply inv_one_odd_nexp. -cut (n + S n = S (n + n)); [ intro | auto with arith ]. -rewrite H1. -auto with arith. -unfold Sum, Sum1 in |- *; simpl in |- *; rational. -cut (n + S (S m + S m) = S (S (n + S (m + m)))); - [ intro | simpl in |- *; repeat rewrite <- plus_n_Sm; auto with arith ]. -rewrite H. -apply - leEq_wdr - with - ( [--]One[^]n[*] - (Sum n (n + S (m + m)) y[+] - (y (S (n + S (m + m))) [+]y (S (S (n + S (m + m))))))). -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. -astepl (ZeroR[+]Zero). -apply plus_resp_leEq_both. -apply Hrecm. -unfold y in |- *. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. -apply leEq_wdr with (x (S (n + S (m + m))) [-]x (S (S (n + S (m + m))))). -apply shift_leEq_minus; astepl (x (S (S (n + S (m + m))))); apply mon_x. -unfold cg_minus in |- *; apply bin_op_wd_unfolded. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. -astepl (One[*]x (S (n + S (m + m)))); apply mult_wdl. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded; [ apply nexp_plus | apply inv_one_even_nexp ]. -cut (n + S (n + S (m + m)) = S (S (n + n + (m + m)))); - [ intro | simpl in |- *; repeat rewrite <- plus_n_Sm; auto with arith ]. -rewrite H0. -auto with arith. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. -rstepl ( [--]One[*]x (S (S (n + S (m + m))))); apply mult_wdl. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded; [ apply nexp_plus | apply inv_one_odd_nexp ]. -cut (n + S (S (n + S (m + m))) = S (S n + S n + (m + m))); - [ intro - | simpl in |- *; repeat rewrite <- plus_n_Sm; simpl in |- *; auto with arith ]. -rewrite H0. -auto with arith. -apply mult_wdr. -unfold Sum, Sum1 in |- *; simpl in |- *; rational. +Proof. + intros; induction m as [| m Hrecm]. + cut (S n = n + S (0 + 0)); [ intro | rewrite <- plus_n_Sm; auto ]. + rewrite <- H. + cut (Sum n (S n) y [=] y n[+]y (S n)). + intro; astepr ( [--]One[^]n[*] (y n[+]y (S n))). + unfold y in |- *. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. + apply leEq_wdr with (x n[-]x (S n)). + apply shift_leEq_minus; astepl (x (S n)). + apply mon_x. + unfold cg_minus in |- *; apply bin_op_wd_unfolded. + astepl (One[*]x n). + astepr ( [--]One[^]n[*][--]One[^]n[*]x n). + apply mult_wdl. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply nexp_plus. + apply inv_one_even_nexp. + auto with arith. + rstepl ( [--]One[*]x (S n)). + astepr ( [--]One[^]n[*][--]One[^]S n[*]x (S n)). + apply mult_wdl. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply nexp_plus. + apply inv_one_odd_nexp. + cut (n + S n = S (n + n)); [ intro | auto with arith ]. + rewrite H1. + auto with arith. + unfold Sum, Sum1 in |- *; simpl in |- *; rational. + cut (n + S (S m + S m) = S (S (n + S (m + m)))); + [ intro | simpl in |- *; repeat rewrite <- plus_n_Sm; auto with arith ]. + rewrite H. + apply leEq_wdr with ( [--]One[^]n[*] (Sum n (n + S (m + m)) y[+] + (y (S (n + S (m + m))) [+]y (S (S (n + S (m + m))))))). + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. + astepl (ZeroR[+]Zero). + apply plus_resp_leEq_both. + apply Hrecm. + unfold y in |- *. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply ring_dist_unfolded. + apply leEq_wdr with (x (S (n + S (m + m))) [-]x (S (S (n + S (m + m))))). + apply shift_leEq_minus; astepl (x (S (S (n + S (m + m))))); apply mon_x. + unfold cg_minus in |- *; apply bin_op_wd_unfolded. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. + astepl (One[*]x (S (n + S (m + m)))); apply mult_wdl. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded; [ apply nexp_plus | apply inv_one_even_nexp ]. + cut (n + S (n + S (m + m)) = S (S (n + n + (m + m)))); + [ intro | simpl in |- *; repeat rewrite <- plus_n_Sm; auto with arith ]. + rewrite H0. + auto with arith. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. + rstepl ( [--]One[*]x (S (S (n + S (m + m))))); apply mult_wdl. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded; [ apply nexp_plus | apply inv_one_odd_nexp ]. + cut (n + S (S (n + S (m + m))) = S (S n + S n + (m + m))); [ intro + | simpl in |- *; repeat rewrite <- plus_n_Sm; simpl in |- *; auto with arith ]. + rewrite H0. + auto with arith. + apply mult_wdr. + unfold Sum, Sum1 in |- *; simpl in |- *; rational. Qed. Let alternate_lemma4 : forall n m : nat, Zero [<=] [--]One[^]n[*]Sum n (n + (m + m)) y. -intros. -case m. -cut (n + (0 + 0) = n); [ intro | auto ]. -rewrite H. -cut (Sum n n y [=] y n); [ intro | apply Sum_one ]. -astepr ( [--]One[^]n[*]y n). -unfold y in |- *. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. -astepl (Zero[*]x n). -apply mult_resp_leEq_rht. -apply leEq_wdr with OneR. -apply less_leEq; apply pos_one. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -apply nexp_plus. -apply inv_one_even_nexp; auto with arith. -apply pos_x. -clear m; intro m. -cut (n + (S m + S m) = S (n + S (m + m))); - [ intro | simpl in |- *; rewrite <- plus_n_Sm; auto ]. -rewrite H. -apply - leEq_wdr - with - ( [--]One[^]n[*]Sum n (n + S (m + m)) y[+] - [--]One[^]n[*]y (S (n + S (m + m)))). -apply leEq_transitive with (Zero[+][--]One[^]n[*]y (S (n + S (m + m)))). -astepr ( [--]One[^]n[*]y (S (n + S (m + m)))). -unfold y in |- *. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. -astepl (Zero[*]x (S (n + S (m + m)))). -apply mult_resp_leEq_rht. -apply leEq_wdr with OneR. -apply less_leEq; apply pos_one. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -apply nexp_plus. -cut (n + S (n + S (m + m)) = n + n + (S m + S m)); - [ intro - | simpl in |- *; repeat rewrite <- plus_n_Sm; simpl in |- *; auto with arith ]. -rewrite H0; apply inv_one_even_nexp. -auto with arith. -apply pos_x. -apply plus_resp_leEq. -apply alternate_lemma3. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply ring_dist_unfolded. -apply mult_wdr. -unfold Sum in |- *; unfold Sum1 in |- *; simpl in |- *; rational. +Proof. + intros. + case m. + cut (n + (0 + 0) = n); [ intro | auto ]. + rewrite H. + cut (Sum n n y [=] y n); [ intro | apply Sum_one ]. + astepr ( [--]One[^]n[*]y n). + unfold y in |- *. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. + astepl (Zero[*]x n). + apply mult_resp_leEq_rht. + apply leEq_wdr with OneR. + apply less_leEq; apply pos_one. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + apply nexp_plus. + apply inv_one_even_nexp; auto with arith. + apply pos_x. + clear m; intro m. + cut (n + (S m + S m) = S (n + S (m + m))); [ intro | simpl in |- *; rewrite <- plus_n_Sm; auto ]. + rewrite H. + apply leEq_wdr with ( [--]One[^]n[*]Sum n (n + S (m + m)) y[+] [--]One[^]n[*]y (S (n + S (m + m)))). + apply leEq_transitive with (Zero[+][--]One[^]n[*]y (S (n + S (m + m)))). + astepr ( [--]One[^]n[*]y (S (n + S (m + m)))). + unfold y in |- *. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. + astepl (Zero[*]x (S (n + S (m + m)))). + apply mult_resp_leEq_rht. + apply leEq_wdr with OneR. + apply less_leEq; apply pos_one. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + apply nexp_plus. + cut (n + S (n + S (m + m)) = n + n + (S m + S m)); [ intro + | simpl in |- *; repeat rewrite <- plus_n_Sm; simpl in |- *; auto with arith ]. + rewrite H0; apply inv_one_even_nexp. + auto with arith. + apply pos_x. + apply plus_resp_leEq. + apply alternate_lemma3. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply ring_dist_unfolded. + apply mult_wdr. + unfold Sum in |- *; unfold Sum1 in |- *; simpl in |- *; rational. Qed. (* end hide *) Lemma alternate_series_conv : convergent (fun n => [--]One[^]n[*]x n). -red in |- *. -red in |- *. -intros e H. -elim (Lim_x e H). -intros N' HN'. -cut {N : nat | 0 < N | forall m : nat, N <= m -> AbsSmall e (x m)}. -intro H0. -elim H0; clear H0; intros N HNm HN. -exists N; intros. -apply AbsSmall_transitive with (x N). -apply HN; auto. -cut - (AbsIR - (seq_part_sum (fun n : nat => [--]One[^]n[*]x n) m[-] - seq_part_sum (fun n : nat => [--]One[^]n[*]x n) N) [=] - AbsIR ( [--]One[^]N[*]Sum N (pred m) y)). -intro. -apply leEq_wdl with (AbsIR ( [--]One[^]N[*]Sum N (pred m) y)). -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x; apply pos_x. -cut ({N < m} + {N = m}); intros. -2: apply le_lt_eq_dec; assumption. -apply - leEq_wdl - with - (Max ( [--]One[^]N[*]Sum N (pred m) y) - [--] ( [--]One[^]N[*]Sum N (pred m) y)). -apply Max_leEq. -inversion_clear H2. -cut {j : nat & {pred m = N + (j + j)} + {pred m = N + S (j + j)}}. -2: apply even_or_odd_plus_gt; apply le_2; auto. -intro. -elim H2; intros j Hj. -clear H2; inversion_clear Hj. -rewrite H2; apply alternate_lemma1. -rewrite H2; apply alternate_lemma2. -rewrite <- H3. -cut (Sum N (pred N) y [=] Zero); [ intro | apply Sum_empty; auto ]. -astepl ( [--]One[^]N[*]ZeroR). -astepl ZeroR; apply pos_x. -astepr ( [--][--] (x N)); apply inv_resp_leEq. -apply leEq_transitive with ZeroR. -astepr ( [--]ZeroR); apply inv_resp_leEq; apply pos_x. -inversion_clear H2. -cut {j : nat & {pred m = N + (j + j)} + {pred m = N + S (j + j)}}. -2: apply even_or_odd_plus_gt; apply le_2; auto. -intro. -elim H2; intros j Hj. -clear H2; inversion_clear Hj. -rewrite H2; apply alternate_lemma4. -rewrite H2; apply alternate_lemma3. -rewrite <- H3. -cut (Sum N (pred N) y [=] Zero); [ intro | apply Sum_empty; auto ]. -astepr ( [--]One[^]N[*]ZeroR). -astepr ZeroR; apply leEq_reflexive. -simpl in |- *; unfold ABSIR in |- *; apply eq_reflexive_unfolded. -apply eq_symmetric_unfolded; assumption. -elim (even_odd_dec N); intro. -apply AbsIR_wd. -eapply eq_transitive_unfolded. -apply seq_part_sum_n; auto; apply lt_le_trans with N; auto. -eapply eq_transitive_unfolded. -2: apply Sum_comm_scal'. -apply Sum_wd. -intro. -unfold y in |- *. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. -apply mult_wdl. -astepl (OneR[*][--]One[^]i). -apply mult_wdl. -apply eq_symmetric_unfolded; apply inv_one_even_nexp; assumption. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply AbsIR_inv. -apply AbsIR_wd. -eapply eq_transitive_unfolded. -apply seq_part_sum_n; auto; apply lt_le_trans with N; auto. -rstepr ( [--] ( [--]One[^]N) [*]Sum N (pred m) y). -eapply eq_transitive_unfolded. -2: apply Sum_comm_scal'. -apply Sum_wd. -intro. -unfold y in |- *. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. -apply mult_wdl. -astepl (OneR[*][--]One[^]i). -apply mult_wdl. -apply eq_symmetric_unfolded. -rstepl ( [--]OneR[^]1[*][--]One[^]N). -eapply eq_transitive_unfolded. -apply nexp_plus. -apply inv_one_even_nexp. -simpl in |- *. -auto with arith. -exists (S N'). -auto with arith. -intros. -astepr (x m[-]Zero); apply HN'; auto with arith. +Proof. + red in |- *. + red in |- *. + intros e H. + elim (Lim_x e H). + intros N' HN'. + cut {N : nat | 0 < N | forall m : nat, N <= m -> AbsSmall e (x m)}. + intro H0. + elim H0; clear H0; intros N HNm HN. + exists N; intros. + apply AbsSmall_transitive with (x N). + apply HN; auto. + cut (AbsIR (seq_part_sum (fun n : nat => [--]One[^]n[*]x n) m[-] + seq_part_sum (fun n : nat => [--]One[^]n[*]x n) N) [=] AbsIR ( [--]One[^]N[*]Sum N (pred m) y)). + intro. + apply leEq_wdl with (AbsIR ( [--]One[^]N[*]Sum N (pred m) y)). + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x; apply pos_x. + cut ({N < m} + {N = m}); intros. + 2: apply le_lt_eq_dec; assumption. + apply leEq_wdl with (Max ( [--]One[^]N[*]Sum N (pred m) y) [--] ( [--]One[^]N[*]Sum N (pred m) y)). + apply Max_leEq. + inversion_clear H2. + cut {j : nat & {pred m = N + (j + j)} + {pred m = N + S (j + j)}}. + 2: apply even_or_odd_plus_gt; apply le_2; auto. + intro. + elim H2; intros j Hj. + clear H2; inversion_clear Hj. + rewrite H2; apply alternate_lemma1. + rewrite H2; apply alternate_lemma2. + rewrite <- H3. + cut (Sum N (pred N) y [=] Zero); [ intro | apply Sum_empty; auto ]. + astepl ( [--]One[^]N[*]ZeroR). + astepl ZeroR; apply pos_x. + astepr ( [--][--] (x N)); apply inv_resp_leEq. + apply leEq_transitive with ZeroR. + astepr ( [--]ZeroR); apply inv_resp_leEq; apply pos_x. + inversion_clear H2. + cut {j : nat & {pred m = N + (j + j)} + {pred m = N + S (j + j)}}. + 2: apply even_or_odd_plus_gt; apply le_2; auto. + intro. + elim H2; intros j Hj. + clear H2; inversion_clear Hj. + rewrite H2; apply alternate_lemma4. + rewrite H2; apply alternate_lemma3. + rewrite <- H3. + cut (Sum N (pred N) y [=] Zero); [ intro | apply Sum_empty; auto ]. + astepr ( [--]One[^]N[*]ZeroR). + astepr ZeroR; apply leEq_reflexive. + simpl in |- *; unfold ABSIR in |- *; apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded; assumption. + elim (even_odd_dec N); intro. + apply AbsIR_wd. + eapply eq_transitive_unfolded. + apply seq_part_sum_n; auto; apply lt_le_trans with N; auto. + eapply eq_transitive_unfolded. + 2: apply Sum_comm_scal'. + apply Sum_wd. + intro. + unfold y in |- *. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. + apply mult_wdl. + astepl (OneR[*][--]One[^]i). + apply mult_wdl. + apply eq_symmetric_unfolded; apply inv_one_even_nexp; assumption. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply AbsIR_inv. + apply AbsIR_wd. + eapply eq_transitive_unfolded. + apply seq_part_sum_n; auto; apply lt_le_trans with N; auto. + rstepr ( [--] ( [--]One[^]N) [*]Sum N (pred m) y). + eapply eq_transitive_unfolded. + 2: apply Sum_comm_scal'. + apply Sum_wd. + intro. + unfold y in |- *. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply mult_assoc_unfolded. + apply mult_wdl. + astepl (OneR[*][--]One[^]i). + apply mult_wdl. + apply eq_symmetric_unfolded. + rstepl ( [--]OneR[^]1[*][--]One[^]N). + eapply eq_transitive_unfolded. + apply nexp_plus. + apply inv_one_even_nexp. + simpl in |- *. + auto with arith. + exists (S N'). + auto with arith. + intros. + astepr (x m[-]Zero); apply HN'; auto with arith. Qed. End Alternate_Series. @@ -1305,46 +1279,43 @@ and $e$#e#, both as sums of convergent series. Definition e_series (n : nat) := One[/] _[//]nring_fac_ap_zero IR n. Lemma e_series_conv : convergent e_series. -apply ratio_test_conv. -exists 1. -exists (OneR [/]TwoNZ). -apply pos_div_two'; apply pos_one. -split. -apply less_leEq; apply pos_div_two; apply pos_one. -intros. -unfold e_series in |- *. -eapply leEq_wdr. -2: apply mult_commutes. -eapply leEq_wdr. -2: apply AbsIR_mult_pos. -2: apply less_leEq; apply pos_div_two; apply pos_one. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -rstepr - (One[*]One[/] _[//] - mult_resp_ap_zero _ _ _ (two_ap_zero IR) (nring_fac_ap_zero _ n)). -rstepr - (One[/] _[//] - mult_resp_ap_zero _ _ _ (two_ap_zero IR) (nring_fac_ap_zero _ n)). -apply recip_resp_leEq. -astepl ((Two:IR) [*]Zero); apply mult_resp_less_lft. -apply pos_nring_fac. -apply pos_two. -cut (fac (S n) = S n * fac n). -2: simpl in |- *; auto with arith. -intro. -rewrite H0. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply nring_comm_mult. -apply mult_resp_leEq_rht. -apply nring_leEq; auto with arith. -apply less_leEq; apply pos_nring_fac. -apply less_leEq; apply mult_resp_pos; apply recip_resp_pos. -apply pos_nring_fac. -apply pos_two. -apply less_leEq; apply recip_resp_pos; apply pos_nring_fac. +Proof. + apply ratio_test_conv. + exists 1. + exists (OneR [/]TwoNZ). + apply pos_div_two'; apply pos_one. + split. + apply less_leEq; apply pos_div_two; apply pos_one. + intros. + unfold e_series in |- *. + eapply leEq_wdr. + 2: apply mult_commutes. + eapply leEq_wdr. + 2: apply AbsIR_mult_pos. + 2: apply less_leEq; apply pos_div_two; apply pos_one. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + rstepr (One[*]One[/] _[//] mult_resp_ap_zero _ _ _ (two_ap_zero IR) (nring_fac_ap_zero _ n)). + rstepr (One[/] _[//] mult_resp_ap_zero _ _ _ (two_ap_zero IR) (nring_fac_ap_zero _ n)). + apply recip_resp_leEq. + astepl ((Two:IR) [*]Zero); apply mult_resp_less_lft. + apply pos_nring_fac. + apply pos_two. + cut (fac (S n) = S n * fac n). + 2: simpl in |- *; auto with arith. + intro. + rewrite H0. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply nring_comm_mult. + apply mult_resp_leEq_rht. + apply nring_leEq; auto with arith. + apply less_leEq; apply pos_nring_fac. + apply less_leEq; apply mult_resp_pos; apply recip_resp_pos. + apply pos_nring_fac. + apply pos_two. + apply less_leEq; apply recip_resp_pos; apply pos_nring_fac. Qed. Definition E := series_sum _ e_series_conv. @@ -1353,36 +1324,32 @@ Definition pi_series n := [--]One[^]n[*] (One[/] _[//]Greater_imp_ap IR _ _ (pos_nring_S _ (n + n))). Lemma pi_series_conv : convergent pi_series. -unfold pi_series in |- *. -apply - alternate_series_conv - with - (x := fun n : nat => - One[/] _[//]Greater_imp_ap IR _ _ (pos_nring_S _ (n + n))). -intro; apply less_leEq. -apply recip_resp_pos; apply pos_nring_S. -apply Cauchy_Lim_prop3_prop2. -red in |- *; intros. -exists (S k); intros. -apply AbsIR_imp_AbsSmall. -apply less_leEq. -apply - less_wdl with (One[/] _[//]Greater_imp_ap IR _ _ (pos_nring_S _ (m + m))). -unfold one_div_succ, Snring in |- *. -apply recip_resp_less. -apply pos_nring_S. -apply nring_less; auto with arith. -apply eq_symmetric_unfolded. -apply - eq_transitive_unfolded - with (AbsIR (One[/] _[//]Greater_imp_ap IR _ _ (pos_nring_S _ (m + m)))). -apply AbsIR_wd; algebra. -apply AbsIR_eq_x; apply less_leEq. -apply recip_resp_pos; apply pos_nring_S. -intros. -apply less_leEq; apply recip_resp_less. -apply pos_nring_S. -apply nring_less; simpl in |- *; rewrite <- plus_n_Sm; auto with arith. +Proof. + unfold pi_series in |- *. + apply alternate_series_conv with (x := fun n : nat => + One[/] _[//]Greater_imp_ap IR _ _ (pos_nring_S _ (n + n))). + intro; apply less_leEq. + apply recip_resp_pos; apply pos_nring_S. + apply Cauchy_Lim_prop3_prop2. + red in |- *; intros. + exists (S k); intros. + apply AbsIR_imp_AbsSmall. + apply less_leEq. + apply less_wdl with (One[/] _[//]Greater_imp_ap IR _ _ (pos_nring_S _ (m + m))). + unfold one_div_succ, Snring in |- *. + apply recip_resp_less. + apply pos_nring_S. + apply nring_less; auto with arith. + apply eq_symmetric_unfolded. + apply eq_transitive_unfolded + with (AbsIR (One[/] _[//]Greater_imp_ap IR _ _ (pos_nring_S _ (m + m)))). + apply AbsIR_wd; algebra. + apply AbsIR_eq_x; apply less_leEq. + apply recip_resp_pos; apply pos_nring_S. + intros. + apply less_leEq; apply recip_resp_less. + apply pos_nring_S. + apply nring_less; simpl in |- *; rewrite <- plus_n_Sm; auto with arith. Qed. Definition pi := Four[*]series_sum _ pi_series_conv. diff --git a/reals/fast/CRAlternatingSum.v b/reals/fast/CRAlternatingSum.v index 3a511b4aa..f80f82ddd 100644 --- a/reals/fast/CRAlternatingSum.v +++ b/reals/fast/CRAlternatingSum.v @@ -61,69 +61,67 @@ Definition DecreasingNonNegative_alt := ForAll (fun (s:Stream Q) => 0 <= (hd (tl (** These two characterizations are equivalent. *) Lemma dnn_alt_dnn : forall s, DecreasingNonNegative_alt s -> DecreasingNonNegative s. Proof. -cofix r1. -intros s H. -constructor. - -cut (hd s <= hd s);[|apply Qle_refl]. -set (x:=hd s). -unfold x at 1. -generalize s H x. -clear s H x. -cofix r2. -intros s H x Hx. -constructor. -destruct H. -split. -apply Qle_trans with (hd (tl s)); firstorder. -assumption. -destruct H. -apply r2. -apply H0. -apply Qle_trans with (hd s); firstorder. - -destruct H. -apply r1. -apply H0. + cofix r1. + intros s H. + constructor. + cut (hd s <= hd s);[|apply Qle_refl]. + set (x:=hd s). + unfold x at 1. + generalize s H x. + clear s H x. + cofix r2. + intros s H x Hx. + constructor. + destruct H. + split. + apply Qle_trans with (hd (tl s)); firstorder. + assumption. + destruct H. + apply r2. + apply H0. + apply Qle_trans with (hd s); firstorder. + destruct H. + apply r1. + apply H0. Qed. Lemma dnn_dnn_alt : forall s, DecreasingNonNegative s -> DecreasingNonNegative_alt s. Proof. -cofix. -intros s H. -constructor. -destruct H. -destruct H. -destruct H1. -assumption. -apply dnn_dnn_alt. -destruct H; assumption. + cofix. + intros s H. + constructor. + destruct H. + destruct H. + destruct H1. + assumption. + apply dnn_dnn_alt. + destruct H; assumption. Qed. Lemma dnn_alt_iff_dnn : forall s, DecreasingNonNegative_alt s <-> DecreasingNonNegative s. Proof. -firstorder using dnn_alt_dnn dnn_dnn_alt. + firstorder using dnn_alt_dnn dnn_dnn_alt. Qed. (** Every tail of a decreasing nonnegative stream is also decreasing and nonnegative. *) Lemma dnn_tl : forall s, DecreasingNonNegative s -> DecreasingNonNegative (tl s). Proof. -intros s [_ H]. -assumption. + intros s [_ H]. + assumption. Qed. (* begin hide *) Hint Resolve dnn_tl : dnn. (* end hide *) Lemma dnn_Str_nth_tl : forall n s, DecreasingNonNegative s -> DecreasingNonNegative (Str_nth_tl n s). Proof. -induction n. - tauto. -intros s X. -simpl. -apply IHn. -apply dnn_tl. -assumption. + induction n. + tauto. + intros s X. + simpl. + apply IHn. + apply dnn_tl. + assumption. Qed. Section InfiniteAlternatingSum. @@ -140,23 +138,23 @@ Definition PartialAlternatingSumUntil (P:Stream Q -> bool)(seq:Stream Q)(ex:Lazy sequence if the sequence is decreasing and nonnegative. *) Lemma PartialAlternatingSumUntil_small : forall (P:Stream Q -> bool)(seq:Stream Q)(dnn:DecreasingNonNegative seq)(ex:LazyExists P seq), 0 <= (PartialAlternatingSumUntil P ex) <= (hd seq). Proof. -intros P seq dnn ex. -unfold PartialAlternatingSumUntil. -generalize dnn; clear dnn. -set (Q := (fun seq b => DecreasingNonNegative seq -> 0 <= b <= hd seq)). -change (Q seq (takeUntil P ex Qminus' 0)). -apply takeUntil_elim; unfold Q; clear seq ex Q. - intros seq _ [[[dnn _] _] _]; auto with *. -intros seq b IH H [[[Za Zb] [[_ Zd] _]] dnn]. -destruct (IH dnn) as [H0 H1]. -split. - rewrite Qminus'_correct. - apply: shift_zero_leEq_minus. - apply Qle_trans with (hd (tl seq)); auto. -rewrite Qle_minus_iff. - rewrite Qminus'_correct. -ring_simplify. -assumption. + intros P seq dnn ex. + unfold PartialAlternatingSumUntil. + generalize dnn; clear dnn. + set (Q := (fun seq b => DecreasingNonNegative seq -> 0 <= b <= hd seq)). + change (Q seq (takeUntil P ex Qminus' 0)). + apply takeUntil_elim; unfold Q; clear seq ex Q. + intros seq _ [[[dnn _] _] _]; auto with *. + intros seq b IH H [[[Za Zb] [[_ Zd] _]] dnn]. + destruct (IH dnn) as [H0 H1]. + split. + rewrite Qminus'_correct. + apply: shift_zero_leEq_minus. + apply Qle_trans with (hd (tl seq)); auto. + rewrite Qle_minus_iff. + rewrite Qminus'_correct. + ring_simplify. + assumption. Qed. (** A boolean version of Qball. *) @@ -165,34 +163,31 @@ Definition Qball_ex_bool e a b : bool := Lemma sumbool_eq_true : forall P (dec:{P}+{~P}), (if dec then true else false) = true <-> P. Proof. -intros. -destruct dec; -simpl;split;auto. -discriminate 1. + intros. + destruct dec; simpl;split;auto. + discriminate 1. Qed. (** If a sequence has a limit of l, then there is a point that gets arbitrarily close to l. *) Lemma Limit_near : forall (seq:Stream Q) (l:Q), Limit seq l -> forall e, LazyExists (fun s => Qball_ex_bool e (hd s) l) seq. Proof. -intros seq l H e. -assert (H' := (H e)). - -induction H'. -left. -destruct H0 as [H0 _]. -unfold Qball_ex_bool. -destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec e (hd x) l). -constructor. -apply n; clear n. -apply H0. - -right. -rename H1 into IHH'. -intro. -apply (IHH' tt). -apply Limit_tl. -assumption. + intros seq l H e. + assert (H' := (H e)). + induction H'. + left. + destruct H0 as [H0 _]. + unfold Qball_ex_bool. + destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec e (hd x) l). + constructor. + apply n; clear n. + apply H0. + right. + rename H1 into IHH'. + intro. + apply (IHH' tt). + apply Limit_tl. + assumption. Defined. (** The infinte sum of an alternating series is the limit of the @@ -202,83 +197,71 @@ PartialAlternatingSumUntil _ (Limit_near zl e). Lemma InfiniteAlternatingSum_prf : forall seq (dnn:DecreasingNonNegative seq) (zl:Limit seq 0), is_RegularFunction (InfiniteAlternatingSum_raw zl). Proof. -Opaque Qmetric_dec. -intros seq dnn zl. -unfold is_RegularFunction, ball, Qball. -simpl. - -(*WLOG e2 <= e1*) -cut (forall e1 e2 : Qpos, e2 <= e1 -> -Qball (e1 + e2) (InfiniteAlternatingSum_raw zl e1) - (InfiniteAlternatingSum_raw zl e2)). -intros H e1 e2. -destruct (Qpos_le_total e1 e2). -setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. -apply: ball_sym;simpl. -auto. -auto. - -intros e1 e2 He. -apply: ball_weak;simpl. -unfold Qball. -unfold InfiniteAlternatingSum_raw. -unfold PartialAlternatingSumUntil. -generalize (Limit_near zl e1) (Limit_near zl e2). -clear zl. -intros ex1 ex2. -simpl in *. -pose (F:= fun e => (fun s : Stream Q => Qball_ex_bool e (hd s) 0)). - -assert(case1: forall seq (dnn:DecreasingNonNegative seq) (ex2: LazyExists _ seq), (Qball e1 (hd seq) 0) -> - AbsSmall (R:=Q_as_COrdField) (e1:Q) (0 - (takeUntil (F e2) ex2 Qminus' 0))). -clear seq dnn ex1 ex2. -intros seq dnn ex2 [Hseq1 Hseq2]. -apply: AbsSmall_minus;simpl. -change (AbsSmall (e1:Q) ((PartialAlternatingSumUntil _ (ex2))-0)). -stepr (PartialAlternatingSumUntil _ (ex2)) by (simpl; ring). -destruct (PartialAlternatingSumUntil_small _ dnn (ex2)) as [Hl1 Hl2]. -apply AbsSmall_leEq_trans with (hd seq). -stepl (hd seq - 0);[assumption|simpl;ring]. -split;[|assumption]. -apply Qle_trans with 0;[|assumption]. -simpl. -rewrite Qle_minus_iff; ring_simplify. -destruct dnn as [[[X _] _] _]; assumption. - -assert(H:=ex1). -induction H; -case (ex1); unfold Qball_ex_bool in *; simpl in *; destruct (Qmetric_dec e1 (hd x) 0); try contradiction; auto. -intros ex3. - -assert (case2:~(Qball e2 (hd x) 0)). -intros q. -apply n. -simpl. -unfold Qball. -apply AbsSmall_leEq_trans with (e2:Q); assumption. - -Opaque Qred. -case (ex2); unfold Qball_ex_bool in *; simpl; destruct (Qmetric_dec e2 (hd x) 0); try contradiction; -try solve[intros; elim case2]. -intros ex4. -simpl. -set (a := - (takeUntil - (fun s : Stream Q => if Qmetric_dec e1 (hd s) 0 then true else false) - (ex3 tt)) Qminus' 0). -set (b:=(takeUntil - (fun s : Stream Q => if Qmetric_dec e2 (hd s) 0 then true else false) - (ex4 tt)) Qminus' 0). -stepr (b-a) by - (simpl; - repeat rewrite Qminus'_correct; - change (b - a == hd x - a - (hd x - b)); ring). -apply AbsSmall_minus. -rename H0 into IHExists. -apply (IHExists tt). -clear - dnn. -destruct dnn. -assumption. + Opaque Qmetric_dec. + intros seq dnn zl. + unfold is_RegularFunction, ball, Qball. + simpl. + (*WLOG e2 <= e1*) + cut (forall e1 e2 : Qpos, e2 <= e1 -> Qball (e1 + e2) (InfiniteAlternatingSum_raw zl e1) + (InfiniteAlternatingSum_raw zl e2)). + intros H e1 e2. + destruct (Qpos_le_total e1 e2). + setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. + apply: ball_sym;simpl. + auto. + auto. + intros e1 e2 He. + apply: ball_weak;simpl. + unfold Qball. + unfold InfiniteAlternatingSum_raw. + unfold PartialAlternatingSumUntil. + generalize (Limit_near zl e1) (Limit_near zl e2). + clear zl. + intros ex1 ex2. + simpl in *. + pose (F:= fun e => (fun s : Stream Q => Qball_ex_bool e (hd s) 0)). + assert(case1: forall seq (dnn:DecreasingNonNegative seq) (ex2: LazyExists _ seq), (Qball e1 (hd seq) 0) -> + AbsSmall (R:=Q_as_COrdField) (e1:Q) (0 - (takeUntil (F e2) ex2 Qminus' 0))). + clear seq dnn ex1 ex2. + intros seq dnn ex2 [Hseq1 Hseq2]. + apply: AbsSmall_minus;simpl. + change (AbsSmall (e1:Q) ((PartialAlternatingSumUntil _ (ex2))-0)). + stepr (PartialAlternatingSumUntil _ (ex2)) by (simpl; ring). + destruct (PartialAlternatingSumUntil_small _ dnn (ex2)) as [Hl1 Hl2]. + apply AbsSmall_leEq_trans with (hd seq). + stepl (hd seq - 0);[assumption|simpl;ring]. + split;[|assumption]. + apply Qle_trans with 0;[|assumption]. + simpl. + rewrite Qle_minus_iff; ring_simplify. + destruct dnn as [[[X _] _] _]; assumption. + assert(H:=ex1). + induction H; + case (ex1); unfold Qball_ex_bool in *; simpl in *; destruct (Qmetric_dec e1 (hd x) 0); try contradiction; auto. + intros ex3. + assert (case2:~(Qball e2 (hd x) 0)). + intros q. + apply n. + simpl. + unfold Qball. + apply AbsSmall_leEq_trans with (e2:Q); assumption. + Opaque Qred. + case (ex2); unfold Qball_ex_bool in *; simpl; destruct (Qmetric_dec e2 (hd x) 0); try contradiction; + try solve[intros; elim case2]. + intros ex4. + simpl. + set (a := (takeUntil (fun s : Stream Q => if Qmetric_dec e1 (hd s) 0 then true else false) + (ex3 tt)) Qminus' 0). + set (b:=(takeUntil (fun s : Stream Q => if Qmetric_dec e2 (hd s) 0 then true else false) + (ex4 tt)) Qminus' 0). + stepr (b-a) by (simpl; repeat rewrite Qminus'_correct; + change (b - a == hd x - a - (hd x - b)); ring). + apply AbsSmall_minus. + rename H0 into IHExists. + apply (IHExists tt). + clear - dnn. + destruct dnn. + assumption. Transparent Qmetric_dec. Qed. @@ -289,78 +272,71 @@ Lemma InfiniteAlternatingSum_step : forall seq (dnn:DecreasingNonNegative seq) ( (InfiniteAlternatingSum dnn zl == ('(hd seq))-(InfiniteAlternatingSum (dnn_tl dnn) (Limit_tl zl)))%CR. Proof. -intros [hd seq] [dnn_hd dnn] zl. -rewrite CRplus_translate. -apply: regFunEq_e. -intros e. -simpl. -unfold Cap_raw; simpl. -unfold InfiniteAlternatingSum_raw. -unfold PartialAlternatingSumUntil. -simpl. -set (P:=(fun s : Stream Q => - Qball_ex_bool e (Streams.hd s) 0)). -case_eq (P (Cons hd seq)); intros H. - -rewrite takeUntil_end;[|apply Is_true_eq_left;assumption]. -case_eq (P seq); intros H0. - -rewrite takeUntil_end;[|apply Is_true_eq_left;assumption]. -simpl. -ring_simplify. -unfold P in H. -apply: ball_weak;simpl. -apply: ball_sym;simpl. -unfold Qball_ex_bool in H. -destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec e (Streams.hd (Cons hd seq))) as [X|X]; - [apply X|discriminate H]. - -unfold P in *. -unfold Qball_ex_bool in *. -destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec e (Streams.hd (Cons hd seq))) as [X|X]; - [|discriminate H]. -destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec e (Streams.hd seq)) as [Y|Y]; - [discriminate H0|]. -elim Y. -simpl in dnn_hd. -destruct dnn_hd as [_ [[Z0 Z1] dnn_hd0]]. -split;simpl. -apply Qle_trans with 0. -rewrite Qle_minus_iff; ring_simplify; apply Qpos_nonneg. -ring_simplify. -apply Z0. -ring_simplify. -eapply Qle_trans. -apply Z1. -destruct X as [_ X]. -replace LHS with (hd - 0) by ring. -apply X. - -destruct (takeUntil_step P (Limit_near zl e) Qminus' 0) as [ex' rw]; - [rewrite H;auto|]. -rewrite rw; clear rw. -simpl. -rewrite (@takeUntil_wd Q Q P _ ex' (Limit_near (Limit_tl zl) e)). - rewrite Qminus'_correct. -apply: ball_refl. + intros [hd seq] [dnn_hd dnn] zl. + rewrite CRplus_translate. + apply: regFunEq_e. + intros e. + simpl. + unfold Cap_raw; simpl. + unfold InfiniteAlternatingSum_raw. + unfold PartialAlternatingSumUntil. + simpl. + set (P:=(fun s : Stream Q => Qball_ex_bool e (Streams.hd s) 0)). + case_eq (P (Cons hd seq)); intros H. + rewrite takeUntil_end;[|apply Is_true_eq_left;assumption]. + case_eq (P seq); intros H0. + rewrite takeUntil_end;[|apply Is_true_eq_left;assumption]. + simpl. + ring_simplify. + unfold P in H. + apply: ball_weak;simpl. + apply: ball_sym;simpl. + unfold Qball_ex_bool in H. + destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec e (Streams.hd (Cons hd seq))) as [X|X]; + [apply X|discriminate H]. + unfold P in *. + unfold Qball_ex_bool in *. + destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec e (Streams.hd (Cons hd seq))) as [X|X]; + [|discriminate H]. + destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec e (Streams.hd seq)) as [Y|Y]; [discriminate H0|]. + elim Y. + simpl in dnn_hd. + destruct dnn_hd as [_ [[Z0 Z1] dnn_hd0]]. + split;simpl. + apply Qle_trans with 0. + rewrite Qle_minus_iff; ring_simplify; apply Qpos_nonneg. + ring_simplify. + apply Z0. + ring_simplify. + eapply Qle_trans. + apply Z1. + destruct X as [_ X]. + replace LHS with (hd - 0) by ring. + apply X. + destruct (takeUntil_step P (Limit_near zl e) Qminus' 0) as [ex' rw]; [rewrite H;auto|]. + rewrite rw; clear rw. + simpl. + rewrite (@takeUntil_wd Q Q P _ ex' (Limit_near (Limit_tl zl) e)). + rewrite Qminus'_correct. + apply: ball_refl. Qed. (** The infinite alternating series is always nonnegative. *) Lemma InfiniteAlternatingSum_nonneg : forall seq (dnn:DecreasingNonNegative seq) (zl:Limit seq 0), (inject_Q 0%Q <= InfiniteAlternatingSum dnn zl)%CR. Proof. -intros seq dnn zl e. -apply Qle_trans with 0. -rewrite Qle_minus_iff; ring_simplify; apply Qpos_nonneg. -unfold InfiniteAlternatingSum. -simpl. -unfold Cap_raw. -simpl. -ring_simplify. -unfold InfiniteAlternatingSum_raw. -simpl. -destruct (PartialAlternatingSumUntil_small _ dnn (Limit_near zl ((1 # 2) * e)%Qpos)). -assumption. + intros seq dnn zl e. + apply Qle_trans with 0. + rewrite Qle_minus_iff; ring_simplify; apply Qpos_nonneg. + unfold InfiniteAlternatingSum. + simpl. + unfold Cap_raw. + simpl. + ring_simplify. + unfold InfiniteAlternatingSum_raw. + simpl. + destruct (PartialAlternatingSumUntil_small _ dnn (Limit_near zl ((1 # 2) * e)%Qpos)). + assumption. Qed. (** The infinite alternating series is always bounded by the first term @@ -368,14 +344,14 @@ in the series. *) Lemma InfiniteAlternatingSum_bound : forall seq (dnn:DecreasingNonNegative seq) (zl:Limit seq 0), (InfiniteAlternatingSum dnn zl <= inject_Q (hd seq))%CR. Proof. -intros seq dnn zl. -rewrite InfiniteAlternatingSum_step. -change (inject_Q (hd seq) - InfiniteAlternatingSum (dnn_tl dnn) (Limit_tl zl)[<=]inject_Q (hd seq))%CR. -stepr (inject_Q (hd seq) - inject_Q 0%Q)%CR. -apply: minus_resp_leEq_rht. -apply InfiniteAlternatingSum_nonneg. -simpl. -ring. + intros seq dnn zl. + rewrite InfiniteAlternatingSum_step. + change (inject_Q (hd seq) - InfiniteAlternatingSum (dnn_tl dnn) (Limit_tl zl)[<=]inject_Q (hd seq))%CR. + stepr (inject_Q (hd seq) - inject_Q 0%Q)%CR. + apply: minus_resp_leEq_rht. + apply InfiniteAlternatingSum_nonneg. + simpl. + ring. Qed. (** [InfiniteAlternatingSum] is correct. *) @@ -383,87 +359,80 @@ Lemma dnn_zl_convergent : forall (seq:Stream Q), forall (dnn:DecreasingNonNegative seq) (zl:Limit seq 0), convergent (fun n => inj_Q IR ((-(1))^n*Str_nth n seq)). Proof. -intros seq dnn zl. -cut (convergent (fun n : nat => [--]One[^]n[*]inj_Q IR (Str_nth n seq))). - apply convergent_wd. - intros n. - stepr ((inj_Q IR ((-(1))^n))[*](inj_Q IR (Str_nth n seq))) by - (apply eq_symmetric; apply inj_Q_mult). - apply mult_wdl. - stepr ((inj_Q IR (-(1)))[^]n) by - (apply eq_symmetric; apply inj_Q_power). - apply nexp_wd. - stepr ([--](inj_Q IR 1)) by - (apply eq_symmetric; apply inj_Q_inv). - apply un_op_wd_unfolded. - rstepl ((nring 1):IR). - apply eq_symmetric; apply (inj_Q_nring IR 1). -apply alternate_series_conv. + intros seq dnn zl. + cut (convergent (fun n : nat => [--]One[^]n[*]inj_Q IR (Str_nth n seq))). + apply convergent_wd. intros n. - unfold Str_nth. - change (Zero:IR) with (nring 0:IR). - stepl (inj_Q IR (nring 0)) by apply inj_Q_nring. - apply inj_Q_leEq. - simpl. - destruct (dnn_Str_nth_tl n dnn) as [[[H _] _] _]. - assumption. - intros e He. - destruct (Q_dense_in_CReals IR e He) as [c Hc]. - cut {N : nat & - forall m : nat, - (N <= m)%nat -> AbsSmall c ((Str_nth m seq))}. - intros [N HN]. - exists N. - intros m Hm. - eapply AbsSmall_trans with (inj_Q IR c). + stepr ((inj_Q IR ((-(1))^n))[*](inj_Q IR (Str_nth n seq))) by (apply eq_symmetric; apply inj_Q_mult). + apply mult_wdl. + stepr ((inj_Q IR (-(1)))[^]n) by (apply eq_symmetric; apply inj_Q_power). + apply nexp_wd. + stepr ([--](inj_Q IR 1)) by (apply eq_symmetric; apply inj_Q_inv). + apply un_op_wd_unfolded. + rstepl ((nring 1):IR). + apply eq_symmetric; apply (inj_Q_nring IR 1). + apply alternate_series_conv. + intros n. + unfold Str_nth. + change (Zero:IR) with (nring 0:IR). + stepl (inj_Q IR (nring 0)) by apply inj_Q_nring. + apply inj_Q_leEq. + simpl. + destruct (dnn_Str_nth_tl n dnn) as [[[H _] _] _]. assumption. - rstepr (inj_Q IR (Str_nth m seq)). - apply inj_Q_AbsSmall. - apply HN. - assumption. - clear e He c0. - assert (Hc':0 AbsSmall c ((Str_nth m seq))}. + intros [N HN]. + exists N. + intros m Hm. + eapply AbsSmall_trans with (inj_Q IR c). + assumption. + rstepr (inj_Q IR (Str_nth m seq)). + apply inj_Q_AbsSmall. + apply HN. assumption. - apply eq_symmetric; apply inj_Q_nring. - assert (L:=(Limit_near zl (mkQpos Hc'))). - exists (takeUntil _ L (fun _ => S) O). - generalize dnn; clear dnn. - set (Q:= (fun seq b => DecreasingNonNegative seq -> forall m : nat, (b <= m)%nat -> - AbsSmall (R:=Q_as_COrdField) c (Str_nth m seq))). - change (Q seq (takeUntil - (fun s : Stream Q_as_MetricSpace => - Qball_ex_bool (mkQpos (a:=c) Hc') (hd s) 0) L - (fun _ : Q_as_MetricSpace => S) 0%nat)). - apply takeUntil_elim; unfold Q; clear seq zl L Q. - intros x H dnn m _. - unfold Str_nth. - unfold Qball_ex_bool in H. - destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec (mkQpos (a:=c) Hc') (hd x) 0) as [b|b]; try contradiction. - simpl in b. - apply leEq_imp_AbsSmall. - destruct (dnn_Str_nth_tl m dnn) as [[[X _] _] _];assumption. - destruct dnn as [X _]. - destruct (ForAll_Str_nth_tl m X) as [[_ Y] _]. - simpl. - eapply Qle_trans. - apply Y. - destruct b as [_ b]. - simpl in b. - autorewrite with QposElim in b. - ring_simplify in b. - assumption. - intros x b IH H dnn [|m] Hm. - elimtype False; auto with *. - apply IH; auto with *. -intros n. -apply inj_Q_leEq. -rewrite <- dnn_alt_iff_dnn in dnn. -destruct (ForAll_Str_nth_tl n dnn) as [[_ X] _]. -rewrite tl_nth_tl in X. -assumption. + clear e He c0. + assert (Hc':0 S) O). + generalize dnn; clear dnn. + set (Q:= (fun seq b => DecreasingNonNegative seq -> forall m : nat, (b <= m)%nat -> + AbsSmall (R:=Q_as_COrdField) c (Str_nth m seq))). + change (Q seq (takeUntil (fun s : Stream Q_as_MetricSpace => + Qball_ex_bool (mkQpos (a:=c) Hc') (hd s) 0) L (fun _ : Q_as_MetricSpace => S) 0%nat)). + apply takeUntil_elim; unfold Q; clear seq zl L Q. + intros x H dnn m _. + unfold Str_nth. + unfold Qball_ex_bool in H. + destruct (ball_ex_dec Q_as_MetricSpace Qmetric_dec (mkQpos (a:=c) Hc') (hd x) 0) as [b|b]; try contradiction. + simpl in b. + apply leEq_imp_AbsSmall. + destruct (dnn_Str_nth_tl m dnn) as [[[X _] _] _];assumption. + destruct dnn as [X _]. + destruct (ForAll_Str_nth_tl m X) as [[_ Y] _]. + simpl. + eapply Qle_trans. + apply Y. + destruct b as [_ b]. + simpl in b. + autorewrite with QposElim in b. + ring_simplify in b. + assumption. + intros x b IH H dnn [|m] Hm. + elimtype False; auto with *. + apply IH; auto with *. + intros n. + apply inj_Q_leEq. + rewrite <- dnn_alt_iff_dnn in dnn. + destruct (ForAll_Str_nth_tl n dnn) as [[_ X] _]. + rewrite tl_nth_tl in X. + assumption. Qed. Lemma InfiniteAlternatingSum_correct : forall (seq:Stream Q) (x:nat -> IR), @@ -471,115 +440,103 @@ Lemma InfiniteAlternatingSum_correct : forall (seq:Stream Q) (x:nat -> IR), forall (dnn:DecreasingNonNegative seq) zl H, (InfiniteAlternatingSum dnn zl==IRasCR (series_sum x H))%CR. Proof. -intros seq x Hx dnn zl H. -unfold series_sum. -rewrite IR_Lim_as_CR. -apply: SeqLimit_unique. -intros e He. -generalize (IR_Cauchy_prop_as_CR (Build_CauchySeq IR (seq_part_sum x) H)). -intros C. -destruct (C _ (pos_div_two _ _ He)) as [n Hn]. -exists n. -intros m Hm. -unfold CS_seq in *. -clear C. -unfold seq_part_sum in *. -rstepr (((IRasCR (Sum0 (G:=IR) m x)[-](IRasCR (Sum0 (G:=IR) n x)))[+] - ((IRasCR (Sum0 (G:=IR) n x)[-]InfiniteAlternatingSum dnn zl)))). -apply AbsSmall_eps_div_two;[apply Hn; assumption|]. - -assert (X:AbsSmall (R:=CRasCReals) (e [/]TwoNZ) (('(((-(1))^n)*(Str_nth n seq)))%CR)). -stepr (IRasCR (x n)). -stepr (Sum n n (fun n => IRasCR (x n))) by apply: Sum_one. -unfold Sum, Sum1. -stepr (IRasCR (Sum0 (S n) x)[-]IRasCR (Sum0 n x )) by - (apply cg_minus_wd; apply IR_Sum0_as_CR). -apply Hn. -auto. -simpl. -symmetry. -rewrite <- IR_inj_Q_as_CR. -apply IRasCR_wd. -apply Hx. - -stepr (('(Sum0 n (fun n => ((-(1))^n)*(Str_nth n seq))%Q))%CR[-]InfiniteAlternatingSum dnn zl). -clear - X. -generalize seq dnn zl X. -clear seq dnn zl X. -generalize (e[/]TwoNZ). -clear e. -induction n; intros e seq dnn zl X. -simpl in *. -apply AbsSmall_minus. -stepr (InfiniteAlternatingSum dnn zl) by (unfold cg_minus;simpl;ring). -apply leEq_imp_AbsSmall;[apply InfiniteAlternatingSum_nonneg|]. -apply: leEq_transitive;simpl. -apply InfiniteAlternatingSum_bound. -setoid_replace (hd seq) with (1*hd seq)%Q by ring. -destruct X; assumption. - -apply AbsSmall_minus. -stepr (('(((Sum0 (G:=Q_as_CAbGroup) n (fun n0 : nat => ((- (1)) ^ n0 * Str_nth n0 (tl seq))%Q)))%CR)[-] - InfiniteAlternatingSum (dnn_tl dnn) (Limit_tl zl)))%CR; - [apply IHn|]. -rewrite inj_S in X. -rstepr ([--][--]('(((- (1)) ^ n * Str_nth n (tl seq))%Q))%CR). -apply inv_resp_AbsSmall. -stepr (' ((- (1)) ^ Zsucc n * Str_nth (S n) seq))%CR;[assumption|]. -simpl. -change ((' ( (- (1)) ^ (n+1) * Str_nth n (tl seq)) == - - ' ((- (1)) ^ n * Str_nth n (tl seq)))%CR). -rewrite Qpower_plus;[|discriminate]. -simpl. -ring. - -stepl (InfiniteAlternatingSum dnn zl[-](('(((- (1)) ^ 0 * Str_nth 0 seq)%Q[+] -((Sum0 (G:=Q_as_CAbGroup) n - (fun n0 : nat => ((- (1)) ^ (S n0) * Str_nth n0 (tl seq))%Q))):Q))%CR));[ -apply cg_minus_wd;[reflexivity| - rewrite CReq_Qeq; - apply: Sum0_shift; - intros i; simpl; reflexivity]|]. -unfold cg_minus; simpl. -rewrite InfiniteAlternatingSum_step. -generalize (InfiniteAlternatingSum (dnn_tl dnn) (Limit_tl zl)). -intros x. -change (Str_nth 0 seq) with (hd seq). -setoid_replace ((Sum0 (G:=Q_as_CAbGroup) n + intros seq x Hx dnn zl H. + unfold series_sum. + rewrite IR_Lim_as_CR. + apply: SeqLimit_unique. + intros e He. + generalize (IR_Cauchy_prop_as_CR (Build_CauchySeq IR (seq_part_sum x) H)). + intros C. + destruct (C _ (pos_div_two _ _ He)) as [n Hn]. + exists n. + intros m Hm. + unfold CS_seq in *. + clear C. + unfold seq_part_sum in *. + rstepr (((IRasCR (Sum0 (G:=IR) m x)[-](IRasCR (Sum0 (G:=IR) n x)))[+] + ((IRasCR (Sum0 (G:=IR) n x)[-]InfiniteAlternatingSum dnn zl)))). + apply AbsSmall_eps_div_two;[apply Hn; assumption|]. + assert (X:AbsSmall (R:=CRasCReals) (e [/]TwoNZ) (('(((-(1))^n)*(Str_nth n seq)))%CR)). + stepr (IRasCR (x n)). + stepr (Sum n n (fun n => IRasCR (x n))) by apply: Sum_one. + unfold Sum, Sum1. + stepr (IRasCR (Sum0 (S n) x)[-]IRasCR (Sum0 n x )) by (apply cg_minus_wd; apply IR_Sum0_as_CR). + apply Hn. + auto. + simpl. + symmetry. + rewrite <- IR_inj_Q_as_CR. + apply IRasCR_wd. + apply Hx. + stepr (('(Sum0 n (fun n => ((-(1))^n)*(Str_nth n seq))%Q))%CR[-]InfiniteAlternatingSum dnn zl). + clear - X. + generalize seq dnn zl X. + clear seq dnn zl X. + generalize (e[/]TwoNZ). + clear e. + induction n; intros e seq dnn zl X. + simpl in *. + apply AbsSmall_minus. + stepr (InfiniteAlternatingSum dnn zl) by (unfold cg_minus;simpl;ring). + apply leEq_imp_AbsSmall;[apply InfiniteAlternatingSum_nonneg|]. + apply: leEq_transitive;simpl. + apply InfiniteAlternatingSum_bound. + setoid_replace (hd seq) with (1*hd seq)%Q by ring. + destruct X; assumption. + apply AbsSmall_minus. + stepr (('(((Sum0 (G:=Q_as_CAbGroup) n (fun n0 : nat => ((- (1)) ^ n0 * Str_nth n0 (tl seq))%Q)))%CR)[-] + InfiniteAlternatingSum (dnn_tl dnn) (Limit_tl zl)))%CR; [apply IHn|]. + rewrite inj_S in X. + rstepr ([--][--]('(((- (1)) ^ n * Str_nth n (tl seq))%Q))%CR). + apply inv_resp_AbsSmall. + stepr (' ((- (1)) ^ Zsucc n * Str_nth (S n) seq))%CR;[assumption|]. + simpl. + change ((' ( (- (1)) ^ (n+1) * Str_nth n (tl seq)) == - ' ((- (1)) ^ n * Str_nth n (tl seq)))%CR). + rewrite Qpower_plus;[|discriminate]. + simpl. + ring. + stepl (InfiniteAlternatingSum dnn zl[-](('(((- (1)) ^ 0 * Str_nth 0 seq)%Q[+] + ((Sum0 (G:=Q_as_CAbGroup) n + (fun n0 : nat => ((- (1)) ^ (S n0) * Str_nth n0 (tl seq))%Q))):Q))%CR));[ + apply cg_minus_wd;[reflexivity| rewrite CReq_Qeq; apply: Sum0_shift; + intros i; simpl; reflexivity]|]. + unfold cg_minus; simpl. + rewrite InfiniteAlternatingSum_step. + generalize (InfiniteAlternatingSum (dnn_tl dnn) (Limit_tl zl)). + intros x. + change (Str_nth 0 seq) with (hd seq). + setoid_replace ((Sum0 (G:=Q_as_CAbGroup) n (fun n0 : nat => Qpower_positive (- (1)) (P_of_succ_nat n0) * Str_nth n0 (tl seq)))%Q:Q) - with (-(Sum0 (G:=Q_as_CAbGroup) n - (fun n0 : nat => ((- (1)) ^ n0 * Str_nth n0 (tl seq)))))%Q;[ring|]. -apply: eq_transitive;[|apply (inv_Sum0 Q_as_CAbGroup)]. -apply: Sum0_wd. -intros i; simpl. -change (Qpower_positive (- (1)) (P_of_succ_nat i)) with ((-(1))^ S i). -rewrite inj_S. -unfold Zsucc. -rewrite Qpower_plus;[|discriminate]. -ring. - -apply cg_minus_wd;[rewrite IR_Sum0_as_CR|reflexivity]. -clear - Hx. -induction n. -reflexivity. -change ((' (Sum0 (G:=Q_as_CAbGroup) n - (fun n0 : nat => ((- (1)) ^ n0 * Str_nth n0 seq)%Q) + - (- (1)) ^ n * Str_nth n seq) == - (Sum0 (G:=CRasCAbGroup) n (fun n0 : nat => IRasCR (x n0)):CR) + IRasCR (x n))%CR). -rewrite <- CRplus_Qplus. -apply ucFun2_wd;[apply IHn|]. -transitivity (IRasCR (inj_Q IR ((- (1)) ^ n * Str_nth n seq)%Q)); - [symmetry;apply IR_inj_Q_as_CR|]. -apply IRasCR_wd. -apply Hx. + with (-(Sum0 (G:=Q_as_CAbGroup) n + (fun n0 : nat => ((- (1)) ^ n0 * Str_nth n0 (tl seq)))))%Q;[ring|]. + apply: eq_transitive;[|apply (inv_Sum0 Q_as_CAbGroup)]. + apply: Sum0_wd. + intros i; simpl. + change (Qpower_positive (- (1)) (P_of_succ_nat i)) with ((-(1))^ S i). + rewrite inj_S. + unfold Zsucc. + rewrite Qpower_plus;[|discriminate]. + ring. + apply cg_minus_wd;[rewrite IR_Sum0_as_CR|reflexivity]. + clear - Hx. + induction n. + reflexivity. + change ((' (Sum0 (G:=Q_as_CAbGroup) n (fun n0 : nat => ((- (1)) ^ n0 * Str_nth n0 seq)%Q) + + (- (1)) ^ n * Str_nth n seq) == + (Sum0 (G:=CRasCAbGroup) n (fun n0 : nat => IRasCR (x n0)):CR) + IRasCR (x n))%CR). + rewrite <- CRplus_Qplus. + apply ucFun2_wd;[apply IHn|]. + transitivity (IRasCR (inj_Q IR ((- (1)) ^ n * Str_nth n seq)%Q)); [symmetry;apply IR_inj_Q_as_CR|]. + apply IRasCR_wd. + apply Hx. Qed. Lemma InfiniteAlternatingSum_correct' : forall (seq:Stream Q), forall (dnn:DecreasingNonNegative seq) zl, (InfiniteAlternatingSum dnn zl==IRasCR (series_sum _ (dnn_zl_convergent dnn zl)))%CR. Proof. -intros seq dnn zl. -apply InfiniteAlternatingSum_correct. -intros; apply eq_reflexive. + intros seq dnn zl. + apply InfiniteAlternatingSum_correct. + intros; apply eq_reflexive. Qed. -End InfiniteAlternatingSum. \ No newline at end of file +End InfiniteAlternatingSum. diff --git a/reals/fast/CRArith.v b/reals/fast/CRArith.v index d3ac77f90..9913df8b7 100644 --- a/reals/fast/CRArith.v +++ b/reals/fast/CRArith.v @@ -36,47 +36,46 @@ Open Local Scope CR_scope. on rational numbers. *) Lemma CReq_Qeq : forall (x y:Q), inject_Q x == inject_Q y <-> (x == y)%Q. Proof. -intros x y. -apply Cunit_eq. + intros x y. + apply Cunit_eq. Qed. Lemma CRle_Qle : forall (x y:Q), inject_Q x <= inject_Q y <-> (x <= y)%Q. Proof. -split. -intros H. -destruct (Qlt_le_dec y x) as [X|X];[|assumption]. -destruct (Qpos_lt_plus X) as [c Hc]. -assert (Y:=(H ((1#2)*c)%Qpos)). -simpl in Y. -unfold Cap_raw in Y; simpl in Y. -rewrite -> Qle_minus_iff in Y. -rewrite -> Hc in Y. -autorewrite with QposElim in Y. -ring_simplify in Y. -elim (Qle_not_lt _ _ Y). -rewrite Qlt_minus_iff. -ring_simplify. -apply: Qpos_prf. - -intros H e. -simpl. -unfold Cap_raw; simpl. -rewrite -> Qle_minus_iff in H. -apply Qle_trans with (0%Q);[|assumption]. -rewrite Qle_minus_iff; ring_simplify. -apply Qpos_nonneg. + split. + intros H. + destruct (Qlt_le_dec y x) as [X|X];[|assumption]. + destruct (Qpos_lt_plus X) as [c Hc]. + assert (Y:=(H ((1#2)*c)%Qpos)). + simpl in Y. + unfold Cap_raw in Y; simpl in Y. + rewrite -> Qle_minus_iff in Y. + rewrite -> Hc in Y. + autorewrite with QposElim in Y. + ring_simplify in Y. + elim (Qle_not_lt _ _ Y). + rewrite Qlt_minus_iff. + ring_simplify. + apply: Qpos_prf. + intros H e. + simpl. + unfold Cap_raw; simpl. + rewrite -> Qle_minus_iff in H. + apply Qle_trans with (0%Q);[|assumption]. + rewrite Qle_minus_iff; ring_simplify. + apply Qpos_nonneg. Qed. Lemma CRplus_Qplus : forall (x y:Q), inject_Q x + inject_Q y == inject_Q (x + y)%Q. Proof. -intros x y e1 e2; apply ball_refl. + intros x y e1 e2; apply ball_refl. Qed. Hint Rewrite <- CRplus_Qplus : toCRring. Lemma CRopp_Qopp : forall (x:Q), - inject_Q x == inject_Q (- x)%Q. Proof. -intros x e1 e2; apply ball_refl. + intros x e1 e2; apply ball_refl. Qed. (* begin hide *) Hint Rewrite CRopp_Qopp : CRfast_compute. @@ -84,57 +83,51 @@ Hint Rewrite <- CRopp_Qopp : toCRring. (* end hide *) Lemma CRminus_Qminus : forall (x y:Q), inject_Q x - inject_Q y == inject_Q (x - y)%Q. Proof. -intros x y e1 e2; apply ball_refl. + intros x y e1 e2; apply ball_refl. Qed. (* begin hide *) Hint Rewrite <- CRminus_Qminus : toCRring. (* end hide *) Lemma CRmult_Qmult : forall (x y:Q), inject_Q x * inject_Q y == inject_Q (x * y)%Q. Proof. -intros x y. -rewrite CRmult_scale. -intros e1 e2; apply ball_refl. + intros x y. + rewrite CRmult_scale. + intros e1 e2; apply ball_refl. Qed. (* begin hide *) Hint Rewrite <- CRmult_Qmult : toCRring. (* end hide *) Lemma Qap_CRap : forall (x y:Q), (~(x==y))%Q -> (' x)><(' y). Proof. -intros x y Hxy. -destruct (Q_dec x y) as [[H|H]|H]; try contradiction; -destruct (Qpos_lt_plus H) as [c Hc];[left|right]; exists c; -abstract (rewrite CRminus_Qminus; -rewrite CRle_Qle; -rewrite Hc; -ring_simplify; -apply Qle_refl). + intros x y Hxy. + destruct (Q_dec x y) as [[H|H]|H]; try contradiction; + destruct (Qpos_lt_plus H) as [c Hc];[left|right]; exists c; abstract (rewrite CRminus_Qminus; + rewrite CRle_Qle; rewrite Hc; ring_simplify; apply Qle_refl). Defined. Lemma CRinv_Qinv : forall (x:Q) x_, CRinv (inject_Q x) x_ == inject_Q (/x). Proof. -intros x [[c x_]|[c x_]]; -[change (' c <= ' 0%Q + - ' x)%CR in x_|change (' c <= ' x + - ' 0%Q)%CR in x_]; -unfold CRinv; -rewrite -> CRopp_Qopp, CRplus_Qplus, CRle_Qle in x_; -try rewrite CRopp_Qopp; -rewrite (@CRinv_pos_Qinv c). - rewrite CRopp_Qopp. - rewrite CReq_Qeq. - assert (~x==0)%Q. - intros H. - rewrite -> H in x_. - apply (Qle_not_lt _ _ x_). - apply Qpos_prf. - field. - intros X; apply H. - replace LHS with (- - x)%Q by ring. - rewrite X. - reflexivity. - replace RHS with (0 + - x)%Q by ring. - assumption. - reflexivity. -replace RHS with (x + - 0)%Q by ring. -assumption. + intros x [[c x_]|[c x_]]; + [change (' c <= ' 0%Q + - ' x)%CR in x_|change (' c <= ' x + - ' 0%Q)%CR in x_]; unfold CRinv; + rewrite -> CRopp_Qopp, CRplus_Qplus, CRle_Qle in x_; try rewrite CRopp_Qopp; + rewrite (@CRinv_pos_Qinv c). + rewrite CRopp_Qopp. + rewrite CReq_Qeq. + assert (~x==0)%Q. + intros H. + rewrite -> H in x_. + apply (Qle_not_lt _ _ x_). + apply Qpos_prf. + field. + intros X; apply H. + replace LHS with (- - x)%Q by ring. + rewrite X. + reflexivity. + replace RHS with (0 + - x)%Q by ring. + assumption. + reflexivity. + replace RHS with (x + - 0)%Q by ring. + assumption. Qed. (* begin hide *) Hint Rewrite <- CRinv_Qinv : toCRring. @@ -143,70 +136,70 @@ Hint Rewrite <- CRinv_Qinv : toCRring. ** Ring CR forms a ring for the ring tactic. *) -Lemma CR_ring_theory : +Lemma CR_ring_theory : @ring_theory CR (' 0%Q) (' 1%Q) (ucFun2 CRplus) CRmult (fun (x y:CR) => (x + - y)) CRopp (@st_eq CR). Proof. -split. -apply: cm_lft_unit_unfolded. -apply: cag_commutes_unfolded. -apply: plus_assoc_unfolded. -apply: one_mult. -apply: mult_commut_unfolded. -apply: mult_assoc_unfolded. -intros x y z;generalize z x y;apply: ring_distl_unfolded. -reflexivity. -apply: cg_minus_correct. + split. + apply: cm_lft_unit_unfolded. + apply: cag_commutes_unfolded. + apply: plus_assoc_unfolded. + apply: one_mult. + apply: mult_commut_unfolded. + apply: mult_assoc_unfolded. + intros x y z;generalize z x y;apply: ring_distl_unfolded. + reflexivity. + apply: cg_minus_correct. Qed. Lemma inject_Q_strext : fun_strext inject_Q. Proof. -intros x y [Hxy|Hxy]. + intros x y [Hxy|Hxy]. + apply: Qlt_not_eq. + apply Qnot_le_lt. + intros H. + absurd ('y[<=]'x). + rewrite leEq_def. + auto with *. + rewrite -> CRle_Qle. + auto. + apply ap_symmetric. apply: Qlt_not_eq. apply Qnot_le_lt. intros H. - absurd ('y[<=]'x). + absurd ('x[<=]'y). rewrite leEq_def. auto with *. rewrite -> CRle_Qle. auto. -apply ap_symmetric. -apply: Qlt_not_eq. -apply Qnot_le_lt. -intros H. -absurd ('x[<=]'y). - rewrite leEq_def. - auto with *. -rewrite -> CRle_Qle. -auto. Qed. Definition inject_Q_csf := Build_CSetoid_fun _ _ _ inject_Q_strext. Lemma inject_Q_hom : RingHom Q_as_CRing CRasCRing. Proof. -exists (inject_Q_csf). - apply: CRplus_Qplus. - intros x y. - apply eq_symmetric. - apply CRmult_Qmult. -apply eq_reflexive. + exists (inject_Q_csf). + apply: CRplus_Qplus. + intros x y. + apply eq_symmetric. + apply CRmult_Qmult. + apply eq_reflexive. Defined. -Lemma CR_Q_ring_morphism : +Lemma CR_Q_ring_morphism : ring_morph (inject_Q 0%Q) (inject_Q 1%Q) (ucFun2 CRplus) CRmult (fun x y => (x + - y)) CRopp (@st_eq CR) (0%Q) (1%Q) Qplus Qmult Qminus Qopp Qeq_bool (inject_Q). Proof. -split; try reflexivity. -apply CRplus_Qplus. -apply CRminus_Qminus. -intros x y; rewrite CRmult_Qmult; reflexivity. -apply CRopp_Qopp. -intros x y H. -rewrite CReq_Qeq. -apply Qeq_bool_eq. -assumption. + split; try reflexivity. + apply CRplus_Qplus. + apply CRminus_Qminus. + intros x y; rewrite CRmult_Qmult; reflexivity. + apply CRopp_Qopp. + intros x y H. + rewrite CReq_Qeq. + apply Qeq_bool_eq. + assumption. Qed. Ltac CRcst t := @@ -219,37 +212,39 @@ Ltac CRring_pre := autorewrite with toCRring. Lemma CR_ring_eq_ext : ring_eq_ext (ucFun2 CRplus) CRmult CRopp (@st_eq CR). Proof. -split. -apply ucFun2_wd. -apply CRmult_wd. -apply uc_wd. + split. + apply ucFun2_wd. + apply CRmult_wd. + apply uc_wd. Qed. Add Ring CR_ring : CR_ring_theory (morphism CR_Q_ring_morphism, setoid (@st_isSetoid (@msp_is_setoid CR)) CR_ring_eq_ext, constants [CRcst], preprocess [CRring_pre]). (** Relationship between strict and nonstrict positivity *) Lemma CRpos_nonNeg : forall x, CRpos x -> CRnonNeg x. -intros x [c Hx]. -cut ('0 <= x)%CR. - unfold CRle. - intros H. - setoid_replace (x - '0)%CR with x in H by ring. - assumption. -apply CRle_trans with (' c)%CR; auto with *. -rewrite CRle_Qle; auto with *. +Proof. + intros x [c Hx]. + cut ('0 <= x)%CR. + unfold CRle. + intros H. + setoid_replace (x - '0)%CR with x in H by ring. + assumption. + apply CRle_trans with (' c)%CR; auto with *. + rewrite CRle_Qle; auto with *. Qed. Lemma CRneg_nonPos : forall x, CRneg x -> CRnonPos x. -intros x [c Hx]. -cut (x <= '0)%CR. - unfold CRle. - intros H. - setoid_replace ('0 - x)%CR with (-x)%CR in H by ring. - intros e. - rewrite <- (Qopp_involutive e). - rewrite <- (Qopp_involutive (approximate x e)). - apply Qopp_le_compat. - apply H. -apply CRle_trans with (' - c)%CR; auto with *. -rewrite CRle_Qle; auto with *. -Qed. \ No newline at end of file +Proof. + intros x [c Hx]. + cut (x <= '0)%CR. + unfold CRle. + intros H. + setoid_replace ('0 - x)%CR with (-x)%CR in H by ring. + intros e. + rewrite <- (Qopp_involutive e). + rewrite <- (Qopp_involutive (approximate x e)). + apply Qopp_le_compat. + apply H. + apply CRle_trans with (' - c)%CR; auto with *. + rewrite CRle_Qle; auto with *. +Qed. diff --git a/reals/fast/CRFieldOps.v b/reals/fast/CRFieldOps.v index a5be83142..3296e7e53 100644 --- a/reals/fast/CRFieldOps.v +++ b/reals/fast/CRFieldOps.v @@ -36,7 +36,7 @@ Opaque CR Qmin Qmax Qred. (** ** Strict Inequality -First we defined positivity. We define positivity to contain a +First we defined positivity. We define positivity to contain a positive rational witness of a lower bound on x. This seems the best way because this witness contains exactly the information needed for functions (such as inverse and logorithm) that have domains @@ -46,39 +46,27 @@ Definition CRpos (x:CR) := sig (fun e:Qpos => ' e <= x)%CR. Lemma CRpos_wd : forall x y, (x==y)%CR -> (CRpos x) -> (CRpos y). Proof. -intros x y Hxy [e H]. -exists e. -abstract ( -rewrite <- Hxy; -assumption -). + intros x y Hxy [e H]. + exists e. + abstract ( rewrite <- Hxy; assumption ). Defined. (** This is a characterization closer to Bishop's definiton. If we replace [2*e] with [e], the theorem still holds, but it could be very expensive to call. We prefer to avoid that. *) -Lemma CRpos_char : forall (e:Qpos) (x:CR), 2*e <= (approximate x e) -> +Lemma CRpos_char : forall (e:Qpos) (x:CR), 2*e <= (approximate x e) -> CRpos x. -intros e x H. -exists e. -abstract ( -intros a; -simpl; -unfold Cap_raw; -simpl; -apply Qle_trans with (-(1#2)*a); - [rewrite Qle_minus_iff; ring_simplify; discriminate|]; -rewrite Qle_minus_iff; -destruct (regFun_prf x e ((1#2)*a)%Qpos) as [_ X]; -(replace RHS with (approximate x ((1 # 2) * a)%Qpos + (1#2)*a + e + - (2*e)) by ring); -rewrite <- Qle_minus_iff; -apply Qle_trans with (approximate x e); try assumption; -simpl in X; -rewrite -> Qle_minus_iff in X; -rewrite Qle_minus_iff; -autorewrite with QposElim in X; -(replace RHS with (e + (1 # 2) * a + - (approximate x e - approximate x ((1 # 2) * a)%Qpos)) by ring); -assumption). +Proof. + intros e x H. + exists e. + abstract ( intros a; simpl; unfold Cap_raw; simpl; apply Qle_trans with (-(1#2)*a); + [rewrite Qle_minus_iff; ring_simplify; discriminate|]; rewrite Qle_minus_iff; + destruct (regFun_prf x e ((1#2)*a)%Qpos) as [_ X]; + (replace RHS with (approximate x ((1 # 2) * a)%Qpos + (1#2)*a + e + - (2*e)) by ring); + rewrite <- Qle_minus_iff; apply Qle_trans with (approximate x e); try assumption; simpl in X; + rewrite -> Qle_minus_iff in X; rewrite Qle_minus_iff; autorewrite with QposElim in X; + (replace RHS with (e + (1 # 2) * a + - (approximate x e - approximate x ((1 # 2) * a)%Qpos)) by ring); + assumption). Defined. (** Negative reals are defined similarly. *) @@ -86,37 +74,24 @@ Definition CRneg (x:CR) := sig (fun e:Qpos => x <= ' (-e)%Q)%CR. Lemma CRneg_wd : forall x y, (x==y)%CR -> (CRneg x) -> (CRneg y). Proof. -intros x y Hxy [e H]. -exists e. -abstract ( -rewrite <- Hxy; -assumption -). + intros x y Hxy [e H]. + exists e. + abstract ( rewrite <- Hxy; assumption ). Defined. -Lemma CRneg_char : forall (e:Qpos) (x:CR), (approximate x e) <= -(2)*e -> +Lemma CRneg_char : forall (e:Qpos) (x:CR), (approximate x e) <= -(2)*e -> CRneg x. -intros e x H. -exists e. -abstract ( -intros a; -simpl; -unfold Cap_raw; -simpl; -apply Qle_trans with (-(1#2)*a); - [rewrite Qle_minus_iff; ring_simplify; discriminate|]; -rewrite Qle_minus_iff; -destruct (regFun_prf x e ((1#2)*a)%Qpos) as [X _]; -(replace RHS with ( - e + - approximate x ((1 # 2) * a)%Qpos + (1 # 2) * a + approximate x e + - approximate x e) by ring); -rewrite <- Qle_minus_iff; -apply Qle_trans with (-(2)*e); try assumption; -simpl in X; -rewrite -> Qle_minus_iff in X; -rewrite Qle_minus_iff; -autorewrite with QposElim in X; -(replace RHS with (approximate x e - approximate x ((1 # 2) * a)%Qpos + - - - (e + (1 # 2) * a)) by ring); -assumption). +Proof. + intros e x H. + exists e. + abstract ( intros a; simpl; unfold Cap_raw; simpl; apply Qle_trans with (-(1#2)*a); + [rewrite Qle_minus_iff; ring_simplify; discriminate|]; rewrite Qle_minus_iff; + destruct (regFun_prf x e ((1#2)*a)%Qpos) as [X _]; + (replace RHS with ( - e + - approximate x ((1 # 2) * a)%Qpos + (1 # 2) * a + approximate x e + - approximate x e) by ring); + rewrite <- Qle_minus_iff; apply Qle_trans with (-(2)*e); try assumption; simpl in X; + rewrite -> Qle_minus_iff in X; rewrite Qle_minus_iff; autorewrite with QposElim in X; + (replace RHS with (approximate x e - approximate x ((1 # 2) * a)%Qpos + + - - (e + (1 # 2) * a)) by ring); assumption). Defined. (** Strict inequality is defined in terms of positivity. *) @@ -126,13 +101,9 @@ Infix "<" := CRlt : CR_scope. Lemma CRlt_wd : forall x1 x2, (x1==x2 -> forall y1 y2, y1==y2 -> x1 < y1 -> x2 < y2)%CR. Proof. -intros x1 x2 Hx y1 y2 Hy H. -apply: CRpos_wd;[|apply H]. -abstract ( -rewrite <- Hx; -rewrite <- Hy; -reflexivity -). + intros x1 x2 Hx y1 y2 Hy H. + apply: CRpos_wd;[|apply H]. + abstract ( rewrite <- Hx; rewrite <- Hy; reflexivity ). Defined. (** @@ -144,7 +115,7 @@ Notation "x >< y" := (CRapart x y) (at level 70, no associativity) : CR_scope. Lemma CRapart_wd : forall x1 x2, (x1==x2 -> forall y1 y2, y1==y2 -> x1> x2> Type) (x:Q) (e:Qpos), (forall y:Qpos, AbsSmall (e/y)%Q (x)%Q -> (P y)) -> P (Qscale_modulus x e). Proof. -intros P [xn xd] e H1. -cut (forall xn:positive, (forall y : Qpos, AbsSmall (e/y)%Q (xn#xd)%Q -> P y) -> -P (Qscale_modulus (xn # xd) e)). -intros H H2. -destruct xn as [|xn|xn]. -apply H1. -constructor. -apply H. -assumption. -apply H. -intros y Hy. -apply H2. -change (Zneg xn # xd)%Q with ([--](xn # xd))%Q. -apply inv_resp_AbsSmall. -assumption. -clear xn H1. -intros xn H2. -simpl. -apply H2. -autorewrite with QposElim. -stepl (/(xd#xn))%Q by (simpl;field). -change (/(xd#xn))%Q with (xn#xd)%Q. -apply AbsSmall_reflexive. -discriminate. -change (xd#xn==0)%Q with ((xd#xn)%Qpos==0)%Q. -split; apply Qpos_nonzero. + intros P [xn xd] e H1. + cut (forall xn:positive, (forall y : Qpos, AbsSmall (e/y)%Q (xn#xd)%Q -> P y) -> + P (Qscale_modulus (xn # xd) e)). + intros H H2. + destruct xn as [|xn|xn]. + apply H1. + constructor. + apply H. + assumption. + apply H. + intros y Hy. + apply H2. + change (Zneg xn # xd)%Q with ([--](xn # xd))%Q. + apply inv_resp_AbsSmall. + assumption. + clear xn H1. + intros xn H2. + simpl. + apply H2. + autorewrite with QposElim. + stepl (/(xd#xn))%Q by (simpl;field). + change (/(xd#xn))%Q with (xn#xd)%Q. + apply AbsSmall_reflexive. + discriminate. + change (xd#xn==0)%Q with ((xd#xn)%Qpos==0)%Q. + split; apply Qpos_nonzero. Qed. (* @@ -215,53 +186,51 @@ Proof Qscale_modulus_pos. Lemma Qscale_uc_prf (a:Q) : is_UniformlyContinuousFunction (fun b:Q => a*b) (Qscale_modulus a). Proof. -intros [[|an|an] ad] e b0 b1 H. -simpl in *. -setoid_replace ((0 # ad)) with 0 by constructor. -unfold Qball. -stepr 0 by (simpl; ring). -apply zero_AbsSmall. -simpl. -auto with *. - -simpl in *. -unfold Qball in *. -autorewrite with QposElim. -stepr ((an#ad)*(b0-b1)) by (simpl; ring). -apply (fun x y => (AbsSmall_cancel_mult _ x y (ad#an))). -constructor. -stepl (((ad # an) * e)%Qpos:Q) by (simpl;QposRing). -stepr (b0 - b1). -apply H. -stepr ((an#ad)*(ad#an)*(b0-b1)) by (simpl;ring). -simpl. -setoid_replace ((an#ad)*(ad#an)) with 1. -ring. -unfold Qeq. -simpl. -rewrite Pmult_1_r. -rewrite Pmult_comm. -reflexivity. - -simpl in *. -unfold Qball in *. -autorewrite with QposElim. -stepr ((Zneg an#ad)*(b0-b1)) by (simpl; ring). -apply (fun x y => (AbsSmall_cancel_mult _ x y (ad#an))). -constructor. -stepl (((ad # an) * e)%Qpos:Q) by (simpl;QposRing). -stepr (b1 - b0). -apply AbsSmall_minus. -apply H. -stepr ((Zneg an#ad)*(ad#an)*(b0-b1)) by (simpl;ring). -simpl. -setoid_replace ((Zneg an#ad)*(ad#an)) with ([--]1). -simpl; ring. -unfold Qeq. -simpl. -rewrite Pmult_1_r. -rewrite Pmult_comm. -reflexivity. + intros [[|an|an] ad] e b0 b1 H. + simpl in *. + setoid_replace ((0 # ad)) with 0 by constructor. + unfold Qball. + stepr 0 by (simpl; ring). + apply zero_AbsSmall. + simpl. + auto with *. + simpl in *. + unfold Qball in *. + autorewrite with QposElim. + stepr ((an#ad)*(b0-b1)) by (simpl; ring). + apply (fun x y => (AbsSmall_cancel_mult _ x y (ad#an))). + constructor. + stepl (((ad # an) * e)%Qpos:Q) by (simpl;QposRing). + stepr (b0 - b1). + apply H. + stepr ((an#ad)*(ad#an)*(b0-b1)) by (simpl;ring). + simpl. + setoid_replace ((an#ad)*(ad#an)) with 1. + ring. + unfold Qeq. + simpl. + rewrite Pmult_1_r. + rewrite Pmult_comm. + reflexivity. + simpl in *. + unfold Qball in *. + autorewrite with QposElim. + stepr ((Zneg an#ad)*(b0-b1)) by (simpl; ring). + apply (fun x y => (AbsSmall_cancel_mult _ x y (ad#an))). + constructor. + stepl (((ad # an) * e)%Qpos:Q) by (simpl;QposRing). + stepr (b1 - b0). + apply AbsSmall_minus. + apply H. + stepr ((Zneg an#ad)*(ad#an)*(b0-b1)) by (simpl;ring). + simpl. + setoid_replace ((Zneg an#ad)*(ad#an)) with ([--]1). + simpl; ring. + unfold Qeq. + simpl. + rewrite Pmult_1_r. + rewrite Pmult_comm. + reflexivity. Qed. (** Scaling by a constant is [Qmult] lifted on one parameter. *) @@ -280,21 +249,21 @@ Lemma QboundAbs_absorb: forall (a b:Qpos) (c:Q), a <= b -> QboundAbs b (QboundAbs a c) == QboundAbs a c. Proof. -intros a b c H. -simpl. -rewrite Qmin_max_distr_r. -setoid_replace (Qmin b (-a)) with (-a). -rewrite Qmax_assoc. -rewrite <- Qmin_max_de_morgan. -rewrite Qmin_assoc. -setoid_replace (Qmin b a) with (a:Q). -reflexivity. -rewrite <- Qle_min_r. -assumption. -rewrite <- Qle_min_r. -rewrite Qle_minus_iff. -ring_simplify. -auto with *. + intros a b c H. + simpl. + rewrite Qmin_max_distr_r. + setoid_replace (Qmin b (-a)) with (-a). + rewrite Qmax_assoc. + rewrite <- Qmin_max_de_morgan. + rewrite Qmin_assoc. + setoid_replace (Qmin b a) with (a:Q). + reflexivity. + rewrite <- Qle_min_r. + assumption. + rewrite <- Qle_min_r. + rewrite Qle_minus_iff. + ring_simplify. + auto with *. Qed. (** Properties of CRboundAbs. *) @@ -302,22 +271,22 @@ Lemma CRboundAbs_Eq : forall (a:Qpos) (x:CR), ('(-a)%Q <= x -> x <= ' a -> CRboundAbs a x == x)%CR. Proof. -intros a x Ha Hb. -unfold CRboundAbs. -transitivity (uc_compose (Cmap QPrelengthSpace (QboundBelow_uc (-a))) (Cmap QPrelengthSpace (QboundAbove_uc a)) x). -simpl. -repeat rewrite Cmap_fun_correct. -apply: MonadLaw2. -simpl. -change (boundBelow (-a)%Q (boundAbove a x) == x)%CR. -assert (X:(boundAbove a x==x)%CR). -rewrite <- CRmin_boundAbove. -rewrite <- CRle_min_r. -assumption. -rewrite X. -rewrite <- CRmax_boundBelow. -rewrite <- CRle_max_r. -assumption. + intros a x Ha Hb. + unfold CRboundAbs. + transitivity (uc_compose (Cmap QPrelengthSpace (QboundBelow_uc (-a))) (Cmap QPrelengthSpace (QboundAbove_uc a)) x). + simpl. + repeat rewrite Cmap_fun_correct. + apply: MonadLaw2. + simpl. + change (boundBelow (-a)%Q (boundAbove a x) == x)%CR. + assert (X:(boundAbove a x==x)%CR). + rewrite <- CRmin_boundAbove. + rewrite <- CRle_min_r. + assumption. + rewrite X. + rewrite <- CRmax_boundBelow. + rewrite <- CRle_max_r. + assumption. Qed. Lemma QboundAbs_elim : forall (z:Qpos) (a:Q) (P:Q->Prop), @@ -326,18 +295,17 @@ Lemma QboundAbs_elim : forall (z:Qpos) (a:Q) (P:Q->Prop), (AbsSmall (z:Q) a -> P (a)) -> P (QboundAbs z a). Proof. -intros z a P H1 H2 H3. -simpl. -apply Qmax_case; apply Qmin_case; -intros Z0 Z1; try solve [apply H1;assumption|apply H2;assumption]. -elim (Qle_not_lt _ _ Z1). -rewrite Qlt_minus_iff. -ring_simplify. -apply: mult_resp_pos. -constructor. -apply Qpos_prf. -apply H3. -split;assumption. + intros z a P H1 H2 H3. + simpl. + apply Qmax_case; apply Qmin_case; intros Z0 Z1; try solve [apply H1;assumption|apply H2;assumption]. + elim (Qle_not_lt _ _ Z1). + rewrite Qlt_minus_iff. + ring_simplify. + apply: mult_resp_pos. + constructor. + apply Qpos_prf. + apply H3. + split;assumption. Qed. (** The modulus of continuity for multiplication depends on the @@ -346,32 +314,28 @@ Definition Qmult_modulus (c:Qpos)(e:Qpos) : QposInf := (e / c)%Qpos. Lemma Qmult_uc_prf (c:Qpos) : is_UniformlyContinuousFunction (fun a => uc_compose (Qscale_uc a) (QboundAbs c)) (Qmult_modulus c). Proof. -intros c e a0 a1 H b. -simpl in *. -set (b' := Qmax (- c) (Qmin c b)). -repeat rewrite (fun x => Qmult_comm x b'). -apply Qscale_uc_prf. -setoid_replace (e/c)%Qpos with (Qpos_inv c*e)%Qpos in H by QposRing. -apply ball_ex_weak_le with (Qpos_inv c*e)%Qpos;[|assumption]. -unfold b'. -apply Qmax_case. -intros H1. -apply: Qle_refl. -apply Qmin_case; intros H1 H2. -apply: Qle_refl. -destruct b as [[|bn|bn] bd]; simpl; try constructor; -(autorewrite with QposElim; -apply: mult_resp_leEq_rht; -[change ((One[/](c:Q)[//](@Qpos_nonzero c))[<=](One[/](bn#bd)[//](@Qpos_nonzero (bn#bd)%Qpos))); - apply recip_resp_leEq; - [apply (@Qpos_prf (bn#bd)%Qpos) - |] -|apply Qpos_nonneg]). -assumption. -replace LHS with (- (- (bn # bd))) by ring. -replace RHS with (- (- c)) by ring. -apply inv_resp_leEq. -apply H2. + intros c e a0 a1 H b. + simpl in *. + set (b' := Qmax (- c) (Qmin c b)). + repeat rewrite (fun x => Qmult_comm x b'). + apply Qscale_uc_prf. + setoid_replace (e/c)%Qpos with (Qpos_inv c*e)%Qpos in H by QposRing. + apply ball_ex_weak_le with (Qpos_inv c*e)%Qpos;[|assumption]. + unfold b'. + apply Qmax_case. + intros H1. + apply: Qle_refl. + apply Qmin_case; intros H1 H2. + apply: Qle_refl. + destruct b as [[|bn|bn] bd]; simpl; try constructor; (autorewrite with QposElim; + apply: mult_resp_leEq_rht; + [change ((One[/](c:Q)[//](@Qpos_nonzero c))[<=](One[/](bn#bd)[//](@Qpos_nonzero (bn#bd)%Qpos))); + apply recip_resp_leEq; [apply (@Qpos_prf (bn#bd)%Qpos) |] |apply Qpos_nonneg]). + assumption. + replace LHS with (- (- (bn # bd))) by ring. + replace RHS with (- (- c)) by ring. + apply inv_resp_leEq. + apply H2. Qed. (* begin hide *) Implicit Arguments Qmult_uc_prf []. @@ -386,71 +350,66 @@ Cmap2 QPrelengthSpace QPrelengthSpace (Qmult_uc c). (** CR_b computes a rational bound on the absolute value of x *) Definition CR_b (e:Qpos) (x:CR) : Qpos. -intros e x. -refine (@mkQpos (Qabs (approximate x e) + e:Q) _). -abstract ( -(replace RHS with (Qabs (approximate x e) - (-e)) by ring); -apply: shift_zero_less_minus; -apply Qlt_le_trans with 0;[constructor|apply Qabs_nonneg] -). +Proof. + intros e x. + refine (@mkQpos (Qabs (approximate x e) + e:Q) _). + abstract ( (replace RHS with (Qabs (approximate x e) - (-e)) by ring); apply: shift_zero_less_minus; + apply Qlt_le_trans with 0;[constructor|apply Qabs_nonneg] ). Defined. Lemma CR_b_lowerBound : forall e x, (' (-CR_b e x)%Q <= x)%CR. Proof. -intros e x e'. -unfold CR_b. -autorewrite with QposElim. -simpl. -unfold Cap_raw. -simpl. -rewrite Qle_minus_iff. -ring_simplify. -destruct (regFun_prf x ((1#2)*e')%Qpos e) as [H _]. -simpl in H. -rewrite -> Qle_minus_iff in H. -ring_simplify in H. -eapply Qle_trans. -apply H. -rewrite Qle_minus_iff. -autorewrite with QposElim. -ring_simplify. -clear H. -apply Qabs_case; intros H; -[repeat apply: plus_resp_nonneg; try assumption -|ring_simplify]; -(apply: mult_resp_nonneg;[discriminate|apply Qpos_nonneg]). + intros e x e'. + unfold CR_b. + autorewrite with QposElim. + simpl. + unfold Cap_raw. + simpl. + rewrite Qle_minus_iff. + ring_simplify. + destruct (regFun_prf x ((1#2)*e')%Qpos e) as [H _]. + simpl in H. + rewrite -> Qle_minus_iff in H. + ring_simplify in H. + eapply Qle_trans. + apply H. + rewrite Qle_minus_iff. + autorewrite with QposElim. + ring_simplify. + clear H. + apply Qabs_case; intros H; [repeat apply: plus_resp_nonneg; try assumption |ring_simplify]; + (apply: mult_resp_nonneg;[discriminate|apply Qpos_nonneg]). Qed. Lemma CR_b_upperBound : forall e x, (x <= 'CR_b e x)%CR. Proof. -intros e x e'. -unfold CR_b. -autorewrite with QposElim. -simpl. -unfold Cap_raw. -simpl. -rewrite Qle_minus_iff. -ring_simplify. -destruct (regFun_prf x ((1#2)*e')%Qpos e) as [_ H]. -simpl in H. -rewrite -> Qle_minus_iff in H. -ring_simplify in H. -eapply Qle_trans. -apply H. -rewrite Qle_minus_iff. -autorewrite with QposElim. -ring_simplify. -clear H. -apply Qabs_case; intros H. -ring_simplify;(apply: mult_resp_nonneg;[discriminate|apply Qpos_nonneg]). -ring_simplify; -repeat apply: plus_resp_nonneg;simpl. -replace RHS with ((2#1)*(-(approximate x e))) by ring. -apply: mult_resp_nonneg. -discriminate. -apply (Qopp_le_compat (approximate x e) 0). -assumption. -(apply: mult_resp_nonneg;[discriminate|apply Qpos_nonneg]). + intros e x e'. + unfold CR_b. + autorewrite with QposElim. + simpl. + unfold Cap_raw. + simpl. + rewrite Qle_minus_iff. + ring_simplify. + destruct (regFun_prf x ((1#2)*e')%Qpos e) as [_ H]. + simpl in H. + rewrite -> Qle_minus_iff in H. + ring_simplify in H. + eapply Qle_trans. + apply H. + rewrite Qle_minus_iff. + autorewrite with QposElim. + ring_simplify. + clear H. + apply Qabs_case; intros H. + ring_simplify;(apply: mult_resp_nonneg;[discriminate|apply Qpos_nonneg]). + ring_simplify; repeat apply: plus_resp_nonneg;simpl. + replace RHS with ((2#1)*(-(approximate x e))) by ring. + apply: mult_resp_nonneg. + discriminate. + apply (Qopp_le_compat (approximate x e) 0). + assumption. + (apply: mult_resp_nonneg;[discriminate|apply Qpos_nonneg]). Qed. (** This version of multiply computes a bound on the second argument @@ -464,117 +423,113 @@ Lemma CRmult_bounded_weaken : forall (c1 c2:Qpos) x y, ((' (-c1)%Q <= y) -> (y <= ' c1) -> (c1 <= c2)%Q -> CRmult_bounded c1 x y == CRmult_bounded c2 x y)%CR. Proof. -intros c1 c2 x y Hc1a Hc1b Hc2. -assert (Hy:=CRboundAbs_Eq Hc1a Hc1b). -set (y':= (CRboundAbs c1 y)) in *. -transitivity (ucFun2 (CRmult_bounded c2) x y'); - [|rewrite Hy;reflexivity]. -assert (H:forall x:Qpos, (x*c1/c2)%Qpos <= x). -intros a. -autorewrite with QposElim. -change (((a* c1)[/](c2:Q)[//]@Qpos_nonzero c2)[<=](a:Q)). -apply shift_div_leEq'. -apply Qpos_prf. -rewrite Qmult_comm. -apply mult_resp_leEq_rht. -assumption. -apply Qpos_nonneg. -change (ucFun2 (CRmult_bounded c1) x y == ucFun2 (CRmult_bounded c2) x y')%CR. -rewrite <- (QreduceApprox_Eq x). -set (x''':=(QreduceApprox x)). -set (x':=faster x''' (fun x => (x * c1 /c2)%Qpos) H). -transitivity (ucFun2 (CRmult_bounded c1) x' y). -unfold x'. -rewrite fasterIsEq. -reflexivity. -apply: regFunEq_e; intros e. -intros. -simpl. -do 3 (unfold Cap_raw; simpl). -assert (X:=fun c => QboundAbs_absorb c Hc2). -unfold QboundAbs in X. -simpl in X. -rewrite X. -clear X. -replace (QposRed ((1 # 2) * e / c1 * c1 / c2)%Qpos) - with (QposRed ((1 # 2) * e / c2)%Qpos); - [repeat rewrite QposInf_bind_id;apply: ball_refl|]. -apply QposRed_complete. -autorewrite with QposElim. -field. -split;apply Qpos_nonzero. + intros c1 c2 x y Hc1a Hc1b Hc2. + assert (Hy:=CRboundAbs_Eq Hc1a Hc1b). + set (y':= (CRboundAbs c1 y)) in *. + transitivity (ucFun2 (CRmult_bounded c2) x y'); [|rewrite Hy;reflexivity]. + assert (H:forall x:Qpos, (x*c1/c2)%Qpos <= x). + intros a. + autorewrite with QposElim. + change (((a* c1)[/](c2:Q)[//]@Qpos_nonzero c2)[<=](a:Q)). + apply shift_div_leEq'. + apply Qpos_prf. + rewrite Qmult_comm. + apply mult_resp_leEq_rht. + assumption. + apply Qpos_nonneg. + change (ucFun2 (CRmult_bounded c1) x y == ucFun2 (CRmult_bounded c2) x y')%CR. + rewrite <- (QreduceApprox_Eq x). + set (x''':=(QreduceApprox x)). + set (x':=faster x''' (fun x => (x * c1 /c2)%Qpos) H). + transitivity (ucFun2 (CRmult_bounded c1) x' y). + unfold x'. + rewrite fasterIsEq. + reflexivity. + apply: regFunEq_e; intros e. + intros. + simpl. + do 3 (unfold Cap_raw; simpl). + assert (X:=fun c => QboundAbs_absorb c Hc2). + unfold QboundAbs in X. + simpl in X. + rewrite X. + clear X. + replace (QposRed ((1 # 2) * e / c1 * c1 / c2)%Qpos) with (QposRed ((1 # 2) * e / c2)%Qpos); + [repeat rewrite QposInf_bind_id;apply: ball_refl|]. + apply QposRed_complete. + autorewrite with QposElim. + field. + split;apply Qpos_nonzero. Qed. Lemma CRmult_bounded_mult : forall (c:Qpos) (x y:CR), (' (-c)%Q <= y -> y <= ' c -> CRmult_bounded c x y == x*y)%CR. Proof. -intros c x y Hc1 Hc2. -unfold CRmult. -set (d:=(CR_b (1 # 1) y)). -destruct (Qle_total c d). -apply CRmult_bounded_weaken; assumption. -symmetry. -apply CRmult_bounded_weaken; try assumption. -apply CR_b_lowerBound. -apply CR_b_upperBound. + intros c x y Hc1 Hc2. + unfold CRmult. + set (d:=(CR_b (1 # 1) y)). + destruct (Qle_total c d). + apply CRmult_bounded_weaken; assumption. + symmetry. + apply CRmult_bounded_weaken; try assumption. + apply CR_b_lowerBound. + apply CR_b_upperBound. Qed. (* begin hide *) Add Morphism CRmult with signature (@st_eq _) ==> (@st_eq _) ==> (@st_eq _) as CRmult_wd. Proof. -intros x1 x2 Hx y1 y2 Hy. -unfold CRmult. -set (c:=(CR_b (1 # 1) y1)). -set (d:=(CR_b (1 # 1) y2)). -rewrite Hx. -rewrite Hy. -unfold d. -apply CRmult_bounded_mult; -rewrite <- Hy. -apply CR_b_lowerBound. -apply CR_b_upperBound. + intros x1 x2 Hx y1 y2 Hy. + unfold CRmult. + set (c:=(CR_b (1 # 1) y1)). + set (d:=(CR_b (1 # 1) y2)). + rewrite Hx. + rewrite Hy. + unfold d. + apply CRmult_bounded_mult; rewrite <- Hy. + apply CR_b_lowerBound. + apply CR_b_upperBound. Qed. (* end hide *) Lemma CRmult_scale : forall (a:Q) (y:CR), ((' a)*y==scale a y)%CR. Proof. -intros a y. -unfold CRmult. -unfold CRmult_bounded. -unfold ucFun2. -unfold Cmap2. -unfold inject_Q. -simpl. -rewrite Cap_fun_correct. -repeat rewrite Cmap_fun_correct. -rewrite MonadLaw3. -rewrite StrongMonadLaw1. -simpl. -transitivity (uc_compose (Cmap QPrelengthSpace (Qscale_uc a)) - (Cmap QPrelengthSpace (QboundAbs (CR_b (1#1) y))) y). -simpl. -repeat rewrite Cmap_fun_correct. -apply: MonadLaw2. -simpl. -repeat rewrite Cmap_fun_correct. -change (Cmap_slow (Qscale_uc a) - (Cmap_slow_fun (QboundAbs (CR_b (1 # 1) y)) y) == - Cmap_slow (Qscale_uc a) y)%CR. -apply uc_wd. -rewrite <- (Cmap_fun_correct (Y:=Q_as_MetricSpace) QPrelengthSpace). -apply: CRboundAbs_Eq. -apply CR_b_lowerBound. -apply CR_b_upperBound. + intros a y. + unfold CRmult. + unfold CRmult_bounded. + unfold ucFun2. + unfold Cmap2. + unfold inject_Q. + simpl. + rewrite Cap_fun_correct. + repeat rewrite Cmap_fun_correct. + rewrite MonadLaw3. + rewrite StrongMonadLaw1. + simpl. + transitivity (uc_compose (Cmap QPrelengthSpace (Qscale_uc a)) + (Cmap QPrelengthSpace (QboundAbs (CR_b (1#1) y))) y). + simpl. + repeat rewrite Cmap_fun_correct. + apply: MonadLaw2. + simpl. + repeat rewrite Cmap_fun_correct. + change (Cmap_slow (Qscale_uc a) (Cmap_slow_fun (QboundAbs (CR_b (1 # 1) y)) y) == + Cmap_slow (Qscale_uc a) y)%CR. + apply uc_wd. + rewrite <- (Cmap_fun_correct (Y:=Q_as_MetricSpace) QPrelengthSpace). + apply: CRboundAbs_Eq. + apply CR_b_lowerBound. + apply CR_b_upperBound. Qed. (* begin hide *) Hint Rewrite CRmult_scale : CRfast_compute. (* end hide *) Lemma scale_Qmult : forall a b:Q, (scale a ('b)=='(a*b)%Q)%CR. Proof. -intros a b. -unfold scale. -simpl. -rewrite Cmap_fun_correct. -apply: MonadLaw3. + intros a b. + unfold scale. + simpl. + rewrite Cmap_fun_correct. + apply: MonadLaw3. Qed. (* begin hide *) Hint Rewrite scale_Qmult : CRfast_compute. @@ -587,40 +542,39 @@ Definition Qinv_modulus (c:Qpos) (e:Qpos) : Qpos := (c*c*e)%Qpos. Lemma Qpos_Qmax : forall (a:Qpos) (b:Q), 0 /(Qmax c a) ) (Qinv_modulus c). Proof. -intros c e a0 a1 Ha. -simpl in *. -unfold Qball in *. -apply: AbsSmall_cancel_mult. -instantiate (1:=(Qmax c a0)*(Qmax c a1)). -rewrite <- (QposAsmkQpos (Qpos_Qmax c a0)). -rewrite <- (QposAsmkQpos (Qpos_Qmax c a1)). -rewrite <- Q_Qpos_mult. -apply Qpos_prf. -assert (H : forall (a:Qpos) b, ~(Qmax a b)==0). -intros a b. -rewrite <- (QposAsmkQpos (Qpos_Qmax a b)). -apply Qpos_nonzero. -stepr (Qmax c a1 - Qmax c a0) by - simpl; field; repeat split; apply H. -apply: AbsSmall_leEq_trans. -instantiate (1:=(c*c*e)). -rewrite Qmult_comm. -apply mult_resp_leEq_lft;[|apply Qpos_nonneg]. -apply mult_resp_leEq_both; (apply Qpos_nonneg || apply Qmax_ub_l). -change (ball (c*c*e) (Qmax c a1) (Qmax c a0)). -apply ball_sym. -apply QboundBelow_uc_prf. -apply Ha. + intros c e a0 a1 Ha. + simpl in *. + unfold Qball in *. + apply: AbsSmall_cancel_mult. + instantiate (1:=(Qmax c a0)*(Qmax c a1)). + rewrite <- (QposAsmkQpos (Qpos_Qmax c a0)). + rewrite <- (QposAsmkQpos (Qpos_Qmax c a1)). + rewrite <- Q_Qpos_mult. + apply Qpos_prf. + assert (H : forall (a:Qpos) b, ~(Qmax a b)==0). + intros a b. + rewrite <- (QposAsmkQpos (Qpos_Qmax a b)). + apply Qpos_nonzero. + stepr (Qmax c a1 - Qmax c a0) by simpl; field; repeat split; apply H. + apply: AbsSmall_leEq_trans. + instantiate (1:=(c*c*e)). + rewrite Qmult_comm. + apply mult_resp_leEq_lft;[|apply Qpos_nonneg]. + apply mult_resp_leEq_both; (apply Qpos_nonneg || apply Qmax_ub_l). + change (ball (c*c*e) (Qmax c a1) (Qmax c a0)). + apply ball_sym. + apply QboundBelow_uc_prf. + apply Ha. Qed. Implicit Arguments Qinv_pos_uc_prf []. @@ -630,14 +584,13 @@ Build_UniformlyContinuousFunction (Qinv_pos_uc_prf c). Lemma Qinv_pos_uc_wd : forall (c1 c2:Qpos), (c1 <= c2) -> forall x, (c2 <= x) -> st_eq (Qinv_pos_uc c1 x) (Qinv_pos_uc c2 x). Proof. -intros c1 c2 Hc x Hx. -simpl. -setoid_replace (Qmax c2 x) with x by - (rewrite <- Qle_max_r; assumption). -setoid_replace (Qmax c1 x) with x. -reflexivity. -rewrite <- Qle_max_r. -apply Qle_trans with c2; assumption. + intros c1 c2 Hc x Hx. + simpl. + setoid_replace (Qmax c2 x) with x by (rewrite <- Qle_max_r; assumption). + setoid_replace (Qmax c1 x) with x. + reflexivity. + rewrite <- Qle_max_r. + apply Qle_trans with c2; assumption. Qed. (** [CRinv_pos] works for inputs greater than c *) @@ -645,61 +598,60 @@ Definition CRinv_pos (c:Qpos) : CR --> CR := (Cmap QPrelengthSpace (Qinv_pos_uc Lemma CRinv_pos_weaken : forall (c1 c2:Qpos), c1 <= c2 -> forall (x:CR), (' c2 <= x -> CRinv_pos c1 x == CRinv_pos c2 x)%CR. Proof. -intros c1 c2 Hc x Hx. -assert (X:((boundBelow c2 x)==x)%CR). -rewrite <- CRmax_boundBelow. -rewrite <- CRle_max_r. -assumption. -rewrite <- X. -rewrite <- (QreduceApprox_Eq x). -pose (f:=(fun e:Qpos => (c1*c1/c2/c2)*e)%Qpos). -assert (Y:forall e:Qpos, f e <= e). -intros e. -unfold f. -autorewrite with QposElim. -apply: (mult_cancel_leEq _ (c1*c1/c2/c2*e) (e:Q) (c2*c2:Q)). - apply: mult_resp_pos;apply: Qpos_prf. - replace LHS with (e*(c1*c1)). - apply mult_resp_leEq_lft;[|apply Qpos_nonneg]. - apply mult_resp_leEq_both;try assumption;apply Qpos_nonneg. -simpl; field; apply Qpos_nonzero. -transitivity (CRinv_pos c2 (boundBelow c2 (faster (QreduceApprox x) f Y))). -apply: regFunEq_e. -intros e. -assert (Z:=Qinv_pos_uc_wd Hc). -simpl in Z. -simpl. -rewrite Z;[|apply Qmax_ub_l]. -unfold Qinv_modulus. -replace (QposRed (c1 * c1 * e)) - with (QposRed (f (c2 * c2 * e)%Qpos)); - [apply: ball_refl|]. -apply QposRed_complete. -unfold f. -autorewrite with QposElim. -field. -apply Qpos_nonzero. -rewrite fasterIsEq. -reflexivity. + intros c1 c2 Hc x Hx. + assert (X:((boundBelow c2 x)==x)%CR). + rewrite <- CRmax_boundBelow. + rewrite <- CRle_max_r. + assumption. + rewrite <- X. + rewrite <- (QreduceApprox_Eq x). + pose (f:=(fun e:Qpos => (c1*c1/c2/c2)*e)%Qpos). + assert (Y:forall e:Qpos, f e <= e). + intros e. + unfold f. + autorewrite with QposElim. + apply: (mult_cancel_leEq _ (c1*c1/c2/c2*e) (e:Q) (c2*c2:Q)). + apply: mult_resp_pos;apply: Qpos_prf. + replace LHS with (e*(c1*c1)). + apply mult_resp_leEq_lft;[|apply Qpos_nonneg]. + apply mult_resp_leEq_both;try assumption;apply Qpos_nonneg. + simpl; field; apply Qpos_nonzero. + transitivity (CRinv_pos c2 (boundBelow c2 (faster (QreduceApprox x) f Y))). + apply: regFunEq_e. + intros e. + assert (Z:=Qinv_pos_uc_wd Hc). + simpl in Z. + simpl. + rewrite Z;[|apply Qmax_ub_l]. + unfold Qinv_modulus. + replace (QposRed (c1 * c1 * e)) with (QposRed (f (c2 * c2 * e)%Qpos)); [apply: ball_refl|]. + apply QposRed_complete. + unfold f. + autorewrite with QposElim. + field. + apply Qpos_nonzero. + rewrite fasterIsEq. + reflexivity. Qed. Lemma CRinv_pos_Qinv : forall (c:Qpos) x, (c <= x)%Q -> (CRinv_pos c (' x) == (' (/x)))%CR. Proof. -intros c x H. -apply: regFunEq_e. -intros e. -simpl. -setoid_replace (Qmax c x) with x. -apply: ball_refl. -rewrite <- Qle_max_r. -assumption. + intros c x H. + apply: regFunEq_e. + intros e. + simpl. + setoid_replace (Qmax c x) with x. + apply: ball_refl. + rewrite <- Qle_max_r. + assumption. Qed. (** [CRinv] works for inputs apart from 0 *) Definition CRinv (x:CR)(x_: (x >< ' 0)%CR) : CR. -intros x [[c H]|[c H]]. -exact ((-(CRinv_pos c (-x)))%CR). -exact (CRinv_pos c x). +Proof. + intros x [[c H]|[c H]]. + exact ((-(CRinv_pos c (-x)))%CR). + exact (CRinv_pos c x). Defined. Implicit Arguments CRinv []. @@ -708,117 +660,108 @@ Lemma CRinv_pos_inv : forall (c:Qpos) (x:CR) x_, (inject_Q c <= x -> CRinv_pos c x == CRinv x x_)%CR. Proof. -intros c x [[e He]|[e He]] H. -assert (X:(' e <= -x)%CR). -rewrite <- (doubleSpeed_Eq x). -intros d. -eapply Qle_trans. -apply He. -simpl. -do 2 (unfold Cap_raw;simpl). -ring_simplify. -apply Qle_refl. -assert (' c <= ' (-e)%Q)%CR. -eapply CRle_trans. -apply H. -intros d. -eapply Qle_trans. -apply X. -simpl. -do 2 (unfold Cap_raw;simpl). -rewrite Qle_minus_iff. -ring_simplify. -apply Qle_refl. -elim (Qlt_not_le _ _ (Qpos_prf c)). -assert (Y:=H0 (e)%Qpos). -simpl in Y. -do 2 (unfold Cap_raw in Y ;simpl in Y). -rewrite -> Qle_minus_iff in Y. -ring_simplify in Y. -rewrite Qle_minus_iff. -ring_simplify;assumption. - -assert (' e <= x)%CR. -rewrite <- (doubleSpeed_Eq x). -intros d. -eapply Qle_trans. -apply He. -simpl. -do 2 (unfold Cap_raw;simpl). -ring_simplify. -apply Qle_refl. -destruct (Qle_total c e);[|symmetry]; -apply: CRinv_pos_weaken; -assumption. + intros c x [[e He]|[e He]] H. + assert (X:(' e <= -x)%CR). + rewrite <- (doubleSpeed_Eq x). + intros d. + eapply Qle_trans. + apply He. + simpl. + do 2 (unfold Cap_raw;simpl). + ring_simplify. + apply Qle_refl. + assert (' c <= ' (-e)%Q)%CR. + eapply CRle_trans. + apply H. + intros d. + eapply Qle_trans. + apply X. + simpl. + do 2 (unfold Cap_raw;simpl). + rewrite Qle_minus_iff. + ring_simplify. + apply Qle_refl. + elim (Qlt_not_le _ _ (Qpos_prf c)). + assert (Y:=H0 (e)%Qpos). + simpl in Y. + do 2 (unfold Cap_raw in Y ;simpl in Y). + rewrite -> Qle_minus_iff in Y. + ring_simplify in Y. + rewrite Qle_minus_iff. + ring_simplify;assumption. + assert (' e <= x)%CR. + rewrite <- (doubleSpeed_Eq x). + intros d. + eapply Qle_trans. + apply He. + simpl. + do 2 (unfold Cap_raw;simpl). + ring_simplify. + apply Qle_refl. + destruct (Qle_total c e);[|symmetry]; apply: CRinv_pos_weaken; assumption. Qed. Lemma CRinv_wd : forall (x y:CR) x_ y_, (x == y -> CRinv x x_ == CRinv y y_)%CR. Proof. -assert (X:forall x, ((' 0%Q) + x == x)%CR). -intros x. -transitivity (doubleSpeed x);[|apply: doubleSpeed_Eq]. -apply: regFunEq_e. -intros e. -simpl. -unfold Cap_raw; simpl. -ring_simplify. -apply: ball_refl. -assert (Y:forall x, (x + - (' 0%Q) == x)%CR). -intros x. -transitivity (doubleSpeed x);[|apply: doubleSpeed_Eq]. -apply: regFunEq_e. -intros e. -simpl. -unfold Cap_raw; simpl. -ring_simplify. -apply: ball_refl. - -intros x y [[c x_]|[c x_]] [[d y_]|[d y_]] H. -change (-(CRinv_pos c (-x))== (-(CRinv_pos d (-y))))%CR. -rewrite H in x_ *. -rewrite X in y_ *. intros. -apply: CRopp_wd. -destruct (Qle_total c d);[|symmetry]; - apply CRinv_pos_weaken; try assumption. - -elim (Qlt_not_le _ _ (Qpos_prf c)). -rewrite -> X in *. -rewrite -> Y in *. -rewrite -> H in *. -assert (Z:=Qplus_le_compat _ _ _ _ (x_ ((1#2)*d)%Qpos) (y_ ((1#2)*d)%Qpos)). -simpl in Z. -unfold Cap_raw in Z; simpl in Z. -autorewrite with QposElim in Z. -rewrite -> Qle_minus_iff in Z. -ring_simplify in Z. -rewrite Qle_minus_iff. -ring_simplify. -assumption. - -elim (Qlt_not_le _ _ (Qpos_prf c)). -rewrite -> X in *. -rewrite -> Y in *. -rewrite -> H in *. -assert (Z:=Qplus_le_compat _ _ _ _ (x_ ((1#2)*d)%Qpos) (y_ ((1#2)*d)%Qpos)). -simpl in Z. -unfold Cap_raw in Z; simpl in Z. -autorewrite with QposElim in Z. -rewrite -> Qle_minus_iff in Z. -ring_simplify in Z. -rewrite Qle_minus_iff. -ring_simplify. -assumption. - -change (CRinv_pos c x== (CRinv_pos d y))%CR. -rewrite -> H in *. -rewrite -> Y in *. -destruct (Qle_total c d);[|symmetry]; - apply CRinv_pos_weaken; try assumption. + assert (X:forall x, ((' 0%Q) + x == x)%CR). + intros x. + transitivity (doubleSpeed x);[|apply: doubleSpeed_Eq]. + apply: regFunEq_e. + intros e. + simpl. + unfold Cap_raw; simpl. + ring_simplify. + apply: ball_refl. + assert (Y:forall x, (x + - (' 0%Q) == x)%CR). + intros x. + transitivity (doubleSpeed x);[|apply: doubleSpeed_Eq]. + apply: regFunEq_e. + intros e. + simpl. + unfold Cap_raw; simpl. + ring_simplify. + apply: ball_refl. + intros x y [[c x_]|[c x_]] [[d y_]|[d y_]] H. + change (-(CRinv_pos c (-x))== (-(CRinv_pos d (-y))))%CR. + rewrite H in x_ *. + rewrite X in y_ *. intros. + apply: CRopp_wd. + destruct (Qle_total c d);[|symmetry]; apply CRinv_pos_weaken; try assumption. + elim (Qlt_not_le _ _ (Qpos_prf c)). + rewrite -> X in *. + rewrite -> Y in *. + rewrite -> H in *. + assert (Z:=Qplus_le_compat _ _ _ _ (x_ ((1#2)*d)%Qpos) (y_ ((1#2)*d)%Qpos)). + simpl in Z. + unfold Cap_raw in Z; simpl in Z. + autorewrite with QposElim in Z. + rewrite -> Qle_minus_iff in Z. + ring_simplify in Z. + rewrite Qle_minus_iff. + ring_simplify. + assumption. + elim (Qlt_not_le _ _ (Qpos_prf c)). + rewrite -> X in *. + rewrite -> Y in *. + rewrite -> H in *. + assert (Z:=Qplus_le_compat _ _ _ _ (x_ ((1#2)*d)%Qpos) (y_ ((1#2)*d)%Qpos)). + simpl in Z. + unfold Cap_raw in Z; simpl in Z. + autorewrite with QposElim in Z. + rewrite -> Qle_minus_iff in Z. + ring_simplify in Z. + rewrite Qle_minus_iff. + ring_simplify. + assumption. + change (CRinv_pos c x== (CRinv_pos d y))%CR. + rewrite -> H in *. + rewrite -> Y in *. + destruct (Qle_total c d);[|symmetry]; apply CRinv_pos_weaken; try assumption. Qed. Lemma CRinv_irrelvent : forall x x_ x__, (CRinv x x_ == CRinv x x__)%CR. Proof. -intros. -apply CRinv_wd. -reflexivity. + intros. + apply CRinv_wd. + reflexivity. Qed. diff --git a/reals/fast/CRGeometricSum.v b/reals/fast/CRGeometricSum.v index 63fda1c06..35b2ff735 100644 --- a/reals/fast/CRGeometricSum.v +++ b/reals/fast/CRGeometricSum.v @@ -60,7 +60,7 @@ head elemement. *) Let err_bound (s:Stream Q) : Q := Qabs (hd s)/(1-a). (** [err_prop]: is err an bound on the series s? *) -Let err_prop (err:Q) (s:Stream Q) : bool := +Let err_prop (err:Q) (s:Stream Q) : bool := match ((err_bound s) ?= err) with Gt => false |_ => true @@ -72,74 +72,73 @@ Coercion Local Is_true : bool >-> Sortclass. Lemma err_prop_prop : forall e s, err_prop e s <-> err_bound s <= e. Proof. -intros e s. -unfold err_prop, err_bound, Qcompare, Qle, Zle. -destruct (Qnum (Qabs (hd s) / (1 - a))%Q * Qden e ?= Qnum e * Qden (Qabs (hd s) / (1 - a))%Q)%Z; - split; auto with *. + intros e s. + unfold err_prop, err_bound, Qcompare, Qle, Zle. + destruct (Qnum (Qabs (hd s) / (1 - a))%Q * Qden e ?= Qnum e * Qden (Qabs (hd s) / (1 - a))%Q)%Z; + split; auto with *. Qed. (** The key lemma bout error bounds. *) -Lemma err_prop_key : forall (e:Q) (s: Stream Q) (x:Q), +Lemma err_prop_key : forall (e:Q) (s: Stream Q) (x:Q), err_prop e s -> Qabs x <= a*e -> Qabs (Qplus' (hd s) x) <= e. Proof. -intros e s x Hs Hx. -rewrite Qplus'_correct. -eapply Qle_trans. - apply Qabs_triangle. -replace RHS with (e*(1-a) + a*e) by ring. -assert (X:0 < 1 - a). - change (0 < 1 + - a). - rewrite <- Qlt_minus_iff. - assumption. -apply: plus_resp_leEq_both; try assumption. -rewrite -> err_prop_prop in Hs. -unfold err_bound in Hs. -apply Qmult_lt_0_le_reg_r with (/(1-a)). - apply Qinv_lt_0_compat; assumption. -replace RHS with (e:Q). - assumption. -field. -auto with *. + intros e s x Hs Hx. + rewrite Qplus'_correct. + eapply Qle_trans. + apply Qabs_triangle. + replace RHS with (e*(1-a) + a*e) by ring. + assert (X:0 < 1 - a). + change (0 < 1 + - a). + rewrite <- Qlt_minus_iff. + assumption. + apply: plus_resp_leEq_both; try assumption. + rewrite -> err_prop_prop in Hs. + unfold err_bound in Hs. + apply Qmult_lt_0_le_reg_r with (/(1-a)). + apply Qinv_lt_0_compat; assumption. + replace RHS with (e:Q). + assumption. + field. + auto with *. Qed. -Lemma err_prop_key' : forall (e:Q) (s: Stream Q), +Lemma err_prop_key' : forall (e:Q) (s: Stream Q), GeometricSeries s -> err_prop e s -> err_prop (a*e) (tl s). Proof. -intros e s [H _] Hs. -rewrite -> err_prop_prop in *. -unfold err_bound in *. -rewrite -> Qle_minus_iff in H, Hs |- *. -rewrite -> Qlt_minus_iff in Ha1. -replace RHS with (a * (e + - (Qabs (hd s)/(1-a)))+ - (a * Qabs (hd s) + - Qabs (hd (tl s)))/(1+-a)). - Qauto_nonneg. -field. -auto with *. + intros e s [H _] Hs. + rewrite -> err_prop_prop in *. + unfold err_bound in *. + rewrite -> Qle_minus_iff in H, Hs |- *. + rewrite -> Qlt_minus_iff in Ha1. + replace RHS with (a * (e + - (Qabs (hd s)/(1-a)))+ (a * Qabs (hd s) + - Qabs (hd (tl s)))/(1+-a)). + Qauto_nonneg. + field. + auto with *. Qed. Lemma err_prop_monotone : forall (e0 e1:Q) (s: Stream Q), (e0 <= e1) -> err_prop e0 s -> err_prop e1 s. Proof. -intros e0 e1 s He H. -rewrite -> err_prop_prop in *. -apply Qle_trans with e0; assumption. + intros e0 e1 s He H. + rewrite -> err_prop_prop in *. + apply Qle_trans with e0; assumption. Qed. Lemma err_prop_monotone' : forall (e:Q) (s: Stream Q), GeometricSeries s -> err_prop e s -> err_prop e (tl s). Proof. -intros e s Hs H. -rewrite -> err_prop_prop in *. -eapply Qle_trans;[|apply H]. -unfold err_bound. -apply: mult_resp_leEq_rht. - destruct Hs as [H0 _]. - eapply Qle_trans;[apply H0|]. - replace RHS with (1*Qabs(hd s)) by ring. - apply: mult_resp_leEq_rht; auto with *. - apply Qabs_nonneg. -apply Qinv_le_0_compat. -unfold Qminus. -rewrite <- Qle_minus_iff. -auto with *. + intros e s Hs H. + rewrite -> err_prop_prop in *. + eapply Qle_trans;[|apply H]. + unfold err_bound. + apply: mult_resp_leEq_rht. + destruct Hs as [H0 _]. + eapply Qle_trans;[apply H0|]. + replace RHS with (1*Qabs(hd s)) by ring. + apply: mult_resp_leEq_rht; auto with *. + apply Qabs_nonneg. + apply Qinv_le_0_compat. + unfold Qminus. + rewrite <- Qle_minus_iff. + auto with *. Qed. (** [InfiniteSum] is sums the series s. @@ -166,25 +165,22 @@ reducing the call of InfiniteGeometricSum_raw_F.*) (** Lemmas for reasoning about InfiniteSum_raw_N. *) Lemma InfiniteSum_raw_N_F : forall p c, - InfiniteSum_raw_N p (fun err s => InfiniteSum_raw_F c err s)= + InfiniteSum_raw_N p (fun err s => InfiniteSum_raw_F c err s)= InfiniteSum_raw_F (fun err s => InfiniteSum_raw_N p c err s). Proof. -induction p; intro c; try reflexivity; - simpl; - repeat rewrite IHp; - reflexivity. + induction p; intro c; try reflexivity; simpl; repeat rewrite IHp; reflexivity. Qed. Lemma InfiniteSum_raw_N_Psucc : forall p c, - InfiniteSum_raw_N (Psucc p) c = + InfiniteSum_raw_N (Psucc p) c = InfiniteSum_raw_F (fun err s => InfiniteSum_raw_N p c err s). Proof. -intros p. -induction p; intros c; try reflexivity. -simpl in *. -do 2 rewrite IHp. -rewrite InfiniteSum_raw_N_F. -reflexivity. + intros p. + induction p; intros c; try reflexivity. + simpl in *. + do 2 rewrite IHp. + rewrite InfiniteSum_raw_N_F. + reflexivity. Qed. @@ -192,45 +188,44 @@ Lemma InfiniteSum_raw_N_extend' : forall (p q:positive) s (err : Stream Q -> boo (err (Str_nth_tl (nat_of_P p) s)) -> (p <= q)%Z -> InfiniteSum_raw_N p (fun _ _ => 0) err s = InfiniteSum_raw_N q (fun _ _ => 0) err s. Proof. -induction p using Pind. - simpl. + induction p using Pind. + simpl. + intros q s err H H0. + destruct q using Pind. + reflexivity. + rewrite InfiniteSum_raw_N_Psucc. + unfold InfiniteSum_raw_F. + destruct (err s); try reflexivity. + destruct q using Pind;[simpl|rewrite InfiniteSum_raw_N_Psucc]; (unfold InfiniteSum_raw_F; + destruct (err (tl s));[reflexivity|contradiction]). intros q s err H H0. destruct q using Pind. - reflexivity. - rewrite InfiniteSum_raw_N_Psucc. + elim (Psucc_discr p). + apply Zpos_eq_rev. + apply Zle_antisym. + rewrite Pplus_one_succ_r. + rewrite Zpos_plus_distr. + auto with *. + eapply Zle_trans. + apply H0. + auto with *. + do 2 rewrite InfiniteSum_raw_N_Psucc. unfold InfiniteSum_raw_F. destruct (err s); try reflexivity. - destruct q using Pind;[simpl|rewrite InfiniteSum_raw_N_Psucc]; - (unfold InfiniteSum_raw_F; - destruct (err (tl s));[reflexivity|contradiction]). -intros q s err H H0. -destruct q using Pind. - elim (Psucc_discr p). - apply Zpos_eq_rev. - apply Zle_antisym. - rewrite Pplus_one_succ_r. - rewrite Zpos_plus_distr. - auto with *. - eapply Zle_trans. - apply H0. - auto with *. -do 2 rewrite InfiniteSum_raw_N_Psucc. -unfold InfiniteSum_raw_F. -destruct (err s); try reflexivity. -do 2 rewrite Zpos_succ_morphism in H0. -rewrite (IHp q); auto with *. -rewrite nat_of_P_succ_morphism in H. -assumption. + do 2 rewrite Zpos_succ_morphism in H0. + rewrite (IHp q); auto with *. + rewrite nat_of_P_succ_morphism in H. + assumption. Qed. Lemma InfiniteSum_raw_N_extend : forall (p:positive) s (err : Stream Q -> bool), (err (Str_nth_tl (nat_of_P p) s)) -> InfiniteSum_raw_N p (fun _ _ => 0) err s = InfiniteSum_raw_N (Psucc p) (fun _ _ => 0) err s. Proof. -intros. -apply InfiniteSum_raw_N_extend'; auto with *. -rewrite Zpos_succ_morphism. -auto with *. + intros. + apply InfiniteSum_raw_N_extend'; auto with *. + rewrite Zpos_succ_morphism. + auto with *. Qed. Lemma InfiniteSum_raw_N_ind : forall (err:Stream Q -> bool) (P:Stream Q -> Q -> Prop), @@ -238,19 +233,19 @@ Lemma InfiniteSum_raw_N_ind : forall (err:Stream Q -> bool) (P:Stream Q -> Q -> (forall s rec, ~(err s) -> P (tl s) rec -> P s (Qplus' (hd s) rec)) -> forall (p:positive) s, (err (Str_nth_tl (nat_of_P p) s)) -> P s (InfiniteSum_raw_N p (fun err s => 0) err s). Proof. -intros err P H0 H1 p. -induction p using Pind; intros s X. - simpl. + intros err P H0 H1 p. + induction p using Pind; intros s X. + simpl. + unfold InfiniteSum_raw_F. + case_eq (err s); auto with *. + intros C; apply H1; auto with *. + destruct (err s); auto with *. + rewrite InfiniteSum_raw_N_Psucc. unfold InfiniteSum_raw_F. case_eq (err s); auto with *. + rewrite nat_of_P_succ_morphism in X. intros C; apply H1; auto with *. destruct (err s); auto with *. -rewrite InfiniteSum_raw_N_Psucc. -unfold InfiniteSum_raw_F. -case_eq (err s); auto with *. -rewrite nat_of_P_succ_morphism in X. -intros C; apply H1; auto with *. -destruct (err s); auto with *. Qed. (** The infinite sum is indeed bounded by an error bound. *) @@ -258,25 +253,25 @@ Lemma err_prop_correct : forall (e:Qpos) s, (GeometricSeries s) -> (err_prop e s forall (p:positive) (e':Stream Q -> bool), (e' (Str_nth_tl (nat_of_P p) s)) -> Qabs (InfiniteSum_raw_N p (fun err s => 0) e' s) <= e. Proof. -intros e s gs H p e' Z. -assert (X:0<=e) by apply Qpos_nonneg. -generalize (QposAsQ e) X H gs. -clear e X H gs. -set (P:=fun s q => forall e, 0 <= e -> err_prop e s -> GeometricSeries s -> Qabs q <= e). -change (P s (InfiniteSum_raw_N p (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) e' s)). -apply InfiniteSum_raw_N_ind; auto with *. - intros s0 H0 e He ep gs0. - assumption. -unfold P in *. -intros s0 rec _ Hrec e He H0 gs0. -apply err_prop_key. + intros e s gs H p e' Z. + assert (X:0<=e) by apply Qpos_nonneg. + generalize (QposAsQ e) X H gs. + clear e X H gs. + set (P:=fun s q => forall e, 0 <= e -> err_prop e s -> GeometricSeries s -> Qabs q <= e). + change (P s (InfiniteSum_raw_N p (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) e' s)). + apply InfiniteSum_raw_N_ind; auto with *. + intros s0 H0 e He ep gs0. + assumption. + unfold P in *. + intros s0 rec _ Hrec e He H0 gs0. + apply err_prop_key. + assumption. + apply Hrec. + apply: mult_resp_nonneg; assumption. + apply err_prop_key'; assumption. + destruct gs0. assumption. -apply Hrec. - apply: mult_resp_nonneg; assumption. - apply err_prop_key'; assumption. -destruct gs0. -assumption. -Qed. +Qed. (** This lemma tells us how to compute an upper bound on the number of terms we will need to compute. It is okay for this error to be loose @@ -285,56 +280,55 @@ estimate of the error is small enough. *) Lemma GeometricCovergenceLemma : forall (n:positive) (e:Qpos), /(e*(1 - a)) <= n -> a^n <= e. Proof. -destruct (Qle_lt_or_eq _ _ Ha0) as [Ha0'|Ha0']. - intros n e H. - assert (0 < a^n). - assert (X:0 < ((mkQpos Ha0')^n)%Qpos) by auto with *. - autorewrite with QposElim in X. - assumption. - apply Qmult_lt_0_le_reg_r with ((/e)*/(a^n)). - apply: mult_resp_pos. - apply Qinv_lt_0_compat; auto with *. - apply Qinv_lt_0_compat. - assumption. - assert (0 Qlt_minus_iff in Ha1. - change (0<1-a) in Ha1. - rewrite -> Qle_minus_iff in H. - apply Qle_trans with (1 + n*(/a -1)). - rewrite Qle_minus_iff. - replace RHS with (1+(1 - a)*((n*(1-a)*/a + (n +-(/(e*(1 - a))))))) by - field; split; auto with *. + destruct (Qle_lt_or_eq _ _ Ha0) as [Ha0'|Ha0']. + intros n e H. + assert (0 < a^n). + assert (X:0 < ((mkQpos Ha0')^n)%Qpos) by auto with *. + autorewrite with QposElim in X. + assumption. + apply Qmult_lt_0_le_reg_r with ((/e)*/(a^n)). + apply: mult_resp_pos. + apply Qinv_lt_0_compat; auto with *. + apply Qinv_lt_0_compat. + assumption. + assert (0 Qlt_minus_iff in Ha1. + change (0<1-a) in Ha1. + rewrite -> Qle_minus_iff in H. + apply Qle_trans with (1 + n*(/a -1)). + rewrite Qle_minus_iff. + replace RHS with (1+(1 - a)*((n*(1-a)*/a + (n +-(/(e*(1 - a))))))) by field; split; auto with *. apply: plus_resp_nonneg; try discriminate. repeat apply: mult_resp_nonneg; simpl; auto with *. assert (0 <= 1-a) by auto with *. Qauto_nonneg. - clear -n Ha0'. - induction n using Pind. - simpl. - replace LHS with (/a) by ring. - apply Qle_refl. - rewrite Zpos_succ_morphism. - unfold Zsucc. - rewrite Qpower_plus;[|auto with *]. - rewrite Qinv_mult_distr. - rewrite injz_plus. - apply Qle_trans with ((1 + n * (/ a - 1))*/a). - rewrite Qle_minus_iff. - replace RHS with (n*(/a -1)^2) by ring. - Qauto_nonneg. - apply: mult_resp_leEq_rht. - assumption. - apply Qinv_le_0_compat; auto with *. -intros n e _. -rewrite <- Ha0'. -rewrite Qpower_0; auto with *. + clear -n Ha0'. + induction n using Pind. + simpl. + replace LHS with (/a) by ring. + apply Qle_refl. + rewrite Zpos_succ_morphism. + unfold Zsucc. + rewrite Qpower_plus;[|auto with *]. + rewrite Qinv_mult_distr. + rewrite injz_plus. + apply Qle_trans with ((1 + n * (/ a - 1))*/a). + rewrite Qle_minus_iff. + replace RHS with (n*(/a -1)^2) by ring. + Qauto_nonneg. + apply: mult_resp_leEq_rht. + assumption. + apply Qinv_le_0_compat; auto with *. + intros n e _. + rewrite <- Ha0'. + rewrite Qpower_0; auto with *. Qed. Definition InfiniteGeometricSum_maxIter series (err:Qpos) : positive := let x := (1-a) in -let (n,d) := (Qabs (hd series))/(err*x*x) in +let (n,d) := (Qabs (hd series))/(err*x*x) in match Zsucc (Zdiv n d) with | Zpos p => p | _ => 1%positive @@ -344,129 +338,120 @@ Lemma InfiniteGeometricSum_maxIter_monotone : forall series (err:Qpos), GeometricSeries series -> (InfiniteGeometricSum_maxIter (tl series) err <= InfiniteGeometricSum_maxIter series err)%Z. Proof. -intros series err Gs. -unfold InfiniteGeometricSum_maxIter. -cut ((Qabs (hd (tl series)) / (err * (1 - a) * (1 - a))) <= - (Qabs (hd series) / (err * (1 - a) * (1 - a)))). - generalize (Qabs (hd (tl series)) / (err * (1 - a) * (1 - a))) - (Qabs (hd series) / (err * (1 - a) * (1 - a))). - intros [na da] [nb db] H. - cut (Zsucc (na/da) <= Zsucc (nb/db))%Z. - generalize (Zsucc (na / da)) (Zsucc (nb/db)). - intros [|x|x] [|y|y] Hxy; - try solve [apply Hxy - | apply Qle_refl - | elim Hxy; constructor - | unfold Qle; simpl; repeat rewrite Pmult_1_r; auto with *]. - apply Zsucc_le_compat. - unfold Qle in H. - simpl in H. - rewrite <- (Zdiv_mult_cancel_r na da db); auto with *. - rewrite <- (Zdiv_mult_cancel_r nb db da); auto with *. - rewrite (Zmult_comm db da). - apply Z_div_le; auto with *. -assert (X:0 < 1 - a). - change (0 < 1 + - a). - rewrite <- Qlt_minus_iff. - assumption. -apply Qle_shift_div_l. - Qauto_pos. -replace LHS with (Qabs (hd (tl series))) by - field;split; auto with *; apply Qpos_nonzero. -destruct Gs as [H _]. -eapply Qle_trans. - apply H. -replace RHS with (1*Qabs (hd series)) by ring. -apply: mult_resp_leEq_rht;simpl; - auto with *. -apply Qabs_nonneg. + intros series err Gs. + unfold InfiniteGeometricSum_maxIter. + cut ((Qabs (hd (tl series)) / (err * (1 - a) * (1 - a))) <= + (Qabs (hd series) / (err * (1 - a) * (1 - a)))). + generalize (Qabs (hd (tl series)) / (err * (1 - a) * (1 - a))) + (Qabs (hd series) / (err * (1 - a) * (1 - a))). + intros [na da] [nb db] H. + cut (Zsucc (na/da) <= Zsucc (nb/db))%Z. + generalize (Zsucc (na / da)) (Zsucc (nb/db)). + intros [|x|x] [|y|y] Hxy; try solve [apply Hxy | apply Qle_refl | elim Hxy; constructor + | unfold Qle; simpl; repeat rewrite Pmult_1_r; auto with *]. + apply Zsucc_le_compat. + unfold Qle in H. + simpl in H. + rewrite <- (Zdiv_mult_cancel_r na da db); auto with *. + rewrite <- (Zdiv_mult_cancel_r nb db da); auto with *. + rewrite (Zmult_comm db da). + apply Z_div_le; auto with *. + assert (X:0 < 1 - a). + change (0 < 1 + - a). + rewrite <- Qlt_minus_iff. + assumption. + apply Qle_shift_div_l. + Qauto_pos. + replace LHS with (Qabs (hd (tl series))) by field;split; auto with *; apply Qpos_nonzero. + destruct Gs as [H _]. + eapply Qle_trans. + apply H. + replace RHS with (1*Qabs (hd series)) by ring. + apply: mult_resp_leEq_rht;simpl; auto with *. + apply Qabs_nonneg. Qed. Lemma InfiniteGeometricSum_maxIter_correct : forall series (err:Qpos), GeometricSeries series -> err_prop err (Str_nth_tl (nat_of_P (InfiniteGeometricSum_maxIter series err)) series). Proof. -intros series err H. -rewrite err_prop_prop. -unfold err_bound. -assert (X:0 < 1 - a). - change (0 < 1 + - a). - rewrite <- Qlt_minus_iff. - assumption. -apply Qle_shift_div_r; try assumption. -assert (Y:(Qabs (hd series) * a ^ InfiniteGeometricSum_maxIter series err <= -err * (1 - a))). - destruct (Qlt_le_dec 0 (Qabs (hd series))). - apply Qmult_lt_0_le_reg_r with (/Qabs (hd series)). - apply Qinv_lt_0_compat; assumption. - replace LHS with (a ^ InfiniteGeometricSum_maxIter series err) by - (field; auto with *). - cut (a ^ InfiniteGeometricSum_maxIter series err <= - (err * mkQpos X / mkQpos q)%Qpos). - autorewrite with QposElim; auto. - apply GeometricCovergenceLemma. - autorewrite with QposElim. - unfold InfiniteGeometricSum_maxIter. - replace LHS with (Qabs (hd series) / (err * (1 - a) * (1 - a))) by - (field;repeat split;auto with *;apply Qpos_nonzero). - cut (0 < (Qabs (hd series) / (err * (1 - a) * (1 - a)))). - generalize (Qabs (hd series) / (err * (1 - a) * (1 - a))). - intros [n d] Hnd. - apply Qle_trans with (Zsucc (n/d)). - unfold Qle. - simpl. - unfold Zsucc. - apply Zle_0_minus_le. - replace RHS with (d*(n/d) + n mod d - n mod d - n + d)%Z by ring. - rewrite <- Z_div_mod_eq; auto with *. - replace RHS with (d - n mod d)%Z by ring. - apply Zle_minus_le_0. - destruct (Z_mod_lt n d); auto with *. - generalize (Zsucc (n/d)). - intros [|z|z]. - discriminate. - apply Qle_refl. - discriminate. - cut (0 < (mkQpos q)/(err * (mkQpos X)*(mkQpos X)))%Qpos. - autorewrite with QposElim; auto. - auto with *. - setoid_replace (Qabs (hd series)) with 0. - replace LHS with 0 by ring. - apply Qlt_le_weak; Qauto_pos. - apply Qle_antisym; try assumption. - apply Qabs_nonneg. -apply Qle_trans with (Qabs (hd series)*a^(InfiniteGeometricSum_maxIter series err)); - try assumption. -clear Y. -generalize (InfiniteGeometricSum_maxIter series err). -intros p. -revert series H. -induction p using Pind; intros series H. - simpl. - destruct H. - rewrite Qmult_comm. - assumption. -rewrite nat_of_P_succ_morphism. -rewrite Zpos_succ_morphism. -unfold Zsucc. -rewrite Qpower_plus';[|discriminate]. -replace RHS with ((Qabs (hd series) * a ^ p)*a) by ring. -apply Qle_trans with (Qabs (hd (Str_nth_tl (nat_of_P p) series))*a). - change (S (nat_of_P p)) with (1+(nat_of_P p))%nat. - rewrite <- Str_nth_tl_plus. - cut (GeometricSeries (Str_nth_tl (nat_of_P p) series)). - generalize (Str_nth_tl (nat_of_P p) series). - intros s [H0 _]. + intros series err H. + rewrite err_prop_prop. + unfold err_bound. + assert (X:0 < 1 - a). + change (0 < 1 + - a). + rewrite <- Qlt_minus_iff. + assumption. + apply Qle_shift_div_r; try assumption. + assert (Y:(Qabs (hd series) * a ^ InfiniteGeometricSum_maxIter series err <= err * (1 - a))). + destruct (Qlt_le_dec 0 (Qabs (hd series))). + apply Qmult_lt_0_le_reg_r with (/Qabs (hd series)). + apply Qinv_lt_0_compat; assumption. + replace LHS with (a ^ InfiniteGeometricSum_maxIter series err) by (field; auto with *). + cut (a ^ InfiniteGeometricSum_maxIter series err <= (err * mkQpos X / mkQpos q)%Qpos). + autorewrite with QposElim; auto. + apply GeometricCovergenceLemma. + autorewrite with QposElim. + unfold InfiniteGeometricSum_maxIter. + replace LHS with (Qabs (hd series) / (err * (1 - a) * (1 - a))) by + (field;repeat split;auto with *;apply Qpos_nonzero). + cut (0 < (Qabs (hd series) / (err * (1 - a) * (1 - a)))). + generalize (Qabs (hd series) / (err * (1 - a) * (1 - a))). + intros [n d] Hnd. + apply Qle_trans with (Zsucc (n/d)). + unfold Qle. + simpl. + unfold Zsucc. + apply Zle_0_minus_le. + replace RHS with (d*(n/d) + n mod d - n mod d - n + d)%Z by ring. + rewrite <- Z_div_mod_eq; auto with *. + replace RHS with (d - n mod d)%Z by ring. + apply Zle_minus_le_0. + destruct (Z_mod_lt n d); auto with *. + generalize (Zsucc (n/d)). + intros [|z|z]. + discriminate. + apply Qle_refl. + discriminate. + cut (0 < (mkQpos q)/(err * (mkQpos X)*(mkQpos X)))%Qpos. + autorewrite with QposElim; auto. + auto with *. + setoid_replace (Qabs (hd series)) with 0. + replace LHS with 0 by ring. + apply Qlt_le_weak; Qauto_pos. + apply Qle_antisym; try assumption. + apply Qabs_nonneg. + apply Qle_trans with (Qabs (hd series)*a^(InfiniteGeometricSum_maxIter series err)); try assumption. + clear Y. + generalize (InfiniteGeometricSum_maxIter series err). + intros p. + revert series H. + induction p using Pind; intros series H. + simpl. + destruct H. rewrite Qmult_comm. assumption. - clear -H. - induction (nat_of_P p). - auto. - change (S n) with (1+n)%nat. - rewrite <- Str_nth_tl_plus. - simpl. - destruct IHn; assumption. -apply: mult_resp_leEq_rht; try assumption. -apply IHp; assumption. + rewrite nat_of_P_succ_morphism. + rewrite Zpos_succ_morphism. + unfold Zsucc. + rewrite Qpower_plus';[|discriminate]. + replace RHS with ((Qabs (hd series) * a ^ p)*a) by ring. + apply Qle_trans with (Qabs (hd (Str_nth_tl (nat_of_P p) series))*a). + change (S (nat_of_P p)) with (1+(nat_of_P p))%nat. + rewrite <- Str_nth_tl_plus. + cut (GeometricSeries (Str_nth_tl (nat_of_P p) series)). + generalize (Str_nth_tl (nat_of_P p) series). + intros s [H0 _]. + rewrite Qmult_comm. + assumption. + clear -H. + induction (nat_of_P p). + auto. + change (S n) with (1+n)%nat. + rewrite <- Str_nth_tl_plus. + simpl. + destruct IHn; assumption. + apply: mult_resp_leEq_rht; try assumption. + apply IHp; assumption. Qed. (** The implemenation of [InfiniteGeometricSum]. *) @@ -480,73 +465,70 @@ end. Lemma InfiniteGeometricSum_raw_prf : forall series, GeometricSeries series -> is_RegularFunction (InfiniteGeometricSum_raw series). Proof. -intros series H e0 e1. -assert (A0:=InfiniteGeometricSum_maxIter_correct e0 H). -assert (A1:=InfiniteGeometricSum_maxIter_correct e1 H). -revert A0 A1. -simpl. -generalize (InfiniteGeometricSum_maxIter series e0) (InfiniteGeometricSum_maxIter series e1). -revert e0 e1. -cut (forall (e0 e1:Qpos), (e1 <= e0) -> forall (p p0 : positive), -err_prop e0 (Str_nth_tl (nat_of_P p) series) -> -err_prop e1 (Str_nth_tl (nat_of_P p0) series) -> -Qball (e0) - (InfiniteSum_raw_N p (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) - (err_prop e0) series) - (InfiniteSum_raw_N p0 (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) - (err_prop e1) series)). - intros X e0 e1 p0 p1. - destruct (Qle_total e1 e0). + intros series H e0 e1. + assert (A0:=InfiniteGeometricSum_maxIter_correct e0 H). + assert (A1:=InfiniteGeometricSum_maxIter_correct e1 H). + revert A0 A1. + simpl. + generalize (InfiniteGeometricSum_maxIter series e0) (InfiniteGeometricSum_maxIter series e1). + revert e0 e1. + cut (forall (e0 e1:Qpos), (e1 <= e0) -> forall (p p0 : positive), + err_prop e0 (Str_nth_tl (nat_of_P p) series) -> err_prop e1 (Str_nth_tl (nat_of_P p0) series) -> + Qball (e0) (InfiniteSum_raw_N p (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) + (err_prop e0) series) (InfiniteSum_raw_N p0 (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) + (err_prop e1) series)). + intros X e0 e1 p0 p1. + destruct (Qle_total e1 e0). + intros H0 H1. + apply: ball_weak;simpl;auto. intros H0 H1. - apply: ball_weak;simpl;auto. - intros H0 H1. - setoid_replace (e0 + e1)%Qpos with (e1+e0)%Qpos by QposRing. - apply: ball_weak. - apply ball_sym. - apply X; auto with *. -intros e0 e1 He p0 p1 H0. -revert H. -set (P0:=fun s q => GeometricSeries s -> - err_prop e1 (Str_nth_tl (nat_of_P p1) s) -> Qball e0 q (InfiniteSum_raw_N p1 (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) + setoid_replace (e0 + e1)%Qpos with (e1+e0)%Qpos by QposRing. + apply: ball_weak. + apply ball_sym. + apply X; auto with *. + intros e0 e1 He p0 p1 H0. + revert H. + set (P0:=fun s q => GeometricSeries s -> + err_prop e1 (Str_nth_tl (nat_of_P p1) s) -> Qball e0 q (InfiniteSum_raw_N p1 (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) (err_prop e1) s)). -change (P0 series (InfiniteSum_raw_N p0 (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) - (err_prop e0) series)). -apply InfiniteSum_raw_N_ind; try assumption; unfold P0. - intros s Hs Gs H1. - apply: ball_sym;simpl. + change (P0 series (InfiniteSum_raw_N p0 (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) + (err_prop e0) series)). + apply InfiniteSum_raw_N_ind; try assumption; unfold P0. + intros s Hs Gs H1. + apply: ball_sym;simpl. + unfold Qball. + rewrite <- AbsSmall_Qabs. + unfold Qminus. + rewrite Qplus_0_r. + apply err_prop_correct; assumption. + intros s rec Hs Ind Gs H1. + clear P0. + rewrite InfiniteSum_raw_N_extend; try assumption. + rewrite InfiniteSum_raw_N_Psucc. + unfold InfiniteSum_raw_F. + case_eq (err_prop e1 s). + intros H. + elim Hs. + apply err_prop_monotone with e1; try assumption. + destruct (err_prop e1 s);[constructor | discriminate H]. + intros H. unfold Qball. rewrite <- AbsSmall_Qabs. - unfold Qminus. - rewrite Qplus_0_r. - apply err_prop_correct; assumption. -intros s rec Hs Ind Gs H1. -clear P0. -rewrite InfiniteSum_raw_N_extend; try assumption. -rewrite InfiniteSum_raw_N_Psucc. -unfold InfiniteSum_raw_F. -case_eq (err_prop e1 s). - intros H. - elim Hs. - apply err_prop_monotone with e1; try assumption. - destruct (err_prop e1 s);[constructor | discriminate H]. -intros H. -unfold Qball. -rewrite <- AbsSmall_Qabs. -repeat rewrite Qplus'_correct. -set (x:=InfiniteSum_raw_N p1 (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) (err_prop e1) (tl s)) in *. -setoid_replace (hd s + rec - (hd s + x)) with (rec - x) by ring. -rewrite AbsSmall_Qabs. -apply Ind. - destruct Gs; assumption. -rewrite <- tl_nth_tl. -apply err_prop_monotone'; try assumption. -clear - Gs. -induction p1 using Pind. - destruct Gs; assumption. -rewrite nat_of_P_succ_morphism. -simpl. -rewrite <- tl_nth_tl. -destruct IHp1; assumption. + repeat rewrite Qplus'_correct. + set (x:=InfiniteSum_raw_N p1 (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) (err_prop e1) (tl s)) in *. + setoid_replace (hd s + rec - (hd s + x)) with (rec - x) by ring. + rewrite AbsSmall_Qabs. + apply Ind. + destruct Gs; assumption. + rewrite <- tl_nth_tl. + apply err_prop_monotone'; try assumption. + clear - Gs. + induction p1 using Pind. + destruct Gs; assumption. + rewrite nat_of_P_succ_morphism. + simpl. + rewrite <- tl_nth_tl. + destruct IHp1; assumption. Qed. Definition InfiniteGeometricSum series (Gs:GeometricSeries series) : CR := @@ -557,144 +539,139 @@ Lemma InfiniteGeometricSum_step : forall series (Gs:GeometricSeries series), (InfiniteGeometricSum Gs == ('(hd series))+(InfiniteGeometricSum (ForAll_Str_nth_tl 1%nat Gs)))%CR. Proof. -intros series Gs. -rewrite CRplus_translate. -apply: regFunEq_e. -intros e. -simpl. -rewrite InfiniteSum_raw_N_extend; - [|apply InfiniteGeometricSum_maxIter_correct; assumption]. -rewrite InfiniteSum_raw_N_Psucc. -unfold InfiniteSum_raw_F. -case_eq (err_prop e series); intros He. - assert (He':err_prop e series). - destruct (err_prop e series);try discriminate He; constructor. - clear He. - apply: ball_sym. + intros series Gs. + rewrite CRplus_translate. + apply: regFunEq_e. + intros e. simpl. - unfold Qball. - rewrite <- AbsSmall_Qabs. - ring_simplify (hd series + - InfiniteSum_raw_N (InfiniteGeometricSum_maxIter (tl series) e) - (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) (err_prop e) - (tl series) - 0). - eapply Qle_trans. - apply Qabs_triangle. - autorewrite with QposElim. - apply: plus_resp_leEq_both;simpl. - rewrite -> err_prop_prop in He'. - unfold err_bound in He'. - assert (X:0 < 1 - a). - change (0 < 1 + - a). - rewrite <- Qlt_minus_iff. + rewrite InfiniteSum_raw_N_extend; [|apply InfiniteGeometricSum_maxIter_correct; assumption]. + rewrite InfiniteSum_raw_N_Psucc. + unfold InfiniteSum_raw_F. + case_eq (err_prop e series); intros He. + assert (He':err_prop e series). + destruct (err_prop e series);try discriminate He; constructor. + clear He. + apply: ball_sym. + simpl. + unfold Qball. + rewrite <- AbsSmall_Qabs. + ring_simplify (hd series + InfiniteSum_raw_N (InfiniteGeometricSum_maxIter (tl series) e) + (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) (err_prop e) (tl series) - 0). + eapply Qle_trans. + apply Qabs_triangle. + autorewrite with QposElim. + apply: plus_resp_leEq_both;simpl. + rewrite -> err_prop_prop in He'. + unfold err_bound in He'. + assert (X:0 < 1 - a). + change (0 < 1 + - a). + rewrite <- Qlt_minus_iff. + assumption. + clear - He' Ha0 X. + replace LHS with ((Qabs (hd series)/(1-a))*(1-a)) by (field; auto with *). + replace RHS with (e*1) by ring. + apply: mult_resp_leEq_both; simpl; try solve[Qauto_nonneg]; auto with *. + rewrite Qle_minus_iff. + ring_simplify. assumption. - clear - He' Ha0 X. - replace LHS with ((Qabs (hd series)/(1-a))*(1-a)) by (field; auto with *). - replace RHS with (e*1) by ring. - apply: mult_resp_leEq_both; simpl; try solve[Qauto_nonneg]; auto with *. - rewrite Qle_minus_iff. - ring_simplify. - assumption. - apply err_prop_correct. - destruct Gs; assumption. - apply err_prop_monotone'; assumption. - change (Is_true (err_prop e - (Str_nth_tl (S (nat_of_P (InfiniteGeometricSum_maxIter (tl series) e))) series))). - induction (S (nat_of_P (InfiniteGeometricSum_maxIter (tl series) e))). + apply err_prop_correct. + destruct Gs; assumption. + apply err_prop_monotone'; assumption. + change (Is_true (err_prop e + (Str_nth_tl (S (nat_of_P (InfiniteGeometricSum_maxIter (tl series) e))) series))). + induction (S (nat_of_P (InfiniteGeometricSum_maxIter (tl series) e))). + assumption. + simpl. + rewrite <- tl_nth_tl. + apply err_prop_monotone'; try assumption. + apply ForAll_Str_nth_tl. assumption. - simpl. - rewrite <- tl_nth_tl. - apply err_prop_monotone'; try assumption. - apply ForAll_Str_nth_tl. + rewrite Qplus'_correct. + rewrite (@InfiniteSum_raw_N_extend' (InfiniteGeometricSum_maxIter (tl series) e) + (InfiniteGeometricSum_maxIter series e)). + apply: ball_refl. + apply InfiniteGeometricSum_maxIter_correct. + destruct Gs; assumption. + apply (@InfiniteGeometricSum_maxIter_monotone series e). assumption. -rewrite Qplus'_correct. -rewrite (@InfiniteSum_raw_N_extend' - (InfiniteGeometricSum_maxIter (tl series) e) - (InfiniteGeometricSum_maxIter series e)). - apply: ball_refl. - apply InfiniteGeometricSum_maxIter_correct. - destruct Gs; assumption. -apply (@InfiniteGeometricSum_maxIter_monotone series e). -assumption. Qed. Lemma InfiniteGeometricSum_bound : forall series (Gs:GeometricSeries series), AbsSmall (R:=CRasCOrdField) ('(err_bound series))%CR (InfiniteGeometricSum Gs). Proof. -intros series Gs. -assert (Y:0 < 1 - a). - change (0 < 1 + - a). - rewrite <- Qlt_minus_iff. - assumption. -destruct (Qeq_dec (err_bound series) 0) as [Hq|Hq]. - stepr ('0)%CR. - split; simpl; - rewrite Hq; try apply CRle_refl. - setoid_replace (-'0)%CR with ('0)%CR by ring. - apply CRle_refl. - apply: regFunEq_e. - intros e. - apply ball_sym. - simpl. - unfold Qball. - stepr 0. - apply zero_AbsSmall. - apply Qpos_nonneg. - simpl. - ring_simplify. - assert (X:err_prop e series). - rewrite err_prop_prop. - rewrite Hq. - apply Qpos_nonneg. - destruct (InfiniteGeometricSum_maxIter series e) using Pind. - simpl. - unfold InfiniteSum_raw_F. - destruct (err_prop e series); try contradiction; reflexivity. - rewrite InfiniteSum_raw_N_Psucc. - unfold InfiniteSum_raw_F. - destruct (err_prop e series); try contradiction; reflexivity. -assert (Herr:0 < err_bound series). - unfold err_bound. - apply Qlt_shift_div_l. - assumption. - ring_simplify. - destruct (Qle_lt_or_eq 0 (Qabs (hd series))). - apply Qabs_nonneg. + intros series Gs. + assert (Y:0 < 1 - a). + change (0 < 1 + - a). + rewrite <- Qlt_minus_iff. assumption. - elim Hq. - unfold err_bound. - rewrite <- H. - field; auto with *. -set (e:=mkQpos Herr). -cut (AbsSmall (R:=CRasCOrdField) (' e)%CR (InfiniteGeometricSum Gs)). - intros [H0 H1]. - unfold e in *. - autorewrite with QposElim in *. - split; assumption. -stepr (InfiniteGeometricSum Gs[-]'0)%CR by (unfold cg_minus; simpl; ring). -rewrite CRAbsSmall_ball. -apply: regFunBall_e. -intros d. -simpl. -set (p:=(InfiniteGeometricSum_maxIter series d)). -set (e':=(err_prop d)). -unfold Qball. -rewrite <- AbsSmall_Qabs. -setoid_replace (InfiniteSum_raw_N p (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) e' - series - 0) with (InfiniteSum_raw_N p (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) e' + destruct (Qeq_dec (err_bound series) 0) as [Hq|Hq]. + stepr ('0)%CR. + split; simpl; rewrite Hq; try apply CRle_refl. + setoid_replace (-'0)%CR with ('0)%CR by ring. + apply CRle_refl. + apply: regFunEq_e. + intros e. + apply ball_sym. + simpl. + unfold Qball. + stepr 0. + apply zero_AbsSmall. + apply Qpos_nonneg. + simpl. + ring_simplify. + assert (X:err_prop e series). + rewrite err_prop_prop. + rewrite Hq. + apply Qpos_nonneg. + destruct (InfiniteGeometricSum_maxIter series e) using Pind. + simpl. + unfold InfiniteSum_raw_F. + destruct (err_prop e series); try contradiction; reflexivity. + rewrite InfiniteSum_raw_N_Psucc. + unfold InfiniteSum_raw_F. + destruct (err_prop e series); try contradiction; reflexivity. + assert (Herr:0 < err_bound series). + unfold err_bound. + apply Qlt_shift_div_l. + assumption. + ring_simplify. + destruct (Qle_lt_or_eq 0 (Qabs (hd series))). + apply Qabs_nonneg. + assumption. + elim Hq. + unfold err_bound. + rewrite <- H. + field; auto with *. + set (e:=mkQpos Herr). + cut (AbsSmall (R:=CRasCOrdField) (' e)%CR (InfiniteGeometricSum Gs)). + intros [H0 H1]. + unfold e in *. + autorewrite with QposElim in *. + split; assumption. + stepr (InfiniteGeometricSum Gs[-]'0)%CR by (unfold cg_minus; simpl; ring). + rewrite CRAbsSmall_ball. + apply: regFunBall_e. + intros d. + simpl. + set (p:=(InfiniteGeometricSum_maxIter series d)). + set (e':=(err_prop d)). + unfold Qball. + rewrite <- AbsSmall_Qabs. + setoid_replace (InfiniteSum_raw_N p (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) e' + series - 0) with (InfiniteSum_raw_N p (fun (_ : Stream Q -> bool) (_ : Stream Q) => 0) e' series) by ring. -apply err_prop_correct; try assumption. - apply err_prop_monotone with e. + apply err_prop_correct; try assumption. + apply err_prop_monotone with e. + autorewrite with QposElim. + Qauto_le. + rewrite err_prop_prop. + unfold e. autorewrite with QposElim. - Qauto_le. - rewrite err_prop_prop. - unfold e. - autorewrite with QposElim. - apply Qle_refl. -unfold e'. -apply InfiniteGeometricSum_maxIter_correct. -assumption. + apply Qle_refl. + unfold e'. + apply InfiniteGeometricSum_maxIter_correct. + assumption. Qed. Lemma InfiniteGeometricSum_small_tail : forall series (e : Qpos), @@ -702,48 +679,45 @@ GeometricSeries series -> {n : nat & forall Gs : GeometricSeries (Str_nth_tl n series), AbsSmall (R:=CRasCOrdField) (' e)%CR (InfiniteGeometricSum Gs)}. Proof. -intros series e. -exists (nat_of_P (InfiniteGeometricSum_maxIter series e)). -intros Gs. -eapply AbsSmall_leEq_trans; - [|apply InfiniteGeometricSum_bound]. -rewrite -> CRle_Qle. -rewrite <- err_prop_prop. -apply InfiniteGeometricSum_maxIter_correct. -assumption. + intros series e. + exists (nat_of_P (InfiniteGeometricSum_maxIter series e)). + intros Gs. + eapply AbsSmall_leEq_trans; [|apply InfiniteGeometricSum_bound]. + rewrite -> CRle_Qle. + rewrite <- err_prop_prop. + apply InfiniteGeometricSum_maxIter_correct. + assumption. Qed. Lemma GeometricSeries_convergent : forall (series:Stream Q), GeometricSeries series -> convergent (fun n => inj_Q IR (Str_nth n series)). Proof. -intros series H. -apply ratio_test_conv. -exists 0%nat. -exists (inj_Q IR a). - rstepr (nring 1:IR). - stepr (inj_Q IR (nring 1)) by apply (inj_Q_nring IR 1). - apply inj_Q_less. - assumption. -assert (Ha0':Zero[<=]inj_Q IR a). - rstepl (nring 0:IR). - stepl (inj_Q IR (nring 0)) by apply (inj_Q_nring IR 0). + intros series H. + apply ratio_test_conv. + exists 0%nat. + exists (inj_Q IR a). + rstepr (nring 1:IR). + stepr (inj_Q IR (nring 1)) by apply (inj_Q_nring IR 1). + apply inj_Q_less. + assumption. + assert (Ha0':Zero[<=]inj_Q IR a). + rstepl (nring 0:IR). + stepl (inj_Q IR (nring 0)) by apply (inj_Q_nring IR 0). + apply inj_Q_leEq. + assumption. + split. + assumption. + intros n _. + destruct (ForAll_Str_nth_tl n H) as [H0 _]. + stepr (inj_Q IR a[*](inj_Q IR (Qabs (Str_nth n series)))) by + apply mult_wdr; apply eq_symmetric; apply AbsIR_Qabs. + stepl (inj_Q IR (Qabs (Str_nth (S n) series))) by apply eq_symmetric; apply AbsIR_Qabs. + stepr (inj_Q IR (a[*]Qabs (Str_nth n series))) by apply inj_Q_mult. apply inj_Q_leEq. + replace (S n) with (1+n)%nat by auto with *. + rewrite <- Str_nth_plus. assumption. -split. - assumption. -intros n _. -destruct (ForAll_Str_nth_tl n H) as [H0 _]. -stepr (inj_Q IR a[*](inj_Q IR (Qabs (Str_nth n series)))) by - apply mult_wdr; apply eq_symmetric; apply AbsIR_Qabs. -stepl (inj_Q IR (Qabs (Str_nth (S n) series))) by - apply eq_symmetric; apply AbsIR_Qabs. -stepr (inj_Q IR (a[*]Qabs (Str_nth n series))) by - apply inj_Q_mult. -apply inj_Q_leEq. -replace (S n) with (1+n)%nat by auto with *. -rewrite <- Str_nth_plus. -assumption. Qed. (* This is a horrendous proof. I'm sure half of it isn't needed, but I don't care to make it better @@ -753,184 +727,167 @@ Lemma InfiniteGeometricSum_correct : forall (series:Stream Q) (x:nat -> IR), forall (Gs:GeometricSeries series) H, (InfiniteGeometricSum Gs==IRasCR (series_sum x H))%CR. Proof. -intros seq x Hx Gs H. -unfold series_sum. -rewrite IR_Lim_as_CR. -apply: SeqLimit_unique. -intros e He. -generalize (IR_Cauchy_prop_as_CR (Build_CauchySeq IR (seq_part_sum x) H)). -intros C. -destruct (C _ (pos_div_two _ _ He)) as [n Hn]. -exists n. -intros m Hm. -unfold CS_seq in *. -clear C. -unfold seq_part_sum in *. -rstepr (((IRasCR (Sum0 (G:=IR) m x)[-](IRasCR (Sum0 (G:=IR) n x)))[+] - ((IRasCR (Sum0 (G:=IR) n x)[-]InfiniteGeometricSum Gs)))). -apply AbsSmall_eps_div_two;[apply Hn; assumption|]. - -clear m Hm. -stepr (('(Sum0 n (fun n => (Str_nth n seq))%Q))%CR[-]InfiniteGeometricSum Gs). - -revert seq x H Hx Gs Hn. -induction n. - intros seq x H Hx Gs Hn. - stepr (Zero[-]InfiniteGeometricSum Gs); - [|apply csbf_wd_unfolded; try apply eq_reflexive; apply eq_symmetric; apply IR_Zero_as_CR]. - apply AbsSmall_minus. - rstepr (InfiniteGeometricSum Gs). - assert (Hn' : forall m : nat, - (0 <= m)%nat -> - AbsSmall (R:=CRasCOrdField) (e [/]TwoNZ) - (IRasCR (Sum0 (G:=IR) m x))). - intros m Hm. - stepr (IRasCR (Sum0 (G:=IR) m x)[-]IRasCR (Sum0 (G:=IR) 0 x)). - apply Hn; assumption. - unfold cg_minus. - simpl. - rewrite IR_Zero_as_CR. - ring. - stepl (IRasCR (CRasIR (e[/]TwoNZ)))%CR by apply CRasIRasCR_id. - stepr (IRasCR (CRasIR (InfiniteGeometricSum Gs)))%CR by apply CRasIRasCR_id. - rewrite <- IR_AbsSmall_as_CR. - apply AbsSmall_approach. - intros d Hd. - rewrite IR_AbsSmall_as_CR. - stepr (InfiniteGeometricSum Gs) by apply eq_symmetric; apply CRasIRasCR_id. - destruct (Q_dense_in_CReals IR d) as [q Hq0 Hq]. - assumption. - assert (Hq0': 0 < q). - apply (less_inj_Q IR). - stepl (Zero:IR). - assumption. - apply eq_symmetric; apply (inj_Q_nring IR 0). - destruct (InfiniteGeometricSum_small_tail (mkQpos Hq0') Gs) as [m Hm]. - rstepr ((IRasCR (Sum0 (G:=IR) m x))[+]((InfiniteGeometricSum Gs)[-](IRasCR (Sum0 (G:=IR) m x)))). - stepl (IRasCR (CRasIR (e [/]TwoNZ))[+](IRasCR d)) by apply eq_symmetric; apply IR_plus_as_CR. - apply AbsSmall_plus. - stepl (e [/]TwoNZ) by apply eq_symmetric; apply CRasIRasCR_id. - apply Hn'; auto with *. - apply AbsSmall_leEq_trans with ('q)%CR. - stepl (IRasCR (inj_Q IR q)) by apply IR_inj_Q_as_CR. - rewrite <- IR_leEq_as_CR. - apply less_leEq. - assumption. - rewrite QposAsmkQpos in Hm. - clear - Hm Hx. - revert seq x Hx Gs Hm. - induction m. - intros seq x Hx Gs Hm. - stepr (InfiniteGeometricSum Gs). - apply Hm. - unfold cg_minus. - simpl. - rewrite IR_Zero_as_CR. - ring. - intros seq x Hx Gs Hm. - stepr ((InfiniteGeometricSum (ForAll_Str_nth_tl 1 Gs)[-]IRasCR (Sum0 (G:=IR) m (fun n => (x (S n)))))). - apply IHm. - intros n. - stepl ((inj_Q IR (Str_nth (S n) seq)%Q)). - apply Hx. + intros seq x Hx Gs H. + unfold series_sum. + rewrite IR_Lim_as_CR. + apply: SeqLimit_unique. + intros e He. + generalize (IR_Cauchy_prop_as_CR (Build_CauchySeq IR (seq_part_sum x) H)). + intros C. + destruct (C _ (pos_div_two _ _ He)) as [n Hn]. + exists n. + intros m Hm. + unfold CS_seq in *. + clear C. + unfold seq_part_sum in *. + rstepr (((IRasCR (Sum0 (G:=IR) m x)[-](IRasCR (Sum0 (G:=IR) n x)))[+] + ((IRasCR (Sum0 (G:=IR) n x)[-]InfiniteGeometricSum Gs)))). + apply AbsSmall_eps_div_two;[apply Hn; assumption|]. + clear m Hm. + stepr (('(Sum0 n (fun n => (Str_nth n seq))%Q))%CR[-]InfiniteGeometricSum Gs). + revert seq x H Hx Gs Hn. + induction n. + intros seq x H Hx Gs Hn. + stepr (Zero[-]InfiniteGeometricSum Gs); + [|apply csbf_wd_unfolded; try apply eq_reflexive; apply eq_symmetric; apply IR_Zero_as_CR]. + apply AbsSmall_minus. + rstepr (InfiniteGeometricSum Gs). + assert (Hn' : forall m : nat, (0 <= m)%nat -> AbsSmall (R:=CRasCOrdField) (e [/]TwoNZ) + (IRasCR (Sum0 (G:=IR) m x))). + intros m Hm. + stepr (IRasCR (Sum0 (G:=IR) m x)[-]IRasCR (Sum0 (G:=IR) 0 x)). + apply Hn; assumption. + unfold cg_minus. + simpl. + rewrite IR_Zero_as_CR. + ring. + stepl (IRasCR (CRasIR (e[/]TwoNZ)))%CR by apply CRasIRasCR_id. + stepr (IRasCR (CRasIR (InfiniteGeometricSum Gs)))%CR by apply CRasIRasCR_id. + rewrite <- IR_AbsSmall_as_CR. + apply AbsSmall_approach. + intros d Hd. + rewrite IR_AbsSmall_as_CR. + stepr (InfiniteGeometricSum Gs) by apply eq_symmetric; apply CRasIRasCR_id. + destruct (Q_dense_in_CReals IR d) as [q Hq0 Hq]. + assumption. + assert (Hq0': 0 < q). + apply (less_inj_Q IR). + stepl (Zero:IR). + assumption. + apply eq_symmetric; apply (inj_Q_nring IR 0). + destruct (InfiniteGeometricSum_small_tail (mkQpos Hq0') Gs) as [m Hm]. + rstepr ((IRasCR (Sum0 (G:=IR) m x))[+]((InfiniteGeometricSum Gs)[-](IRasCR (Sum0 (G:=IR) m x)))). + stepl (IRasCR (CRasIR (e [/]TwoNZ))[+](IRasCR d)) by apply eq_symmetric; apply IR_plus_as_CR. + apply AbsSmall_plus. + stepl (e [/]TwoNZ) by apply eq_symmetric; apply CRasIRasCR_id. + apply Hn'; auto with *. + apply AbsSmall_leEq_trans with ('q)%CR. + stepl (IRasCR (inj_Q IR q)) by apply IR_inj_Q_as_CR. + rewrite <- IR_leEq_as_CR. + apply less_leEq. + assumption. + rewrite QposAsmkQpos in Hm. + clear - Hm Hx. + revert seq x Hx Gs Hm. + induction m. + intros seq x Hx Gs Hm. + stepr (InfiniteGeometricSum Gs). + apply Hm. + unfold cg_minus. + simpl. + rewrite IR_Zero_as_CR. + ring. + intros seq x Hx Gs Hm. + stepr ((InfiniteGeometricSum (ForAll_Str_nth_tl 1 Gs)[-]IRasCR (Sum0 (G:=IR) m (fun n => (x (S n)))))). + apply IHm. + intros n. + stepl ((inj_Q IR (Str_nth (S n) seq)%Q)). + apply Hx. + apply eq_reflexive. + intros. + apply Hm. + change (InfiniteGeometricSum (ForAll_Str_nth_tl 1 Gs)- + IRasCR (Sum0 (G:=IR) m (fun n : nat => (x (S n)))) == + InfiniteGeometricSum Gs-IRasCR (Sum0 (G:=IR) (S m) x))%CR. + symmetry. + rewrite InfiniteGeometricSum_step. + setoid_replace (IRasCR (Sum0 (G:=IR) (S m) x)) + with (IRasCR (inj_Q _ (hd seq) [+](Sum0 (G:=IR) m (fun n0 : nat => (x (S n0)))%Q))). + rewrite (IR_plus_as_CR). + rewrite IR_inj_Q_as_CR. + ring. + apply IRasCR_wd. + apply eq_symmetric. + stepl (x O[+]Sum0 (G:=IR) m (fun n0 : nat => (x (S n0)))). + apply Sum0_shift. + intros i. + apply eq_reflexive. + apply bin_op_wd_unfolded. + apply eq_symmetric. + apply (Hx O). apply eq_reflexive. - intros. - apply Hm. - change (InfiniteGeometricSum (ForAll_Str_nth_tl 1 Gs)- - IRasCR (Sum0 (G:=IR) m (fun n : nat => (x (S n)))) == - InfiniteGeometricSum Gs-IRasCR (Sum0 (G:=IR) (S m) x))%CR. - symmetry. - rewrite InfiniteGeometricSum_step. - setoid_replace (IRasCR (Sum0 (G:=IR) (S m) x)) - with (IRasCR (inj_Q _ (hd seq) [+](Sum0 (G:=IR) m (fun n0 : nat => (x (S n0)))%Q))). - rewrite (IR_plus_as_CR). - rewrite IR_inj_Q_as_CR. - ring. - apply IRasCR_wd. - apply eq_symmetric. - stepl (x O[+]Sum0 (G:=IR) m (fun n0 : nat => (x (S n0)))). + intros seq x H Hx Gs Hn. + set (y:=(fun n => (x (n + 1)%nat))). + stepr (('(((Sum0 (G:=Q_as_CAbGroup) n (fun n0 : nat => Str_nth n0 (tl seq))%Q)))%CR)[-] + InfiniteGeometricSum (ForAll_Str_nth_tl 1 Gs))%CR; [apply (IHn (tl seq) y )|]. + apply tail_series with x. + assumption. + exists 1%nat. + exists 0%nat. + intros; apply eq_reflexive. + intros m. + unfold y. + stepr ((inj_Q IR (Str_nth (m+1) seq))) by apply (Hx (m + 1)%nat). + rewrite <- Str_nth_plus. + apply eq_reflexive. + intros m Hm. + stepr (IRasCR (Sum0 (G:=IR) (S m) x)[-]IRasCR (Sum0 (G:=IR) (S n) x)). + apply Hn. + auto with *. + change ((IRasCR (Sum0 (G:=IR) (S m) x) - IRasCR (Sum0 (G:=IR) (S n) x) == + IRasCR (Sum0 (G:=IR) m y) - IRasCR (Sum0 (G:=IR) n y))%CR). + do 2 rewrite <- IR_minus_as_CR. + apply IRasCR_wd. + stepr ((x O[+]Sum0 (G:=IR) m y[-](x O[+]Sum0 (G:=IR) n y))). + apply bin_op_wd_unfolded;[|apply un_op_wd_unfolded]; apply eq_symmetric; apply Sum0_shift; + intros; unfold y;rewrite plus_comm; apply eq_reflexive. + rational. + change ((' Sum0 (G:=Q_as_CAbGroup) n (fun n0 : nat => (Str_nth n0 (tl seq))%Q) - + InfiniteGeometricSum (ForAll_Str_nth_tl 1 Gs) == ' (Sum0 (G:=Q_as_CAbGroup) (S n) + (fun n0 : nat => (Str_nth n0 seq)%Q)) - InfiniteGeometricSum Gs))%CR. + symmetry. + rewrite InfiniteGeometricSum_step. + set (z:=(fun n0 : nat => (Str_nth n0 seq)%Q)). + setoid_replace ((Sum0 (G:=Q_as_CAbGroup) (S n) z):Q) with ((z O + (Sum0 (G:=Q_as_CAbGroup) n + (fun n0 : nat => (Str_nth n0 (tl seq))%Q)))). + rewrite <- (CRplus_Qplus (z O)). + unfold z, Str_nth. + simpl. + ring. + symmetry. apply Sum0_shift. intros i. - apply eq_reflexive. - apply bin_op_wd_unfolded. - apply eq_symmetric. - apply (Hx O). - apply eq_reflexive. - -intros seq x H Hx Gs Hn. -set (y:=(fun n => (x (n + 1)%nat))). -stepr (('(((Sum0 (G:=Q_as_CAbGroup) n (fun n0 : nat => Str_nth n0 (tl seq))%Q)))%CR)[-] - InfiniteGeometricSum (ForAll_Str_nth_tl 1 Gs))%CR; - [apply (IHn (tl seq) y )|]. - apply tail_series with x. - assumption. - exists 1%nat. - exists 0%nat. - intros; apply eq_reflexive. - intros m. - unfold y. - stepr ((inj_Q IR (Str_nth (m+1) seq))) by - apply (Hx (m + 1)%nat). - rewrite <- Str_nth_plus. - apply eq_reflexive. - intros m Hm. - stepr (IRasCR (Sum0 (G:=IR) (S m) x)[-]IRasCR (Sum0 (G:=IR) (S n) x)). - apply Hn. - auto with *. - change ((IRasCR (Sum0 (G:=IR) (S m) x) - IRasCR (Sum0 (G:=IR) (S n) x) == - IRasCR (Sum0 (G:=IR) m y) - IRasCR (Sum0 (G:=IR) n y))%CR). - do 2 rewrite <- IR_minus_as_CR. + reflexivity. + apply cg_minus_wd;[rewrite IR_Sum0_as_CR|reflexivity]. + clear - Hx. + induction n. + reflexivity. + change ((' (Sum0 (G:=Q_as_CAbGroup) n (fun n0 : nat => (Str_nth n0 seq)%Q) + (Str_nth n seq)) == + (Sum0 (G:=CRasCAbGroup) n (fun n0 : nat => IRasCR (x n0)):CR) + IRasCR (x n))%CR). + rewrite <- CRplus_Qplus. + apply ucFun2_wd;[apply IHn|]. + transitivity (IRasCR (inj_Q IR (Str_nth n seq)%Q)); [symmetry;apply IR_inj_Q_as_CR|]. apply IRasCR_wd. - stepr ((x O[+]Sum0 (G:=IR) m y[-](x O[+]Sum0 (G:=IR) n y))). - apply bin_op_wd_unfolded;[|apply un_op_wd_unfolded]; - apply eq_symmetric; - apply Sum0_shift; - intros; unfold y;rewrite plus_comm; apply eq_reflexive. - rational. -change ((' Sum0 (G:=Q_as_CAbGroup) n - (fun n0 : nat => (Str_nth n0 (tl seq))%Q) - - InfiniteGeometricSum (ForAll_Str_nth_tl 1 Gs) == - ' (Sum0 (G:=Q_as_CAbGroup) (S n) - (fun n0 : nat => (Str_nth n0 seq)%Q)) - - InfiniteGeometricSum Gs))%CR. -symmetry. -rewrite InfiniteGeometricSum_step. -set (z:=(fun n0 : nat => (Str_nth n0 seq)%Q)). -setoid_replace ((Sum0 (G:=Q_as_CAbGroup) (S n) z):Q) - with ((z O + (Sum0 (G:=Q_as_CAbGroup) n - (fun n0 : nat => (Str_nth n0 (tl seq))%Q)))). - rewrite <- (CRplus_Qplus (z O)). - unfold z, Str_nth. - simpl. - ring. -symmetry. -apply Sum0_shift. -intros i. -reflexivity. - -apply cg_minus_wd;[rewrite IR_Sum0_as_CR|reflexivity]. -clear - Hx. -induction n. -reflexivity. -change ((' (Sum0 (G:=Q_as_CAbGroup) n - (fun n0 : nat => (Str_nth n0 seq)%Q) + - (Str_nth n seq)) == - (Sum0 (G:=CRasCAbGroup) n (fun n0 : nat => IRasCR (x n0)):CR) + IRasCR (x n))%CR). -rewrite <- CRplus_Qplus. -apply ucFun2_wd;[apply IHn|]. -transitivity (IRasCR (inj_Q IR (Str_nth n seq)%Q)); - [symmetry;apply IR_inj_Q_as_CR|]. -apply IRasCR_wd. -apply Hx. + apply Hx. Qed. Lemma InfiniteGeometricSum_correct' : forall (series:Stream Q), forall (Gs:GeometricSeries series), (InfiniteGeometricSum Gs == IRasCR (series_sum _ (GeometricSeries_convergent Gs)))%CR. Proof. -intros series Gs. -apply InfiniteGeometricSum_correct. -intros; apply eq_reflexive. + intros series Gs. + apply InfiniteGeometricSum_correct. + intros; apply eq_reflexive. Qed. -End GeometricSeries. \ No newline at end of file +End GeometricSeries. diff --git a/reals/fast/CRGroupOps.v b/reals/fast/CRGroupOps.v index b18b75959..d142475d7 100644 --- a/reals/fast/CRGroupOps.v +++ b/reals/fast/CRGroupOps.v @@ -39,11 +39,11 @@ Lifting addition over [Q] by one parameter yields a rational translation function. *) Lemma Qtranslate_uc_prf (a:Q) : is_UniformlyContinuousFunction (fun b:QS => (a[+]b):QS) Qpos2QposInf. Proof. -intros a e b0 b1 H. -simpl in *. -unfold Qball in *. -stepr (b0-b1) by (simpl; ring). -assumption. + intros a e b0 b1 H. + simpl in *. + unfold Qball in *. + stepr (b0-b1) by (simpl; ring). + assumption. Qed. Definition Qtranslate_uc (a:Q_as_MetricSpace) : Q_as_MetricSpace --> Q_as_MetricSpace := @@ -53,27 +53,26 @@ Definition translate (a:Q) : CR --> CR := Cmap QPrelengthSpace (Qtranslate_uc a) Lemma translate_ident : forall x:CR, (translate 0 x==x)%CR. Proof. -intros x. -unfold translate. -assert (H:st_eq (Qtranslate_uc 0) (uc_id _)). -intros a. -simpl. -ring. - -simpl. -rewrite -> H. -rewrite Cmap_fun_correct. -apply: MonadLaw1. + intros x. + unfold translate. + assert (H:st_eq (Qtranslate_uc 0) (uc_id _)). + intros a. + simpl. + ring. + simpl. + rewrite -> H. + rewrite Cmap_fun_correct. + apply: MonadLaw1. Qed. (** Lifting translate yields binary addition over CR. *) Lemma Qplus_uc_prf : is_UniformlyContinuousFunction Qtranslate_uc Qpos2QposInf. Proof. -intros e a0 a1 H b. -simpl in *. -repeat rewrite (fun x => Qplus_comm x b). -apply Qtranslate_uc_prf. -assumption. + intros e a0 a1 H b. + simpl in *. + repeat rewrite (fun x => Qplus_comm x b). + apply Qtranslate_uc_prf. + assumption. Qed. Definition Qplus_uc : Q_as_MetricSpace --> Q_as_MetricSpace --> Q_as_MetricSpace := @@ -85,27 +84,27 @@ Notation "x + y" := (ucFun2 CRplus x y) : CR_scope. Lemma CRplus_translate : forall (a:Q) (y:CR), (' a + y == translate a y)%CR. Proof. -intros a y. -unfold ucFun2, CRplus. -unfold Cmap2. -unfold inject_Q. -simpl. -do 2 rewrite Cmap_fun_correct. -rewrite Cap_fun_correct. -rewrite MonadLaw3. -rewrite StrongMonadLaw1. -reflexivity. + intros a y. + unfold ucFun2, CRplus. + unfold Cmap2. + unfold inject_Q. + simpl. + do 2 rewrite Cmap_fun_correct. + rewrite Cap_fun_correct. + rewrite MonadLaw3. + rewrite StrongMonadLaw1. + reflexivity. Qed. Hint Rewrite CRplus_translate : CRfast_compute. Lemma translate_Qplus : forall a b:Q, (translate a ('b)=='(a+b)%Q)%CR. Proof. -intros a b. -unfold translate, Cmap. -simpl. -rewrite Cmap_fun_correct. -apply: MonadLaw3. + intros a b. + unfold translate, Cmap. + simpl. + rewrite Cmap_fun_correct. + apply: MonadLaw3. Qed. Hint Rewrite translate_Qplus : CRfast_compute. @@ -115,12 +114,12 @@ Lifting negation on [Q] yields negation on CR. *) Lemma Qopp_uc_prf : is_UniformlyContinuousFunction Qopp Qpos2QposInf. Proof. -intros e a b H. -simpl in *. -unfold Qball in *. -stepr (b - a) by (simpl;ring). -apply AbsSmall_minus. -assumption. + intros e a b H. + simpl in *. + unfold Qball in *. + stepr (b - a) by (simpl;ring). + apply AbsSmall_minus. + assumption. Qed. Definition Qopp_uc : Q_as_MetricSpace --> Q_as_MetricSpace := @@ -140,7 +139,7 @@ Notation "x - y" := (x + (- y))%CR : CR_scope. (* begin hide *) Add Morphism CRopp with signature (@st_eq _) ==> (@st_eq _) as CRopp_wd. Proof. -apply uc_wd. + apply uc_wd. Qed. (* end hide *) (** @@ -149,88 +148,88 @@ First a predicate for nonnegative numbers is defined. *) Definition CRnonNeg (x:CR) := forall e:Qpos, (-e) <= (approximate x e). (* begin hide *) Add Morphism CRnonNeg with signature (@st_eq _) ==> iff as CRnonNeg_wd. -assert (forall x1 x2 : RegularFunction Q_as_MetricSpace, -regFunEq x1 x2 -> CRnonNeg x1 -> CRnonNeg x2). -intros x y Hxy Hx e. -apply Qnot_lt_le. -intros He. -rewrite -> Qlt_minus_iff in He. -pose (e' := mkQpos He). -pose (H1:=(Hx ((1#3)*e')%Qpos)). -pose (H2:=(Hxy ((1#3)*e')%Qpos e)). -destruct H2 as [_ H2]. -simpl in H2. -rewrite -> Qle_minus_iff in H1. -rewrite -> Qle_minus_iff in H2. -autorewrite with QposElim in *. -ring_simplify in H1. -ring_simplify in H2. -assert (H3: 0+0<=(approximate x ((1 # 3) * e')%Qpos + (1 # 3) * e') + ((1 # 3) * e' + e + (-1 # 1) * approximate x ((1 # 3) * e')%Qpos + approximate y e)). -apply: plus_resp_leEq_both; assumption. -ring_simplify in H3. -setoid_replace ((6 # 9) * e' + e + approximate y e) with ((6#9)*e'-e') in H3. -ring_simplify in H3. -apply (Qle_not_lt _ _ H3). -rewrite Qlt_minus_iff. -ring_simplify. -apply: mult_resp_pos. -constructor. -apply Qpos_prf. -unfold e'. -rewrite QposAsmkQpos. -ring. - -intros. -split. -apply H; assumption. -apply H. -change (y==x)%CR. -symmetry. -assumption. +Proof. + assert (forall x1 x2 : RegularFunction Q_as_MetricSpace, + regFunEq x1 x2 -> CRnonNeg x1 -> CRnonNeg x2). + intros x y Hxy Hx e. + apply Qnot_lt_le. + intros He. + rewrite -> Qlt_minus_iff in He. + pose (e' := mkQpos He). + pose (H1:=(Hx ((1#3)*e')%Qpos)). + pose (H2:=(Hxy ((1#3)*e')%Qpos e)). + destruct H2 as [_ H2]. + simpl in H2. + rewrite -> Qle_minus_iff in H1. + rewrite -> Qle_minus_iff in H2. + autorewrite with QposElim in *. + ring_simplify in H1. + ring_simplify in H2. + assert (H3: 0+0<=(approximate x ((1 # 3) * e')%Qpos + (1 # 3) * e') + ((1 # 3) * e' + e + (-1 # 1) * approximate x ((1 # 3) * e')%Qpos + approximate y e)). + apply: plus_resp_leEq_both; assumption. + ring_simplify in H3. + setoid_replace ((6 # 9) * e' + e + approximate y e) with ((6#9)*e'-e') in H3. + ring_simplify in H3. + apply (Qle_not_lt _ _ H3). + rewrite Qlt_minus_iff. + ring_simplify. + apply: mult_resp_pos. + constructor. + apply Qpos_prf. + unfold e'. + rewrite QposAsmkQpos. + ring. + intros. + split. + apply H; assumption. + apply H. + change (y==x)%CR. + symmetry. + assumption. Qed. (* end hide *) (** And similarly for nonpositive. *) Definition CRnonPos (x:CR) := forall e:Qpos, (approximate x e) <= e. (* begin hide *) Add Morphism CRnonPos with signature (@st_eq _) ==> iff as CRnonPos_wd. -assert (forall x1 x2 : RegularFunction Q_as_MetricSpace, -regFunEq x1 x2 -> CRnonPos x1 -> CRnonPos x2). -intros x y Hxy Hx e. -apply Qnot_lt_le. -intros He. -rewrite -> Qlt_minus_iff in He. -pose (e' := mkQpos He). -pose (H1:=(Hx ((1#3)*e')%Qpos)). -pose (H2:=(Hxy ((1#3)*e')%Qpos e)). -destruct H2 as [H2 _]. -simpl in H2. -rewrite -> Qle_minus_iff in H1. -rewrite -> Qle_minus_iff in H2. -autorewrite with QposElim in *. -ring_simplify in H1. -ring_simplify in H2. -assert (H3: 0+0<=((1 # 3) * e' + (-1 # 1) * approximate x ((1 # 3) * e')%Qpos)+(approximate x ((1 # 3) * e')%Qpos + (-1 # 1) * approximate y e + (1 # 3) * e' + e)). -apply: plus_resp_leEq_both; assumption. -ring_simplify in H3. -setoid_replace ((6 # 9) * e' + (-1 # 1) * approximate y e + e) with ((6#9)*e'-e') in H3. -ring_simplify in H3. -apply (Qle_not_lt _ _ H3). -rewrite Qlt_minus_iff. -ring_simplify. -apply: mult_resp_pos. -constructor. -apply Qpos_prf. -unfold e'. -rewrite QposAsmkQpos. -ring. - -intros. -split. -apply H; assumption. -apply H. -change (y==x)%CR. -symmetry. -assumption. +Proof. + assert (forall x1 x2 : RegularFunction Q_as_MetricSpace, + regFunEq x1 x2 -> CRnonPos x1 -> CRnonPos x2). + intros x y Hxy Hx e. + apply Qnot_lt_le. + intros He. + rewrite -> Qlt_minus_iff in He. + pose (e' := mkQpos He). + pose (H1:=(Hx ((1#3)*e')%Qpos)). + pose (H2:=(Hxy ((1#3)*e')%Qpos e)). + destruct H2 as [H2 _]. + simpl in H2. + rewrite -> Qle_minus_iff in H1. + rewrite -> Qle_minus_iff in H2. + autorewrite with QposElim in *. + ring_simplify in H1. + ring_simplify in H2. + assert (H3: 0+0<=((1 # 3) * e' + (-1 # 1) * approximate x ((1 # 3) * e')%Qpos)+(approximate x ((1 # 3) * e')%Qpos + (-1 # 1) * approximate y e + (1 # 3) * e' + e)). + apply: plus_resp_leEq_both; assumption. + ring_simplify in H3. + setoid_replace ((6 # 9) * e' + (-1 # 1) * approximate y e + e) with ((6#9)*e'-e') in H3. + ring_simplify in H3. + apply (Qle_not_lt _ _ H3). + rewrite Qlt_minus_iff. + ring_simplify. + apply: mult_resp_pos. + constructor. + apply Qpos_prf. + unfold e'. + rewrite QposAsmkQpos. + ring. + intros. + split. + apply H; assumption. + apply H. + change (y==x)%CR. + symmetry. + assumption. Qed. (* end hide *) (** Inequality is defined in terms of nonnegativity. *) @@ -239,63 +238,63 @@ Definition CRle (x y:CR) := (CRnonNeg (y - x))%CR. Infix "<=" := CRle : CR_scope. (* begin hide *) Add Morphism CRle with signature (@st_eq _) ==> (@st_eq _) ==> iff as CRle_wd. -intros x1 x2 Hx y1 y2 Hy. -change (x1==x2)%CR in Hx. -change (y1==y2)%CR in Hy. -unfold CRle. -apply: CRnonNeg_wd. -apply ucFun2_wd. -assumption. -apply CRopp_wd. -assumption. +Proof. + intros x1 x2 Hx y1 y2 Hy. + change (x1==x2)%CR in Hx. + change (y1==y2)%CR in Hy. + unfold CRle. + apply: CRnonNeg_wd. + apply ucFun2_wd. + assumption. + apply CRopp_wd. + assumption. Qed. (* end hide *) (** Basic properties of inequality *) Lemma CRle_refl : forall x, (x <= x)%CR. Proof. -intros x e. -simpl. -unfold Cap_raw. -simpl. -rewrite Qle_minus_iff. -ring_simplify. -apply Qpos_nonneg. + intros x e. + simpl. + unfold Cap_raw. + simpl. + rewrite Qle_minus_iff. + ring_simplify. + apply Qpos_nonneg. Qed. Lemma CRle_def : forall x y, (x==y <-> (x <= y /\ y <= x))%CR. Proof. -intros x y. -split;[intros H;rewrite H;split; apply CRle_refl|]. -intros [H1 H2]. -rewrite <- (doubleSpeed_Eq x). -rewrite <- (doubleSpeed_Eq y). -apply: regFunEq_e. -intros e. -apply ball_weak. -split;[apply H2|]. -apply: inv_cancel_leEq;simpl. -replace RHS with (approximate y ((1 # 2) * e)%Qpos - approximate x ((1 # 2) * e)%Qpos) by ring. -apply H1. + intros x y. + split;[intros H;rewrite H;split; apply CRle_refl|]. + intros [H1 H2]. + rewrite <- (doubleSpeed_Eq x). + rewrite <- (doubleSpeed_Eq y). + apply: regFunEq_e. + intros e. + apply ball_weak. + split;[apply H2|]. + apply: inv_cancel_leEq;simpl. + replace RHS with (approximate y ((1 # 2) * e)%Qpos - approximate x ((1 # 2) * e)%Qpos) by ring. + apply H1. Qed. Lemma CRle_trans : forall x y z, (x <= y -> y <= z -> x <= z)%CR. Proof. -intros x y z H1 H2. -unfold CRle. -rewrite <- (doubleSpeed_Eq (z-x)%CR). -intros e. -assert (H1':=H1 ((1#2)*e)%Qpos). -assert (H2':=H2 ((1#2)*e)%Qpos). -clear H1 H2. -simpl in *. -unfold Cap_raw in *. -simpl in *. -replace RHS with ((approximate z ((1 # 2) * ((1 # 2) * e))%Qpos -- approximate y ((1 # 2) * ((1 # 2) * e))%Qpos -+ (approximate y ((1 # 2) * ((1 # 2) * e))%Qpos -- approximate x ((1 # 2) * ((1 # 2) * e))%Qpos))) by ring. -replace LHS with (-(1#2)*e + - (1#2)*e) by ring. -apply Qplus_le_compat;assumption. + intros x y z H1 H2. + unfold CRle. + rewrite <- (doubleSpeed_Eq (z-x)%CR). + intros e. + assert (H1':=H1 ((1#2)*e)%Qpos). + assert (H2':=H2 ((1#2)*e)%Qpos). + clear H1 H2. + simpl in *. + unfold Cap_raw in *. + simpl in *. + replace RHS with ((approximate z ((1 # 2) * ((1 # 2) * e))%Qpos + - approximate y ((1 # 2) * ((1 # 2) * e))%Qpos + (approximate y ((1 # 2) * ((1 # 2) * e))%Qpos + - approximate x ((1 # 2) * ((1 # 2) * e))%Qpos))) by ring. + replace LHS with (-(1#2)*e + - (1#2)*e) by ring. + apply Qplus_le_compat;assumption. Qed. (** @@ -305,37 +304,35 @@ rational number. It is the lifting of the first parameter of [Qmax]. *) Lemma QboundBelow_uc_prf (a:Q) : is_UniformlyContinuousFunction (fun b:QS => (Qmax a b):QS) Qpos2QposInf. Proof. -intros a e b0 b1 H. -simpl in *. -assert (X:forall a b0 b1, Qball e b0 b1 -> b0 <= a <= b1 -> Qball e a b1). -clear a b0 b1 H. -intros a b0 b1 H [H1 H2]. -unfold Qball in *. -unfold AbsSmall in *. -split. -apply Qle_trans with (b0-b1). -tauto. -apply (minus_resp_leEq _ b0). -assumption. -apply Qle_trans with 0. -apply (shift_minus_leEq _ a). -stepr b1. -assumption. -simpl; ring. -apply Qpos_nonneg. - -do 2 apply Qmax_case; -intros H1 H2. -apply: ball_refl. -eapply X. -apply H. -tauto. -apply: ball_sym. -apply X with b1. -apply: ball_sym. -apply H. -tauto. -assumption. + intros a e b0 b1 H. + simpl in *. + assert (X:forall a b0 b1, Qball e b0 b1 -> b0 <= a <= b1 -> Qball e a b1). + clear a b0 b1 H. + intros a b0 b1 H [H1 H2]. + unfold Qball in *. + unfold AbsSmall in *. + split. + apply Qle_trans with (b0-b1). + tauto. + apply (minus_resp_leEq _ b0). + assumption. + apply Qle_trans with 0. + apply (shift_minus_leEq _ a). + stepr b1. + assumption. + simpl; ring. + apply Qpos_nonneg. + do 2 apply Qmax_case; intros H1 H2. + apply: ball_refl. + eapply X. + apply H. + tauto. + apply: ball_sym. + apply X with b1. + apply: ball_sym. + apply H. + tauto. + assumption. Qed. Definition QboundBelow_uc (a:Q_as_MetricSpace) : Q_as_MetricSpace --> Q_as_MetricSpace := @@ -346,11 +343,11 @@ Definition boundBelow (a:Q) : CR --> CR := Cmap QPrelengthSpace (QboundBelow_uc (** CRmax is the lifting of [QboundBelow]. *) Lemma Qmax_uc_prf : is_UniformlyContinuousFunction QboundBelow_uc Qpos2QposInf. Proof. -intros e a0 a1 H b. -simpl in *. -repeat rewrite (fun x => Qmax_comm x b). -apply QboundBelow_uc_prf. -assumption. + intros e a0 a1 H b. + simpl in *. + repeat rewrite (fun x => Qmax_comm x b). + apply QboundBelow_uc_prf. + assumption. Qed. Definition Qmax_uc : Q_as_MetricSpace --> Q_as_MetricSpace --> Q_as_MetricSpace := @@ -360,93 +357,91 @@ Definition CRmax : CR --> CR --> CR := Cmap2 QPrelengthSpace QPrelengthSpace Qma Lemma CRmax_boundBelow : forall (a:Q) (y:CR), (CRmax (' a) y == boundBelow a y)%CR. Proof. -intros a y. -unfold ucFun2, CRmax. -unfold Cmap2. -unfold inject_Q. -simpl. -do 2 rewrite Cmap_fun_correct. -rewrite Cap_fun_correct. -rewrite MonadLaw3. -rewrite StrongMonadLaw1. -reflexivity. + intros a y. + unfold ucFun2, CRmax. + unfold Cmap2. + unfold inject_Q. + simpl. + do 2 rewrite Cmap_fun_correct. + rewrite Cap_fun_correct. + rewrite MonadLaw3. + rewrite StrongMonadLaw1. + reflexivity. Qed. (** Basic properties of CRmax. *) Lemma CRmax_ub_l : forall x y, (x <= CRmax x y)%CR. Proof. -intros x y e. -simpl. -unfold Cap_raw. -simpl. -unfold Cap_raw. -simpl. -rewrite Qmax_plus_distr_l. -eapply Qle_trans;[|apply Qmax_ub_l]. -cut (AbsSmall (e:Q) (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos + -- approximate x ((1 # 2) * e)%Qpos));[unfold AbsSmall;tauto|]. -change (ball e (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos) - (approximate x ((1 # 2) * e)%Qpos)). -eapply ball_weak_le;[|apply regFun_prf]. -autorewrite with QposElim. -rewrite Qle_minus_iff. -ring_simplify. -apply: mult_resp_nonneg. -discriminate. -apply Qpos_nonneg. + intros x y e. + simpl. + unfold Cap_raw. + simpl. + unfold Cap_raw. + simpl. + rewrite Qmax_plus_distr_l. + eapply Qle_trans;[|apply Qmax_ub_l]. + cut (AbsSmall (e:Q) (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos + + - approximate x ((1 # 2) * e)%Qpos));[unfold AbsSmall;tauto|]. + change (ball e (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos) (approximate x ((1 # 2) * e)%Qpos)). + eapply ball_weak_le;[|apply regFun_prf]. + autorewrite with QposElim. + rewrite Qle_minus_iff. + ring_simplify. + apply: mult_resp_nonneg. + discriminate. + apply Qpos_nonneg. Qed. Lemma CRmax_ub_r : forall x y, (y <= CRmax x y)%CR. Proof. -intros y x e. -simpl. -unfold Cap_raw. -simpl. -unfold Cap_raw. -simpl. -rewrite Qmax_plus_distr_l. -eapply Qle_trans;[|apply Qmax_ub_r]. -cut (AbsSmall (e:Q) (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos + -- approximate x ((1 # 2) * e)%Qpos));[unfold AbsSmall;tauto|]. -change (ball e (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos) - (approximate x ((1 # 2) * e)%Qpos)). -eapply ball_weak_le;[|apply regFun_prf]. -autorewrite with QposElim. -rewrite Qle_minus_iff. -ring_simplify. -apply: mult_resp_nonneg. -discriminate. -apply Qpos_nonneg. + intros y x e. + simpl. + unfold Cap_raw. + simpl. + unfold Cap_raw. + simpl. + rewrite Qmax_plus_distr_l. + eapply Qle_trans;[|apply Qmax_ub_r]. + cut (AbsSmall (e:Q) (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos + + - approximate x ((1 # 2) * e)%Qpos));[unfold AbsSmall;tauto|]. + change (ball e (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos) (approximate x ((1 # 2) * e)%Qpos)). + eapply ball_weak_le;[|apply regFun_prf]. + autorewrite with QposElim. + rewrite Qle_minus_iff. + ring_simplify. + apply: mult_resp_nonneg. + discriminate. + apply Qpos_nonneg. Qed. Lemma CRmax_lub: forall x y z : CR, (x <= z -> y <= z -> CRmax x y <= z)%CR. Proof. -intros x y z Hx Hy. -rewrite <- (doubleSpeed_Eq z) in * |- *. -intros e. -assert (Hx':=Hx ((1#2)*e)%Qpos). -assert (Hy':=Hy ((1#2)*e)%Qpos). -clear Hx Hy. -simpl in *. -unfold Cap_raw in *. -simpl in *. -unfold Cap_raw. -simpl. -replace LHS with ((-(1#2)*e) + (- (1#2)*e)) by ring. -replace RHS with ((approximate z ((1#2)*((1 # 2) * e))%Qpos + -- approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos) + -(approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos -- Qmax (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos) - (approximate y ((1 # 2) * ((1 # 2) * e))%Qpos))) by ring. -apply Qplus_le_compat;[|apply Qmax_case;intro;assumption]. -cut (ball ((1#2)*e)%Qpos (approximate z ((1#2)*((1 # 2) * e))%Qpos) -(approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos));[intros [A B]; assumption|]. -apply: ball_weak_le;[|apply regFun_prf]. -rewrite Qle_minus_iff. -autorewrite with QposElim. -ring_simplify. -apply: mult_resp_nonneg. -discriminate. -apply Qpos_nonneg. + intros x y z Hx Hy. + rewrite <- (doubleSpeed_Eq z) in * |- *. + intros e. + assert (Hx':=Hx ((1#2)*e)%Qpos). + assert (Hy':=Hy ((1#2)*e)%Qpos). + clear Hx Hy. + simpl in *. + unfold Cap_raw in *. + simpl in *. + unfold Cap_raw. + simpl. + replace LHS with ((-(1#2)*e) + (- (1#2)*e)) by ring. + replace RHS with ((approximate z ((1#2)*((1 # 2) * e))%Qpos + + - approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos) + + (approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos + - Qmax (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos) + (approximate y ((1 # 2) * ((1 # 2) * e))%Qpos))) by ring. + apply Qplus_le_compat;[|apply Qmax_case;intro;assumption]. + cut (ball ((1#2)*e)%Qpos (approximate z ((1#2)*((1 # 2) * e))%Qpos) + (approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos));[intros [A B]; assumption|]. + apply: ball_weak_le;[|apply regFun_prf]. + rewrite Qle_minus_iff. + autorewrite with QposElim. + ring_simplify. + apply: mult_resp_nonneg. + discriminate. + apply Qpos_nonneg. Qed. (** ** Minimum @@ -455,20 +450,20 @@ rational number. It is the lifting of the first parameter of [Qmin]. *) Lemma QboundAbove_uc_prf (a:Q) : is_UniformlyContinuousFunction (fun b:QS => (Qmin a b):QS) Qpos2QposInf. Proof. -intros a e b0 b1 H. -simpl in *. -unfold Qball. -stepr ((Qmax (- a) (-b1)) - (Qmax (-a) (-b0))). -apply QboundBelow_uc_prf. -apply Qopp_uc_prf. -apply ball_sym. -assumption. -unfold Qminus. -simpl. -rewrite Qmin_max_de_morgan. -rewrite Qmax_min_de_morgan. -repeat rewrite Qopp_involutive. -ring. + intros a e b0 b1 H. + simpl in *. + unfold Qball. + stepr ((Qmax (- a) (-b1)) - (Qmax (-a) (-b0))). + apply QboundBelow_uc_prf. + apply Qopp_uc_prf. + apply ball_sym. + assumption. + unfold Qminus. + simpl. + rewrite Qmin_max_de_morgan. + rewrite Qmax_min_de_morgan. + repeat rewrite Qopp_involutive. + ring. Qed. Definition QboundAbove_uc (a:Q_as_MetricSpace) : Q_as_MetricSpace --> Q_as_MetricSpace := @@ -479,11 +474,11 @@ Definition boundAbove (a:Q) : CR --> CR := Cmap QPrelengthSpace (QboundAbove_uc (** CRmin is the lifting of [QboundAbove]. *) Lemma Qmin_uc_prf : is_UniformlyContinuousFunction QboundAbove_uc Qpos2QposInf. Proof. -intros e a0 a1 H b. -simpl in *. -repeat rewrite (fun x => Qmin_comm x b). -apply QboundAbove_uc_prf. -assumption. + intros e a0 a1 H b. + simpl in *. + repeat rewrite (fun x => Qmin_comm x b). + apply QboundAbove_uc_prf. + assumption. Qed. Definition Qmin_uc : Q_as_MetricSpace --> Q_as_MetricSpace --> Q_as_MetricSpace := @@ -493,93 +488,91 @@ Definition CRmin : CR --> CR --> CR := Cmap2 QPrelengthSpace QPrelengthSpace Qmi Lemma CRmin_boundAbove : forall (a:Q) (y:CR), (CRmin (' a) y == boundAbove a y)%CR. Proof. -intros a y. -unfold ucFun2, CRmin. -unfold Cmap2. -unfold inject_Q. -simpl. -do 2 rewrite Cmap_fun_correct. -rewrite Cap_fun_correct. -rewrite MonadLaw3. -rewrite StrongMonadLaw1. -reflexivity. + intros a y. + unfold ucFun2, CRmin. + unfold Cmap2. + unfold inject_Q. + simpl. + do 2 rewrite Cmap_fun_correct. + rewrite Cap_fun_correct. + rewrite MonadLaw3. + rewrite StrongMonadLaw1. + reflexivity. Qed. (** Basic properties of CRmin. *) Lemma CRmin_lb_l : forall x y, (CRmin x y <= x)%CR. Proof. -intros x y e. -simpl. -unfold Cap_raw. -simpl. -unfold Cap_raw. -simpl. -rewrite Qmin_max_de_morgan. -rewrite Qmax_plus_distr_r. -eapply Qle_trans;[|apply Qmax_ub_l]. -cut (AbsSmall (e:Q) (approximate x ((1 # 2) * e)%Qpos + -- approximate x ((1 # 2) * ((1 # 2) * e))%Qpos));[unfold AbsSmall;tauto|]. -change (ball e (approximate x ((1 # 2) * e)%Qpos) (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos)). -eapply ball_weak_le;[|apply regFun_prf]. -autorewrite with QposElim. -rewrite Qle_minus_iff. -ring_simplify. -apply: mult_resp_nonneg. -discriminate. -apply Qpos_nonneg. + intros x y e. + simpl. + unfold Cap_raw. + simpl. + unfold Cap_raw. + simpl. + rewrite Qmin_max_de_morgan. + rewrite Qmax_plus_distr_r. + eapply Qle_trans;[|apply Qmax_ub_l]. + cut (AbsSmall (e:Q) (approximate x ((1 # 2) * e)%Qpos + + - approximate x ((1 # 2) * ((1 # 2) * e))%Qpos));[unfold AbsSmall;tauto|]. + change (ball e (approximate x ((1 # 2) * e)%Qpos) (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos)). + eapply ball_weak_le;[|apply regFun_prf]. + autorewrite with QposElim. + rewrite Qle_minus_iff. + ring_simplify. + apply: mult_resp_nonneg. + discriminate. + apply Qpos_nonneg. Qed. Lemma CRmin_lb_r : forall x y, (CRmin x y <= y)%CR. Proof. -intros y x e. -simpl. -unfold Cap_raw. -simpl. -unfold Cap_raw. -simpl. -rewrite Qmin_max_de_morgan. -rewrite Qmax_plus_distr_r. -eapply Qle_trans;[|apply Qmax_ub_r]. -cut (AbsSmall (e:Q) (approximate x ((1 # 2) * e)%Qpos + -- approximate x ((1 # 2) * ((1 # 2) * e))%Qpos));[unfold AbsSmall;tauto|]. -change (ball e (approximate x ((1 # 2) * e)%Qpos) - (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos)). -eapply ball_weak_le;[|apply regFun_prf]. -autorewrite with QposElim. -rewrite Qle_minus_iff. -ring_simplify. -apply: mult_resp_nonneg. -discriminate. -apply Qpos_nonneg. + intros y x e. + simpl. + unfold Cap_raw. + simpl. + unfold Cap_raw. + simpl. + rewrite Qmin_max_de_morgan. + rewrite Qmax_plus_distr_r. + eapply Qle_trans;[|apply Qmax_ub_r]. + cut (AbsSmall (e:Q) (approximate x ((1 # 2) * e)%Qpos + + - approximate x ((1 # 2) * ((1 # 2) * e))%Qpos));[unfold AbsSmall;tauto|]. + change (ball e (approximate x ((1 # 2) * e)%Qpos) (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos)). + eapply ball_weak_le;[|apply regFun_prf]. + autorewrite with QposElim. + rewrite Qle_minus_iff. + ring_simplify. + apply: mult_resp_nonneg. + discriminate. + apply Qpos_nonneg. Qed. Lemma CRmin_glb: forall x y z : CR, (z <= x -> z <= y -> z <= CRmin x y)%CR. Proof. -intros x y z Hx Hy. -rewrite <- (doubleSpeed_Eq z) in * |- *. -intros e. -assert (Hx':=Hx ((1#2)*e)%Qpos). -assert (Hy':=Hy ((1#2)*e)%Qpos). -clear Hx Hy. -simpl in *. -unfold Cap_raw in *. -simpl in *. -unfold Cap_raw. -simpl. -replace LHS with ((-(1#2)*e) + (- (1#2)*e)) by ring. -replace RHS with ((approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos + -- approximate z ((1#2)*((1 # 2) * e))%Qpos) + -(Qmin (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos) - (approximate y ((1 # 2) * ((1 # 2) * e))%Qpos) + -- approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos)) by ring. -apply Qplus_le_compat;[|apply Qmin_case;intro;assumption]. -cut (ball ((1#2)*e)%Qpos (approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos) -(approximate z ((1#2)*((1 # 2) * e))%Qpos));[intros [A B]; assumption|]. -apply: ball_weak_le;[|apply regFun_prf]. -rewrite Qle_minus_iff. -autorewrite with QposElim. -ring_simplify. -apply: mult_resp_nonneg. -discriminate. -apply Qpos_nonneg. + intros x y z Hx Hy. + rewrite <- (doubleSpeed_Eq z) in * |- *. + intros e. + assert (Hx':=Hx ((1#2)*e)%Qpos). + assert (Hy':=Hy ((1#2)*e)%Qpos). + clear Hx Hy. + simpl in *. + unfold Cap_raw in *. + simpl in *. + unfold Cap_raw. + simpl. + replace LHS with ((-(1#2)*e) + (- (1#2)*e)) by ring. + replace RHS with ((approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos + + - approximate z ((1#2)*((1 # 2) * e))%Qpos) + (Qmin (approximate x ((1 # 2) * ((1 # 2) * e))%Qpos) + (approximate y ((1 # 2) * ((1 # 2) * e))%Qpos) + + - approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos)) by ring. + apply Qplus_le_compat;[|apply Qmin_case;intro;assumption]. + cut (ball ((1#2)*e)%Qpos (approximate z ((1#2)*((1 # 2) * ((1 # 2) * e)))%Qpos) + (approximate z ((1#2)*((1 # 2) * e))%Qpos));[intros [A B]; assumption|]. + apply: ball_weak_le;[|apply regFun_prf]. + rewrite Qle_minus_iff. + autorewrite with QposElim. + ring_simplify. + apply: mult_resp_nonneg. + discriminate. + apply Qpos_nonneg. Qed. diff --git a/reals/fast/CRIR.v b/reals/fast/CRIR.v index 2f320281c..08a38ed3f 100644 --- a/reals/fast/CRIR.v +++ b/reals/fast/CRIR.v @@ -36,7 +36,7 @@ converting expressions over IR to expressions over CR. *) Lemma CRIR_iso : Isomorphism CRasCReals IR. Proof. -apply Canonic_Isomorphism_between_CReals. + apply Canonic_Isomorphism_between_CReals. Qed. Definition CRasIR : CR -> IR := iso_map_lft _ _ CRIR_iso. @@ -44,104 +44,102 @@ Definition IRasCR : IR -> CR := iso_map_rht _ _ CRIR_iso. Lemma CRasIRasCR_id : forall (x:CR), (IRasCR (CRasIR x)==x)%CR. Proof. -apply (inversity_rht _ _ CRIR_iso). + apply (inversity_rht _ _ CRIR_iso). Qed. Lemma IRasCRasIR_id : forall (x:IR), (CRasIR (IRasCR x)[=]x). Proof. -apply (inversity_lft _ _ CRIR_iso). + apply (inversity_lft _ _ CRIR_iso). Qed. Lemma IRasCR_wd : forall x y, x[=]y -> (IRasCR x == IRasCR y)%CR. Proof. -apply: map_wd_unfolded. + apply: map_wd_unfolded. Qed. Lemma IR_eq_as_CR : forall x y, x[=]y <-> (IRasCR x == IRasCR y)%CR. Proof. -split. -apply: map_wd_unfolded. -intros H. -stepl (CRasIR (IRasCR x)) by apply IRasCRasIR_id. -stepr (CRasIR (IRasCR y)) by apply IRasCRasIR_id. -apply map_wd_unfolded. -assumption. + split. + apply: map_wd_unfolded. + intros H. + stepl (CRasIR (IRasCR x)) by apply IRasCRasIR_id. + stepr (CRasIR (IRasCR y)) by apply IRasCRasIR_id. + apply map_wd_unfolded. + assumption. Qed. Lemma CRasIR_wd : forall x y, (x==y)%CR -> CRasIR x [=] CRasIR y. Proof. -apply: map_wd_unfolded. + apply: map_wd_unfolded. Qed. Lemma CR_less_as_IR : forall x y, (IRasCR x < IRasCR y -> x[<]y)%CR. Proof. -intros x y H. -stepl (CRasIR (IRasCR x)) by apply IRasCRasIR_id. -stepr (CRasIR (IRasCR y)) by apply IRasCRasIR_id. -apply map_pres_less. -assumption. + intros x y H. + stepl (CRasIR (IRasCR x)) by apply IRasCRasIR_id. + stepr (CRasIR (IRasCR y)) by apply IRasCRasIR_id. + apply map_pres_less. + assumption. Qed. Lemma CR_ap_as_IR : forall x y, (IRasCR x >< IRasCR y -> x[#]y)%CR. Proof. -intros. -stepl (CRasIR (IRasCR x)) by apply IRasCRasIR_id. -stepr (CRasIR (IRasCR y)) by apply IRasCRasIR_id. -apply map_pres_apartness. -assumption. + intros. + stepl (CRasIR (IRasCR x)) by apply IRasCRasIR_id. + stepr (CRasIR (IRasCR y)) by apply IRasCRasIR_id. + apply map_pres_apartness. + assumption. Qed. Lemma IR_leEq_as_CR : forall x y, x[<=]y <-> (IRasCR x <= IRasCR y)%CR. Proof. -intros x y. -split;[apply: f_pres_leEq|apply: leEq_pres_f]; -solve [ apply map_strext - |apply map_pres_less]. + intros x y. + split;[apply: f_pres_leEq|apply: leEq_pres_f]; solve [ apply map_strext |apply map_pres_less]. Qed. Lemma IR_Zero_as_CR : (IRasCR Zero=='0)%CR. Proof. -apply: map_pres_zero_unfolded. + apply: map_pres_zero_unfolded. Qed. Hint Rewrite IR_Zero_as_CR : IRtoCR. Lemma CR_ap_zero_as_IR : forall x, (IRasCR x >< '0 -> x[#]Zero)%CR. Proof. -intros. -apply CR_ap_as_IR. -generalize X. -apply CRapart_wd. - reflexivity. -symmetry. -apply IR_Zero_as_CR. + intros. + apply CR_ap_as_IR. + generalize X. + apply CRapart_wd. + reflexivity. + symmetry. + apply IR_Zero_as_CR. Qed. Lemma IR_plus_as_CR : forall x y, (IRasCR (x[+]y)== IRasCR x + IRasCR y)%CR. Proof. -apply: map_pres_plus. + apply: map_pres_plus. Qed. Hint Rewrite IR_plus_as_CR : IRtoCR. -Lemma IR_Sum0_as_CR : forall m x, +Lemma IR_Sum0_as_CR : forall m x, (IRasCR (Sum0 m x)==Sum0 m (fun n => IRasCR (x n)))%CR. Proof. -intros m x. -induction m. -apply IR_Zero_as_CR. -simpl in *. -set (a:=Sum0 (G:=CRasCAbGroup) m (fun n : nat => IRasCR (x n))) in *. -clearbody a. -rewrite <- IHm. -apply IR_plus_as_CR. + intros m x. + induction m. + apply IR_Zero_as_CR. + simpl in *. + set (a:=Sum0 (G:=CRasCAbGroup) m (fun n : nat => IRasCR (x n))) in *. + clearbody a. + rewrite <- IHm. + apply IR_plus_as_CR. Qed. Lemma IR_opp_as_CR : forall x, (IRasCR ([--]x)== - IRasCR x)%CR. Proof. -apply: map_pres_minus. + apply: map_pres_minus. Qed. Hint Rewrite IR_opp_as_CR : IRtoCR. @@ -149,218 +147,213 @@ Hint Rewrite IR_opp_as_CR : IRtoCR. Lemma IR_minus_as_CR : forall x y, (IRasCR (x[-]y)== IRasCR x - IRasCR y)%CR. Proof. -unfold cg_minus. -intros x y. -rewrite IR_plus_as_CR. -rewrite IR_opp_as_CR. -reflexivity. + unfold cg_minus. + intros x y. + rewrite IR_plus_as_CR. + rewrite IR_opp_as_CR. + reflexivity. Qed. Hint Rewrite IR_minus_as_CR : IRtoCR. Lemma IR_One_as_CR : (IRasCR One=='1)%CR. Proof. -apply: map_pres_one_unfolded. + apply: map_pres_one_unfolded. Qed. Hint Rewrite IR_One_as_CR : IRtoCR. -Lemma IR_mult_as_CR : forall x y, +Lemma IR_mult_as_CR : forall x y, (IRasCR (x[*]y)==(IRasCR x * IRasCR y))%CR. Proof. -apply: map_pres_mult. + apply: map_pres_mult. Qed. Hint Rewrite IR_mult_as_CR : IRtoCR. -Lemma IR_div_as_CR : forall x y y_ y__, +Lemma IR_div_as_CR : forall x y y_ y__, (IRasCR (x[/]y[//]y_)==(IRasCR x[/]IRasCR y[//]y__))%CR. Proof. -intros x y y_ y__. -apply: mult_cancel_lft. -apply (map_pres_ap_zero _ _ (iso_map_rht _ _ CRIR_iso) y y_). -change ((IRasCR y[*]IRasCR (x[/]y[//]y_):CR)==IRasCR y*((IRasCR x[/]IRasCR y[//]y__):CR))%CR. -rewrite <- IR_mult_as_CR. -transitivity (IRasCR x). -apply IRasCR_wd. -rational. -symmetry. -change (IRasCR y[*](IRasCR x[/]IRasCR y[//]y__)[=]IRasCR x). -apply: div_1'. + intros x y y_ y__. + apply: mult_cancel_lft. + apply (map_pres_ap_zero _ _ (iso_map_rht _ _ CRIR_iso) y y_). + change ((IRasCR y[*]IRasCR (x[/]y[//]y_):CR)==IRasCR y*((IRasCR x[/]IRasCR y[//]y__):CR))%CR. + rewrite <- IR_mult_as_CR. + transitivity (IRasCR x). + apply IRasCR_wd. + rational. + symmetry. + change (IRasCR y[*](IRasCR x[/]IRasCR y[//]y__)[=]IRasCR x). + apply: div_1'. Qed. Lemma IR_div_as_CR_1 :forall x y y_, (IRasCR (x[/]y[//]y_)==(IRasCR x[/]IRasCR y[//](map_pres_ap_zero _ _ (iso_map_rht _ _ CRIR_iso) y y_)))%CR. Proof. -intros; apply IR_div_as_CR. + intros; apply IR_div_as_CR. Qed. Lemma IR_div_as_CR_2 :forall x y y_, (IRasCR (x[/]y[//](CR_ap_zero_as_IR _ y_))==(IRasCR x[/]IRasCR y[//]y_))%CR. Proof. -intros; apply IR_div_as_CR. + intros; apply IR_div_as_CR. Qed. Lemma IR_recip_as_CR :forall y y_ y__, (IRasCR (One[/]y[//]y_)==(CRinv (IRasCR y) y__))%CR. Proof. -intros y y_ y__. -assert (X:=(IR_div_as_CR One y y_ y__)). -rewrite X. -change ((IRasCR One * CRinv (IRasCR y) y__) == (CRinv (IRasCR y) y__))%CR. -rewrite IR_One_as_CR. -change (('1 * CRinv (IRasCR y) y__ == CRinv (IRasCR y) y__)%CR). -ring. + intros y y_ y__. + assert (X:=(IR_div_as_CR One y y_ y__)). + rewrite X. + change ((IRasCR One * CRinv (IRasCR y) y__) == (CRinv (IRasCR y) y__))%CR. + rewrite IR_One_as_CR. + change (('1 * CRinv (IRasCR y) y__ == CRinv (IRasCR y) y__)%CR). + ring. Qed. Lemma IR_recip_as_CR_1 :forall y y_, (IRasCR (One[/]y[//]y_)==(CRinv (IRasCR y) (map_pres_ap_zero _ _ (iso_map_rht _ _ CRIR_iso) y y_)))%CR. Proof. -intros; apply IR_recip_as_CR. + intros; apply IR_recip_as_CR. Qed. Lemma IR_recip_as_CR_2 :forall y y_, (IRasCR (One[/]y[//](CR_ap_zero_as_IR _ y_))==(CRinv (IRasCR y) y_))%CR. Proof. -intros; apply IR_recip_as_CR. + intros; apply IR_recip_as_CR. Qed. -Lemma IR_nring_as_CR : forall n, +Lemma IR_nring_as_CR : forall n, (IRasCR (nring n)==ms_id (nring n))%CR. Proof. -unfold ms_id. -induction n. -apply IR_Zero_as_CR. -simpl in *. -set (a:= (nring (R:=CRasCRing) n)) in *. -clearbody a. -rewrite IR_plus_as_CR. -rewrite IHn. -rewrite IR_One_as_CR. -reflexivity. + unfold ms_id. + induction n. + apply IR_Zero_as_CR. + simpl in *. + set (a:= (nring (R:=CRasCRing) n)) in *. + clearbody a. + rewrite IR_plus_as_CR. + rewrite IHn. + rewrite IR_One_as_CR. + reflexivity. Qed. Hint Rewrite IR_nring_as_CR : IRtoCR. -Lemma IR_pring_as_CR : forall p, +Lemma IR_pring_as_CR : forall p, (IRasCR (pring _ p)==ms_id (pring _ p))%CR. Proof. -unfold ms_id, pring. -intros p. -cut (IRasCR One == One)%CR;[|apply IR_One_as_CR]. -generalize (One:IR). -generalize (One:CR). -induction p;intros a b Hab. - -simpl. -assert (IRasCR ((Zero[+]One[+]One)[*]b)== (Zero[+]One[+]One)[*]a)%CR. -simpl. -rewrite IR_mult_as_CR. -repeat rewrite IR_plus_as_CR. -repeat rewrite IR_One_as_CR. -simpl. -rewrite IR_Zero_as_CR. -simpl. -rewrite Hab. -reflexivity. -assert (X:= (IHp _ _ H)). -simpl in X. -set (c:=pring_aux CRasCRing p ((' 0 + ' 1 + ' 1) * a)%CR) in *. -clearbody c. -rewrite <- X. -rewrite IR_plus_as_CR. -rewrite Hab. -reflexivity. - -simpl. -assert (IRasCR ((Zero[+]One[+]One)[*]b)== (Zero[+]One[+]One)[*]a)%CR. -simpl. -rewrite IR_mult_as_CR. -repeat rewrite IR_plus_as_CR. -repeat rewrite IR_One_as_CR. -simpl. -rewrite IR_Zero_as_CR. -simpl. -rewrite Hab. -reflexivity. -apply (IHp _ _ H). - -simpl. -assumption. + unfold ms_id, pring. + intros p. + cut (IRasCR One == One)%CR;[|apply IR_One_as_CR]. + generalize (One:IR). + generalize (One:CR). + induction p;intros a b Hab. + simpl. + assert (IRasCR ((Zero[+]One[+]One)[*]b)== (Zero[+]One[+]One)[*]a)%CR. + simpl. + rewrite IR_mult_as_CR. + repeat rewrite IR_plus_as_CR. + repeat rewrite IR_One_as_CR. + simpl. + rewrite IR_Zero_as_CR. + simpl. + rewrite Hab. + reflexivity. + assert (X:= (IHp _ _ H)). + simpl in X. + set (c:=pring_aux CRasCRing p ((' 0 + ' 1 + ' 1) * a)%CR) in *. + clearbody c. + rewrite <- X. + rewrite IR_plus_as_CR. + rewrite Hab. + reflexivity. + simpl. + assert (IRasCR ((Zero[+]One[+]One)[*]b)== (Zero[+]One[+]One)[*]a)%CR. + simpl. + rewrite IR_mult_as_CR. + repeat rewrite IR_plus_as_CR. + repeat rewrite IR_One_as_CR. + simpl. + rewrite IR_Zero_as_CR. + simpl. + rewrite Hab. + reflexivity. + apply (IHp _ _ H). + simpl. + assumption. Qed. -Lemma IR_zring_as_CR : forall z, +Lemma IR_zring_as_CR : forall z, (IRasCR (zring z)==ms_id (zring z))%CR. Proof. -unfold ms_id. -intros [|p|p]. -apply IR_Zero_as_CR. -apply IR_pring_as_CR. -change ((IRasCR [--](pring IR p) == - ((pring CRasCRing p):CR))%CR). -rewrite IR_opp_as_CR. -apply CRopp_wd. -apply IR_pring_as_CR. + unfold ms_id. + intros [|p|p]. + apply IR_Zero_as_CR. + apply IR_pring_as_CR. + change ((IRasCR [--](pring IR p) == - ((pring CRasCRing p):CR))%CR). + rewrite IR_opp_as_CR. + apply CRopp_wd. + apply IR_pring_as_CR. Qed. Hint Rewrite IR_zring_as_CR : IRtoCR. Lemma IR_inj_Q_as_CR : forall (a:Q), (IRasCR (inj_Q IR a)==('a))%CR. Proof. -intros [n d]. -unfold inj_Q. -rewrite IR_div_as_CR_1. -generalize (map_pres_ap_zero IR CRasCReals (iso_map_rht CRasCReals IR CRIR_iso) (nring (R:=IR) (nat_of_P d)) - (den_is_nonzero IR (n # d)%Q)). -intros d_. -change ((((IRasCR (zring (R:=IR) n)[/]IRasCR (nring (R:=IR) (nat_of_P d))[//]d_):CR) == ' (n # d))%CR). -rewrite Qmake_Qdiv. -change ((((IRasCR (zring (R:=IR) n)[/]IRasCR (nring (R:=IR) (nat_of_P d))[//]d_):CR) == - ' ((n # 1) * / (d # 1)))%CR). -rewrite <- CRmult_Qmult. -assert (d__:('d><'0%Q)%CR). -apply Qap_CRap. -discriminate. -change ((((IRasCR (zring (R:=IR) n)[/]IRasCR (nring (R:=IR) (nat_of_P d))[//]d_):CR) == - ' (n # 1) * ' (/ (d # 1)))%CR). -rewrite <- (CRinv_Qinv d d__). -unfold cf_div. - -assert (X:(forall (n:positive), IRasCR (nring (R:=IR) (nat_of_P n)) == ' ('n)%Z)%CR). -intros x. -clear -x. -rewrite <- convert_is_POS. -induction (nat_of_P x); clear x. -apply IR_Zero_as_CR. -simpl. -rewrite IR_plus_as_CR. -rewrite IHn. -rewrite IR_One_as_CR. -simpl. -rewrite CRplus_Qplus. -rewrite CReq_Qeq. -unfold Qeq. -simpl. -rewrite Pmult_1_r. -rewrite <- POS_anti_convert. -ring_simplify. -symmetry. -rewrite Zplus_comm. -apply (inj_plus 1 n). - -apply: mult_wd;[|apply: f_rcpcl_wd;apply (X d)]. -destruct n as [|p|p];[apply IR_Zero_as_CR| |];simpl. -transitivity (IRasCR (nring (nat_of_P p))). -apply IRasCR_wd. -apply pring_convert. -apply (X p). -transitivity (IRasCR [--](nring (nat_of_P p))). -apply IRasCR_wd. -apply csf_wd_unfolded. -apply pring_convert. -rewrite IR_opp_as_CR. -rewrite X. -rewrite CRopp_Qopp. -reflexivity. + intros [n d]. + unfold inj_Q. + rewrite IR_div_as_CR_1. + generalize (map_pres_ap_zero IR CRasCReals (iso_map_rht CRasCReals IR CRIR_iso) (nring (R:=IR) (nat_of_P d)) + (den_is_nonzero IR (n # d)%Q)). + intros d_. + change ((((IRasCR (zring (R:=IR) n)[/]IRasCR (nring (R:=IR) (nat_of_P d))[//]d_):CR) == ' (n # d))%CR). + rewrite Qmake_Qdiv. + change ((((IRasCR (zring (R:=IR) n)[/]IRasCR (nring (R:=IR) (nat_of_P d))[//]d_):CR) == + ' ((n # 1) * / (d # 1)))%CR). + rewrite <- CRmult_Qmult. + assert (d__:('d><'0%Q)%CR). + apply Qap_CRap. + discriminate. + change ((((IRasCR (zring (R:=IR) n)[/]IRasCR (nring (R:=IR) (nat_of_P d))[//]d_):CR) == + ' (n # 1) * ' (/ (d # 1)))%CR). + rewrite <- (CRinv_Qinv d d__). + unfold cf_div. + assert (X:(forall (n:positive), IRasCR (nring (R:=IR) (nat_of_P n)) == ' ('n)%Z)%CR). + intros x. + clear -x. + rewrite <- convert_is_POS. + induction (nat_of_P x); clear x. + apply IR_Zero_as_CR. + simpl. + rewrite IR_plus_as_CR. + rewrite IHn. + rewrite IR_One_as_CR. + simpl. + rewrite CRplus_Qplus. + rewrite CReq_Qeq. + unfold Qeq. + simpl. + rewrite Pmult_1_r. + rewrite <- POS_anti_convert. + ring_simplify. + symmetry. + rewrite Zplus_comm. + apply (inj_plus 1 n). + apply: mult_wd;[|apply: f_rcpcl_wd;apply (X d)]. + destruct n as [|p|p];[apply IR_Zero_as_CR| |];simpl. + transitivity (IRasCR (nring (nat_of_P p))). + apply IRasCR_wd. + apply pring_convert. + apply (X p). + transitivity (IRasCR [--](nring (nat_of_P p))). + apply IRasCR_wd. + apply csf_wd_unfolded. + apply pring_convert. + rewrite IR_opp_as_CR. + rewrite X. + rewrite CRopp_Qopp. + reflexivity. Qed. Hint Rewrite IR_inj_Q_as_CR : IRtoCR. @@ -368,39 +361,39 @@ Hint Rewrite IR_inj_Q_as_CR : IRtoCR. Lemma IR_Cauchy_prop_as_CR : forall (x:CauchySeq IR), (Cauchy_prop (fun n => (IRasCR (x n)))). Proof. -intros x. -assert (X:=map_pres_Lim _ _ (iso_map_rht CRasCReals IR CRIR_iso) _ _ (Cauchy_complete x)). -intros e He. -destruct (X _ (pos_div_two _ _ He)) as [n Hn]. -exists n. -intros m Hm. -assert (A:=Hn m Hm). -assert (B:=Hn n (le_n n)). -set (a:=(IRasCR (x m))) in *. -set (b:=IRasCR (Lim (IR:=IR) x)) in *. -set (c:=IRasCR (x n)) in *. -rstepr ((a[-]b)[+](b[-]c)). -apply AbsSmall_eps_div_two. -assumption. -apply AbsSmall_minus. -assumption. + intros x. + assert (X:=map_pres_Lim _ _ (iso_map_rht CRasCReals IR CRIR_iso) _ _ (Cauchy_complete x)). + intros e He. + destruct (X _ (pos_div_two _ _ He)) as [n Hn]. + exists n. + intros m Hm. + assert (A:=Hn m Hm). + assert (B:=Hn n (le_n n)). + set (a:=(IRasCR (x m))) in *. + set (b:=IRasCR (Lim (IR:=IR) x)) in *. + set (c:=IRasCR (x n)) in *. + rstepr ((a[-]b)[+](b[-]c)). + apply AbsSmall_eps_div_two. + assumption. + apply AbsSmall_minus. + assumption. Qed. Lemma IR_Lim_as_CR : forall (x:CauchySeq IR), (IRasCR (Lim x)==Lim (Build_CauchySeq _ _ (IR_Cauchy_prop_as_CR x)))%CR. Proof. -intros x. -apply: SeqLimit_unique. -apply (map_pres_Lim _ _ (iso_map_rht CRasCReals IR CRIR_iso) _ _ (Cauchy_complete x)). + intros x. + apply: SeqLimit_unique. + apply (map_pres_Lim _ _ (iso_map_rht CRasCReals IR CRIR_iso) _ _ (Cauchy_complete x)). Qed. Lemma IR_AbsSmall_as_CR : forall (x y:IR), AbsSmall x y <-> AbsSmall (R:=CRasCOrdField) (IRasCR x) (IRasCR y). Proof. -unfold AbsSmall. -intros x y. -simpl. -do 2 rewrite IR_leEq_as_CR. -rewrite IR_opp_as_CR. -reflexivity. -Qed. \ No newline at end of file + unfold AbsSmall. + intros x y. + simpl. + do 2 rewrite IR_leEq_as_CR. + rewrite IR_opp_as_CR. + reflexivity. +Qed. diff --git a/reals/fast/CRabs.v b/reals/fast/CRabs.v index 368598bee..4e4c13f29 100644 --- a/reals/fast/CRabs.v +++ b/reals/fast/CRabs.v @@ -35,25 +35,25 @@ Open Local Scope Q_scope. Lemma Qabs_uc_prf : is_UniformlyContinuousFunction (Qabs:Q_as_MetricSpace -> Q_as_MetricSpace) Qpos2QposInf. Proof. -intros e a b Hab. -simpl in *. -unfold Qball in *. -rewrite <- AbsSmall_Qabs in *. -apply Qabs_case. + intros e a b Hab. + simpl in *. + unfold Qball in *. + rewrite <- AbsSmall_Qabs in *. + apply Qabs_case. + intros _. + eapply Qle_trans;[|apply Hab]. + apply Qabs_triangle_reverse. intros _. + replace LHS with (Qabs b - Qabs a) by ring. + setoid_replace (a - b) with (- (b - a)) in Hab by ring. + rewrite -> Qabs_opp in Hab. eapply Qle_trans;[|apply Hab]. apply Qabs_triangle_reverse. -intros _. -replace LHS with (Qabs b - Qabs a) by ring. -setoid_replace (a - b) with (- (b - a)) in Hab by ring. -rewrite -> Qabs_opp in Hab. -eapply Qle_trans;[|apply Hab]. -apply Qabs_triangle_reverse. Qed. Open Local Scope uc_scope. -Definition Qabs_uc : Q_as_MetricSpace --> Q_as_MetricSpace := +Definition Qabs_uc : Q_as_MetricSpace --> Q_as_MetricSpace := Build_UniformlyContinuousFunction Qabs_uc_prf. Definition CRabs : CR --> CR := Cmap QPrelengthSpace Qabs_uc. @@ -61,89 +61,89 @@ Definition CRabs : CR --> CR := Cmap QPrelengthSpace Qabs_uc. Lemma CRabs_correct : forall x, (IRasCR (AbsIR x) == CRabs (IRasCR x))%CR. Proof. -intros x. -apply stableEq. - apply Complete_stable. - apply stableQ. -generalize (leEq_or_leEq _ Zero x). -cut ((x[<=]Zero or Zero[<=]x) -> (IRasCR (AbsIR x) == CRabs (IRasCR x))%CR). - unfold Not. - tauto. -intros [H|H]. - transitivity (IRasCR ([--]x)). + intros x. + apply stableEq. + apply Complete_stable. + apply stableQ. + generalize (leEq_or_leEq _ Zero x). + cut ((x[<=]Zero or Zero[<=]x) -> (IRasCR (AbsIR x) == CRabs (IRasCR x))%CR). + unfold Not. + tauto. + intros [H|H]. + transitivity (IRasCR ([--]x)). + apply IRasCR_wd. + apply AbsIR_eq_inv_x; auto. + rewrite IR_opp_as_CR. + rewrite -> IR_leEq_as_CR in H. + rewrite -> IR_Zero_as_CR in H. + revert H. + generalize (IRasCR x). + intros m Hm. + rewrite -> CRle_min_r in Hm. + rewrite -> CRmin_boundAbove in Hm. + setoid_replace (CRabs m)%CR with (- (- (CRabs m)))%CR by ring. + apply CRopp_wd. + rewrite <- Hm. + apply: regFunEq_e. + intros e. + simpl. + rewrite Qabs_neg; auto with *. + rewrite Qopp_involutive. + apply: ball_refl. + transitivity (IRasCR x). apply IRasCR_wd. - apply AbsIR_eq_inv_x; auto. - rewrite IR_opp_as_CR. + apply AbsIR_eq_x; auto. rewrite -> IR_leEq_as_CR in H. rewrite -> IR_Zero_as_CR in H. revert H. generalize (IRasCR x). intros m Hm. - rewrite -> CRle_min_r in Hm. - rewrite -> CRmin_boundAbove in Hm. - setoid_replace (CRabs m)%CR with (- (- (CRabs m)))%CR by ring. - apply CRopp_wd. + rewrite -> CRle_max_r in Hm. + rewrite -> CRmax_boundBelow in Hm. rewrite <- Hm. apply: regFunEq_e. intros e. - simpl. - rewrite Qabs_neg; auto with *. - rewrite Qopp_involutive. + simpl. + rewrite Qabs_pos; auto with *. apply: ball_refl. -transitivity (IRasCR x). - apply IRasCR_wd. - apply AbsIR_eq_x; auto. -rewrite -> IR_leEq_as_CR in H. -rewrite -> IR_Zero_as_CR in H. -revert H. -generalize (IRasCR x). -intros m Hm. -rewrite -> CRle_max_r in Hm. -rewrite -> CRmax_boundBelow in Hm. -rewrite <- Hm. -apply: regFunEq_e. -intros e. -simpl. -rewrite Qabs_pos; auto with *. -apply: ball_refl. Qed. Lemma CRabs_AbsSmall : forall a b, (CRabs b[<=]a) <-> AbsSmall a b. Proof. -intros a b. -rewrite <- (CRasIRasCR_id a). -rewrite <- (CRasIRasCR_id b). -rewrite <- CRabs_correct. -rewrite <- IR_AbsSmall_as_CR. -rewrite <- IR_leEq_as_CR. -split. - apply AbsIR_imp_AbsSmall. -apply AbsSmall_imp_AbsIR. + intros a b. + rewrite <- (CRasIRasCR_id a). + rewrite <- (CRasIRasCR_id b). + rewrite <- CRabs_correct. + rewrite <- IR_AbsSmall_as_CR. + rewrite <- IR_leEq_as_CR. + split. + apply AbsIR_imp_AbsSmall. + apply AbsSmall_imp_AbsIR. Qed. Lemma CRabs_pos : forall x:CR, ('0 <= x -> CRabs x == x)%CR. Proof. -intros x. -rewrite <- (CRasIRasCR_id x). -rewrite <- CRabs_correct. -intros H. -apply IRasCR_wd. -apply AbsIR_eq_x. -rewrite IR_leEq_as_CR. -rewrite IR_Zero_as_CR. -auto. + intros x. + rewrite <- (CRasIRasCR_id x). + rewrite <- CRabs_correct. + intros H. + apply IRasCR_wd. + apply AbsIR_eq_x. + rewrite IR_leEq_as_CR. + rewrite IR_Zero_as_CR. + auto. Qed. Lemma CRabs_neg: forall x, (x <= '0 -> CRabs x == - x)%CR. Proof. -intros x. -rewrite <- (CRasIRasCR_id x). -rewrite <- CRabs_correct. -intros H. -rewrite <- IR_opp_as_CR. -apply IRasCR_wd. -apply AbsIR_eq_inv_x. -rewrite IR_leEq_as_CR. -rewrite IR_Zero_as_CR. -auto. + intros x. + rewrite <- (CRasIRasCR_id x). + rewrite <- CRabs_correct. + intros H. + rewrite <- IR_opp_as_CR. + apply IRasCR_wd. + apply AbsIR_eq_inv_x. + rewrite IR_leEq_as_CR. + rewrite IR_Zero_as_CR. + auto. Qed. diff --git a/reals/fast/CRarctan.v b/reals/fast/CRarctan.v index f5bcd5c26..3b5558ead 100644 --- a/reals/fast/CRarctan.v +++ b/reals/fast/CRarctan.v @@ -42,314 +42,281 @@ Using pi and properties of arctangent, we define arctangent from 1 to infinity. *) Definition rational_arctan_big_pos (a:Q) (Ha:1 <= a) : CR. -intros a Ha. -refine ((r_pi (1#2)) -(@rational_arctan_small_pos (/a) _))%CR. -split. - abstract ( - apply Qinv_le_0_compat; - apply Qle_trans with 1; - [discriminate|assumption]). -abstract ( -assert (H:0 (rational_arctan_big_pos Ha == IRasCR (ArcTan (inj_Q IR a)))%CR. Proof. -intros a Ha H. -unfold rational_arctan_big_pos. -assert (H0:0 Zmult_1_r in Ha; -assert (H:~(n+d)%Z==0);[ - intros H0; - apply (Zle_not_lt _ _ Ha); - unfold Qeq in H0; - simpl in H0; - rewrite <- H0; - apply Zlt_0_minus_lt; - ring_simplify; - auto with *|]; -change (-(1) <= ((inject_Z (n-d)%Z)[/]_[//]H) <= 1); -split; [apply: shift_leEq_div;simpl | apply: shift_div_leEq';simpl];try - (unfold Qlt; simpl; auto with *); - rewrite Qle_minus_iff; - try change (0 <= (n + d)%Z * 1 + (- (n - d))%Z); - ring_simplify; - unfold Qle; simpl; - ring_simplify; - auto with *. + intros [n d] Ha. + refine (r_pi (1#4) + (@rational_arctan_small ((n-d)%Z/(n+d)%Z) _))%CR. + unfold Qle in Ha; simpl in Ha; rewrite -> Zmult_1_r in Ha; assert (H:~(n+d)%Z==0);[ intros H0; + apply (Zle_not_lt _ _ Ha); unfold Qeq in H0; simpl in H0; rewrite <- H0; apply Zlt_0_minus_lt; + ring_simplify; auto with *|]; change (-(1) <= ((inject_Z (n-d)%Z)[/]_[//]H) <= 1); + split; [apply: shift_leEq_div;simpl | apply: shift_div_leEq';simpl];try + (unfold Qlt; simpl; auto with *); rewrite Qle_minus_iff; + try change (0 <= (n + d)%Z * 1 + (- (n - d))%Z); ring_simplify; unfold Qle; simpl; + ring_simplify; auto with *. Defined. Lemma rational_arctan_mid_pos_correct : forall a (Ha: 0 <= a), 0 < a -> (rational_arctan_mid_pos Ha == IRasCR (ArcTan (inj_Q IR a)))%CR. Proof. -intros [[|n|n] d] Ha H; - try solve [elim (Qlt_not_le _ _ H); unfold Qle; auto with *]. -unfold rational_arctan_mid_pos. -assert (X:(n - d)%Z / (n + d)%Z < 1). - assert ((n-d) < (n+d))%Z. - apply Zlt_0_minus_lt. + intros [[|n|n] d] Ha H; try solve [elim (Qlt_not_le _ _ H); unfold Qle; auto with *]. + unfold rational_arctan_mid_pos. + assert (X:(n - d)%Z / (n + d)%Z < 1). + assert ((n-d) < (n+d))%Z. + apply Zlt_0_minus_lt. + ring_simplify. + auto with *. + generalize (n - d)%Z H0. + intros z Hz. + unfold Qlt. + simpl. ring_simplify. auto with *. - generalize (n - d)%Z H0. - intros z Hz. - unfold Qlt. - simpl. - ring_simplify. - auto with *. -assert (X0:- (1) < (n - d)%Z / (n + d)%Z). - assert ((d-n) < (n+d))%Z. - apply Zlt_0_minus_lt. - ring_simplify. + assert (X0:- (1) < (n - d)%Z / (n + d)%Z). + assert ((d-n) < (n+d))%Z. + apply Zlt_0_minus_lt. + ring_simplify. + auto with *. + replace (n-d)%Z with (-(d-n))%Z by ring. + generalize (d - n)%Z H0. + intros z Hz. + unfold Qlt. + simpl. + change (Zneg (n+d))%Z with (-(n+d))%Z. auto with *. - replace (n-d)%Z with (-(d-n))%Z by ring. - generalize (d - n)%Z H0. - intros z Hz. - unfold Qlt. - simpl. - change (Zneg (n+d))%Z with (-(n+d))%Z. - auto with *. -rewrite rational_arctan_small_correct; - try assumption. -rewrite r_pi_correct. -rewrite <- IR_plus_as_CR. -apply IRasCR_wd. -stepl (Pi[/]FourNZ[+]ArcTan (inj_Q IR ((n - d)%Z / (n + d)%Z))). - csetoid_rewrite_rev (ArcTan_one). - set (y:= (inj_Q IR ((n - d)%Z / (n + d)%Z))). - assert (Y:Zero[<]One[-]One[*]y). - apply shift_zero_less_minus. - rstepl y. - rstepr (nring 1:IR). - stepr (inj_Q IR 1) by apply (inj_Q_nring IR 1). - apply inj_Q_less. - assumption. - apply eq_transitive with (ArcTan (One[+]y[/]_[//](Greater_imp_ap _ _ _ Y))). - apply ArcTan_plus_ArcTan. - apply shift_zero_leEq_minus'. - rstepr (Two:IR). - apply nring_nonneg. - apply leEq_reflexive. - rstepl ([--](nring 1:IR)). - stepl (inj_Q IR ([--](1))). - apply inj_Q_leEq. - apply less_leEq; assumption. - csetoid_rewrite_rev (inj_Q_nring IR 1). - apply inj_Q_inv. - rstepr (nring 1:IR). - stepr (inj_Q IR 1) by apply (inj_Q_nring IR 1). - apply inj_Q_leEq. - apply less_leEq; assumption. - apply ArcTan_wd. - apply mult_cancel_lft with (One[-]One[*]y). - apply Greater_imp_ap; assumption. - rstepl (One[+]y). - rstepr (inj_Q IR (n # d)[-]y[*]inj_Q IR (n # d)). - csetoid_replace (One:IR) (inj_Q IR 1). - unfold y. - set (y' := ((n - d)%Z / (n + d)%Z)). - unfold cg_minus. - csetoid_rewrite_rev (inj_Q_mult IR y' (n#d)). - eapply eq_transitive. - apply eq_symmetric; apply inj_Q_plus. - apply eq_transitive with (inj_Q IR ((n # d)[+][--](y'[*](n # d))));[| - apply inj_Q_minus]. + rewrite rational_arctan_small_correct; try assumption. + rewrite r_pi_correct. + rewrite <- IR_plus_as_CR. + apply IRasCR_wd. + stepl (Pi[/]FourNZ[+]ArcTan (inj_Q IR ((n - d)%Z / (n + d)%Z))). + csetoid_rewrite_rev (ArcTan_one). + set (y:= (inj_Q IR ((n - d)%Z / (n + d)%Z))). + assert (Y:Zero[<]One[-]One[*]y). + apply shift_zero_less_minus. + rstepl y. + rstepr (nring 1:IR). + stepr (inj_Q IR 1) by apply (inj_Q_nring IR 1). + apply inj_Q_less. + assumption. + apply eq_transitive with (ArcTan (One[+]y[/]_[//](Greater_imp_ap _ _ _ Y))). + apply ArcTan_plus_ArcTan. + apply shift_zero_leEq_minus'. + rstepr (Two:IR). + apply nring_nonneg. + apply leEq_reflexive. + rstepl ([--](nring 1:IR)). + stepl (inj_Q IR ([--](1))). + apply inj_Q_leEq. + apply less_leEq; assumption. + csetoid_rewrite_rev (inj_Q_nring IR 1). + apply inj_Q_inv. + rstepr (nring 1:IR). + stepr (inj_Q IR 1) by apply (inj_Q_nring IR 1). + apply inj_Q_leEq. + apply less_leEq; assumption. + apply ArcTan_wd. + apply mult_cancel_lft with (One[-]One[*]y). + apply Greater_imp_ap; assumption. + rstepl (One[+]y). + rstepr (inj_Q IR (n # d)[-]y[*]inj_Q IR (n # d)). + csetoid_replace (One:IR) (inj_Q IR 1). + unfold y. + set (y' := ((n - d)%Z / (n + d)%Z)). + unfold cg_minus. + csetoid_rewrite_rev (inj_Q_mult IR y' (n#d)). + eapply eq_transitive. + apply eq_symmetric; apply inj_Q_plus. + apply eq_transitive with (inj_Q IR ((n # d)[+][--](y'[*](n # d))));[| apply inj_Q_minus]. + apply inj_Q_wd. + simpl. + rewrite (Qmake_Qdiv n d). + unfold y'. + unfold Zminus. + repeat rewrite injz_plus. + change (inject_Z (- d)) with (- (inject_Z d)). + field. + split; unfold Qeq; simpl; auto with *. + rstepl (nring 1:IR). + apply eq_symmetric; apply (inj_Q_nring IR 1). + apply bin_op_wd_unfolded;[|apply eq_reflexive]. + apply mult_cancel_lft with Four. + apply four_ap_zero. + rstepl ((nring 1:IR)[*]Pi). + rstepr ((Four[*]inj_Q IR (1 # 4))[*]Pi). + apply mult_wdl. + stepl (inj_Q IR 1) by apply (inj_Q_nring IR 1). + stepr (inj_Q IR (4*(1#4))). apply inj_Q_wd. - simpl. - rewrite (Qmake_Qdiv n d). - unfold y'. - unfold Zminus. - repeat rewrite injz_plus. - change (inject_Z (- d)) with (- (inject_Z d)). - field. - split; unfold Qeq; simpl; auto with *. - rstepl (nring 1:IR). - apply eq_symmetric; apply (inj_Q_nring IR 1). -apply bin_op_wd_unfolded;[|apply eq_reflexive]. -apply mult_cancel_lft with Four. - apply four_ap_zero. -rstepl ((nring 1:IR)[*]Pi). -rstepr ((Four[*]inj_Q IR (1 # 4))[*]Pi). -apply mult_wdl. -stepl (inj_Q IR 1) by apply (inj_Q_nring IR 1). -stepr (inj_Q IR (4*(1#4))). - apply inj_Q_wd. - simpl. - ring. -eapply eq_transitive. - apply inj_Q_mult. -apply mult_wdl. -apply (inj_Q_nring IR 4). + simpl. + ring. + eapply eq_transitive. + apply inj_Q_mult. + apply mult_wdl. + apply (inj_Q_nring IR 4). Qed. (** We glue all of are different methods of computing arctangent into a nice fast one that works for nonnegative numbers. *) Definition rational_arctan_pos (a:Q) (Ha:0 <= a) : CR. -intros a. -destruct (Qle_total (2#5) a) as [A|A]. - destruct (Qle_total (5#2) a) as [B|_]; intros _. - apply (@rational_arctan_big_pos a). - abstract (eapply Qle_trans;[|apply B];discriminate). - apply (@rational_arctan_mid_pos a). - abstract (eapply Qle_trans;[|apply A];discriminate). -intros H. -apply (@rational_arctan_small_pos a). -abstract ( -split;[assumption| - abstract (eapply Qle_trans;[apply A|discriminate])]). +Proof. + intros a. + destruct (Qle_total (2#5) a) as [A|A]. + destruct (Qle_total (5#2) a) as [B|_]; intros _. + apply (@rational_arctan_big_pos a). + abstract (eapply Qle_trans;[|apply B];discriminate). + apply (@rational_arctan_mid_pos a). + abstract (eapply Qle_trans;[|apply A];discriminate). + intros H. + apply (@rational_arctan_small_pos a). + abstract ( split;[assumption| abstract (eapply Qle_trans;[apply A|discriminate])]). Defined. Lemma rational_arctan_pos_correct : forall a (Ha: 0 <= a), (rational_arctan_pos Ha == IRasCR (ArcTan (inj_Q IR a)))%CR. Proof. -intros a Ha. -unfold rational_arctan_pos. -destruct (Qle_total (2 # 5) a). - destruct (Qle_total (5 # 2) a). - apply rational_arctan_big_pos_correct. - apply Qlt_le_trans with (5#2); - [constructor|assumption]. - apply rational_arctan_mid_pos_correct. - apply Qlt_le_trans with (2#5); - [constructor|assumption]. -apply rational_arctan_small_pos_correct. -apply Qle_lt_trans with (2#5); - [assumption|constructor]. + intros a Ha. + unfold rational_arctan_pos. + destruct (Qle_total (2 # 5) a). + destruct (Qle_total (5 # 2) a). + apply rational_arctan_big_pos_correct. + apply Qlt_le_trans with (5#2); [constructor|assumption]. + apply rational_arctan_mid_pos_correct. + apply Qlt_le_trans with (2#5); [constructor|assumption]. + apply rational_arctan_small_pos_correct. + apply Qle_lt_trans with (2#5); [assumption|constructor]. Qed. (** By symmetry we get arctangent for all numbers. *) Definition rational_arctan (a:Q) : CR. -intros a. -destruct (Qle_total a 0) as [H|H]. - refine (-(@rational_arctan_pos (-a)%Q _))%CR. - abstract ( - change (-0 <= -a); - apply: (inv_resp_leEq); - assumption). -apply (rational_arctan_pos H). +Proof. + intros a. + destruct (Qle_total a 0) as [H|H]. + refine (-(@rational_arctan_pos (-a)%Q _))%CR. + abstract ( change (-0 <= -a); apply: (inv_resp_leEq); assumption). + apply (rational_arctan_pos H). Defined. Lemma rational_arctan_correct : forall (a:Q), (rational_arctan a == IRasCR (ArcTan (inj_Q IR a)))%CR. Proof. -intros a. -unfold rational_arctan. -destruct (Qle_total a 0); - rewrite rational_arctan_pos_correct; try reflexivity. -rewrite <- IR_opp_as_CR. -apply IRasCR_wd. -csetoid_rewrite_rev (ArcTan_inv (inj_Q IR (-a))). -apply ArcTan_wd. -eapply eq_transitive. - apply eq_symmetric; apply (inj_Q_inv IR (-a)). -apply inj_Q_wd. -simpl. -ring. + intros a. + unfold rational_arctan. + destruct (Qle_total a 0); rewrite rational_arctan_pos_correct; try reflexivity. + rewrite <- IR_opp_as_CR. + apply IRasCR_wd. + csetoid_rewrite_rev (ArcTan_inv (inj_Q IR (-a))). + apply ArcTan_wd. + eapply eq_transitive. + apply eq_symmetric; apply (inj_Q_inv IR (-a)). + apply inj_Q_wd. + simpl. + ring. Qed. (** Lift arctangent on the rationals to the reals. *) Lemma arctan_uc_prf : is_UniformlyContinuousFunction rational_arctan Qpos2QposInf. Proof. -apply (is_UniformlyContinuousFunction_wd) with rational_arctan (Qscale_modulus (1#1)). - reflexivity. - intros x. - simpl. - autorewrite with QposElim. - change (/1) with 1. - replace RHS with (x:Q) by ring. - apply Qle_refl. -apply (is_UniformlyContinuousD None None I _ _ (Derivative_ArcTan CI) rational_arctan). - intros q [] _. - apply rational_arctan_correct. -intros x Hx _. -assert (X:Zero[<]One[+]One[*]x[*]x). - apply plus_resp_pos_nonneg. - apply pos_one. - rstepr (x[^]2). - apply sqr_nonneg. -stepr (One:IR). - simpl. - apply AbsSmall_imp_AbsIR. - apply leEq_imp_AbsSmall. - apply shift_leEq_div. + apply (is_UniformlyContinuousFunction_wd) with rational_arctan (Qscale_modulus (1#1)). + reflexivity. + intros x. + simpl. + autorewrite with QposElim. + change (/1) with 1. + replace RHS with (x:Q) by ring. + apply Qle_refl. + apply (is_UniformlyContinuousD None None I _ _ (Derivative_ArcTan CI) rational_arctan). + intros q [] _. + apply rational_arctan_correct. + intros x Hx _. + assert (X:Zero[<]One[+]One[*]x[*]x). + apply plus_resp_pos_nonneg. + apply pos_one. + rstepr (x[^]2). + apply sqr_nonneg. + stepr (One:IR). + simpl. + apply AbsSmall_imp_AbsIR. + apply leEq_imp_AbsSmall. + apply shift_leEq_div. + assumption. + rstepl (Zero:IR). + apply less_leEq; apply pos_one. + apply shift_div_leEq. assumption. + rstepr (One[+]x[^]2). + apply shift_leEq_plus'. rstepl (Zero:IR). - apply less_leEq; apply pos_one. - apply shift_div_leEq. - assumption. - rstepr (One[+]x[^]2). - apply shift_leEq_plus'. - rstepl (Zero:IR). - apply sqr_nonneg. -rstepl (nring 1:IR). -apply eq_symmetric; apply (inj_Q_nring IR 1). + apply sqr_nonneg. + rstepl (nring 1:IR). + apply eq_symmetric; apply (inj_Q_nring IR 1). Qed. -Definition arctan_uc : Q_as_MetricSpace --> CR := +Definition arctan_uc : Q_as_MetricSpace --> CR := Build_UniformlyContinuousFunction arctan_uc_prf. Definition arctan : CR --> CR := Cbind QPrelengthSpace arctan_uc. @@ -357,25 +324,24 @@ Definition arctan : CR --> CR := Cbind QPrelengthSpace arctan_uc. Lemma arctan_correct : forall x, (IRasCR (ArcTan x) == arctan (IRasCR x))%CR. Proof. -intros x. -apply (ContinuousCorrect (CI:proper realline)); - [apply Continuous_ArcTan | | constructor]. -intros q [] _. -transitivity (rational_arctan q);[|apply rational_arctan_correct]. -unfold arctan. -rewrite (Cbind_correct QPrelengthSpace arctan_uc (' q))%CR. -apply: BindLaw1. + intros x. + apply (ContinuousCorrect (CI:proper realline)); [apply Continuous_ArcTan | | constructor]. + intros q [] _. + transitivity (rational_arctan q);[|apply rational_arctan_correct]. + unfold arctan. + rewrite (Cbind_correct QPrelengthSpace arctan_uc (' q))%CR. + apply: BindLaw1. Qed. (* begin hide *) Hint Rewrite arctan_correct : IRtoCR. (* end hide *) Lemma arctan_Qarctan : forall x : Q, (arctan (' x) == rational_arctan x)%CR. Proof. -intros x. -unfold arctan. -rewrite (Cbind_correct QPrelengthSpace arctan_uc (' x))%CR. -apply: BindLaw1. + intros x. + unfold arctan. + rewrite (Cbind_correct QPrelengthSpace arctan_uc (' x))%CR. + apply: BindLaw1. Qed. (* begin hide *) Hint Rewrite arctan_Qarctan : CRfast_compute. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/reals/fast/CRarctan_small.v b/reals/fast/CRarctan_small.v index 0308c61b4..50ec19124 100644 --- a/reals/fast/CRarctan_small.v +++ b/reals/fast/CRarctan_small.v @@ -50,168 +50,154 @@ Definition arctanSequence := (mult_Streams (everyOther recip_positives) (powers_ Lemma Str_nth_arctanSequence : forall n, (Str_nth n arctanSequence == (1#P_of_succ_nat (2*n))*a^(1+2*n)%nat)%Q. Proof. -intros n. -unfold arctanSequence. -unfold mult_Streams. -rewrite Str_nth_zipWith. -rewrite Str_nth_everyOther. -rewrite Str_nth_recip_positives. -rewrite Str_nth_powers_help. -rewrite <- Qpower_mult. -rewrite inj_plus. -rewrite (Qpower_plus' a 1 (2*n)%nat); - auto with *. -rewrite inj_mult. -reflexivity. + intros n. + unfold arctanSequence. + unfold mult_Streams. + rewrite Str_nth_zipWith. + rewrite Str_nth_everyOther. + rewrite Str_nth_recip_positives. + rewrite Str_nth_powers_help. + rewrite <- Qpower_mult. + rewrite inj_plus. + rewrite (Qpower_plus' a 1 (2*n)%nat); auto with *. + rewrite inj_mult. + reflexivity. Qed. Hypothesis Ha: 0 <= a <= 1. Lemma square_zero_one : 0 <= a^2 <= 1. Proof. -split. - replace RHS with ((1*a)*a) by ring. - apply (sqr_nonneg _ a). -rewrite Qle_minus_iff. -replace RHS with ((1-a)*(1+a)) by ring. -destruct Ha as [Ha0 Ha1]. -apply: mult_resp_nonneg; - [unfold Qminus|replace RHS with (a + - (-(1))) by ring]; - rewrite <- Qle_minus_iff; - try assumption. -apply Qle_trans with 0. - discriminate. -assumption. + split. + replace RHS with ((1*a)*a) by ring. + apply (sqr_nonneg _ a). + rewrite Qle_minus_iff. + replace RHS with ((1-a)*(1+a)) by ring. + destruct Ha as [Ha0 Ha1]. + apply: mult_resp_nonneg; [unfold Qminus|replace RHS with (a + - (-(1))) by ring]; + rewrite <- Qle_minus_iff; try assumption. + apply Qle_trans with 0. + discriminate. + assumption. Qed. Lemma arctanSequence_dnn : DecreasingNonNegative arctanSequence. Proof. -apply mult_Streams_dnn. - apply everyOther_dnn. - apply recip_positives_dnn. -apply powers_help_dnn. - apply square_zero_one; assumption. -destruct Ha; assumption. + apply mult_Streams_dnn. + apply everyOther_dnn. + apply recip_positives_dnn. + apply powers_help_dnn. + apply square_zero_one; assumption. + destruct Ha; assumption. Qed. Lemma arctanSequence_zl : Limit arctanSequence 0. Proof. -unfold arctanSequence. -apply mult_Streams_zl with (1#1)%Qpos. - apply everyOther_zl. - apply recip_positives_zl. -abstract (apply powers_help_nbz; try - apply square_zero_one; assumption). + unfold arctanSequence. + apply mult_Streams_zl with (1#1)%Qpos. + apply everyOther_zl. + apply recip_positives_zl. + abstract (apply powers_help_nbz; try apply square_zero_one; assumption). Defined. End ArcTanSeries. -Definition rational_arctan_small_pos (a:Q) (p: 0 <= a <= 1) : CR := +Definition rational_arctan_small_pos (a:Q) (p: 0 <= a <= 1) : CR := InfiniteAlternatingSum (arctanSequence_dnn p) (arctanSequence_zl p). Lemma rational_arctan_small_pos_correct : forall (a:Q) Ha, a < 1 -> (@rational_arctan_small_pos a Ha == IRasCR (ArcTan (inj_Q IR a)))%CR. Proof. -intros a Ha Ha0. -unfold rational_arctan_small_pos. -rewrite InfiniteAlternatingSum_correct'. -apply IRasCR_wd. -assert (X:(olor ([--]One) One (inj_Q IR a))). - split. - apply less_leEq_trans with Zero. - apply shift_zero_less_minus'. - rstepr (One:IR). - apply pos_one. - stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). - apply inj_Q_leEq. - destruct Ha; assumption. - rstepr (nring 1:IR). - stepr (inj_Q IR 1) by apply (inj_Q_nring IR 1). - apply inj_Q_less. - assumption. -eapply eq_transitive_unfolded; - [|apply (arctan_series (inj_Q IR a) (arctan_series_convergent_IR) X)]. -apply: series_sum_wd. -intros n. -change (inj_Q IR ((- (1)) ^ n * Str_nth n (arctanSequence a))[=] -(([--]One[^]n[/]nring (R:=IR) (S (2 * n))[//]nringS_ap_zero IR (2 * n))[*] - (inj_Q IR a)[^](2 * n + 1))). -rstepr (([--]One[^]n)[*]((inj_Q IR a)[^](2*n+1)[/]nring (R:=IR) (S (2 * n))[//]nringS_ap_zero IR (2 * n))). -eapply eq_transitive_unfolded. - apply inj_Q_mult. -apply mult_wd. - eapply eq_transitive_unfolded. - apply inj_Q_power. - apply nexp_wd. + intros a Ha Ha0. + unfold rational_arctan_small_pos. + rewrite InfiniteAlternatingSum_correct'. + apply IRasCR_wd. + assert (X:(olor ([--]One) One (inj_Q IR a))). + split. + apply less_leEq_trans with Zero. + apply shift_zero_less_minus'. + rstepr (One:IR). + apply pos_one. + stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). + apply inj_Q_leEq. + destruct Ha; assumption. + rstepr (nring 1:IR). + stepr (inj_Q IR 1) by apply (inj_Q_nring IR 1). + apply inj_Q_less. + assumption. + eapply eq_transitive_unfolded; [|apply (arctan_series (inj_Q IR a) (arctan_series_convergent_IR) X)]. + apply: series_sum_wd. + intros n. + change (inj_Q IR ((- (1)) ^ n * Str_nth n (arctanSequence a))[=] + (([--]One[^]n[/]nring (R:=IR) (S (2 * n))[//]nringS_ap_zero IR (2 * n))[*] + (inj_Q IR a)[^](2 * n + 1))). + rstepr (([--]One[^]n)[*]((inj_Q IR a)[^](2*n+1)[/]nring (R:=IR) (S (2 * n))[//]nringS_ap_zero IR (2 * n))). eapply eq_transitive_unfolded. - apply inj_Q_inv. - apply un_op_wd_unfolded. - rstepr (nring 1:IR). - apply (inj_Q_nring IR 1). -apply mult_cancel_lft with (nring (R:=IR) (S (2 * n))). - apply nringS_ap_zero. -rstepr (inj_Q IR a[^](2 * n + 1)). -stepr (inj_Q IR (a^(2*n+1)%nat)) by apply inj_Q_power. -stepl ((inj_Q IR (nring (S (2*n))))[*]inj_Q IR (Str_nth n (arctanSequence a))) by - apply mult_wdl; apply inj_Q_nring. -stepl (inj_Q IR (nring (S (2*n))[*]Str_nth n (arctanSequence a))) - by apply inj_Q_mult. -apply inj_Q_wd. -csetoid_rewrite (nring_Q (S (2*n))). -change (S (2 * n)*Str_nth n (arctanSequence a)==a ^ (2 * n + 1)%nat). -rewrite Str_nth_arctanSequence. -rewrite (Qmake_Qdiv). -rewrite plus_comm. -generalize (a^(2*n+1)%nat). -intros b. -rewrite <- POS_anti_convert. -field. -unfold Qeq; simpl. -rewrite Pmult_1_r. -rewrite <- POS_anti_convert. -auto with *. + apply inj_Q_mult. + apply mult_wd. + eapply eq_transitive_unfolded. + apply inj_Q_power. + apply nexp_wd. + eapply eq_transitive_unfolded. + apply inj_Q_inv. + apply un_op_wd_unfolded. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). + apply mult_cancel_lft with (nring (R:=IR) (S (2 * n))). + apply nringS_ap_zero. + rstepr (inj_Q IR a[^](2 * n + 1)). + stepr (inj_Q IR (a^(2*n+1)%nat)) by apply inj_Q_power. + stepl ((inj_Q IR (nring (S (2*n))))[*]inj_Q IR (Str_nth n (arctanSequence a))) by + apply mult_wdl; apply inj_Q_nring. + stepl (inj_Q IR (nring (S (2*n))[*]Str_nth n (arctanSequence a))) by apply inj_Q_mult. + apply inj_Q_wd. + csetoid_rewrite (nring_Q (S (2*n))). + change (S (2 * n)*Str_nth n (arctanSequence a)==a ^ (2 * n + 1)%nat). + rewrite Str_nth_arctanSequence. + rewrite (Qmake_Qdiv). + rewrite plus_comm. + generalize (a^(2*n+1)%nat). + intros b. + rewrite <- POS_anti_convert. + field. + unfold Qeq; simpl. + rewrite Pmult_1_r. + rewrite <- POS_anti_convert. + auto with *. Qed. (** Extend the range to [[-1,1]] by symmetry. *) Definition rational_arctan_small (a:Q) (p: -(1) <= a <= 1) : CR. -intros a. -destruct (Qle_total a 0); intros Ha. - refine (-(@rational_arctan_small_pos (-a)%Q _))%CR. - abstract ( - split; - [(replace RHS with (0+-a) by ring); - rewrite <- Qle_minus_iff; - assumption - |rewrite Qle_minus_iff; - (replace RHS with (a + - - (1)) by ring); - rewrite <- Qle_minus_iff; - destruct Ha; assumption]). -apply (@rational_arctan_small_pos a). -abstract ( -split;[|destruct Ha; assumption]; - apply Qnot_lt_le; apply Qle_not_lt; assumption). +Proof. + intros a. + destruct (Qle_total a 0); intros Ha. + refine (-(@rational_arctan_small_pos (-a)%Q _))%CR. + abstract ( split; [(replace RHS with (0+-a) by ring); rewrite <- Qle_minus_iff; assumption + |rewrite Qle_minus_iff; (replace RHS with (a + - - (1)) by ring); rewrite <- Qle_minus_iff; + destruct Ha; assumption]). + apply (@rational_arctan_small_pos a). + abstract ( split;[|destruct Ha; assumption]; apply Qnot_lt_le; apply Qle_not_lt; assumption). Defined. Lemma rational_arctan_small_correct : forall (a:Q) Ha, -(1) < a -> a < 1 -> (@rational_arctan_small a Ha == IRasCR (ArcTan (inj_Q IR a)))%CR. Proof. -intros a Ha Ha0 Ha1. -unfold rational_arctan_small. -destruct (Qle_total a 0); - rewrite rational_arctan_small_pos_correct. - rewrite <- IR_opp_as_CR. - apply IRasCR_wd. - csetoid_rewrite_rev (ArcTan_inv (inj_Q IR (-a))). - apply ArcTan_wd. - eapply eq_transitive. - apply eq_symmetric; apply (inj_Q_inv IR (-a)). - apply inj_Q_wd. - simpl. - ring. - rewrite Qlt_minus_iff. - replace RHS with (a + - - (1)) by ring. - rewrite <- Qlt_minus_iff. - assumption. - reflexivity. -assumption. + intros a Ha Ha0 Ha1. + unfold rational_arctan_small. + destruct (Qle_total a 0); rewrite rational_arctan_small_pos_correct. + rewrite <- IR_opp_as_CR. + apply IRasCR_wd. + csetoid_rewrite_rev (ArcTan_inv (inj_Q IR (-a))). + apply ArcTan_wd. + eapply eq_transitive. + apply eq_symmetric; apply (inj_Q_inv IR (-a)). + apply inj_Q_wd. + simpl. + ring. + rewrite Qlt_minus_iff. + replace RHS with (a + - - (1)) by ring. + rewrite <- Qlt_minus_iff. + assumption. + reflexivity. + assumption. Qed. diff --git a/reals/fast/CRartanh_slow.v b/reals/fast/CRartanh_slow.v index a8f735477..0379f9859 100644 --- a/reals/fast/CRartanh_slow.v +++ b/reals/fast/CRartanh_slow.v @@ -48,142 +48,138 @@ Opaque inj_Q CR. Lemma arctanSequence_Gs : forall a, GeometricSeries (a^2) (arctanSequence a). Proof. -intros a. -apply mult_Streams_Gs. - apply everyOther_dnn. - apply recip_positives_dnn. -apply powers_help_Gs. + intros a. + apply mult_Streams_Gs. + apply everyOther_dnn. + apply recip_positives_dnn. + apply powers_help_Gs. apply Qsqr_nonneg. Qed. Lemma Qsqr_lt_one : forall (a:Q), (-(1) < a) -> a < 1 -> (a^2 < 1). Proof. -intros a H0 H1. -rewrite -> Qlt_minus_iff in *. -replace RHS with ((1 + - a)*(a + - -(1))) by ring. -Qauto_pos. + intros a H0 H1. + rewrite -> Qlt_minus_iff in *. + replace RHS with ((1 + - a)*(a + - -(1))) by ring. + Qauto_pos. Qed. Lemma artanh_DomArTanH : forall a, (a^2 < 1) -> DomArTanH (inj_Q IR a). Proof. -intros a Ha. -split. - stepl (inj_Q IR ([--](1))%Q). + intros a Ha. + split. + stepl (inj_Q IR ([--](1))%Q). + apply inj_Q_less; simpl. + apply Qnot_le_lt. + intros H. + apply (Qlt_not_le _ _ Ha). + rewrite -> Qle_minus_iff in *. + replace RHS with ((- (1) + - a + 2)*(-(1) +- a)) by ring. + Qauto_nonneg. + stepr ([--](inj_Q IR 1)). + apply inj_Q_inv. + apply un_op_wd_unfolded. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). + stepr (inj_Q IR (1)). apply inj_Q_less; simpl. apply Qnot_le_lt. intros H. apply (Qlt_not_le _ _ Ha). - rewrite -> Qle_minus_iff in *. - replace RHS with ((- (1) + - a + 2)*(-(1) +- a)) by ring. + rewrite -> Qle_minus_iff in *. + replace RHS with ((a + - (1) + 2)*(a +- (1))) by ring. Qauto_nonneg. - stepr ([--](inj_Q IR 1)). - apply inj_Q_inv. - apply un_op_wd_unfolded. rstepr (nring 1:IR). apply (inj_Q_nring IR 1). -stepr (inj_Q IR (1)). - apply inj_Q_less; simpl. - apply Qnot_le_lt. - intros H. - apply (Qlt_not_le _ _ Ha). - rewrite -> Qle_minus_iff in *. - replace RHS with ((a + - (1) + 2)*(a +- (1))) by ring. - Qauto_nonneg. -rstepr (nring 1:IR). -apply (inj_Q_nring IR 1). Qed. (** Although this function works on the entire domain of [artanh], it is only reasonably fast for values close to 0, say [[-(2/3), 2/3]]. *) -Definition rational_artanh_slow (a:Q) (p1: a^2 < 1) : CR := +Definition rational_artanh_slow (a:Q) (p1: a^2 < 1) : CR := InfiniteGeometricSum (Qsqr_nonneg a) p1 (arctanSequence_Gs a). Lemma rational_artanh_slow_correct : forall (a:Q) Ha Ha0, (@rational_artanh_slow a Ha == IRasCR (ArTanH (inj_Q IR a) Ha0))%CR. Proof. -intros a Ha Ha0. -unfold rational_artanh_slow. -rewrite InfiniteGeometricSum_correct'. -apply IRasCR_wd. + intros a Ha Ha0. + unfold rational_artanh_slow. + rewrite InfiniteGeometricSum_correct'. + apply IRasCR_wd. eapply eq_transitive_unfolded; - [|apply (ArTanH_series (inj_Q IR a) (ArTanH_series_convergent_IR) (artanh_DomArTanH Ha) Ha0)]. -simpl. -unfold series_sum. -apply Lim_seq_eq_Lim_subseq with double. + [|apply (ArTanH_series (inj_Q IR a) (ArTanH_series_convergent_IR) (artanh_DomArTanH Ha) Ha0)]. + simpl. + unfold series_sum. + apply Lim_seq_eq_Lim_subseq with double. + unfold double; auto with *. + intros n. + exists (S n). unfold double; auto with *. intros n. - exists (S n). - unfold double; auto with *. -intros n. -simpl. -clear - n. -induction n. - apply eq_reflexive. -simpl. -set (A:=nexp IR (n + S n) (inj_Q IR a[-]Zero)). -rewrite plus_comm. -simpl. -fold (double n). -csetoid_rewrite_rev IHn. -clear IHn. -csetoid_replace (ArTanH_series_coef (double n)[*]nexp IR (double n) (inj_Q IR a[-]Zero)) (Zero:IR). - csetoid_replace (ArTanH_series_coef (S (double n))[*]A) (inj_Q IR (Str_nth n (arctanSequence a))). - rational. - unfold ArTanH_series_coef. - case_eq (even_odd_dec (S (double n))); intros H. - elim (not_even_and_odd _ H). - constructor. - apply even_plus_n_n. - intros _. - eapply eq_transitive; - [|apply inj_Q_wd; simpl;symmetry;apply Str_nth_arctanSequence]. - eapply eq_transitive; - [|apply eq_symmetric; apply inj_Q_mult]. - apply mult_wd. - assert (X:(inj_Q IR (nring (S (double n))))[#]Zero). - stepr (inj_Q IR Zero). - apply inj_Q_ap. - apply nringS_ap_zero. - apply (inj_Q_nring IR 0). - stepr (inj_Q IR (nring 1)[/]_[//]X). - apply div_wd. - rstepl (nring 1:IR). + simpl. + clear - n. + induction n. + apply eq_reflexive. + simpl. + set (A:=nexp IR (n + S n) (inj_Q IR a[-]Zero)). + rewrite plus_comm. + simpl. + fold (double n). + csetoid_rewrite_rev IHn. + clear IHn. + csetoid_replace (ArTanH_series_coef (double n)[*]nexp IR (double n) (inj_Q IR a[-]Zero)) (Zero:IR). + csetoid_replace (ArTanH_series_coef (S (double n))[*]A) (inj_Q IR (Str_nth n (arctanSequence a))). + rational. + unfold ArTanH_series_coef. + case_eq (even_odd_dec (S (double n))); intros H. + elim (not_even_and_odd _ H). + constructor. + apply even_plus_n_n. + intros _. + eapply eq_transitive; [|apply inj_Q_wd; simpl;symmetry;apply Str_nth_arctanSequence]. + eapply eq_transitive; [|apply eq_symmetric; apply inj_Q_mult]. + apply mult_wd. + assert (X:(inj_Q IR (nring (S (double n))))[#]Zero). + stepr (inj_Q IR Zero). + apply inj_Q_ap. + apply nringS_ap_zero. + apply (inj_Q_nring IR 0). + stepr (inj_Q IR (nring 1)[/]_[//]X). + apply div_wd. + rstepl (nring 1:IR). + apply eq_symmetric. + apply (inj_Q_nring IR 1). apply eq_symmetric. - apply (inj_Q_nring IR 1). - apply eq_symmetric. - apply (inj_Q_nring). - assert (X0:inj_Q IR ((P_of_succ_nat (2 * n)):Q)[#]Zero). - stepr (inj_Q IR Zero). - apply inj_Q_ap. - discriminate. - apply (inj_Q_nring IR 0). - eapply eq_transitive; - [|apply inj_Q_wd; symmetry; apply Qmake_Qdiv]. - eapply eq_transitive; - [|apply eq_symmetric; apply (fun b => inj_Q_div _ b _ X0)]. - apply div_wd. - apply eq_reflexive. - apply inj_Q_wd. - rewrite <- POS_anti_convert. - eapply eq_transitive;[apply nring_Q|]. - unfold double. - simpl. - replace (n+0)%nat with n by ring. - reflexivity. - unfold A; clear A. - eapply eq_transitive;[|apply eq_symmetric; apply inj_Q_power]. - change ((inj_Q IR a[-]Zero)[^](n+S n)[=]inj_Q IR a[^](1 + 2 * n)). - replace (n + S n)%nat with (1 + 2*n)%nat by ring. + apply (inj_Q_nring). + assert (X0:inj_Q IR ((P_of_succ_nat (2 * n)):Q)[#]Zero). + stepr (inj_Q IR Zero). + apply inj_Q_ap. + discriminate. + apply (inj_Q_nring IR 0). + eapply eq_transitive; [|apply inj_Q_wd; symmetry; apply Qmake_Qdiv]. + eapply eq_transitive; [|apply eq_symmetric; apply (fun b => inj_Q_div _ b _ X0)]. + apply div_wd. + apply eq_reflexive. + apply inj_Q_wd. + rewrite <- POS_anti_convert. + eapply eq_transitive;[apply nring_Q|]. + unfold double. + simpl. + replace (n+0)%nat with n by ring. + reflexivity. + unfold A; clear A. + eapply eq_transitive;[|apply eq_symmetric; apply inj_Q_power]. + change ((inj_Q IR a[-]Zero)[^](n+S n)[=]inj_Q IR a[^](1 + 2 * n)). + replace (n + S n)%nat with (1 + 2*n)%nat by ring. apply nexp_wd. - rational. -unfold ArTanH_series_coef. -case_eq (even_odd_dec (double n)). - intros _ _. - rational. -intros o. -elim (fun x=> not_even_and_odd _ x o). -apply even_plus_n_n. + rational. + unfold ArTanH_series_coef. + case_eq (even_odd_dec (double n)). + intros _ _. + rational. + intros o. + elim (fun x=> not_even_and_odd _ x o). + apply even_plus_n_n. Qed. (* This development is incomplete. At the moment only what is need -for logorithm has been developed. *) \ No newline at end of file +for logorithm has been developed. *) diff --git a/reals/fast/CRcorrect.v b/reals/fast/CRcorrect.v index 31d5dd332..ddebae357 100644 --- a/reals/fast/CRcorrect.v +++ b/reals/fast/CRcorrect.v @@ -43,36 +43,36 @@ Definition CRasCauchy_IR_raw (x:CR) (n:nat) := approximate x (1 # P_of_succ_nat Lemma CRasCauchy_IR_raw_is_Cauchy : forall (x:CR), Cauchy_prop (R:=Q_as_COrdField) (CRasCauchy_IR_raw x). -intros x e He. -rewrite <- (QposAsmkQpos He). -generalize (mkQpos He). -clear e He. -intros [en ed]. -unfold CRasCauchy_IR_raw. -exists (pred (nat_of_P (2*ed))). -rewrite <- anti_convert_pred_convert. -intros m Hm. -change (ball (en#ed) (approximate x (1 # P_of_succ_nat m)%Qpos) - (approximate x (1#(2*ed)))%Qpos). -apply: ball_weak_le;[|apply regFun_prf]. -autorewrite with QposElim. -apply Qle_trans with (((1 # P_of_succ_nat (pred (nat_of_P (2*ed)))) + (1 # 2 * ed)))%Q. -apply: plus_resp_leEq. -change (P_of_succ_nat (pred (nat_of_P (2*ed))) <= P_of_succ_nat m)%Z. -destruct (Z_lt_le_dec (P_of_succ_nat m)(P_of_succ_nat (pred (nat_of_P (2 * ed)))))%Z. -elim (le_not_lt _ _ Hm). -apply surj_lt. -repeat rewrite succ_nat in z. -omega. -assumption. -rewrite <- anti_convert_pred_convert. -replace LHS with ((2#1)*(1#(2*ed)))%Q by ring. -change ((2#1)*((1/2)*(1/ed)) <= en#ed)%Q. -ring_simplify. -change ((2#2)*(1/ed)<=en#ed)%Q. -setoid_replace (2#2)%Q with 1%Q by constructor. -ring_simplify. -auto with *. +Proof. + intros x e He. + rewrite <- (QposAsmkQpos He). + generalize (mkQpos He). + clear e He. + intros [en ed]. + unfold CRasCauchy_IR_raw. + exists (pred (nat_of_P (2*ed))). + rewrite <- anti_convert_pred_convert. + intros m Hm. + change (ball (en#ed) (approximate x (1 # P_of_succ_nat m)%Qpos) (approximate x (1#(2*ed)))%Qpos). + apply: ball_weak_le;[|apply regFun_prf]. + autorewrite with QposElim. + apply Qle_trans with (((1 # P_of_succ_nat (pred (nat_of_P (2*ed)))) + (1 # 2 * ed)))%Q. + apply: plus_resp_leEq. + change (P_of_succ_nat (pred (nat_of_P (2*ed))) <= P_of_succ_nat m)%Z. + destruct (Z_lt_le_dec (P_of_succ_nat m)(P_of_succ_nat (pred (nat_of_P (2 * ed)))))%Z. + elim (le_not_lt _ _ Hm). + apply surj_lt. + repeat rewrite succ_nat in z. + omega. + assumption. + rewrite <- anti_convert_pred_convert. + replace LHS with ((2#1)*(1#(2*ed)))%Q by ring. + change ((2#1)*((1/2)*(1/ed)) <= en#ed)%Q. + ring_simplify. + change ((2#2)*(1/ed)<=en#ed)%Q. + setoid_replace (2#2)%Q with 1%Q by constructor. + ring_simplify. + auto with *. Qed. Definition CRasCauchy_IR (x:CR) : Cauchy_IR := @@ -80,34 +80,34 @@ Build_CauchySeq _ _ (CRasCauchy_IR_raw_is_Cauchy x). Lemma CRasCauchy_IR_wd : forall (x y:CR), (x==y)%CR -> CRasCauchy_IR x[=]CRasCauchy_IR y. Proof. -intros x y Hxy. -apply: Eq_alt_2_2. -intros e He. -rewrite <- (QposAsmkQpos He). -generalize (mkQpos He). -clear He e. -intros [en ed]. -exists (pred(nat_of_P (2*ed))). -intros m Hm. -simpl. -unfold CRasCauchy_IR_raw. -set (d:=(1 # P_of_succ_nat m)%Qpos). -change (ball (en#ed)%Qpos (approximate x d) (approximate y d)). -apply: ball_weak_le;[|apply Hxy]. -unfold d. -autorewrite with QposElim. -ring_simplify. -apply Qle_trans with ((2#1)*(1#(2 * ed)))%Q. -apply: mult_resp_leEq_lft;try discriminate. -change ((2*ed)<=P_of_succ_nat m)%Z. -rewrite <- Zpos_mult_morphism. -rewrite (anti_convert_pred_convert (2*ed)). -do 2 rewrite <- POS_anti_convert. -apply inj_le. -auto with *. -change (1#2*ed)%Q with ((1#2)*(1#ed))%Q. -ring_simplify. -auto with *. + intros x y Hxy. + apply: Eq_alt_2_2. + intros e He. + rewrite <- (QposAsmkQpos He). + generalize (mkQpos He). + clear He e. + intros [en ed]. + exists (pred(nat_of_P (2*ed))). + intros m Hm. + simpl. + unfold CRasCauchy_IR_raw. + set (d:=(1 # P_of_succ_nat m)%Qpos). + change (ball (en#ed)%Qpos (approximate x d) (approximate y d)). + apply: ball_weak_le;[|apply Hxy]. + unfold d. + autorewrite with QposElim. + ring_simplify. + apply Qle_trans with ((2#1)*(1#(2 * ed)))%Q. + apply: mult_resp_leEq_lft;try discriminate. + change ((2*ed)<=P_of_succ_nat m)%Z. + rewrite <- Zpos_mult_morphism. + rewrite (anti_convert_pred_convert (2*ed)). + do 2 rewrite <- POS_anti_convert. + apply inj_le. + auto with *. + change (1#2*ed)%Q with ((1#2)*(1#ed))%Q. + ring_simplify. + auto with *. Qed. (** @@ -115,36 +115,37 @@ Qed. *) Definition Cauchy_IRasCR_raw (x:Cauchy_IR) (e:QposInf) : Q. -intros x [e|];[|exact 0%Q]. -destruct x as [f Hf]. -unfold Cauchy_prop in Hf. -destruct (Hf (e:Q) (Qpos_prf e)) as [n Hn]. -exact (f n). +Proof. + intros x [e|];[|exact 0%Q]. + destruct x as [f Hf]. + unfold Cauchy_prop in Hf. + destruct (Hf (e:Q) (Qpos_prf e)) as [n Hn]. + exact (f n). Defined. Lemma Cauchy_IRasCR_is_Regular : forall (x:Cauchy_IR), is_RegularFunction (Cauchy_IRasCR_raw x). Proof. -intros [f Hf] e1 e2. -simpl. -destruct (Hf (e1:Q) (Qpos_prf e1)) as [n1 Hn1]. -destruct (Hf (e2:Q) (Qpos_prf e2)) as [n2 Hn2]. -cut (forall (e1 e2:Qpos) n1 n2, n2 <= n1 -> -(forall m : nat, n1 <= m -> AbsSmall (R:=Q_as_COrdField) (e1:Q) (f m[-]f n1)) -> -(forall m : nat, n2 <= m -> AbsSmall (R:=Q_as_COrdField) (e2:Q) (f m[-]f n2)) -> -Qball (e1 + e2) (f n1) (f n2)). -intros H. -destruct (le_ge_dec n1 n2). -apply: ball_sym;simpl. -setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. -apply H; assumption. -auto. -clear - Hf. -intros e1 e2 n1 n2 H Hn1 Hn2. -setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. -apply: ball_weak. -apply: Hn2. -assumption. + intros [f Hf] e1 e2. + simpl. + destruct (Hf (e1:Q) (Qpos_prf e1)) as [n1 Hn1]. + destruct (Hf (e2:Q) (Qpos_prf e2)) as [n2 Hn2]. + cut (forall (e1 e2:Qpos) n1 n2, n2 <= n1 -> + (forall m : nat, n1 <= m -> AbsSmall (R:=Q_as_COrdField) (e1:Q) (f m[-]f n1)) -> + (forall m : nat, n2 <= m -> AbsSmall (R:=Q_as_COrdField) (e2:Q) (f m[-]f n2)) -> + Qball (e1 + e2) (f n1) (f n2)). + intros H. + destruct (le_ge_dec n1 n2). + apply: ball_sym;simpl. + setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. + apply H; assumption. + auto. + clear - Hf. + intros e1 e2 n1 n2 H Hn1 Hn2. + setoid_replace (e1+e2)%Qpos with (e2+e1)%Qpos by QposRing. + apply: ball_weak. + apply: Hn2. + assumption. Qed. Definition Cauchy_IRasCR (x:Cauchy_IR) : CR := @@ -152,136 +153,134 @@ Build_RegularFunction (Cauchy_IRasCR_is_Regular x). Lemma Cauchy_IRasCR_wd : forall (x y:Cauchy_IR), x[=]y -> (Cauchy_IRasCR x==Cauchy_IRasCR y)%CR. Proof. -intros [x Hx] [y Hy] Hxy. -apply: regFunEq_e. -intros e. -apply ball_closed. -intros d. -simpl. -destruct (Hx (e:Q) (Qpos_prf e)) as [a Ha]. -destruct (Hy (e:Q) (Qpos_prf e)) as [b Hb]. -destruct (Eq_alt_2_1 _ _ _ Hxy _ (Qpos_prf d)) as [c Hc]. -simpl in Hc. -unfold Qball. -set (n:=max (max a b) c). -stepr ((x a - x n) + (y n - y b) + (x n - y n))%Q by (simpl;ring). -autorewrite with QposElim. -repeat (apply: AbsSmall_plus). -apply AbsSmall_minus. -apply Ha;unfold n;apply le_trans with (max a b); auto with *. -apply Hb; unfold n;apply le_trans with (max a b); auto with *. -apply Hc; unfold n;auto with *. + intros [x Hx] [y Hy] Hxy. + apply: regFunEq_e. + intros e. + apply ball_closed. + intros d. + simpl. + destruct (Hx (e:Q) (Qpos_prf e)) as [a Ha]. + destruct (Hy (e:Q) (Qpos_prf e)) as [b Hb]. + destruct (Eq_alt_2_1 _ _ _ Hxy _ (Qpos_prf d)) as [c Hc]. + simpl in Hc. + unfold Qball. + set (n:=max (max a b) c). + stepr ((x a - x n) + (y n - y b) + (x n - y n))%Q by (simpl;ring). + autorewrite with QposElim. + repeat (apply: AbsSmall_plus). + apply AbsSmall_minus. + apply Ha;unfold n;apply le_trans with (max a b); auto with *. + apply Hb; unfold n;apply le_trans with (max a b); auto with *. + apply Hc; unfold n;auto with *. Qed. (** Composition is the identity *) Lemma CRasCR : forall x:CR, (Cauchy_IRasCR (CRasCauchy_IR x)==x)%CR. Proof. -intros x. -apply: regFunEq_e. -intros e. -simpl. -destruct (CRasCauchy_IR_raw_is_Cauchy x (e:Q) (Qpos_prf e)) as [n Hn]. -unfold CRasCauchy_IR_raw in *. -apply: ball_closed. -intros [dn dd]. -setoid_replace (e+e+(dn#dd))%Qpos with (e+((dn#dd)+e))%Qpos by QposRing. -apply ball_triangle with (approximate x (1#P_of_succ_nat (n+(nat_of_P dd))))%Qpos. -apply ball_sym. -apply: Hn;auto with *. -apply: ball_weak_le;[|apply regFun_prf]. -autorewrite with QposElim. -apply: plus_resp_leEq;simpl. -apply Qle_trans with (1#dd)%Q. -change (dd <= P_of_succ_nat (n + nat_of_P dd))%Z. -destruct n. -simpl. -rewrite P_of_succ_nat_o_nat_of_P_eq_succ. -rewrite Pplus_one_succ_r. -rewrite Zpos_plus_distr. -auto with *. -rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ. -rewrite <- nat_of_P_plus_morphism. -rewrite P_of_succ_nat_o_nat_of_P_eq_succ. -rewrite Pplus_one_succ_r. -repeat rewrite Zpos_plus_distr. -rewrite <- Zplus_assoc. -rewrite Zplus_comm. -rewrite <- Zplus_assoc. -rewrite <- Zpos_plus_distr. -rewrite <- Pplus_one_succ_l. -change (dd+0 <= dd + Psucc (P_of_succ_nat n))%Z. -auto with *. -change (dd <= dn*dd)%Z. -auto with *. + intros x. + apply: regFunEq_e. + intros e. + simpl. + destruct (CRasCauchy_IR_raw_is_Cauchy x (e:Q) (Qpos_prf e)) as [n Hn]. + unfold CRasCauchy_IR_raw in *. + apply: ball_closed. + intros [dn dd]. + setoid_replace (e+e+(dn#dd))%Qpos with (e+((dn#dd)+e))%Qpos by QposRing. + apply ball_triangle with (approximate x (1#P_of_succ_nat (n+(nat_of_P dd))))%Qpos. + apply ball_sym. + apply: Hn;auto with *. + apply: ball_weak_le;[|apply regFun_prf]. + autorewrite with QposElim. + apply: plus_resp_leEq;simpl. + apply Qle_trans with (1#dd)%Q. + change (dd <= P_of_succ_nat (n + nat_of_P dd))%Z. + destruct n. + simpl. + rewrite P_of_succ_nat_o_nat_of_P_eq_succ. + rewrite Pplus_one_succ_r. + rewrite Zpos_plus_distr. + auto with *. + rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ. + rewrite <- nat_of_P_plus_morphism. + rewrite P_of_succ_nat_o_nat_of_P_eq_succ. + rewrite Pplus_one_succ_r. + repeat rewrite Zpos_plus_distr. + rewrite <- Zplus_assoc. + rewrite Zplus_comm. + rewrite <- Zplus_assoc. + rewrite <- Zpos_plus_distr. + rewrite <- Pplus_one_succ_l. + change (dd+0 <= dd + Psucc (P_of_succ_nat n))%Z. + auto with *. + change (dd <= dn*dd)%Z. + auto with *. Qed. Lemma Cauchy_IRasCauchy_IR : forall x:Cauchy_IR, CRasCauchy_IR (Cauchy_IRasCR x)[=]x. Proof. -intros [x Hx]. -apply: Eq_alt_2_2. -intros e He. -rewrite <- (QposAsmkQpos He). -set (e':=(mkQpos He)). -clearbody e'. -clear e He. -assert (Z:(0<(1#2)*e')%Q). -replace LHS with ((1#2)*0)%Q by ring. -apply: mult_resp_less_lft. -apply Qpos_prf. -constructor. -destruct (Hx _ Z) as [n Hn]. -destruct e' as [en ed]. -exists (max n (nat_of_P ed)). -intros m Hm. -simpl. -destruct (Hx ((1 # P_of_succ_nat m)%Qpos:Q) (Qpos_prf (1 # P_of_succ_nat m)%Qpos)) - as [n' Hn']. -apply AbsSmall_minus. -destruct (le_lt_dec n' m) as [H|H]. -apply: AbsSmall_trans;[|apply Hn';assumption]. -change (ed < en*(P_of_succ_nat m))%Z. -apply Zlt_le_trans with (P_of_succ_nat m). -rewrite <- POS_anti_convert. -rewrite Zpos_eq_Z_of_nat_o_nat_of_P. -apply inj_lt. -apply le_lt_n_Sm. -apply le_trans with (max n (nat_of_P ed));auto with *. -change (1*P_of_succ_nat m <= en * P_of_succ_nat m)%Z. -apply Zmult_lt_0_le_compat_r;auto with *. -stepl ((1#2)*(en#ed)%Qpos+(1#2)*(en#ed)%Qpos)%Q by (simpl;ring). -rstepr ((x m[-]x n)[+](x n[-]x n')). -assert (Y:n <= m). -apply le_trans with (max n (nat_of_P ed));auto with *. -apply AbsSmall_plus. -apply Hn. -assumption. -apply AbsSmall_minus; -auto with *. + intros [x Hx]. + apply: Eq_alt_2_2. + intros e He. + rewrite <- (QposAsmkQpos He). + set (e':=(mkQpos He)). + clearbody e'. + clear e He. + assert (Z:(0<(1#2)*e')%Q). + replace LHS with ((1#2)*0)%Q by ring. + apply: mult_resp_less_lft. + apply Qpos_prf. + constructor. + destruct (Hx _ Z) as [n Hn]. + destruct e' as [en ed]. + exists (max n (nat_of_P ed)). + intros m Hm. + simpl. + destruct (Hx ((1 # P_of_succ_nat m)%Qpos:Q) (Qpos_prf (1 # P_of_succ_nat m)%Qpos)) as [n' Hn']. + apply AbsSmall_minus. + destruct (le_lt_dec n' m) as [H|H]. + apply: AbsSmall_trans;[|apply Hn';assumption]. + change (ed < en*(P_of_succ_nat m))%Z. + apply Zlt_le_trans with (P_of_succ_nat m). + rewrite <- POS_anti_convert. + rewrite Zpos_eq_Z_of_nat_o_nat_of_P. + apply inj_lt. + apply le_lt_n_Sm. + apply le_trans with (max n (nat_of_P ed));auto with *. + change (1*P_of_succ_nat m <= en * P_of_succ_nat m)%Z. + apply Zmult_lt_0_le_compat_r;auto with *. + stepl ((1#2)*(en#ed)%Qpos+(1#2)*(en#ed)%Qpos)%Q by (simpl;ring). + rstepr ((x m[-]x n)[+](x n[-]x n')). + assert (Y:n <= m). + apply le_trans with (max n (nat_of_P ed));auto with *. + apply AbsSmall_plus. + apply Hn. + assumption. + apply AbsSmall_minus; auto with *. Qed. (** Equalities are well defined. *) Lemma Cauchy_IR_eq_as_CR_eq : forall (x y:Cauchy_IR), ((Cauchy_IRasCR x) == (Cauchy_IRasCR y))%CR <-> x[=]y. Proof. -intros x y. -split;[|apply Cauchy_IRasCR_wd]. -intros H. -stepl (CRasCauchy_IR (Cauchy_IRasCR x)) by (apply Cauchy_IRasCauchy_IR). -stepr (CRasCauchy_IR (Cauchy_IRasCR y)) by (apply Cauchy_IRasCauchy_IR). -apply CRasCauchy_IR_wd. -assumption. + intros x y. + split;[|apply Cauchy_IRasCR_wd]. + intros H. + stepl (CRasCauchy_IR (Cauchy_IRasCR x)) by (apply Cauchy_IRasCauchy_IR). + stepr (CRasCauchy_IR (Cauchy_IRasCR y)) by (apply Cauchy_IRasCauchy_IR). + apply CRasCauchy_IR_wd. + assumption. Qed. Lemma CR_eq_as_Cauchy_IR_eq : forall (x y:CR), (CRasCauchy_IR x [=] CRasCauchy_IR y) <-> (x==y)%CR. Proof. -intros x y. -set (x':=CRasCauchy_IR x). -set (y':=CRasCauchy_IR y). -rewrite <- (CRasCR x). -rewrite <- (CRasCR y). -symmetry. -apply Cauchy_IR_eq_as_CR_eq. + intros x y. + set (x':=CRasCauchy_IR x). + set (y':=CRasCauchy_IR y). + rewrite <- (CRasCR x). + rewrite <- (CRasCR y). + symmetry. + apply Cauchy_IR_eq_as_CR_eq. Qed. Open Local Scope uc_scope. @@ -292,80 +291,77 @@ Lemma reverse_iso_wd_fun : forall (f:Cauchy_IR -> Cauchy_IR) (g:CR -> CR), (forall x y, (x==y -> g x == g y)%CR) -> -(forall (x:Cauchy_IR), +(forall (x:Cauchy_IR), (g (Cauchy_IRasCR x) == Cauchy_IRasCR (f x))%CR) -> forall (x:CR), (f (CRasCauchy_IR x) [=] CRasCauchy_IR (g x)). Proof. -intros f g g_wd H x. -stepl (CRasCauchy_IR (Cauchy_IRasCR (f (CRasCauchy_IR x)))) by -apply Cauchy_IRasCauchy_IR. -apply CRasCauchy_IR_wd. -symmetry. -transitivity (g (Cauchy_IRasCR (CRasCauchy_IR x))); try apply H. -apply g_wd. -symmetry. -apply CRasCR. + intros f g g_wd H x. + stepl (CRasCauchy_IR (Cauchy_IRasCR (f (CRasCauchy_IR x)))) by apply Cauchy_IRasCauchy_IR. + apply CRasCauchy_IR_wd. + symmetry. + transitivity (g (Cauchy_IRasCR (CRasCauchy_IR x))); try apply H. + apply g_wd. + symmetry. + apply CRasCR. Qed. Lemma reverse_iso_uc_fun : forall (f:Cauchy_IR -> Cauchy_IR) (g:CR --> CR), -(forall (x:Cauchy_IR), +(forall (x:Cauchy_IR), (g (Cauchy_IRasCR x) == Cauchy_IRasCR (f x))%CR) -> forall (x:CR), (f (CRasCauchy_IR x) [=] CRasCauchy_IR (g x)). Proof. -intros f g H x. -apply reverse_iso_wd_fun. -apply uc_wd. -assumption. + intros f g H x. + apply reverse_iso_wd_fun. + apply uc_wd. + assumption. Qed. Lemma reverse_iso_bin_wd_fun : forall (f:Cauchy_IR -> Cauchy_IR -> Cauchy_IR) (g:CR -> CR -> CR), (forall w x, (w == x)%CR -> forall y z, (y == z -> g w y == g x z)%CR) -> -(forall (x y:Cauchy_IR), +(forall (x y:Cauchy_IR), (g (Cauchy_IRasCR x) (Cauchy_IRasCR y) == Cauchy_IRasCR (f x y))%CR) -> forall (x y:CR), (f (CRasCauchy_IR x) (CRasCauchy_IR y) [=] CRasCauchy_IR (g x y)). Proof. -intros f g g_wd H x y. -stepl (CRasCauchy_IR (Cauchy_IRasCR (f (CRasCauchy_IR x) (CRasCauchy_IR y)))) by - apply Cauchy_IRasCauchy_IR. -apply CRasCauchy_IR_wd. -symmetry. -transitivity (g (Cauchy_IRasCR (CRasCauchy_IR x)) (Cauchy_IRasCR (CRasCauchy_IR y))); [|apply H]. -apply g_wd; -symmetry; -apply CRasCR. + intros f g g_wd H x y. + stepl (CRasCauchy_IR (Cauchy_IRasCR (f (CRasCauchy_IR x) (CRasCauchy_IR y)))) by + apply Cauchy_IRasCauchy_IR. + apply CRasCauchy_IR_wd. + symmetry. + transitivity (g (Cauchy_IRasCR (CRasCauchy_IR x)) (Cauchy_IRasCR (CRasCauchy_IR y))); [|apply H]. + apply g_wd; symmetry; apply CRasCR. Qed. Lemma reverse_iso_bin_uc_fun : forall (f:Cauchy_IR -> Cauchy_IR -> Cauchy_IR) (g:CR --> CR --> CR), -(forall (x y:Cauchy_IR), +(forall (x y:Cauchy_IR), (g (Cauchy_IRasCR x) (Cauchy_IRasCR y) == Cauchy_IRasCR (f x y))%CR) -> forall (x y:CR), (f (CRasCauchy_IR x) (CRasCauchy_IR y) [=] CRasCauchy_IR (g x y)). Proof. -intros f g H x y. -apply (reverse_iso_bin_wd_fun f (ucFun2 g)). -apply ucFun2_wd. -assumption. + intros f g H x y. + apply (reverse_iso_bin_wd_fun f (ucFun2 g)). + apply ucFun2_wd. + assumption. Qed. (** injection of rationals is preserved. *) Lemma Cauchy_IR_inject_Q_as_CR_inject_Q : forall x:Q, (' x == Cauchy_IRasCR (Cauchy_CReals.inject_Q _ x))%CR. Proof. -intros x. -apply: regFunEq_e. -intros e. -simpl. -destruct (CS_seq_const Q_as_COrdField x (e:Q) (Qpos_prf e)). -apply: ball_refl. + intros x. + apply: regFunEq_e. + intros e. + simpl. + destruct (CS_seq_const Q_as_COrdField x (e:Q) (Qpos_prf e)). + apply: ball_refl. Qed. Hint Rewrite Cauchy_IR_inject_Q_as_CR_inject_Q : CRtoCauchy_IR. @@ -373,161 +369,151 @@ Hint Rewrite Cauchy_IR_inject_Q_as_CR_inject_Q : CRtoCauchy_IR. Lemma CR_inject_Q_as_Cauchy_IR_inject_Q : forall x:Q, Cauchy_CReals.inject_Q _ x [=] CRasCauchy_IR (' x)%CR. Proof. -intros x. -apply: Eq_alt_2_2. -simpl. -intros e He. -exists 0. -intros m Hm. -unfold cg_minus. -rstepr (Zero:Q). -apply zero_AbsSmall. -apply Qlt_le_weak. -assumption. + intros x. + apply: Eq_alt_2_2. + simpl. + intros e He. + exists 0. + intros m Hm. + unfold cg_minus. + rstepr (Zero:Q). + apply zero_AbsSmall. + apply Qlt_le_weak. + assumption. Qed. (** plus is preserved. *) -Lemma Cauchy_IR_plus_as_CR_plus : forall x y:Cauchy_IR, +Lemma Cauchy_IR_plus_as_CR_plus : forall x y:Cauchy_IR, (Cauchy_IRasCR x + Cauchy_IRasCR y == Cauchy_IRasCR (x[+]y))%CR. Proof. -intros [x Hx] [y Hy]. -apply: regFunEq_e. -intros e. -simpl. -unfold Cap_raw. -simpl. -destruct (Hx (((1 # 2) * e)%Qpos:Q) (Qpos_prf ((1 # 2) * e)%Qpos)) as [n1 Hn1]. -destruct (Hy (((1 # 2) * e)%Qpos:Q) (Qpos_prf ((1 # 2) * e)%Qpos)) as [n2 Hn2]. -destruct (CS_seq_plus Q_as_COrdField x y Hx Hy (e:Q) (Qpos_prf e)) as [n3 Hn3]. -set (n:= max n3 (max n1 n2)). -change (ball (e+e) (x n1 + y n2) (x n3 + y n3))%Q. -apply ball_triangle with (x n + y n)%Q. -setoid_replace e with (((1 # 2) * e +(1 # 2) * e)%Qpos ) by QposRing. -apply ball_triangle with (x n1 + y n)%Q; -simpl; -unfold Qball. - -stepr (y n2 - y n)%Q by (simpl;ring). -apply AbsSmall_minus. -apply Hn2. -unfold n. -rewrite max_assoc. -auto with *. - -stepr (x n1 - x n)%Q by (simpl;ring). -apply AbsSmall_minus. -apply Hn1. -unfold n. -rewrite (max_comm n1). -rewrite max_assoc. -auto with *. - -apply: Hn3; unfold n; auto with *. + intros [x Hx] [y Hy]. + apply: regFunEq_e. + intros e. + simpl. + unfold Cap_raw. + simpl. + destruct (Hx (((1 # 2) * e)%Qpos:Q) (Qpos_prf ((1 # 2) * e)%Qpos)) as [n1 Hn1]. + destruct (Hy (((1 # 2) * e)%Qpos:Q) (Qpos_prf ((1 # 2) * e)%Qpos)) as [n2 Hn2]. + destruct (CS_seq_plus Q_as_COrdField x y Hx Hy (e:Q) (Qpos_prf e)) as [n3 Hn3]. + set (n:= max n3 (max n1 n2)). + change (ball (e+e) (x n1 + y n2) (x n3 + y n3))%Q. + apply ball_triangle with (x n + y n)%Q. + setoid_replace e with (((1 # 2) * e +(1 # 2) * e)%Qpos ) by QposRing. + apply ball_triangle with (x n1 + y n)%Q; simpl; unfold Qball. + stepr (y n2 - y n)%Q by (simpl;ring). + apply AbsSmall_minus. + apply Hn2. + unfold n. + rewrite max_assoc. + auto with *. + stepr (x n1 - x n)%Q by (simpl;ring). + apply AbsSmall_minus. + apply Hn1. + unfold n. + rewrite (max_comm n1). + rewrite max_assoc. + auto with *. + apply: Hn3; unfold n; auto with *. Qed. Hint Rewrite Cauchy_IR_plus_as_CR_plus : CRtoCauchy_IR. -Lemma CR_plus_as_Cauchy_IR_plus : forall x y:CR, +Lemma CR_plus_as_Cauchy_IR_plus : forall x y:CR, CRasCauchy_IR x [+] CRasCauchy_IR y [=] CRasCauchy_IR (x+y)%CR. Proof. -apply reverse_iso_bin_uc_fun. -apply Cauchy_IR_plus_as_CR_plus. + apply reverse_iso_bin_uc_fun. + apply Cauchy_IR_plus_as_CR_plus. Qed. (** opp is preserved. *) -Lemma Cauchy_IR_opp_as_CR_opp : forall x:Cauchy_IR, +Lemma Cauchy_IR_opp_as_CR_opp : forall x:Cauchy_IR, (-Cauchy_IRasCR x == Cauchy_IRasCR ([--]x))%CR. Proof. -intros [x Hx]. -apply: regFunEq_e. -intros e. -simpl. -destruct (Hx (e:Q) (Qpos_prf e)) as [n1 Hn1]. -destruct (CS_seq_inv Q_as_COrdField x Hx (e:Q) (Qpos_prf e)) as [n2 Hn2]. -set (n:=(max n1 n2)). -change (ball (e+e) (- x n1) (- x n2))%Q. -apply ball_triangle with (- x n)%Q; -simpl; -unfold Qball; -[stepr (x n - x n1)%Q by (simpl;ring);apply Hn1| - apply Hn2]; -unfold n; auto with*. + intros [x Hx]. + apply: regFunEq_e. + intros e. + simpl. + destruct (Hx (e:Q) (Qpos_prf e)) as [n1 Hn1]. + destruct (CS_seq_inv Q_as_COrdField x Hx (e:Q) (Qpos_prf e)) as [n2 Hn2]. + set (n:=(max n1 n2)). + change (ball (e+e) (- x n1) (- x n2))%Q. + apply ball_triangle with (- x n)%Q; simpl; unfold Qball; + [stepr (x n - x n1)%Q by (simpl;ring);apply Hn1| apply Hn2]; unfold n; auto with*. Qed. Hint Rewrite Cauchy_IR_opp_as_CR_opp : CRtoCauchy_IR. -Lemma CR_opp_as_Cauchy_IR_opp : forall x:CR, +Lemma CR_opp_as_Cauchy_IR_opp : forall x:CR, [--](CRasCauchy_IR x) [=] CRasCauchy_IR (- x)%CR. Proof. -apply reverse_iso_uc_fun. -apply Cauchy_IR_opp_as_CR_opp. + apply reverse_iso_uc_fun. + apply Cauchy_IR_opp_as_CR_opp. Qed. (** le is preserved. *) Lemma Cauchy_IR_le_as_CR_le : forall (x y:Cauchy_IR), (Cauchy_IRasCR x <= Cauchy_IRasCR y)%CR <-> x[<=]y. Proof. -intros [x Hx] [y Hy]. -split. -intros H1 [n [e He H2]]. -assert (H1':=H1 ((1#3)*(mkQpos He))%Qpos). -clear H1. -simpl in H1'. -unfold Cap_raw in H1'; simpl in H1'. -destruct (Hy (((1 # 2) * ((1#3)* mkQpos He))%Qpos:Q) - (Qpos_prf ((1 # 2) * ((1#3)*mkQpos He))%Qpos)) as [n1 Hn1]. -destruct (Hx (((1 # 2) * ((1#3)* mkQpos He))%Qpos:Q) - (Qpos_prf ((1 # 2) * ((1#3)*mkQpos He))%Qpos)) as [n2 Hn2]. -simpl in H2. -set (m:=max n (max n1 n2)). -assert (m1:n<=m);[unfold m; auto with *|]. -assert (m2:n1<=m);[unfold m; apply le_trans with (max n1 n2); auto with *|]. -assert (m3:n2<=m);[unfold m; apply le_trans with (max n1 n2); auto with *|]. -apply (Qle_not_lt _ _ H1'). -apply: inv_cancel_less;simpl. -clear H1'. -autorewrite with QposElim in *. -apply Qlt_le_trans with ((2#3)*e)%Q. -ring_simplify. -apply: mult_resp_less. -constructor. -assumption. -replace LHS with (e + - ((1#2)*((1#3)*e)) + - ((1#2)*((1#3)*e)))%Q by ring. -replace RHS with ((x m - y m) + (y m - y n1) + -(x m - x n2))%Q by ring. -apply: plus_resp_leEq_both. -apply plus_resp_leEq_both. -apply H2; assumption. -refine (proj1 (Hn1 m _));assumption. -apply inv_resp_leEq. -refine (proj2 (Hn2 m _));assumption. - -(*Other Direction*) -intros H e. -simpl. -unfold Cap_raw; simpl. -destruct (Hy (((1 # 2) * e)%Qpos:Q) (Qpos_prf ((1 # 2) * e)%Qpos)) as [n1 Hn1]. -destruct (Hx (((1 # 2) * e)%Qpos:Q) (Qpos_prf ((1 # 2) * e)%Qpos)) as [n2 Hn2]. -apply Qnot_lt_le. -intros A. -apply H; clear H. -exists (max n1 n2). -simpl. -set (n:=max n1 n2). -exists (- e + - (y n1 + - x n2))%Q. -rewrite <- Qlt_minus_iff. -assumption. -intros m Hm. -unfold cg_minus. -simpl. -replace RHS with ((x m - x n2) + -(y m - y n1) + -(y n1 + - x n2))%Q by ring. -apply: plus_resp_leEq. -replace LHS with (-((1 # 2) * e) + - ((1 # 2) * e))%Q by ring. -apply plus_resp_leEq_both. -refine (proj1 (Hn2 _ _)). -apply le_trans with n; [unfold n;auto with *|assumption]. -apply inv_resp_leEq. -refine (proj2 (Hn1 _ _)). -apply le_trans with n; [unfold n;auto with *|assumption]. + intros [x Hx] [y Hy]. + split. + intros H1 [n [e He H2]]. + assert (H1':=H1 ((1#3)*(mkQpos He))%Qpos). + clear H1. + simpl in H1'. + unfold Cap_raw in H1'; simpl in H1'. + destruct (Hy (((1 # 2) * ((1#3)* mkQpos He))%Qpos:Q) + (Qpos_prf ((1 # 2) * ((1#3)*mkQpos He))%Qpos)) as [n1 Hn1]. + destruct (Hx (((1 # 2) * ((1#3)* mkQpos He))%Qpos:Q) + (Qpos_prf ((1 # 2) * ((1#3)*mkQpos He))%Qpos)) as [n2 Hn2]. + simpl in H2. + set (m:=max n (max n1 n2)). + assert (m1:n<=m);[unfold m; auto with *|]. + assert (m2:n1<=m);[unfold m; apply le_trans with (max n1 n2); auto with *|]. + assert (m3:n2<=m);[unfold m; apply le_trans with (max n1 n2); auto with *|]. + apply (Qle_not_lt _ _ H1'). + apply: inv_cancel_less;simpl. + clear H1'. + autorewrite with QposElim in *. + apply Qlt_le_trans with ((2#3)*e)%Q. + ring_simplify. + apply: mult_resp_less. + constructor. + assumption. + replace LHS with (e + - ((1#2)*((1#3)*e)) + - ((1#2)*((1#3)*e)))%Q by ring. + replace RHS with ((x m - y m) + (y m - y n1) + -(x m - x n2))%Q by ring. + apply: plus_resp_leEq_both. + apply plus_resp_leEq_both. + apply H2; assumption. + refine (proj1 (Hn1 m _));assumption. + apply inv_resp_leEq. + refine (proj2 (Hn2 m _));assumption. + (*Other Direction*) + intros H e. + simpl. + unfold Cap_raw; simpl. + destruct (Hy (((1 # 2) * e)%Qpos:Q) (Qpos_prf ((1 # 2) * e)%Qpos)) as [n1 Hn1]. + destruct (Hx (((1 # 2) * e)%Qpos:Q) (Qpos_prf ((1 # 2) * e)%Qpos)) as [n2 Hn2]. + apply Qnot_lt_le. + intros A. + apply H; clear H. + exists (max n1 n2). + simpl. + set (n:=max n1 n2). + exists (- e + - (y n1 + - x n2))%Q. + rewrite <- Qlt_minus_iff. + assumption. + intros m Hm. + unfold cg_minus. + simpl. + replace RHS with ((x m - x n2) + -(y m - y n1) + -(y n1 + - x n2))%Q by ring. + apply: plus_resp_leEq. + replace LHS with (-((1 # 2) * e) + - ((1 # 2) * e))%Q by ring. + apply plus_resp_leEq_both. + refine (proj1 (Hn2 _ _)). + apply le_trans with n; [unfold n;auto with *|assumption]. + apply inv_resp_leEq. + refine (proj2 (Hn1 _ _)). + apply le_trans with n; [unfold n;auto with *|assumption]. Qed. Hint Rewrite Cauchy_IR_le_as_CR_le : CRtoCauchy_IR. @@ -535,447 +521,416 @@ Hint Rewrite Cauchy_IR_le_as_CR_le : CRtoCauchy_IR. Lemma CR_le_as_Cauchy_IR_le : forall (x y:CR), CRasCauchy_IR x[<=]CRasCauchy_IR y <-> (x<=y)%CR. Proof. -intros x y. -rewrite <- Cauchy_IR_le_as_CR_le. -do 2 rewrite CRasCR. -reflexivity. + intros x y. + rewrite <- Cauchy_IR_le_as_CR_le. + do 2 rewrite CRasCR. + reflexivity. Qed. (** mult is preserved. *) -Lemma Cauchy_IR_mult_as_CRmult_bounded : forall x y:Cauchy_IR, +Lemma Cauchy_IR_mult_as_CRmult_bounded : forall x y:Cauchy_IR, forall (z:Qpos) (N:nat), (forall i:nat, (N<=i) -> AbsSmall (z:Q) (CS_seq _ y i)) -> (ucFun2 (CRmult_bounded z) (Cauchy_IRasCR x) (Cauchy_IRasCR y) == Cauchy_IRasCR (x[*]y))%CR. Proof. -intros [x Hx] y z N Hz. -destruct y as [y Hy]. -apply: regFunEq_e. -intros e. -simpl. -destruct (CS_seq_mult Q_as_COrdField x y Hx Hy (e:Q) (Qpos_prf e)) as [n3 Hn3]. -unfold Cap_raw. -simpl in *. -destruct (Hx (((1 # 2) * e / z)%Qpos:Q) (Qpos_prf ((1 # 2) * e / z)%Qpos)) as [n1 Hn1]. -apply Qscale_modulus_elim. - -intros Hxn1. -pose (n:=(max n3 (max n1 N))). -rewrite Hxn1. -setoid_replace (0 * - Qmax (- z) - (Qmin z - (Cauchy_IRasCR_raw (Build_CauchySeq Q_as_COrdField y Hy)(QposInf_bind (fun e0 : Qpos => e0) QposInfinity))))%Q - with (0 * y n)%Q by ring. -change (ball (e+e) (0 * y n) (x n3 * y n3))%Q. -apply ball_triangle with (x n*y n)%Q;[|apply: Hn3; unfold n; auto with *]. -apply ball_sym. -simpl. -rewrite <- Hxn1. -unfold Qball. -stepr ((x n - x n1)*y n)%Q by (simpl; ring). -apply AbsSmall_trans with ((1#2)*e)%Q. -apply half_3. -apply Qpos_prf. -stepl (((1#2)*e/z)*z)%Q by (simpl;field;apply Qpos_nonzero). -apply mult_AbsSmall;[apply Hn1|apply Hz]; -unfold n; apply le_trans with (max n1 N); auto with *. - -intros w Hw. -simpl. -destruct (Hy (w:Q) (Qpos_prf w)) as [n2 Hn2]. -pose (n:=(max (max n1 n2) (max n3 N))). -assert (n1 <= n);[unfold n; apply le_trans with (max n1 n2); auto with *|]. -assert (n2 <= n);[unfold n; apply le_trans with (max n1 n2); auto with *|]. -assert (n3 <= n);[unfold n; apply le_trans with (max n3 N); auto with *|]. -assert (N <= n);[unfold n; apply le_trans with (max n3 N); auto with *|]. -change (Qball (e+e)) with (@ball Q_as_MetricSpace (e + e)). -apply ball_triangle with (x n * y n)%Q;[|apply: Hn3; assumption]. -clear Hn3. -setoid_replace e with ((1#2)*e + (1#2)*e)%Qpos by QposRing. -apply ball_triangle with (x n1 * y n)%Q; -apply ball_sym; -simpl; -unfold Qball. -stepr (x n1*(y n - Qmax (- z) (Qmin z (y n2))))%Q by (simpl;ring). -autorewrite with QposElim. -stepl (((1#2)*e/w)*w)%Q by (simpl;field;apply Qpos_nonzero). -apply mult_AbsSmall;[apply Hw|]. -destruct (Hz n H2) as [X0 X1]. -destruct (Hn2 _ H0) as [X2 X3]. -unfold cg_minus in *. -simpl in *. -change (Qmax (- z) (Qmin z (y n2)))%Q with (QboundAbs z (y n2))%Q. - -assert (A0:(-w<=0)%Q). -rewrite Qle_minus_iff. -ring_simplify. - -apply Qpos_nonneg. -rewrite -> Qle_minus_iff in *. -clear - A0 X0 X1 X2 X3 Hn2 H0. -ring_simplify in A0. -ring_simplify in X0. -ring_simplify in X1. -ring_simplify in X2. -ring_simplify in X3. - -apply QboundAbs_elim; intros I; try solve [apply Hn2;assumption]; -rewrite -> Qle_minus_iff in I. -apply AbsSmall_minus. -unfold cg_minus;simpl. -apply leEq_imp_AbsSmall. -apply X1. -rewrite -> Qle_minus_iff. -replace RHS with ((y n + (-1 # 1) * y n2 + w)+(y n2 + - z))%Q by ring. -apply: plus_resp_nonneg; assumption. -apply: leEq_imp_AbsSmall; simpl; ring_simplify. -apply X0. -rewrite Qle_minus_iff. -replace RHS with ((w + (-1 # 1) * y n + y n2)+(- z + - y n2))%Q by ring. -apply: plus_resp_nonneg; assumption. - -stepr ((x n - x n1)*y n)%Q by (simpl;ring). -autorewrite with QposElim. -stepl (((1#2)*e/z)*z)%Q by (simpl;field;apply Qpos_nonzero). -apply mult_AbsSmall;[apply Hn1;assumption|apply Hz;assumption]. + intros [x Hx] y z N Hz. + destruct y as [y Hy]. + apply: regFunEq_e. + intros e. + simpl. + destruct (CS_seq_mult Q_as_COrdField x y Hx Hy (e:Q) (Qpos_prf e)) as [n3 Hn3]. + unfold Cap_raw. + simpl in *. + destruct (Hx (((1 # 2) * e / z)%Qpos:Q) (Qpos_prf ((1 # 2) * e / z)%Qpos)) as [n1 Hn1]. + apply Qscale_modulus_elim. + intros Hxn1. + pose (n:=(max n3 (max n1 N))). + rewrite Hxn1. + setoid_replace (0 * Qmax (- z) (Qmin z + (Cauchy_IRasCR_raw (Build_CauchySeq Q_as_COrdField y Hy)(QposInf_bind (fun e0 : Qpos => e0) QposInfinity))))%Q + with (0 * y n)%Q by ring. + change (ball (e+e) (0 * y n) (x n3 * y n3))%Q. + apply ball_triangle with (x n*y n)%Q;[|apply: Hn3; unfold n; auto with *]. + apply ball_sym. + simpl. + rewrite <- Hxn1. + unfold Qball. + stepr ((x n - x n1)*y n)%Q by (simpl; ring). + apply AbsSmall_trans with ((1#2)*e)%Q. + apply half_3. + apply Qpos_prf. + stepl (((1#2)*e/z)*z)%Q by (simpl;field;apply Qpos_nonzero). + apply mult_AbsSmall;[apply Hn1|apply Hz]; unfold n; apply le_trans with (max n1 N); auto with *. + intros w Hw. + simpl. + destruct (Hy (w:Q) (Qpos_prf w)) as [n2 Hn2]. + pose (n:=(max (max n1 n2) (max n3 N))). + assert (n1 <= n);[unfold n; apply le_trans with (max n1 n2); auto with *|]. + assert (n2 <= n);[unfold n; apply le_trans with (max n1 n2); auto with *|]. + assert (n3 <= n);[unfold n; apply le_trans with (max n3 N); auto with *|]. + assert (N <= n);[unfold n; apply le_trans with (max n3 N); auto with *|]. + change (Qball (e+e)) with (@ball Q_as_MetricSpace (e + e)). + apply ball_triangle with (x n * y n)%Q;[|apply: Hn3; assumption]. + clear Hn3. + setoid_replace e with ((1#2)*e + (1#2)*e)%Qpos by QposRing. + apply ball_triangle with (x n1 * y n)%Q; apply ball_sym; simpl; unfold Qball. + stepr (x n1*(y n - Qmax (- z) (Qmin z (y n2))))%Q by (simpl;ring). + autorewrite with QposElim. + stepl (((1#2)*e/w)*w)%Q by (simpl;field;apply Qpos_nonzero). + apply mult_AbsSmall;[apply Hw|]. + destruct (Hz n H2) as [X0 X1]. + destruct (Hn2 _ H0) as [X2 X3]. + unfold cg_minus in *. + simpl in *. + change (Qmax (- z) (Qmin z (y n2)))%Q with (QboundAbs z (y n2))%Q. + assert (A0:(-w<=0)%Q). + rewrite Qle_minus_iff. + ring_simplify. + apply Qpos_nonneg. + rewrite -> Qle_minus_iff in *. + clear - A0 X0 X1 X2 X3 Hn2 H0. + ring_simplify in A0. + ring_simplify in X0. + ring_simplify in X1. + ring_simplify in X2. + ring_simplify in X3. + apply QboundAbs_elim; intros I; try solve [apply Hn2;assumption]; rewrite -> Qle_minus_iff in I. + apply AbsSmall_minus. + unfold cg_minus;simpl. + apply leEq_imp_AbsSmall. + apply X1. + rewrite -> Qle_minus_iff. + replace RHS with ((y n + (-1 # 1) * y n2 + w)+(y n2 + - z))%Q by ring. + apply: plus_resp_nonneg; assumption. + apply: leEq_imp_AbsSmall; simpl; ring_simplify. + apply X0. + rewrite Qle_minus_iff. + replace RHS with ((w + (-1 # 1) * y n + y n2)+(- z + - y n2))%Q by ring. + apply: plus_resp_nonneg; assumption. + stepr ((x n - x n1)*y n)%Q by (simpl;ring). + autorewrite with QposElim. + stepl (((1#2)*e/z)*z)%Q by (simpl;field;apply Qpos_nonzero). + apply mult_AbsSmall;[apply Hn1;assumption|apply Hz;assumption]. Qed. Lemma AbsSmall_Qabs : forall x y, (Qabs y <= x)%Q <-> AbsSmall x y. Proof. -cut (forall x y, (0 <= y)%Q -> ((Qabs y <= x)%Q <-> AbsSmall (R:=Q_as_COrdField) x y)). -intros H x y. -generalize (H x y) (H x (-y)%Q). -clear H. -rewrite Qabs_opp. -apply Qabs_case; -intros H H1 H2. -auto. -assert (X:AbsSmall (R:=Q_as_COrdField) x y <-> AbsSmall (R:=Q_as_COrdField) x (- y)%Q). -split. -apply inv_resp_AbsSmall. -intros X. -stepr (- - y)%Q by (simpl; ring). -apply inv_resp_AbsSmall. -assumption. -rewrite X. -apply: H2. -rewrite -> Qle_minus_iff in H. -ring_simplify in H. -ring_simplify. -apply H. - -intros x y H. -rewrite Qabs_pos;[|assumption]. -split. -intros H0. -apply leEq_imp_AbsSmall; assumption. -intros [_ H0]. -assumption. -Qed. - -Lemma Cauchy_IR_mult_as_CR_mult : forall x y:Cauchy_IR, + cut (forall x y, (0 <= y)%Q -> ((Qabs y <= x)%Q <-> AbsSmall (R:=Q_as_COrdField) x y)). + intros H x y. + generalize (H x y) (H x (-y)%Q). + clear H. + rewrite Qabs_opp. + apply Qabs_case; intros H H1 H2. + auto. + assert (X:AbsSmall (R:=Q_as_COrdField) x y <-> AbsSmall (R:=Q_as_COrdField) x (- y)%Q). + split. + apply inv_resp_AbsSmall. + intros X. + stepr (- - y)%Q by (simpl; ring). + apply inv_resp_AbsSmall. + assumption. + rewrite X. + apply: H2. + rewrite -> Qle_minus_iff in H. + ring_simplify in H. + ring_simplify. + apply H. + intros x y H. + rewrite Qabs_pos;[|assumption]. + split. + intros H0. + apply leEq_imp_AbsSmall; assumption. + intros [_ H0]. + assumption. +Qed. + +Lemma Cauchy_IR_mult_as_CR_mult : forall x y:Cauchy_IR, ((Cauchy_IRasCR x)*(Cauchy_IRasCR y) == Cauchy_IRasCR (x[*]y))%CR. Proof. -intros x [y Hy]. -destruct (CS_seq_bounded _ y Hy) as [k Hk [n Hn]]. -set (y':=Build_CauchySeq Q_as_COrdField y Hy). -set (k':=(mkQpos Hk)). - -transitivity ((ucFun2 (CRmult_bounded (CR_b (1 # 1) (Cauchy_IRasCR y')+k')%Qpos) (Cauchy_IRasCR x) + intros x [y Hy]. + destruct (CS_seq_bounded _ y Hy) as [k Hk [n Hn]]. + set (y':=Build_CauchySeq Q_as_COrdField y Hy). + set (k':=(mkQpos Hk)). + transitivity ((ucFun2 (CRmult_bounded (CR_b (1 # 1) (Cauchy_IRasCR y')+k')%Qpos) (Cauchy_IRasCR x) (Cauchy_IRasCR y'))). -apply CRmult_bounded_weaken. -apply CR_b_lowerBound. -apply CR_b_upperBound. -autorewrite with QposElim. -rewrite Qle_minus_iff. -ring_simplify. -discriminate. -apply Cauchy_IR_mult_as_CRmult_bounded with n. - -intros i Hi. -apply: AbsSmall_trans;[|apply Hn;assumption]. -simpl. -rewrite Qlt_minus_iff. -unfold k'. -autorewrite with QposElim. -ring_simplify. -apply Qpos_prf. + apply CRmult_bounded_weaken. + apply CR_b_lowerBound. + apply CR_b_upperBound. + autorewrite with QposElim. + rewrite Qle_minus_iff. + ring_simplify. + discriminate. + apply Cauchy_IR_mult_as_CRmult_bounded with n. + intros i Hi. + apply: AbsSmall_trans;[|apply Hn;assumption]. + simpl. + rewrite Qlt_minus_iff. + unfold k'. + autorewrite with QposElim. + ring_simplify. + apply Qpos_prf. Qed. Hint Rewrite Cauchy_IR_mult_as_CR_mult : CRtoCauchy_IR. -Lemma CR_mult_as_Cauchy_IR_mult : forall x y:CR, +Lemma CR_mult_as_Cauchy_IR_mult : forall x y:CR, (CRasCauchy_IR x)[*](CRasCauchy_IR y) [=] CRasCauchy_IR (x*y)%CR. Proof. -apply reverse_iso_bin_wd_fun. -apply CRmult_wd. -apply Cauchy_IR_mult_as_CR_mult. + apply reverse_iso_bin_wd_fun. + apply CRmult_wd. + apply Cauchy_IR_mult_as_CR_mult. Qed. (** lt is preserved. *) Lemma Cauchy_IR_lt_as_CR_lt_1 : forall (x y:Cauchy_IR), x[<]y -> (Cauchy_IRasCR x < Cauchy_IRasCR y)%CR. Proof. -intros x y [n [e He Hn]]. -exists (mkQpos He). - -abstract ( -autorewrite with CRtoCauchy_IR; -intros [m [d Hd Hm]]; -refine (Qle_not_lt _ _ (Hn (max n m) _) _);[auto with *|]; -rewrite Qlt_minus_iff; -apply Qlt_le_trans with d;[assumption|]; -autorewrite with QposElim in Hm; -apply: Hm; auto with * -). + intros x y [n [e He Hn]]. + exists (mkQpos He). + abstract ( autorewrite with CRtoCauchy_IR; intros [m [d Hd Hm]]; + refine (Qle_not_lt _ _ (Hn (max n m) _) _);[auto with *|]; rewrite Qlt_minus_iff; + apply Qlt_le_trans with d;[assumption|]; autorewrite with QposElim in Hm; apply: Hm; auto with * + ). Defined. Lemma CR_lt_as_Cauchy_IR_lt_1 : forall (x y:CR), (x < y)%CR -> (CRasCauchy_IR x)[<](CRasCauchy_IR y). Proof. -intros x y [e He]. -apply shift_zero_less_minus'. -apply (less_leEq_trans _ Zero (Cauchy_CReals.inject_Q _ (e:Q))). -apply: ing_lt. -apply Qpos_prf. -unfold cg_minus. -stepr (CRasCauchy_IR (y-x))%CR. -stepl (CRasCauchy_IR (' e)%CR). -rewrite <- Cauchy_IR_le_as_CR_le. -do 2 rewrite CRasCR. -assumption. -apply: CR_inject_Q_as_Cauchy_IR_inject_Q. -stepl (CRasCauchy_IR y[+]CRasCauchy_IR(- x)%CR). -apply plus_resp_eq. -apply: CR_opp_as_Cauchy_IR_opp. -apply: CR_plus_as_Cauchy_IR_plus. + intros x y [e He]. + apply shift_zero_less_minus'. + apply (less_leEq_trans _ Zero (Cauchy_CReals.inject_Q _ (e:Q))). + apply: ing_lt. + apply Qpos_prf. + unfold cg_minus. + stepr (CRasCauchy_IR (y-x))%CR. + stepl (CRasCauchy_IR (' e)%CR). + rewrite <- Cauchy_IR_le_as_CR_le. + do 2 rewrite CRasCR. + assumption. + apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + stepl (CRasCauchy_IR y[+]CRasCauchy_IR(- x)%CR). + apply plus_resp_eq. + apply: CR_opp_as_Cauchy_IR_opp. + apply: CR_plus_as_Cauchy_IR_plus. Qed. Lemma Cauchy_IR_lt_as_CR_lt_2 : forall (x y:Cauchy_IR), ((Cauchy_IRasCR x) < (Cauchy_IRasCR y))%CR -> x[<]y. Proof. -intros x y H. -stepl (CRasCauchy_IR (Cauchy_IRasCR (x))) by (apply Cauchy_IRasCauchy_IR). -stepr (CRasCauchy_IR (Cauchy_IRasCR (y))) by (apply Cauchy_IRasCauchy_IR). -apply CR_lt_as_Cauchy_IR_lt_1. -assumption. + intros x y H. + stepl (CRasCauchy_IR (Cauchy_IRasCR (x))) by (apply Cauchy_IRasCauchy_IR). + stepr (CRasCauchy_IR (Cauchy_IRasCR (y))) by (apply Cauchy_IRasCauchy_IR). + apply CR_lt_as_Cauchy_IR_lt_1. + assumption. Qed. Lemma CR_lt_as_Cauchy_IR_lt_2 : forall (x y:CR), (CRasCauchy_IR x)[<](CRasCauchy_IR y) -> (x < y)%CR. Proof. -intros x y H. -eapply CRlt_wd;try apply CRasCR. -apply Cauchy_IR_lt_as_CR_lt_1. -assumption. + intros x y H. + eapply CRlt_wd;try apply CRasCR. + apply Cauchy_IR_lt_as_CR_lt_1. + assumption. Qed. (** appartness is preserved. *) Lemma Cauchy_IR_ap_as_CR_ap_1 : forall (x y:Cauchy_IR), x[#]y -> (CRapart (Cauchy_IRasCR x) (Cauchy_IRasCR y))%CR. Proof. -intros x y [H|H];[left|right];apply Cauchy_IR_lt_as_CR_lt_1; apply H. + intros x y [H|H];[left|right];apply Cauchy_IR_lt_as_CR_lt_1; apply H. Defined. Lemma CR_ap_as_Cauchy_IR_ap_1 : forall (x y:CR), CRapart x y -> (CRasCauchy_IR x) [#] (CRasCauchy_IR y). Proof. -intros x y [H|H];[left|right];apply CR_lt_as_Cauchy_IR_lt_1; apply H. + intros x y [H|H];[left|right];apply CR_lt_as_Cauchy_IR_lt_1; apply H. Defined. Lemma Cauchy_IR_ap_as_CR_ap_2 : forall (x y:Cauchy_IR), (CRapart (Cauchy_IRasCR x) (Cauchy_IRasCR y))%CR -> x[#]y. Proof. -intros x y [H|H];[left|right];apply Cauchy_IR_lt_as_CR_lt_2; apply H. + intros x y [H|H];[left|right];apply Cauchy_IR_lt_as_CR_lt_2; apply H. Qed. Lemma CR_ap_as_Cauchy_IR_ap_2 : forall (x y:CR), (CRasCauchy_IR x) [#] (CRasCauchy_IR y) -> CRapart x y. Proof. -intros x y [H|H];[left|right];apply CR_lt_as_Cauchy_IR_lt_2; apply H. + intros x y [H|H];[left|right];apply CR_lt_as_Cauchy_IR_lt_2; apply H. Defined. (** inv is preserved. *) -Lemma Cauchy_IR_inv_as_CRinv_pos : forall (x:Cauchy_IR) x_, +Lemma Cauchy_IR_inv_as_CRinv_pos : forall (x:Cauchy_IR) x_, forall (z:Qpos) (N:nat), (forall i:nat, (N<=i) -> (z <= (CS_seq _ x i))%Q) -> (CRinv_pos z (Cauchy_IRasCR x) == Cauchy_IRasCR (f_rcpcl x (Cinright _ _ x_)))%CR. Proof. -intros [x Hx] [a [d d_ x_]] z n Hn. -apply: regFunEq_e. -intros e. -simpl. -unfold Qinv_modulus. -destruct (Hx ((z * z * e)%Qpos:Q) (Qpos_prf (z * z * e)%Qpos)) as [b Hb]. -destruct (CS_seq_recip Q_as_COrdField x Hx d d_ a (fun (n0 : nat) (H : le a n0) => - leEq_wdr Q_as_COrdField d (@cg_minus Q_as_CGroup (x n0) (Qmake Z0 xH)) (x n0) (x_ n0 H) (cg_inv_zero Q_as_CGroup (x n0))) (e:Q) (Qpos_prf e)) as [c Hc]. -set (y:=(CS_seq_recip_seq Q_as_COrdField x d d_ a (fun (n0 : nat) (H : le a n0) => - leEq_wdr Q_as_COrdField d (@cg_minus Q_as_CGroup (x n0) (Qmake Z0 xH)) (x n0) (x_ n0 H) (cg_inv_zero Q_as_CGroup (x n0))))) in *. -unfold CS_seq_recip_seq in y. -simpl in y. -set (m:=max (max a n) (max b c)). -assert (Hm1: c<=m). -unfold m; apply le_trans with (max b c); auto with *. -change (ball (e+e) (/ Qmax z (x b))%Q (y c)). -apply ball_triangle with (y m);[|apply: Hc;assumption]. -clear Hc. -unfold y. -destruct (lt_le_dec m a) as [Z|Z]. -elim (le_not_lt _ _ Z). -unfold m. -apply lt_le_trans with (S (max a n)); auto with *. -change (AbsSmall (e:Q) (/ Qmax z (x b)-1 * / x m))%Q. -clear y. -assert (T:(~ (x m == 0)%Q /\ ~ (Qmax z (x b) == 0)%Q)). -split; apply (ap_symmetric_unfolded Q_as_CSetoid); apply: Qlt_not_eq. -apply Qlt_le_trans with z. -apply Qpos_prf. -apply Hn. -apply le_trans with (max a n). -auto with *. -unfold m; auto with *. -apply Qlt_le_trans with z; -auto with *. -stepr ((/(Qmax z (x b))*/(x m))*(x m - (Qmax z (x b))))%Q by - (simpl; field; assumption). -stepl ((/ Qmax z (x b) * / x m)*((Qmax z (x b))*(x m)*e))%Q by - (simpl;field; assumption). -apply mult_resp_AbsSmall. -assert (foo:forall q:Q, (0<=q -> 0<=/q)%Q). -intros [[|p|p] q] qH; -apply qH. -apply mult_resp_nonneg. -apply foo. -apply Qle_trans with z. -apply Qpos_nonneg. -apply Qmax_ub_l. -apply foo. -apply Qle_trans with z. -apply Qpos_nonneg. -apply Hn. -apply le_trans with (max a n); unfold m; auto with *. -simpl in x_. -apply (AbsSmall_leEq_trans _ (z*z*e)%Q). -apply mult_resp_leEq_rht;[apply mult_resp_leEq_both|]; -try apply Qpos_nonneg. -apply Qmax_ub_l. -apply Hn. -apply le_trans with (max a n); unfold m; auto with *. -assert (W:AbsSmall (R:=Q_as_COrdField) (z * z * e)%Q (x m - x b)%Q). -apply Hb. -apply le_trans with (max b c); unfold m; auto with *. -apply Qmax_case;intros C;[|assumption]. -apply leEq_imp_AbsSmall. -unfold Qminus. -rewrite <- Qle_minus_iff. -apply Hn. -apply le_trans with (max a n); unfold m; auto with *. -apply Qle_trans with (x m - x b)%Q. -rewrite Qle_minus_iff. -replace RHS with (z + - x b)%Q by ring. -rewrite <- Qle_minus_iff. -assumption. -destruct W; assumption. + intros [x Hx] [a [d d_ x_]] z n Hn. + apply: regFunEq_e. + intros e. + simpl. + unfold Qinv_modulus. + destruct (Hx ((z * z * e)%Qpos:Q) (Qpos_prf (z * z * e)%Qpos)) as [b Hb]. + destruct (CS_seq_recip Q_as_COrdField x Hx d d_ a (fun (n0 : nat) (H : le a n0) => + leEq_wdr Q_as_COrdField d (@cg_minus Q_as_CGroup (x n0) (Qmake Z0 xH)) (x n0) (x_ n0 H) (cg_inv_zero Q_as_CGroup (x n0))) (e:Q) (Qpos_prf e)) as [c Hc]. + set (y:=(CS_seq_recip_seq Q_as_COrdField x d d_ a (fun (n0 : nat) (H : le a n0) => + leEq_wdr Q_as_COrdField d (@cg_minus Q_as_CGroup (x n0) (Qmake Z0 xH)) (x n0) (x_ n0 H) (cg_inv_zero Q_as_CGroup (x n0))))) in *. + unfold CS_seq_recip_seq in y. + simpl in y. + set (m:=max (max a n) (max b c)). + assert (Hm1: c<=m). + unfold m; apply le_trans with (max b c); auto with *. + change (ball (e+e) (/ Qmax z (x b))%Q (y c)). + apply ball_triangle with (y m);[|apply: Hc;assumption]. + clear Hc. + unfold y. + destruct (lt_le_dec m a) as [Z|Z]. + elim (le_not_lt _ _ Z). + unfold m. + apply lt_le_trans with (S (max a n)); auto with *. + change (AbsSmall (e:Q) (/ Qmax z (x b)-1 * / x m))%Q. + clear y. + assert (T:(~ (x m == 0)%Q /\ ~ (Qmax z (x b) == 0)%Q)). + split; apply (ap_symmetric_unfolded Q_as_CSetoid); apply: Qlt_not_eq. + apply Qlt_le_trans with z. + apply Qpos_prf. + apply Hn. + apply le_trans with (max a n). + auto with *. + unfold m; auto with *. + apply Qlt_le_trans with z; auto with *. + stepr ((/(Qmax z (x b))*/(x m))*(x m - (Qmax z (x b))))%Q by (simpl; field; assumption). + stepl ((/ Qmax z (x b) * / x m)*((Qmax z (x b))*(x m)*e))%Q by (simpl;field; assumption). + apply mult_resp_AbsSmall. + assert (foo:forall q:Q, (0<=q -> 0<=/q)%Q). + intros [[|p|p] q] qH; apply qH. + apply mult_resp_nonneg. + apply foo. + apply Qle_trans with z. + apply Qpos_nonneg. + apply Qmax_ub_l. + apply foo. + apply Qle_trans with z. + apply Qpos_nonneg. + apply Hn. + apply le_trans with (max a n); unfold m; auto with *. + simpl in x_. + apply (AbsSmall_leEq_trans _ (z*z*e)%Q). + apply mult_resp_leEq_rht;[apply mult_resp_leEq_both|]; try apply Qpos_nonneg. + apply Qmax_ub_l. + apply Hn. + apply le_trans with (max a n); unfold m; auto with *. + assert (W:AbsSmall (R:=Q_as_COrdField) (z * z * e)%Q (x m - x b)%Q). + apply Hb. + apply le_trans with (max b c); unfold m; auto with *. + apply Qmax_case;intros C;[|assumption]. + apply leEq_imp_AbsSmall. + unfold Qminus. + rewrite <- Qle_minus_iff. + apply Hn. + apply le_trans with (max a n); unfold m; auto with *. + apply Qle_trans with (x m - x b)%Q. + rewrite Qle_minus_iff. + replace RHS with (z + - x b)%Q by ring. + rewrite <- Qle_minus_iff. + assumption. + destruct W; assumption. Qed. Lemma Cauchy_IR_nonZero_as_CR_nonZero_1 : forall (x:Cauchy_IR), Dom (f_rcpcl' _) x -> (CRapart (Cauchy_IRasCR x) (inject_Q 0%Q))%CR. Proof. -intros x x_. -eapply CRapart_wd. -reflexivity. -symmetry. -apply Cauchy_IR_inject_Q_as_CR_inject_Q. -apply Cauchy_IR_ap_as_CR_ap_1. -assumption. + intros x x_. + eapply CRapart_wd. + reflexivity. + symmetry. + apply Cauchy_IR_inject_Q_as_CR_inject_Q. + apply Cauchy_IR_ap_as_CR_ap_1. + assumption. Defined. Lemma CR_nonZero_as_Cauchy_IR_nonZero_1 : forall (x:CR), (CRapart x (inject_Q 0%Q))%CR -> Dom (f_rcpcl' _) (CRasCauchy_IR x). Proof. -intros x x_. -change ((CRasCauchy_IR x)[#]Zero). -stepr (CRasCauchy_IR (inject_Q 0)). -apply CR_ap_as_Cauchy_IR_ap_1. -assumption. -apply: CR_inject_Q_as_Cauchy_IR_inject_Q. + intros x x_. + change ((CRasCauchy_IR x)[#]Zero). + stepr (CRasCauchy_IR (inject_Q 0)). + apply CR_ap_as_Cauchy_IR_ap_1. + assumption. + apply: CR_inject_Q_as_Cauchy_IR_inject_Q. Defined. -Lemma Cauchy_IR_inv_as_CR_inv_short : forall (x:Cauchy_IR) x_, +Lemma Cauchy_IR_inv_as_CR_inv_short : forall (x:Cauchy_IR) x_, (@CRinv (Cauchy_IRasCR x) (Cauchy_IR_nonZero_as_CR_nonZero_1 _ x_) == Cauchy_IRasCR (f_rcpcl x x_))%CR. Proof. -intros [x Hx] [H|H]. -set (x':=(Build_CauchySeq Q_as_COrdField x Hx)) in *. -assert (H':(cm_unit Cauchy_IR)[<][--](x':Cauchy_IR)). -apply inv_cancel_less. -rstepl x'. -assumption. -set (y:= (Cauchy_IRasCR - [--](f_rcpcl (F:=Cauchy_IR) ([--](x':Cauchy_IR)) (Cinright _ _ H')))%CR). -transitivity y. -destruct H as [n [e He H]]. -change (-(CRinv_pos (mkQpos He) (- Cauchy_IRasCR (Build_CauchySeq Q_as_COrdField x Hx)))==y)%CR. -unfold y. -rewrite <- Cauchy_IR_opp_as_CR_opp. -apply CRopp_wd. -set (X := (Cauchy_IRasCR - (f_rcpcl (F:=Cauchy_IR) [--](x':Cauchy_IR) - (Cinright (R_lt Q_as_COrdField [--](x':Cauchy_IR) (Zero:Cauchy_IR)) (Zero[<][--](x':Cauchy_IR)) H')))%CR). -rewrite Cauchy_IR_opp_as_CR_opp. -apply: Cauchy_IR_inv_as_CRinv_pos. -intros i Hi. -autorewrite with QposElim. -simpl. -replace RHS with (0 - x i)%Q by ring. -apply: H. -apply Hi. -unfold y. -apply Cauchy_IRasCR_wd. -apply: mult_cancel_lft. -left. -apply H. -stepr (One:Cauchy_IR). -eapply eq_transitive. -apply cring_inv_mult_lft. -apply eq_symmetric. -eapply eq_transitive;[|apply cring_inv_mult_rht]. -apply eq_symmetric. -apply x_div_x. -apply eq_symmetric. -apply x_div_x. - -destruct H as [n [e He H]]. -apply: Cauchy_IR_inv_as_CRinv_pos. -intros i Hi. -autorewrite with QposElim. -simpl in *. -replace RHS with (x i- 0)%Q by ring. -apply H. -apply Hi. + intros [x Hx] [H|H]. + set (x':=(Build_CauchySeq Q_as_COrdField x Hx)) in *. + assert (H':(cm_unit Cauchy_IR)[<][--](x':Cauchy_IR)). + apply inv_cancel_less. + rstepl x'. + assumption. + set (y:= (Cauchy_IRasCR [--](f_rcpcl (F:=Cauchy_IR) ([--](x':Cauchy_IR)) (Cinright _ _ H')))%CR). + transitivity y. + destruct H as [n [e He H]]. + change (-(CRinv_pos (mkQpos He) (- Cauchy_IRasCR (Build_CauchySeq Q_as_COrdField x Hx)))==y)%CR. + unfold y. + rewrite <- Cauchy_IR_opp_as_CR_opp. + apply CRopp_wd. + set (X := (Cauchy_IRasCR (f_rcpcl (F:=Cauchy_IR) [--](x':Cauchy_IR) + (Cinright (R_lt Q_as_COrdField [--](x':Cauchy_IR) (Zero:Cauchy_IR)) (Zero[<][--](x':Cauchy_IR)) H')))%CR). + rewrite Cauchy_IR_opp_as_CR_opp. + apply: Cauchy_IR_inv_as_CRinv_pos. + intros i Hi. + autorewrite with QposElim. + simpl. + replace RHS with (0 - x i)%Q by ring. + apply: H. + apply Hi. + unfold y. + apply Cauchy_IRasCR_wd. + apply: mult_cancel_lft. + left. + apply H. + stepr (One:Cauchy_IR). + eapply eq_transitive. + apply cring_inv_mult_lft. + apply eq_symmetric. + eapply eq_transitive;[|apply cring_inv_mult_rht]. + apply eq_symmetric. + apply x_div_x. + apply eq_symmetric. + apply x_div_x. + destruct H as [n [e He H]]. + apply: Cauchy_IR_inv_as_CRinv_pos. + intros i Hi. + autorewrite with QposElim. + simpl in *. + replace RHS with (x i- 0)%Q by ring. + apply H. + apply Hi. Qed. Hint Rewrite Cauchy_IR_inv_as_CR_inv_short : CRtoCauchy_IR. -Lemma Cauchy_IR_inv_as_CR_inv : forall (x:Cauchy_IR) x_ H, +Lemma Cauchy_IR_inv_as_CR_inv : forall (x:Cauchy_IR) x_ H, (@CRinv (Cauchy_IRasCR x) H == Cauchy_IRasCR (f_rcpcl x x_))%CR. Proof. -intros x x_ H. -rewrite <- Cauchy_IR_inv_as_CR_inv_short. -apply CRinv_irrelvent. + intros x x_ H. + rewrite <- Cauchy_IR_inv_as_CR_inv_short. + apply CRinv_irrelvent. Qed. Lemma CR_inv_as_Cauchy_IR_inv : forall (x:CR) x_ H, f_rcpcl (CRasCauchy_IR x) H [=] CRasCauchy_IR (@CRinv x x_). Proof. -intros x x_ H. -stepl (CRasCauchy_IR (Cauchy_IRasCR (f_rcpcl (CRasCauchy_IR x) H))) by apply Cauchy_IRasCauchy_IR. -apply CRasCauchy_IR_wd. -rewrite <- Cauchy_IR_inv_as_CR_inv_short. -apply CRinv_wd. -apply CRasCR. + intros x x_ H. + stepl (CRasCauchy_IR (Cauchy_IRasCR (f_rcpcl (CRasCauchy_IR x) H))) by apply Cauchy_IRasCauchy_IR. + apply CRasCauchy_IR_wd. + rewrite <- Cauchy_IR_inv_as_CR_inv_short. + apply CRinv_wd. + apply CRasCR. Qed. Lemma CR_inv_as_Cauchy_IR_inv_short : forall (x:CR) x_, f_rcpcl (CRasCauchy_IR x) (CR_nonZero_as_Cauchy_IR_nonZero_1 _ x_) [=] CRasCauchy_IR (@CRinv x x_). Proof. -intros. -apply CR_inv_as_Cauchy_IR_inv. + intros. + apply CR_inv_as_Cauchy_IR_inv. Qed. diff --git a/reals/fast/CRcos.v b/reals/fast/CRcos.v index fcd2fed78..68c9ce434 100644 --- a/reals/fast/CRcos.v +++ b/reals/fast/CRcos.v @@ -52,111 +52,113 @@ Definition cos_poly_fun (x:Q) :Q := 1-2*x*x. Lemma cos_poly_fun_correct : forall (q:Q), inj_Q IR (cos_poly_fun q)[=]One[-]Two[*](inj_Q IR q[^]2). Proof. -intros q. -unfold cos_poly_fun. -stepr (inj_Q IR (One[-]Two*q^2)). - apply inj_Q_wd. - unfold cg_minus; simpl; unfold QONE; ring. -stepr (inj_Q IR (One)[-]inj_Q IR (Two[*]q ^ 2))%Q. - apply inj_Q_minus. -apply cg_minus_wd. - rstepr (nring 1:IR). - apply (inj_Q_nring IR 1). -stepr (inj_Q IR Two[*]inj_Q IR (q^2)). - apply inj_Q_mult. -apply mult_wd. - apply (inj_Q_nring IR 2). -apply (inj_Q_power IR q 2). + intros q. + unfold cos_poly_fun. + stepr (inj_Q IR (One[-]Two*q^2)). + apply inj_Q_wd. + unfold cg_minus; simpl; unfold QONE; ring. + stepr (inj_Q IR (One)[-]inj_Q IR (Two[*]q ^ 2))%Q. + apply inj_Q_minus. + apply cg_minus_wd. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). + stepr (inj_Q IR Two[*]inj_Q IR (q^2)). + apply inj_Q_mult. + apply mult_wd. + apply (inj_Q_nring IR 2). + apply (inj_Q_power IR q 2). Qed. Definition cos_poly_modulus (e:Qpos) := Qpos2QposInf ((1#4)*e). Let X:((-(1))<1)%Q. -constructor. +Proof. + constructor. Qed. Let D : Derivative (clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q))) (inj_Q_less _ _ _ X) ([-C-](One:IR){-}(Two:IR){**}FId{^}2) ([-C-](Zero:IR){-}(Two:IR){**}((nring 2){**}([-C-]One{*}FId{^}1))). -apply Derivative_minus. - apply Derivative_const. -apply Derivative_scal. -apply Derivative_nth. -apply Derivative_id. +Proof. + apply Derivative_minus. + apply Derivative_const. + apply Derivative_scal. + apply Derivative_nth. + apply Derivative_id. Qed. Lemma cos_poly_prf : is_UniformlyContinuousFunction (fun x => cos_poly_fun (QboundAbs (1#1) x)) cos_poly_modulus. Proof. -apply (fun a => is_UniformlyContinuousD_Q (Some (-(1))%Q) (Some (1:Q)) X _ _ D cos_poly_fun a (4#1)). - simpl; intros q _ _. - apply cos_poly_fun_correct. -simpl; intros x' _ [Hx0 Hx1]. -set (x:=(inj_Q IR x')) in *. -stepr (Four:IR) by (apply eq_symmetric; apply (inj_Q_nring IR 4)). -stepl (ABSIR ([--](Four[*]x))) by (apply AbsIR_wd; rational). -stepl (ABSIR (Four[*]x)) by apply AbsIR_inv. -rstepr (Four[*]One:IR). -apply AbsSmall_imp_AbsIR. -apply mult_resp_AbsSmall. - apply nring_nonneg. -split. - stepl ([--](pring IR 1)[/]Zero[+]One[//]den_is_nonzero IR (-1#1)). + apply (fun a => is_UniformlyContinuousD_Q (Some (-(1))%Q) (Some (1:Q)) X _ _ D cos_poly_fun a (4#1)). + simpl; intros q _ _. + apply cos_poly_fun_correct. + simpl; intros x' _ [Hx0 Hx1]. + set (x:=(inj_Q IR x')) in *. + stepr (Four:IR) by (apply eq_symmetric; apply (inj_Q_nring IR 4)). + stepl (ABSIR ([--](Four[*]x))) by (apply AbsIR_wd; rational). + stepl (ABSIR (Four[*]x)) by apply AbsIR_inv. + rstepr (Four[*]One:IR). + apply AbsSmall_imp_AbsIR. + apply mult_resp_AbsSmall. + apply nring_nonneg. + split. + stepl ([--](pring IR 1)[/]Zero[+]One[//]den_is_nonzero IR (-1#1)). + assumption. + unfold pring; simpl; rational. + stepr (pring IR 1[/]Zero[+]One[//]den_is_nonzero IR 1). assumption. unfold pring; simpl; rational. -stepr (pring IR 1[/]Zero[+]One[//]den_is_nonzero IR 1). - assumption. -unfold pring; simpl; rational. Qed. -Definition cos_poly_uc : Q_as_MetricSpace --> Q_as_MetricSpace := +Definition cos_poly_uc : Q_as_MetricSpace --> Q_as_MetricSpace := Build_UniformlyContinuousFunction cos_poly_prf. Definition cos_poly : CR --> CR := Cmap QPrelengthSpace cos_poly_uc. Lemma cos_poly_correct : forall x, AbsSmall (inj_Q IR (1)) x -> (IRasCR (One[-]Two[*]x[^]2)==cos_poly (IRasCR x))%CR. Proof. -intros x Hx. -assert (Y:Continuous (clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q))) ([-C-](One:IR){-}(Two:IR){**}FId{^}2)). - eapply Derivative_imp_Continuous. - apply D. -apply: (ContinuousCorrect (I:=(clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q)))) (inj_Q_less _ _ _ X) Y); - [|repeat constructor|]. - intros q Hq Hq0. - transitivity (IRasCR (inj_Q IR (cos_poly_fun q)));[|apply IRasCR_wd; apply cos_poly_fun_correct]. - simpl. - change (' q)%CR with (Cunit_fun _ q). - rewrite Cmap_fun_correct. - rewrite MonadLaw3. - rewrite IR_inj_Q_as_CR. - rewrite CReq_Qeq. - simpl. - unfold cos_poly_fun. - setoid_replace (Qmax (- (1 # 1)%Qpos) (Qmin (1 # 1)%Qpos q)) with q. - reflexivity. - setoid_replace (Qmin (1 # 1)%Qpos q) with q. - rewrite <- Qle_max_r. + intros x Hx. + assert (Y:Continuous (clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q))) ([-C-](One:IR){-}(Two:IR){**}FId{^}2)). + eapply Derivative_imp_Continuous. + apply D. + apply: (ContinuousCorrect (I:=(clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q)))) (inj_Q_less _ _ _ X) Y); + [|repeat constructor|]. + intros q Hq Hq0. + transitivity (IRasCR (inj_Q IR (cos_poly_fun q)));[|apply IRasCR_wd; apply cos_poly_fun_correct]. + simpl. + change (' q)%CR with (Cunit_fun _ q). + rewrite Cmap_fun_correct. + rewrite MonadLaw3. + rewrite IR_inj_Q_as_CR. + rewrite CReq_Qeq. + simpl. + unfold cos_poly_fun. + setoid_replace (Qmax (- (1 # 1)%Qpos) (Qmin (1 # 1)%Qpos q)) with q. + reflexivity. + setoid_replace (Qmin (1 # 1)%Qpos q) with q. + rewrite <- Qle_max_r. + apply leEq_inj_Q with IR. + destruct Hq0; assumption. + rewrite <- Qle_min_r. apply leEq_inj_Q with IR. destruct Hq0; assumption. - rewrite <- Qle_min_r. - apply leEq_inj_Q with IR. - destruct Hq0; assumption. -destruct Hx; split;[stepl [--](inj_Q IR (1:Q)) by apply eq_symmetric; apply inj_Q_inv|];assumption. + destruct Hx; split;[stepl [--](inj_Q IR (1:Q)) by apply eq_symmetric; apply inj_Q_inv|];assumption. Qed. Lemma Cos_double_angle : forall x, (Cos(Two[*]x)[=]One[-]Two[*]Sin x[^]2). Proof. -intros x. -csetoid_replace (Two[*]x) (x[+]x);[|rational]. -csetoid_rewrite (Cos_plus x x). -set (sx:=Sin x). -set (cx:=Cos x). -rstepl ((cx[^]2)[-](sx[^]2)). -unfold cg_minus. -csetoid_replace (cx[^]2) (One[-]sx[^]2). - rational. -apply cg_inv_unique_2. -rstepl ((cx[^]2[+]sx[^]2)[-]One). -apply x_minus_x. -apply FFT. + intros x. + csetoid_replace (Two[*]x) (x[+]x);[|rational]. + csetoid_rewrite (Cos_plus x x). + set (sx:=Sin x). + set (cx:=Cos x). + rstepl ((cx[^]2)[-](sx[^]2)). + unfold cg_minus. + csetoid_replace (cx[^]2) (One[-]sx[^]2). + rational. + apply cg_inv_unique_2. + rstepl ((cx[^]2[+]sx[^]2)[-]One). + apply x_minus_x. + apply FFT. Qed. End Cos_Poly. @@ -167,47 +169,47 @@ Definition rational_cos (x:Q) := cos_poly (rational_sin (x/2)). Lemma rational_cos_correct : forall (a:Q), (rational_cos a == IRasCR (Cos (inj_Q IR a)))%CR. Proof. -intros a. -unfold rational_cos. -rewrite rational_sin_correct. -rewrite <- cos_poly_correct. - apply IRasCR_wd. - csetoid_rewrite_rev (Cos_double_angle (inj_Q IR (a/2))). - apply Cos_wd. - csetoid_replace (Two:IR) (inj_Q IR (2:Q));[|apply eq_symmetric; apply (inj_Q_nring IR 2)]. - stepl (inj_Q IR (2*(a/2))) by apply inj_Q_mult. - apply inj_Q_wd. - simpl; field; discriminate. -apply AbsIR_imp_AbsSmall. -stepr (nring 1:IR) by (apply eq_symmetric; apply (inj_Q_nring IR 1)). -rstepr (One:IR). -apply AbsIR_Sin_leEq_One. + intros a. + unfold rational_cos. + rewrite rational_sin_correct. + rewrite <- cos_poly_correct. + apply IRasCR_wd. + csetoid_rewrite_rev (Cos_double_angle (inj_Q IR (a/2))). + apply Cos_wd. + csetoid_replace (Two:IR) (inj_Q IR (2:Q));[|apply eq_symmetric; apply (inj_Q_nring IR 2)]. + stepl (inj_Q IR (2*(a/2))) by apply inj_Q_mult. + apply inj_Q_wd. + simpl; field; discriminate. + apply AbsIR_imp_AbsSmall. + stepr (nring 1:IR) by (apply eq_symmetric; apply (inj_Q_nring IR 1)). + rstepr (One:IR). + apply AbsIR_Sin_leEq_One. Qed. Definition cos_uc_prf : is_UniformlyContinuousFunction rational_cos Qpos2QposInf. Proof. -apply (is_UniformlyContinuousFunction_wd) with (fun x => rational_cos x) (Qscale_modulus (1#1)). - reflexivity. - intros x. - simpl. - autorewrite with QposElim. - change (/1) with 1. - replace RHS with (x:Q) by ring. - apply Qle_refl. -apply (is_UniformlyContinuousD None None I _ _ (Derivative_Cos CI) rational_cos). - intros q [] _. - apply rational_cos_correct. -intros x [] _. -stepr (One:IR). - change (AbsIR ([--](Sin x))[<=]One). - stepl (AbsIR (Sin x)) by apply AbsIR_inv. - apply AbsIR_Sin_leEq_One. -rstepl (nring 1:IR). -apply eq_symmetric. -apply (inj_Q_nring IR 1). + apply (is_UniformlyContinuousFunction_wd) with (fun x => rational_cos x) (Qscale_modulus (1#1)). + reflexivity. + intros x. + simpl. + autorewrite with QposElim. + change (/1) with 1. + replace RHS with (x:Q) by ring. + apply Qle_refl. + apply (is_UniformlyContinuousD None None I _ _ (Derivative_Cos CI) rational_cos). + intros q [] _. + apply rational_cos_correct. + intros x [] _. + stepr (One:IR). + change (AbsIR ([--](Sin x))[<=]One). + stepl (AbsIR (Sin x)) by apply AbsIR_inv. + apply AbsIR_Sin_leEq_One. + rstepl (nring 1:IR). + apply eq_symmetric. + apply (inj_Q_nring IR 1). Qed. -Definition cos_uc : Q_as_MetricSpace --> CR := +Definition cos_uc : Q_as_MetricSpace --> CR := Build_UniformlyContinuousFunction cos_uc_prf. Definition cos_slow : CR --> CR := Cbind QPrelengthSpace cos_uc. @@ -215,14 +217,13 @@ Definition cos_slow : CR --> CR := Cbind QPrelengthSpace cos_uc. Lemma cos_slow_correct : forall x, (IRasCR (Cos x) == cos_slow (IRasCR x))%CR. Proof. -intros x. -apply: (ContinuousCorrect (CI:proper realline)); - [apply Continuous_Cos | | constructor]. -intros q [] _. -transitivity (rational_cos q);[|apply rational_cos_correct]. -unfold cos_slow. -rewrite (Cbind_correct QPrelengthSpace cos_uc (' q))%CR. -apply: BindLaw1. + intros x. + apply: (ContinuousCorrect (CI:proper realline)); [apply Continuous_Cos | | constructor]. + intros q [] _. + transitivity (rational_cos q);[|apply rational_cos_correct]. + unfold cos_slow. + rewrite (Cbind_correct QPrelengthSpace cos_uc (' q))%CR. + apply: BindLaw1. Qed. Definition cos (x:CR) := cos_slow (x - (compress (scale (2*Qceiling (approximate (x*(CRinv_pos (6#1) (scale 2 CRpi))) (1#2)%Qpos -(1#2))) CRpi)))%CR. @@ -230,29 +231,27 @@ Definition cos (x:CR) := cos_slow (x - (compress (scale (2*Qceiling (approximate Lemma cos_correct : forall x, (IRasCR (Cos x) == cos (IRasCR x))%CR. Proof. -intros x. -unfold cos. -generalize (Qceiling - (approximate (IRasCR x * CRinv_pos (6 # 1) (scale 2 CRpi)) - (1 # 2)%Qpos - (1 # 2)))%CR. -intros z. -rewrite compress_correct. -rewrite <- CRpi_correct, <- CRmult_scale, - <- IR_inj_Q_as_CR, <- IR_mult_as_CR, - <- IR_minus_as_CR, <- cos_slow_correct. -apply IRasCR_wd. -rewrite inj_Q_mult. -change (2:Q) with (Two:Q). -rewrite inj_Q_nring. -rstepr (Cos (x[+]([--](inj_Q IR z))[*](Two[*]Pi))). -setoid_replace (inj_Q IR z) with (zring z:IR). - rewrite <- zring_inv. - symmetry; apply Cos_periodic_Z. -rewrite <- inj_Q_zring. -apply inj_Q_wd. -symmetry; apply zring_Q. + intros x. + unfold cos. + generalize (Qceiling (approximate (IRasCR x * CRinv_pos (6 # 1) (scale 2 CRpi)) + (1 # 2)%Qpos - (1 # 2)))%CR. + intros z. + rewrite compress_correct. + rewrite <- CRpi_correct, <- CRmult_scale, <- IR_inj_Q_as_CR, <- IR_mult_as_CR, + <- IR_minus_as_CR, <- cos_slow_correct. + apply IRasCR_wd. + rewrite inj_Q_mult. + change (2:Q) with (Two:Q). + rewrite inj_Q_nring. + rstepr (Cos (x[+]([--](inj_Q IR z))[*](Two[*]Pi))). + setoid_replace (inj_Q IR z) with (zring z:IR). + rewrite <- zring_inv. + symmetry; apply Cos_periodic_Z. + rewrite <- inj_Q_zring. + apply inj_Q_wd. + symmetry; apply zring_Q. Qed. (* begin hide *) Hint Rewrite cos_correct : IRtoCR. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/reals/fast/CRexp.v b/reals/fast/CRexp.v index 456f2d6ef..eb6b463cb 100644 --- a/reals/fast/CRexp.v +++ b/reals/fast/CRexp.v @@ -61,13 +61,13 @@ Definition expSequence := mult_Streams recip_factorials (powers a). Lemma Str_nth_expSequence : forall n, (Str_nth n expSequence == (1#P_of_succ_nat (pred (fac n)))*a^n)%Q. Proof. -intros n. -unfold expSequence. -unfold mult_Streams. -rewrite Str_nth_zipWith. -rewrite Str_nth_powers. -rewrite Str_nth_recip_factorials. -reflexivity. + intros n. + unfold expSequence. + unfold mult_Streams. + rewrite Str_nth_zipWith. + rewrite Str_nth_powers. + rewrite Str_nth_recip_factorials. + reflexivity. Qed. (** The exponential is first defined on [[-1,0]]. *) @@ -75,169 +75,161 @@ Hypothesis Ha: 0 <= a <= 1. Lemma expSequence_dnn : DecreasingNonNegative expSequence. Proof. -apply mult_Streams_dnn. -apply recip_factorials_dnn. -apply powers_dnn. -assumption. + apply mult_Streams_dnn. + apply recip_factorials_dnn. + apply powers_dnn. + assumption. Qed. Lemma expSequence_zl : Limit expSequence 0. Proof. -apply: mult_Streams_zl. -apply recip_factorials_zl. -apply powers_nbz. -assumption. + apply: mult_Streams_zl. + apply recip_factorials_zl. + apply powers_nbz. + assumption. Defined. End ExpSeries. -Lemma exp_ps_correct : forall a (n:nat) H, +Lemma exp_ps_correct : forall a (n:nat) H, inj_Q IR ((((-(1))^n)*Str_nth n (expSequence (-a)))%Q)[=]Exp_ps n (inj_Q IR a) H. Proof. -intros a n H. -stepr (inj_Q IR ((1 # P_of_succ_nat (pred (fac n))) * a ^ n)%Q). -apply inj_Q_wd;simpl. -rewrite Str_nth_expSequence. -setoid_replace (a^n)%Q with ((-(1))^n*(-a)^n)%Q. -ring. - rewrite <- Qmult_power. - setoid_replace (- (1) * - a) with a by ring. - reflexivity. -generalize H; clear H. -induction n. - -intros H. -simpl. -unfold pring. -simpl. -rational. - -intros H. -stepl ((One[/](nring (S n))[//]nringS_ap_zero IR n)[*](inj_Q IR a)[*]Exp_ps n (inj_Q IR a) H). - -simpl. -change (nring (R:=IR) n[+]One) with (nring (R:=IR) (S n)). -rstepl (((One[/]nring (R:=IR) (S n)[//]nringS_ap_zero IR n)[*] -(One[/]nring (R:=IR) (fac n)[//]nring_fac_ap_zero IR n))[*] - (nexp IR n (inj_Q IR a[-]Zero)[*]inj_Q IR a)). -apply mult_wd;[|rational]. -assert (X:=(mult_resp_ap_zero _ _ _ (nringS_ap_zero IR n) (nring_fac_ap_zero IR n))). -rstepl (One[/]((nring (R:=IR) (S n))[*]nring (R:=IR) (fac n))[//]X). -apply div_wd;[rational|]. -apply eq_symmetric. -change (fac n + n * fac n)%nat with (S n*(fac n))%nat. -apply nring_comm_mult. - -stepl (inj_Q IR ((1#(P_of_succ_nat n))*a*((1 # P_of_succ_nat (pred (fac n))) * a ^ n))%Q). -apply inj_Q_wd. -change ((1 # P_of_succ_nat n) * a * ((1 # P_of_succ_nat (pred (fac n))) * a ^ n) == - (1 # P_of_succ_nat (pred (S n * fac n))) * a ^ S n)%Q. -replace (P_of_succ_nat (pred (S n * fac n))%nat) with - (P_of_succ_nat (pred (S n)) * P_of_succ_nat (pred (fac n)))%positive. -rewrite <- pred_Sn. -rewrite inj_S. -unfold Zsucc. -rewrite Qpower_plus'; auto with *. -change ((1 # P_of_succ_nat n * P_of_succ_nat (pred (fac n))%positive))%Q - with ((1 # P_of_succ_nat n) * (1#P_of_succ_nat (pred (fac n))))%Q. -ring. -apply nat_of_P_inj. -rewrite nat_of_P_mult_morphism. -repeat rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -rewrite <- pred_Sn. -rewrite S_predn. -rewrite S_predn. -reflexivity. - -cut (0 < S n * fac n)%nat;[auto with *|apply (nat_fac_gtzero (S n))]. -cut (0 < fac n)%nat;[auto with *|apply (nat_fac_gtzero n)]. - -stepl ((One[/]nring (R:=IR) (S n)[//]nringS_ap_zero IR n)[*]inj_Q IR a[*] - inj_Q IR ((1 # P_of_succ_nat (pred (fac n))) * a ^ n)%Q); - [apply mult_wdr; apply IHn|]. -apply eq_symmetric. -eapply eq_transitive;[apply inj_Q_mult|]. -eapply eq_transitive;[apply mult_wdl;apply inj_Q_mult|]. -apply mult_wdl. -apply mult_wdl. -change (1 # P_of_succ_nat n)%Q with (1/P_of_succ_nat n)%Q. -assert (A:inj_Q IR ((P_of_succ_nat n):Q)[=]nring (S n)). -stepl (inj_Q IR (nring (S n))). -apply inj_Q_nring. -apply inj_Q_wd. -simpl. -clear - n. -induction n. -reflexivity. -simpl. -rewrite IHn. -unfold Qeq. -simpl. -rewrite Pplus_one_succ_r. -repeat (rewrite Zpos_mult_morphism || rewrite Zpos_plus_distr). -ring. - -assert (B:inj_Q IR (P_of_succ_nat n:Q)[#]Zero). -stepl (nring (R:=IR) (S n)). -apply nringS_ap_zero. -apply eq_symmetric;assumption. -eapply eq_transitive;[apply inj_Q_div|]. -instantiate (1:=B). -apply div_wd. -rstepr (Zero[+]One:IR). -apply (inj_Q_nring IR 1). -assumption. + intros a n H. + stepr (inj_Q IR ((1 # P_of_succ_nat (pred (fac n))) * a ^ n)%Q). + apply inj_Q_wd;simpl. + rewrite Str_nth_expSequence. + setoid_replace (a^n)%Q with ((-(1))^n*(-a)^n)%Q. + ring. + rewrite <- Qmult_power. + setoid_replace (- (1) * - a) with a by ring. + reflexivity. + generalize H; clear H. + induction n. + intros H. + simpl. + unfold pring. + simpl. + rational. + intros H. + stepl ((One[/](nring (S n))[//]nringS_ap_zero IR n)[*](inj_Q IR a)[*]Exp_ps n (inj_Q IR a) H). + simpl. + change (nring (R:=IR) n[+]One) with (nring (R:=IR) (S n)). + rstepl (((One[/]nring (R:=IR) (S n)[//]nringS_ap_zero IR n)[*] + (One[/]nring (R:=IR) (fac n)[//]nring_fac_ap_zero IR n))[*] + (nexp IR n (inj_Q IR a[-]Zero)[*]inj_Q IR a)). + apply mult_wd;[|rational]. + assert (X:=(mult_resp_ap_zero _ _ _ (nringS_ap_zero IR n) (nring_fac_ap_zero IR n))). + rstepl (One[/]((nring (R:=IR) (S n))[*]nring (R:=IR) (fac n))[//]X). + apply div_wd;[rational|]. + apply eq_symmetric. + change (fac n + n * fac n)%nat with (S n*(fac n))%nat. + apply nring_comm_mult. + stepl (inj_Q IR ((1#(P_of_succ_nat n))*a*((1 # P_of_succ_nat (pred (fac n))) * a ^ n))%Q). + apply inj_Q_wd. + change ((1 # P_of_succ_nat n) * a * ((1 # P_of_succ_nat (pred (fac n))) * a ^ n) == + (1 # P_of_succ_nat (pred (S n * fac n))) * a ^ S n)%Q. + replace (P_of_succ_nat (pred (S n * fac n))%nat) with + (P_of_succ_nat (pred (S n)) * P_of_succ_nat (pred (fac n)))%positive. + rewrite <- pred_Sn. + rewrite inj_S. + unfold Zsucc. + rewrite Qpower_plus'; auto with *. + change ((1 # P_of_succ_nat n * P_of_succ_nat (pred (fac n))%positive))%Q + with ((1 # P_of_succ_nat n) * (1#P_of_succ_nat (pred (fac n))))%Q. + ring. + apply nat_of_P_inj. + rewrite nat_of_P_mult_morphism. + repeat rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + rewrite <- pred_Sn. + rewrite S_predn. + rewrite S_predn. + reflexivity. + cut (0 < S n * fac n)%nat;[auto with *|apply (nat_fac_gtzero (S n))]. + cut (0 < fac n)%nat;[auto with *|apply (nat_fac_gtzero n)]. + stepl ((One[/]nring (R:=IR) (S n)[//]nringS_ap_zero IR n)[*]inj_Q IR a[*] + inj_Q IR ((1 # P_of_succ_nat (pred (fac n))) * a ^ n)%Q); [apply mult_wdr; apply IHn|]. + apply eq_symmetric. + eapply eq_transitive;[apply inj_Q_mult|]. + eapply eq_transitive;[apply mult_wdl;apply inj_Q_mult|]. + apply mult_wdl. + apply mult_wdl. + change (1 # P_of_succ_nat n)%Q with (1/P_of_succ_nat n)%Q. + assert (A:inj_Q IR ((P_of_succ_nat n):Q)[=]nring (S n)). + stepl (inj_Q IR (nring (S n))). + apply inj_Q_nring. + apply inj_Q_wd. + simpl. + clear - n. + induction n. + reflexivity. + simpl. + rewrite IHn. + unfold Qeq. + simpl. + rewrite Pplus_one_succ_r. + repeat (rewrite Zpos_mult_morphism || rewrite Zpos_plus_distr). + ring. + assert (B:inj_Q IR (P_of_succ_nat n:Q)[#]Zero). + stepl (nring (R:=IR) (S n)). + apply nringS_ap_zero. + apply eq_symmetric;assumption. + eapply eq_transitive;[apply inj_Q_div|]. + instantiate (1:=B). + apply div_wd. + rstepr (Zero[+]One:IR). + apply (inj_Q_nring IR 1). + assumption. Qed. Lemma Qle_ZO_flip : forall a, -(1) <= a <= 0 -> 0 <= (-a) <= 1. Proof. -intros a [H0 H1]. -auto with *. -split. -change 0 with (-0). -apply Qopp_le_compat. -assumption. -change 1 with (- (-(1))). -apply Qopp_le_compat. -assumption. + intros a [H0 H1]. + auto with *. + split. + change 0 with (-0). + apply Qopp_le_compat. + assumption. + change 1 with (- (-(1))). + apply Qopp_le_compat. + assumption. Qed. -Definition rational_exp_small_neg (a:Q) (p:-(1) <= a <= 0) : CR +Definition rational_exp_small_neg (a:Q) (p:-(1) <= a <= 0) : CR := let p':= (Qle_ZO_flip p) in InfiniteAlternatingSum (expSequence_dnn p') (expSequence_zl p'). Lemma rational_exp_small_neg_correct : forall (a:Q) Ha, (@rational_exp_small_neg a Ha == IRasCR (Exp (inj_Q IR a)))%CR. Proof. -intros a Ha. -unfold rational_exp_small_neg. -apply: InfiniteAlternatingSum_correct. -intros n. -clear Ha. -apply exp_ps_correct. + intros a Ha. + unfold rational_exp_small_neg. + apply: InfiniteAlternatingSum_correct. + intros n. + clear Ha. + apply exp_ps_correct. Qed. (** exp is extended to work on [[-2^n, 0]] for all n. *) Lemma shrink_by_two : forall n a, (-(2^(S n)))%Z <= a <= 0 -> (-(2^n))%Z <= (a/2) <= 0. Proof. -intros n a [H0 H1]. -split. - apply Qmult_lt_0_le_reg_r with 2. + intros n a [H0 H1]. + split. + apply Qmult_lt_0_le_reg_r with 2. + constructor. + change ((-(2 ^ n)%Z) * 2 <= a / 2 * 2). + rewrite Zpower_Qpower; auto with *. + rewrite (inj_S n) in H0. + replace LHS with (-(2%positive^n*2^1)) by ring. + rewrite <- Qpower_plus;[|discriminate]. + replace RHS with a by (field; discriminate). + change (- (2 ^ Zsucc n)%Z <= a) in H0. + rewrite -> Zpower_Qpower in H0. + assumption. + auto with *. + apply: (fun a b => mult_cancel_leEq _ a b (2:Q));simpl. constructor. - change ((-(2 ^ n)%Z) * 2 <= a / 2 * 2). - rewrite Zpower_Qpower; auto with *. - rewrite (inj_S n) in H0. - replace LHS with (-(2%positive^n*2^1)) by ring. - rewrite <- Qpower_plus;[|discriminate]. - replace RHS with a by (field; discriminate). - change (- (2 ^ Zsucc n)%Z <= a) in H0. - rewrite -> Zpower_Qpower in H0. - assumption. - auto with *. -apply: (fun a b => mult_cancel_leEq _ a b (2:Q));simpl. - constructor. -replace LHS with a by (field; discriminate). -replace RHS with 0 by ring. -assumption. + replace LHS with a by (field; discriminate). + replace RHS with 0 by ring. + assumption. Qed. Fixpoint rational_exp_neg_bounded (n:nat) (a:Q) : (-(2^n))%Z <= a <= 0 -> CR := @@ -254,269 +246,270 @@ end. Lemma rational_exp_neg_bounded_correct : forall n (a:Q) Ha, (@rational_exp_neg_bounded n a Ha == IRasCR (Exp (inj_Q IR a)))%CR. Proof. -unfold rational_exp_neg_bounded. -induction n. + unfold rational_exp_neg_bounded. + induction n. + apply rational_exp_small_neg_correct. + intros a Ha. + destruct (Qlt_le_dec_fast a (- (1))). + rewrite IHn. + clear IHn. + rewrite compress_correct. + rewrite <- CRpower_positive_bounded_correct. + apply IRasCR_wd. + set (a':=inj_Q IR (a/2)). + simpl. + rstepl (Exp a'[*]Exp a'). + stepl (Exp (a'[+]a')) by apply Exp_plus. + apply Exp_wd. + unfold a'. + eapply eq_transitive. + apply eq_symmetric; apply (inj_Q_plus IR). + apply inj_Q_wd. + simpl. + field; discriminate. + apply leEq_imp_AbsSmall. + apply less_leEq; apply Exp_pos. + stepr (One:IR). + apply Exp_leEq_One. + stepr (inj_Q IR 0) by apply (inj_Q_nring IR 0). + apply inj_Q_leEq. + apply mult_cancel_leEq with (2:Q). + constructor. + change (a/2*2<=0). + replace LHS with a by (field; discriminate). + apply Qle_trans with (-(1)); try discriminate. + apply Qlt_le_weak. + assumption. + rstepl (nring 1:IR). + apply eq_symmetric; apply (inj_Q_nring IR 1). apply rational_exp_small_neg_correct. -intros a Ha. -destruct (Qlt_le_dec_fast a (- (1))). - rewrite IHn. - clear IHn. - rewrite compress_correct. - rewrite <- CRpower_positive_bounded_correct. - apply IRasCR_wd. - set (a':=inj_Q IR (a/2)). - simpl. - rstepl (Exp a'[*]Exp a'). - stepl (Exp (a'[+]a')) by apply Exp_plus. - apply Exp_wd. - unfold a'. - eapply eq_transitive. - apply eq_symmetric; apply (inj_Q_plus IR). - apply inj_Q_wd. - simpl. - field; discriminate. - apply leEq_imp_AbsSmall. - apply less_leEq; apply Exp_pos. - stepr (One:IR). - apply Exp_leEq_One. - stepr (inj_Q IR 0) by apply (inj_Q_nring IR 0). - apply inj_Q_leEq. - apply mult_cancel_leEq with (2:Q). - constructor. - change (a/2*2<=0). - replace LHS with a by (field; discriminate). - apply Qle_trans with (-(1)); try discriminate. - apply Qlt_le_weak. - assumption. - rstepl (nring 1:IR). - apply eq_symmetric; apply (inj_Q_nring IR 1). -apply rational_exp_small_neg_correct. Qed. Lemma rational_exp_bound_power_2 : forall (a:Q), a <= 0 -> (-2^(Z_of_nat match (Qnum a) with |Z0 => O | Zpos x => Psize x | Zneg x => Psize x end))%Z <= a. Proof. -intros [[|n|n] d] Ha; -simpl. - discriminate. - elim Ha. - reflexivity. -rewrite Qle_minus_iff. -change (0<=(-(n#d) + - (-2^Psize n)%Z)). -rewrite Qplus_comm. -rewrite <- Qle_minus_iff. -change (n # d <= - - (2 ^ Psize n)%Z). -replace RHS with ((2^Psize n)%Z:Q) by ring. -unfold Qle. -simpl. -change (n * 1 <= 2 ^ Psize n * d)%Z. -apply Zmult_le_compat; try auto with *. -clear - n. -apply Zle_trans with (n+1)%Z. - auto with *. -induction n. - change (Psize (xI n)) with (1 + (Psize n))%nat. + intros [[|n|n] d] Ha; simpl. + discriminate. + elim Ha. + reflexivity. + rewrite Qle_minus_iff. + change (0<=(-(n#d) + - (-2^Psize n)%Z)). + rewrite Qplus_comm. + rewrite <- Qle_minus_iff. + change (n # d <= - - (2 ^ Psize n)%Z). + replace RHS with ((2^Psize n)%Z:Q) by ring. + unfold Qle. + simpl. + change (n * 1 <= 2 ^ Psize n * d)%Z. + apply Zmult_le_compat; try auto with *. + clear - n. + apply Zle_trans with (n+1)%Z. + auto with *. + induction n. + change (Psize (xI n)) with (1 + (Psize n))%nat. + rewrite inj_plus. + rewrite Zpower_exp; try auto with *. + rewrite Zpos_xI. + replace LHS with (2*(n+1))%Z by ring. + apply Zmult_le_compat; auto with *. + change (Psize (xO n)) with (1 + (Psize n))%nat. rewrite inj_plus. rewrite Zpower_exp; try auto with *. - rewrite Zpos_xI. - replace LHS with (2*(n+1))%Z by ring. + rewrite Zpos_xO. + apply Zle_trans with (2*(n+1))%Z. + auto with *. apply Zmult_le_compat; auto with *. - change (Psize (xO n)) with (1 + (Psize n))%nat. - rewrite inj_plus. - rewrite Zpower_exp; try auto with *. - rewrite Zpos_xO. - apply Zle_trans with (2*(n+1))%Z. - auto with *. - apply Zmult_le_compat; auto with *. -discriminate. + discriminate. Qed. Definition rational_exp_neg (a:Q) : a <= 0 -> CR. -intros a Ha. -refine (@rational_exp_neg_bounded _ a _). -split. - apply (rational_exp_bound_power_2 Ha). -apply Ha. +Proof. + intros a Ha. + refine (@rational_exp_neg_bounded _ a _). + split. + apply (rational_exp_bound_power_2 Ha). + apply Ha. Defined. Lemma rational_exp_neg_correct : forall (a:Q) Ha, (@rational_exp_neg a Ha == IRasCR (Exp (inj_Q IR a)))%CR. Proof. -intros a Ha. -apply rational_exp_neg_bounded_correct. + intros a Ha. + apply rational_exp_neg_bounded_correct. Qed. (** exp(x) is bounded below by (3^x) for x nonpositive, and hence exp(x) is positive. *) Lemma minus_one_works_for_rational_exp_small_neg : -(1) <= -(1) <= 0. Proof. -constructor; discriminate. + constructor; discriminate. Qed. Lemma rational_exp_small_neg_posH : forall (a:Q) (p:-(1) <= a <= 0), ('(1#3) <= rational_exp_small_neg p)%CR. Proof. -intros a p. -apply CRle_trans with (rational_exp_small_neg minus_one_works_for_rational_exp_small_neg). -unfold CRle. -apply CRpos_nonNeg. -CR_solve_pos (1#1)%Qpos. -do 2 rewrite (rational_exp_small_neg_correct). -rewrite <- IR_leEq_as_CR. -apply Exp_resp_leEq. -apply inj_Q_leEq. -destruct p; assumption. + intros a p. + apply CRle_trans with (rational_exp_small_neg minus_one_works_for_rational_exp_small_neg). + unfold CRle. + apply CRpos_nonNeg. + CR_solve_pos (1#1)%Qpos. + do 2 rewrite (rational_exp_small_neg_correct). + rewrite <- IR_leEq_as_CR. + apply Exp_resp_leEq. + apply inj_Q_leEq. + destruct p; assumption. Qed. Lemma rational_exp_neg_posH : forall (n:nat) (a:Q) Ha, (-n <= a) -> ('((1#3)^n) <= @rational_exp_neg a Ha)%CR. Proof. -intros n a Ha Hn. -rewrite rational_exp_neg_correct. -rewrite <- IR_inj_Q_as_CR. -rewrite <- IR_leEq_as_CR. -stepl (inj_Q IR (1#3)[^]n) by (apply eq_symmetric; apply inj_Q_power). -assert (X:Zero[<]inj_Q IR (1#3)). - stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). - apply inj_Q_less. - constructor. -astepl (inj_Q IR (1#3)[!](nring n)[//]X). -unfold power. -apply Exp_resp_leEq. -destruct n. - rstepl (Zero:IR). - stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). - apply inj_Q_leEq. - assumption. -apply (fun a b => (shift_mult_leEq' _ a b _ (nringS_ap_zero IR n))). - apply nring_pos; auto with *. -stepr (inj_Q IR (a/(S n))). - apply Exp_cancel_leEq. - astepl (inj_Q IR (1#3)). - rewrite IR_leEq_as_CR. - rewrite IR_inj_Q_as_CR. - assert (Ha0 : -(1)<=(a/S n)<=0). - split. - rewrite Qle_minus_iff. - replace RHS with ((a + S n)*(1/(S n))) by (field;discriminate). - replace LHS with (0*(1/(S n))) by ring. + intros n a Ha Hn. + rewrite rational_exp_neg_correct. + rewrite <- IR_inj_Q_as_CR. + rewrite <- IR_leEq_as_CR. + stepl (inj_Q IR (1#3)[^]n) by (apply eq_symmetric; apply inj_Q_power). + assert (X:Zero[<]inj_Q IR (1#3)). + stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). + apply inj_Q_less. + constructor. + astepl (inj_Q IR (1#3)[!](nring n)[//]X). + unfold power. + apply Exp_resp_leEq. + destruct n. + rstepl (Zero:IR). + stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). + apply inj_Q_leEq. + assumption. + apply (fun a b => (shift_mult_leEq' _ a b _ (nringS_ap_zero IR n))). + apply nring_pos; auto with *. + stepr (inj_Q IR (a/(S n))). + apply Exp_cancel_leEq. + astepl (inj_Q IR (1#3)). + rewrite IR_leEq_as_CR. + rewrite IR_inj_Q_as_CR. + assert (Ha0 : -(1)<=(a/S n)<=0). + split. + rewrite Qle_minus_iff. + replace RHS with ((a + S n)*(1/(S n))) by (field;discriminate). + replace LHS with (0*(1/(S n))) by ring. + apply: mult_resp_leEq_rht;simpl. + replace RHS with (a + - (- (P_of_succ_nat n))) by ring. + rewrite <- Qle_minus_iff. + assumption. + rewrite <- (Qmake_Qdiv 1 (P_of_succ_nat n)). + discriminate. + replace RHS with (0*(1/(S n))) by ring. apply: mult_resp_leEq_rht;simpl. - replace RHS with (a + - (- (P_of_succ_nat n))) by ring. - rewrite <- Qle_minus_iff. assumption. rewrite <- (Qmake_Qdiv 1 (P_of_succ_nat n)). discriminate. - replace RHS with (0*(1/(S n))) by ring. - apply: mult_resp_leEq_rht;simpl. - assumption. - rewrite <- (Qmake_Qdiv 1 (P_of_succ_nat n)). - discriminate. - rewrite <- (rational_exp_small_neg_correct Ha0). - apply rational_exp_small_neg_posH. -assert (X0:inj_Q IR (inject_Z (S n))[#]Zero). - stepl (inj_Q IR (nring (S n))). - stepl (nring (S n):IR) by (apply eq_symmetric; apply (inj_Q_nring IR (S n))). - apply (nringS_ap_zero). - apply inj_Q_wd. - apply nring_Q. -stepl (inj_Q IR a[/]_[//]X0). - apply div_wd. - apply eq_reflexive. - stepl (inj_Q IR (nring (S n))). - apply inj_Q_nring. - apply inj_Q_wd. - apply nring_Q. -apply eq_symmetric. -apply inj_Q_div. + rewrite <- (rational_exp_small_neg_correct Ha0). + apply rational_exp_small_neg_posH. + assert (X0:inj_Q IR (inject_Z (S n))[#]Zero). + stepl (inj_Q IR (nring (S n))). + stepl (nring (S n):IR) by (apply eq_symmetric; apply (inj_Q_nring IR (S n))). + apply (nringS_ap_zero). + apply inj_Q_wd. + apply nring_Q. + stepl (inj_Q IR a[/]_[//]X0). + apply div_wd. + apply eq_reflexive. + stepl (inj_Q IR (nring (S n))). + apply inj_Q_nring. + apply inj_Q_wd. + apply nring_Q. + apply eq_symmetric. + apply inj_Q_div. Qed. Lemma rational_exp_neg_posH' : forall (a:Q) Ha, ('((3#1)^(Zdiv (Qnum a) (Qden a)))%Qpos <= @rational_exp_neg a Ha)%CR. Proof. -intros [n d] Ha. -simpl. -assert (X1:(d > 0)%Z) by auto with *. -assert (X:n = (d * (n / d) + n mod d)%Z). - apply Z_div_mod_eq. - assumption. -set (c:=(n/d)%Z) in *. -assert (X0:(0 <= -c)%Z). - apply Zmult_le_0_reg_r with d. - auto with *. - replace RHS with (-(d*c))%Z by ring. - change (-(d*c))%Z with (0-(d*c))%Z. - rewrite <- Zle_plus_swap. - replace LHS with (d*c + 0)%Z by ring. - apply Zle_trans with n. + intros [n d] Ha. + simpl. + assert (X1:(d > 0)%Z) by auto with *. + assert (X:n = (d * (n / d) + n mod d)%Z). + apply Z_div_mod_eq. + assumption. + set (c:=(n/d)%Z) in *. + assert (X0:(0 <= -c)%Z). + apply Zmult_le_0_reg_r with d. + auto with *. + replace RHS with (-(d*c))%Z by ring. + change (-(d*c))%Z with (0-(d*c))%Z. + rewrite <- Zle_plus_swap. + replace LHS with (d*c + 0)%Z by ring. + apply Zle_trans with n. + rewrite X. + apply Zplus_le_compat_l. + destruct (Z_mod_lt n _ X1). + assumption. + unfold Qle in Ha. + simpl in Ha. + replace LHS with (n*1)%Z by ring. + assumption. + setoid_replace (QposAsQ ((3#1)^c)%Qpos) with ((1#3)^(Z_to_nat X0)). + apply rational_exp_neg_posH. + rewrite <- (Z_to_nat_correct X0). + unfold Qle. + simpl. rewrite X. + replace LHS with (d*c + 0)%Z by ring. + replace RHS with (d*c + n mod d)%Z by ring. apply Zplus_le_compat_l. destruct (Z_mod_lt n _ X1). assumption. - unfold Qle in Ha. - simpl in Ha. - replace LHS with (n*1)%Z by ring. - assumption. -setoid_replace (QposAsQ ((3#1)^c)%Qpos) with ((1#3)^(Z_to_nat X0)). - apply rational_exp_neg_posH. - rewrite <- (Z_to_nat_correct X0). - unfold Qle. - simpl. - rewrite X. - replace LHS with (d*c + 0)%Z by ring. - replace RHS with (d*c + n mod d)%Z by ring. - apply Zplus_le_compat_l. - destruct (Z_mod_lt n _ X1). - assumption. -rewrite <- Z_to_nat_correct. -rewrite Q_Qpos_power. -change (1#3) with (/3). -rewrite Qinv_power. -rewrite <- Qpower_opp. -replace (- - c)%Z with c by ring. -reflexivity. + rewrite <- Z_to_nat_correct. + rewrite Q_Qpos_power. + change (1#3) with (/3). + rewrite Qinv_power. + rewrite <- Qpower_opp. + replace (- - c)%Z with c by ring. + reflexivity. Qed. Lemma rational_exp_neg_pos : forall (a:Q) Ha, CRpos (@rational_exp_neg a Ha). Proof. -intros a Ha. -exists ((3#1)^(Zdiv (Qnum a) (Qden a)))%Qpos. -apply rational_exp_neg_posH'. + intros a Ha. + exists ((3#1)^(Zdiv (Qnum a) (Qden a)))%Qpos. + apply rational_exp_neg_posH'. Defined. (** exp is extended to all numbers by saying exp(x) = 1/exp(-x) when x is positive. *) Definition rational_exp (a:Q) : CR. -intros a. -destruct (Qle_total 0 a). -refine (CRinv_pos ((3#1)^(Zdiv (Qnum (- a)) (Qden (- a))))%Qpos (@rational_exp_neg (-a) _)). -apply (Qopp_le_compat 0); assumption. -apply (rational_exp_neg q). +Proof. + intros a. + destruct (Qle_total 0 a). + refine (CRinv_pos ((3#1)^(Zdiv (Qnum (- a)) (Qden (- a))))%Qpos (@rational_exp_neg (-a) _)). + apply (Qopp_le_compat 0); assumption. + apply (rational_exp_neg q). Defined. Lemma rational_exp_correct : forall (a:Q), (rational_exp a == IRasCR (Exp (inj_Q IR a)))%CR. Proof. -intros a. -unfold rational_exp. -destruct (Qle_total 0 a); try apply rational_exp_neg_correct. -assert (X0:=rational_exp_neg_correct (Qopp_le_compat 0 a q)). -rewrite X0. -assert (X:((IRasCR (Exp (inj_Q IR (- a)%Q)) >< '0)%CR)). - cut (rational_exp_neg (Qopp_le_compat 0 a q) >< ' 0)%CR. - apply CRapart_wd; assumption || reflexivity. - right. - exists ((3 # 1) ^ (Qnum (-a) / Qden (-a)))%Qpos. - ring_simplify. - apply rational_exp_neg_posH'. -rewrite (@CRinv_pos_inv ((3 # 1) ^ (Qnum (-a) / Qden (-a))) _ X); - [|rewrite <- X0; apply rational_exp_neg_posH']. -rewrite <- IR_recip_as_CR_2. -apply IRasCR_wd. -apply eq_symmetric. -eapply eq_transitive;[|apply div_wd; apply eq_reflexive]. -apply Exp_inv'. -rstepl ([--][--](inj_Q IR a)). -csetoid_rewrite_rev (inj_Q_inv IR a). -apply eq_reflexive. + intros a. + unfold rational_exp. + destruct (Qle_total 0 a); try apply rational_exp_neg_correct. + assert (X0:=rational_exp_neg_correct (Qopp_le_compat 0 a q)). + rewrite X0. + assert (X:((IRasCR (Exp (inj_Q IR (- a)%Q)) >< '0)%CR)). + cut (rational_exp_neg (Qopp_le_compat 0 a q) >< ' 0)%CR. + apply CRapart_wd; assumption || reflexivity. + right. + exists ((3 # 1) ^ (Qnum (-a) / Qden (-a)))%Qpos. + ring_simplify. + apply rational_exp_neg_posH'. + rewrite (@CRinv_pos_inv ((3 # 1) ^ (Qnum (-a) / Qden (-a))) _ X); + [|rewrite <- X0; apply rational_exp_neg_posH']. + rewrite <- IR_recip_as_CR_2. + apply IRasCR_wd. + apply eq_symmetric. + eapply eq_transitive;[|apply div_wd; apply eq_reflexive]. + apply Exp_inv'. + rstepl ([--][--](inj_Q IR a)). + csetoid_rewrite_rev (inj_Q_inv IR a). + apply eq_reflexive. Qed. (** @@ -526,13 +519,13 @@ Definition CRe : CR := rational_exp 1. Lemma CRe_correct : (CRe == IRasCR E)%CR. Proof. -unfold CRe. -rewrite rational_exp_correct. -apply IRasCR_wd. -csetoid_replace (inj_Q IR 1) (One:IR). - algebra. -rstepr (nring 1:IR). -apply (inj_Q_nring IR 1). + unfold CRe. + rewrite rational_exp_correct. + apply IRasCR_wd. + csetoid_replace (inj_Q IR 1) (One:IR). + algebra. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). Qed. Hint Rewrite <- CRe_correct : IRtoCR. @@ -549,40 +542,89 @@ Definition exp_bound (z:Z) : Qpos := Lemma exp_bound_bound : forall (z:Z) x, closer (inj_Q IR (z:Q)) x -> AbsIR (Exp x)[<=]inj_Q IR (exp_bound z:Q). Proof. -intros [|z|z]; simpl; intros x Hx; - apply AbsSmall_imp_AbsIR; - (apply leEq_imp_AbsSmall;[apply less_leEq; apply Exp_pos|]). - stepr (One:IR). - apply Exp_leEq_One. - stepr (inj_Q IR (0%Z:Q)). - assumption. + intros [|z|z]; simpl; intros x Hx; apply AbsSmall_imp_AbsIR; + (apply leEq_imp_AbsSmall;[apply less_leEq; apply Exp_pos|]). + stepr (One:IR). + apply Exp_leEq_One. + stepr (inj_Q IR (0%Z:Q)). + assumption. + apply (inj_Q_nring IR 0). + rstepl (nring 1:IR). + apply eq_symmetric; apply (inj_Q_nring IR 1). + apply leEq_transitive with (Exp (Max x Zero)). + apply Exp_resp_leEq. + apply lft_leEq_Max. + stepr (Three[!](inj_Q IR (z:Q))[//](pos_three IR):IR). + astepl (E[!](Max x Zero)[//]pos_E). + apply real_power_resp_leEq_both; try solve [IR_solve_ineq (1#1)%Qpos]. + apply rht_leEq_Max. + apply Max_leEq; auto. + stepl (inj_Q IR 0). + apply inj_Q_leEq. + simpl; auto with *. apply (inj_Q_nring IR 0). - rstepl (nring 1:IR). - apply eq_symmetric; apply (inj_Q_nring IR 1). - apply leEq_transitive with (Exp (Max x Zero)). - apply Exp_resp_leEq. - apply lft_leEq_Max. - stepr (Three[!](inj_Q IR (z:Q))[//](pos_three IR):IR). - astepl (E[!](Max x Zero)[//]pos_E). - apply real_power_resp_leEq_both; - try solve [IR_solve_ineq (1#1)%Qpos]. - apply rht_leEq_Max. - apply Max_leEq; auto. - stepl (inj_Q IR 0). - apply inj_Q_leEq. - simpl; auto with *. - apply (inj_Q_nring IR 0). - stepl (Three[!]nring (nat_of_P z)[//]pos_three IR). - astepl (Three[^](nat_of_P z):IR). - stepl ((inj_Q IR (3:Q))[^](nat_of_P z)). - stepl (inj_Q IR (3^z)). + stepl (Three[!]nring (nat_of_P z)[//]pos_three IR). + astepl (Three[^](nat_of_P z):IR). + stepl ((inj_Q IR (3:Q))[^](nat_of_P z)). + stepl (inj_Q IR (3^z)). + apply inj_Q_wd. + apply eq_symmetric. + apply Q_Qpos_power. + rewrite <- convert_is_POS. + apply inj_Q_power. + apply nexp_wd. + apply (inj_Q_nring IR 3). + apply power_wd. + apply eq_reflexive. + apply eq_symmetric. + rewrite <- convert_is_POS. + stepl (inj_Q IR (nring (nat_of_P z))). + apply (inj_Q_nring). + apply inj_Q_wd; apply nring_Q. + stepr (Half[!](inj_Q IR (z:Q))[//](pos_half IR):IR). + astepl (Exp [--][--]x). + astepl (One[/]_[//](Exp_ap_zero [--]x)). + unfold Half. + astepr ((One[!]inj_Q IR (z:Q)[//]pos_one _)[/]((Two[!]inj_Q IR (z:Q)[//]pos_two _))[//]power_ap_zero _ _ _). + astepr (One[/]((Two[!]inj_Q IR (z:Q)[//]pos_two _))[//]power_ap_zero _ _ _). + apply recip_resp_leEq. + apply power_pos. + astepr (E[!][--]x[//]pos_E). + apply real_power_resp_leEq_both; try solve [IR_solve_ineq (1#1)%Qpos]. + stepl (inj_Q IR 0). + apply inj_Q_leEq. + simpl; auto with *. + apply (inj_Q_nring IR 0). + rstepl ([--][--](inj_Q IR (z:Q))). + apply inv_resp_leEq. + stepr (inj_Q IR ((Zneg z):Q)). + assumption. + astepr (inj_Q IR ([--](z:Q))). + apply inj_Q_wd. + simpl; reflexivity. + stepl (Half[!]nring (nat_of_P z)[//]pos_half IR). + astepl (Half[^](nat_of_P z):IR). + stepl ((inj_Q IR ((1#2):Q))[^](nat_of_P z)). + stepl (inj_Q IR ((1#2)^z)). apply inj_Q_wd. apply eq_symmetric. apply Q_Qpos_power. - rewrite <- convert_is_POS. + rewrite <- (convert_is_POS z). apply inj_Q_power. apply nexp_wd. - apply (inj_Q_nring IR 3). + assert (X:(inj_Q IR (2:Q))[#]Zero). + stepr (inj_Q IR 0). + apply inj_Q_ap; discriminate. + apply (inj_Q_nring IR 0). + stepr ((inj_Q IR 1)[/]_[//]X). + stepl (inj_Q IR (1/2)). + apply inj_Q_div. + apply inj_Q_wd. + apply eq_symmetric; apply Qmake_Qdiv. + apply div_wd. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). + apply (inj_Q_nring IR 2). apply power_wd. apply eq_reflexive. apply eq_symmetric. @@ -590,74 +632,21 @@ intros [|z|z]; simpl; intros x Hx; stepl (inj_Q IR (nring (nat_of_P z))). apply (inj_Q_nring). apply inj_Q_wd; apply nring_Q. - -stepr (Half[!](inj_Q IR (z:Q))[//](pos_half IR):IR). - astepl (Exp [--][--]x). - astepl (One[/]_[//](Exp_ap_zero [--]x)). - unfold Half. - astepr ((One[!]inj_Q IR (z:Q)[//]pos_one _)[/]((Two[!]inj_Q IR (z:Q)[//]pos_two _))[//]power_ap_zero _ _ _). - astepr (One[/]((Two[!]inj_Q IR (z:Q)[//]pos_two _))[//]power_ap_zero _ _ _). - apply recip_resp_leEq. - apply power_pos. - astepr (E[!][--]x[//]pos_E). - apply real_power_resp_leEq_both; - try solve [IR_solve_ineq (1#1)%Qpos]. - stepl (inj_Q IR 0). - apply inj_Q_leEq. - simpl; auto with *. - apply (inj_Q_nring IR 0). - rstepl ([--][--](inj_Q IR (z:Q))). - apply inv_resp_leEq. - stepr (inj_Q IR ((Zneg z):Q)). - assumption. - astepr (inj_Q IR ([--](z:Q))). - apply inj_Q_wd. - simpl; reflexivity. -stepl (Half[!]nring (nat_of_P z)[//]pos_half IR). - astepl (Half[^](nat_of_P z):IR). - stepl ((inj_Q IR ((1#2):Q))[^](nat_of_P z)). - stepl (inj_Q IR ((1#2)^z)). - apply inj_Q_wd. - apply eq_symmetric. - apply Q_Qpos_power. - rewrite <- (convert_is_POS z). - apply inj_Q_power. - apply nexp_wd. - assert (X:(inj_Q IR (2:Q))[#]Zero). - stepr (inj_Q IR 0). - apply inj_Q_ap; discriminate. - apply (inj_Q_nring IR 0). - stepr ((inj_Q IR 1)[/]_[//]X). - stepl (inj_Q IR (1/2)). - apply inj_Q_div. - apply inj_Q_wd. - apply eq_symmetric; apply Qmake_Qdiv. - apply div_wd. - rstepr (nring 1:IR). - apply (inj_Q_nring IR 1). - apply (inj_Q_nring IR 2). -apply power_wd. - apply eq_reflexive. -apply eq_symmetric. -rewrite <- convert_is_POS. -stepl (inj_Q IR (nring (nat_of_P z))). - apply (inj_Q_nring). -apply inj_Q_wd; apply nring_Q. -Qed. +Qed. Lemma exp_bound_uc_prf : forall z:Z, is_UniformlyContinuousFunction (fun a => rational_exp (Qmin z a)) (Qscale_modulus (exp_bound z)). Proof. -intros z. -assert (Z:Derivative (closer (inj_Q IR (z:Q))) CI Expon Expon). - apply (Included_imp_Derivative realline CI). - Deriv. - Included. -apply (is_UniformlyContinuousD None (Some (z:Q)) I _ _ Z). - intros q [] H. - apply rational_exp_correct. -intros x [] H. -apply: exp_bound_bound. -assumption. + intros z. + assert (Z:Derivative (closer (inj_Q IR (z:Q))) CI Expon Expon). + apply (Included_imp_Derivative realline CI). + Deriv. + Included. + apply (is_UniformlyContinuousD None (Some (z:Q)) I _ _ Z). + intros q [] H. + apply rational_exp_correct. + intros x [] H. + apply: exp_bound_bound. + assumption. Qed. Definition exp_bound_uc (z:Z) : Q_as_MetricSpace --> CR := @@ -668,28 +657,28 @@ Definition exp_bounded (z:Z) : CR --> CR := (Cbind QPrelengthSpace (exp_bound_uc Lemma exp_bounded_correct : forall (z:Z) x, closer (inj_Q _ (z:Q)) x -> (IRasCR (Exp x)==exp_bounded z (IRasCR x))%CR. Proof. -intros z x Hx. -assert (Z:Continuous (closer (inj_Q IR (z:Q))) Expon). - apply (Included_imp_Continuous realline). - Contin. - Included. -apply (fun a b c => @ContinuousCorrect _ a Expon Z b c x CI); auto with *. - constructor. -intros q [] H. -transitivity (exp_bound_uc z q);[|]. - change (' q)%CR with (Cunit_fun _ q). - unfold exp_bounded. - rewrite (Cbind_correct QPrelengthSpace (exp_bound_uc z) (Cunit_fun Q_as_MetricSpace q)). - apply: BindLaw1. -change (rational_exp (Qmin z q) == IRasCR (Exp (inj_Q IR q)))%CR. -rewrite rational_exp_correct. -apply IRasCR_wd. -apply Exp_wd. -apply inj_Q_wd. -simpl. -rewrite <- Qle_min_r. -apply leEq_inj_Q with IR. -assumption. + intros z x Hx. + assert (Z:Continuous (closer (inj_Q IR (z:Q))) Expon). + apply (Included_imp_Continuous realline). + Contin. + Included. + apply (fun a b c => @ContinuousCorrect _ a Expon Z b c x CI); auto with *. + constructor. + intros q [] H. + transitivity (exp_bound_uc z q);[|]. + change (' q)%CR with (Cunit_fun _ q). + unfold exp_bounded. + rewrite (Cbind_correct QPrelengthSpace (exp_bound_uc z) (Cunit_fun Q_as_MetricSpace q)). + apply: BindLaw1. + change (rational_exp (Qmin z q) == IRasCR (Exp (inj_Q IR q)))%CR. + rewrite rational_exp_correct. + apply IRasCR_wd. + apply Exp_wd. + apply inj_Q_wd. + simpl. + rewrite <- Qle_min_r. + apply leEq_inj_Q with IR. + assumption. Qed. (** exp on all real numbers. [exp_bounded] should be used instead when [x] @@ -700,35 +689,34 @@ Implicit Arguments exp []. (* end hide *) Lemma exp_bound_lemma : forall x : CR, (x <= ' (approximate x (1 # 1)%Qpos + 1))%CR. Proof. -intros x. -assert (X:=ball_approx_l x (1#1)). -rewrite <- CRAbsSmall_ball in X. -destruct X as [X _]. -simpl in X. -rewrite <- CRplus_Qplus. -apply CRle_trans with (doubleSpeed x). - rewrite (doubleSpeed_Eq x); apply CRle_refl. -intros e. -assert (Y:=X e). -simpl in *. -do 2 (unfold Cap_raw in *; simpl in *). -replace RHS with (approximate x (1 # 1)%Qpos + - - approximate x ((1 # 2) * ((1 # 2) * e))%Qpos + - - (1 # 1)%Qpos) - by QposRing. -assumption. + intros x. + assert (X:=ball_approx_l x (1#1)). + rewrite <- CRAbsSmall_ball in X. + destruct X as [X _]. + simpl in X. + rewrite <- CRplus_Qplus. + apply CRle_trans with (doubleSpeed x). + rewrite (doubleSpeed_Eq x); apply CRle_refl. + intros e. + assert (Y:=X e). + simpl in *. + do 2 (unfold Cap_raw in *; simpl in *). + replace RHS with (approximate x (1 # 1)%Qpos + + - approximate x ((1 # 2) * ((1 # 2) * e))%Qpos + - - (1 # 1)%Qpos) by QposRing. + assumption. Qed. Lemma exp_correct : forall x, (IRasCR (Exp x)==exp (IRasCR x))%CR. Proof. -intros x. -unfold exp. -apply exp_bounded_correct. -simpl. -apply leEq_transitive with (inj_Q IR ((approximate (IRasCR x) (1 # 1)%Qpos + 1))); - [|apply inj_Q_leEq; simpl;auto with *]. -rewrite IR_leEq_as_CR. -rewrite IR_inj_Q_as_CR. -apply exp_bound_lemma. + intros x. + unfold exp. + apply exp_bounded_correct. + simpl. + apply leEq_transitive with (inj_Q IR ((approximate (IRasCR x) (1 # 1)%Qpos + 1))); + [|apply inj_Q_leEq; simpl;auto with *]. + rewrite IR_leEq_as_CR. + rewrite IR_inj_Q_as_CR. + apply exp_bound_lemma. Qed. (* begin hide *) Hint Rewrite exp_correct : IRtoCR. @@ -737,49 +725,50 @@ Lemma exp_bound_exp : forall (z:Z) (x:CR), (x <= 'z -> exp_bounded z x == exp x)%CR. Proof. -intros z x H. -unfold exp. -set (a:=(approximate x (1 # 1)%Qpos + 1)). -rewrite <- (CRasIRasCR_id x). -rewrite <- exp_bounded_correct. + intros z x H. + unfold exp. + set (a:=(approximate x (1 # 1)%Qpos + 1)). + rewrite <- (CRasIRasCR_id x). rewrite <- exp_bounded_correct. - reflexivity. - change (CRasIR x [<=] inj_Q IR (Qceiling a:Q)). + rewrite <- exp_bounded_correct. + reflexivity. + change (CRasIR x [<=] inj_Q IR (Qceiling a:Q)). + rewrite IR_leEq_as_CR. + autorewrite with IRtoCR. + rewrite CRasIRasCR_id. + apply CRle_trans with ('a)%CR. + apply exp_bound_lemma. + rewrite CRle_Qle. + auto with *. + change (CRasIR x [<=] inj_Q IR (z:Q)). rewrite IR_leEq_as_CR. autorewrite with IRtoCR. rewrite CRasIRasCR_id. + assumption. +Qed. +(* begin hide *) +Add Morphism exp with signature (@st_eq _) ==> (@st_eq _) as exp_wd. +Proof. + intros x y Hxy. + unfold exp at 1. + set (a := (approximate x (1 # 1)%Qpos + 1)). + rewrite Hxy. + apply exp_bound_exp. + rewrite <- Hxy. apply CRle_trans with ('a)%CR. apply exp_bound_lemma. rewrite CRle_Qle. auto with *. -change (CRasIR x [<=] inj_Q IR (z:Q)). -rewrite IR_leEq_as_CR. -autorewrite with IRtoCR. -rewrite CRasIRasCR_id. -assumption. -Qed. -(* begin hide *) -Add Morphism exp with signature (@st_eq _) ==> (@st_eq _) as exp_wd. -intros x y Hxy. -unfold exp at 1. -set (a := (approximate x (1 # 1)%Qpos + 1)). -rewrite Hxy. -apply exp_bound_exp. -rewrite <- Hxy. -apply CRle_trans with ('a)%CR. - apply exp_bound_lemma. -rewrite CRle_Qle. -auto with *. Qed. (* end hide *) Lemma exp_Qexp : forall x : Q, (exp (' x) == rational_exp x)%CR. Proof. -intros x. -rewrite <- IR_inj_Q_as_CR. -rewrite <- exp_correct. -rewrite <- rational_exp_correct. -reflexivity. + intros x. + rewrite <- IR_inj_Q_as_CR. + rewrite <- exp_correct. + rewrite <- rational_exp_correct. + reflexivity. Qed. (* begin hide *) Hint Rewrite exp_Qexp : CRfast_compute. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/reals/fast/CRln.v b/reals/fast/CRln.v index ece39bd7a..65ecab7bf 100644 --- a/reals/fast/CRln.v +++ b/reals/fast/CRln.v @@ -44,124 +44,116 @@ Opaque inj_Q CR Logarithm. Logarithm is defined in terms of artanh. [ln (n/d) = 2*artan((n-d)/(n+d))] *) -Lemma lnDomainAdaptor : forall a, (0 < a) -> +Lemma lnDomainAdaptor : forall a, (0 < a) -> (let (n,d) := a in (n - d)/(n + d))^2 < 1. Proof. -intros [[|n|n] d] Ha; - try solve [elim (Qlt_not_le _ _ Ha); auto with *]. -simpl. -replace LHS with ((n-d)*(n-d)/((n+d)*(n+d))) by - field; auto with *. -apply Qlt_shift_div_r. - auto with *. -rewrite Qlt_minus_iff. -ring_simplify. -Qauto_pos. + intros [[|n|n] d] Ha; try solve [elim (Qlt_not_le _ _ Ha); auto with *]. + simpl. + replace LHS with ((n-d)*(n-d)/((n+d)*(n+d))) by field; auto with *. + apply Qlt_shift_div_r. + auto with *. + rewrite Qlt_minus_iff. + ring_simplify. + Qauto_pos. Qed. (** Although [rational_ln_slow] works on the entire to domain, it is only efficent for values close 1. *) -Definition rational_ln_slow (a:Q) (p: 0 < a) : CR := +Definition rational_ln_slow (a:Q) (p: 0 < a) : CR := scale 2 (rational_artanh_slow (lnDomainAdaptor p)). Lemma Qpos_adaptor : forall q, 0 < q -> Zero[<]inj_Q IR q. Proof. -intros q H. -stepl (inj_Q IR 0). - apply inj_Q_less. - assumption. -apply (inj_Q_nring IR 0). + intros q H. + stepl (inj_Q IR 0). + apply inj_Q_less. + assumption. + apply (inj_Q_nring IR 0). Qed. Lemma rational_ln_slow_correct : forall (a:Q) Ha Ha0, (@rational_ln_slow a Ha == IRasCR (Log (inj_Q IR a) Ha0))%CR. Proof. -intros a Ha Ha0. -unfold rational_ln_slow. -assert (X:=artanh_DomArTanH (lnDomainAdaptor Ha)). -rewrite (fun x => rational_artanh_slow_correct x X). -rewrite <- CRmult_scale. -rewrite <- IR_inj_Q_as_CR. -rewrite <- IR_mult_as_CR. -apply IRasCR_wd. -csetoid_replace (inj_Q IR (2:Q)) (Two:IR); - [|apply (inj_Q_nring IR 2)]. -stepr (Two[*](Half[*]Log _ Ha0)); - [|unfold Half; rational]. -do 2 apply: mult_wdr. -unfold Log. -simpl. -apply cspf_wd. -set (b:=let (n, d) := a in (n - d) / (n + d)). -assert (Y:inj_Q IR a[+]One[#]Zero). - apply Greater_imp_ap. - apply plus_resp_pos; try assumption. - apply pos_one. -assert (Z:One[-](inj_Q IR a[-]One[/]_[//]Y)[#]Zero). - apply Greater_imp_ap. - rstepr (Two[/]_[//]Y). - apply div_resp_pos. + intros a Ha Ha0. + unfold rational_ln_slow. + assert (X:=artanh_DomArTanH (lnDomainAdaptor Ha)). + rewrite (fun x => rational_artanh_slow_correct x X). + rewrite <- CRmult_scale. + rewrite <- IR_inj_Q_as_CR. + rewrite <- IR_mult_as_CR. + apply IRasCR_wd. + csetoid_replace (inj_Q IR (2:Q)) (Two:IR); [|apply (inj_Q_nring IR 2)]. + stepr (Two[*](Half[*]Log _ Ha0)); [|unfold Half; rational]. + do 2 apply: mult_wdr. + unfold Log. + simpl. + apply cspf_wd. + set (b:=let (n, d) := a in (n - d) / (n + d)). + assert (Y:inj_Q IR a[+]One[#]Zero). + apply Greater_imp_ap. apply plus_resp_pos; try assumption. apply pos_one. - apply pos_two. -rstepr (One[+](inj_Q IR a[-]One[/]_[//]Y)[/]_[//]Z). -cut (inj_Q IR b[=](inj_Q IR a[-]One[/]inj_Q IR a[+]One[//]Y)). - intros. - apply div_wd; - apply bin_op_wd_unfolded; try apply eq_reflexive; try apply un_op_wd_unfolded; assumption. -stepr (inj_Q IR ((a-1)/(a+1))). - apply inj_Q_wd. - clear - Ha. - destruct a as [n d]. - simpl. - unfold b. - rewrite Qmake_Qdiv. - field. - split. - unfold Qeq. - auto with *. - unfold Qeq, Qlt in *. - simpl in *. - intros H. - apply (Zlt_not_le _ _ Ha). - ring_simplify in H. - ring_simplify. - apply Zle_trans with (-(d*1))%Z; auto with *. - apply Zle_left_rev. - replace RHS with (-(n + (d*1)))%Z by ring. - simpl. - rewrite H. - apply Zle_refl. -clear - Y. -assert (X:inj_Q IR (a + 1)[#]Zero). - stepl (inj_Q IR a [+]inj_Q IR (nring 1)) by - apply eq_symmetric; apply inj_Q_plus. - csetoid_rewrite (inj_Q_nring IR 1). - rstepl (inj_Q IR a[+]One). - assumption. -stepl (inj_Q IR (a - 1)[/]_[//]X) by - apply eq_symmetric; apply inj_Q_div. -apply div_wd. - stepl (inj_Q IR a[-]inj_Q IR 1) by - apply eq_symmetric; apply inj_Q_minus. + assert (Z:One[-](inj_Q IR a[-]One[/]_[//]Y)[#]Zero). + apply Greater_imp_ap. + rstepr (Two[/]_[//]Y). + apply div_resp_pos. + apply plus_resp_pos; try assumption. + apply pos_one. + apply pos_two. + rstepr (One[+](inj_Q IR a[-]One[/]_[//]Y)[/]_[//]Z). + cut (inj_Q IR b[=](inj_Q IR a[-]One[/]inj_Q IR a[+]One[//]Y)). + intros. + apply div_wd; + apply bin_op_wd_unfolded; try apply eq_reflexive; try apply un_op_wd_unfolded; assumption. + stepr (inj_Q IR ((a-1)/(a+1))). + apply inj_Q_wd. + clear - Ha. + destruct a as [n d]. + simpl. + unfold b. + rewrite Qmake_Qdiv. + field. + split. + unfold Qeq. + auto with *. + unfold Qeq, Qlt in *. + simpl in *. + intros H. + apply (Zlt_not_le _ _ Ha). + ring_simplify in H. + ring_simplify. + apply Zle_trans with (-(d*1))%Z; auto with *. + apply Zle_left_rev. + replace RHS with (-(n + (d*1)))%Z by ring. + simpl. + rewrite H. + apply Zle_refl. + clear - Y. + assert (X:inj_Q IR (a + 1)[#]Zero). + stepl (inj_Q IR a [+]inj_Q IR (nring 1)) by apply eq_symmetric; apply inj_Q_plus. + csetoid_rewrite (inj_Q_nring IR 1). + rstepl (inj_Q IR a[+]One). + assumption. + stepl (inj_Q IR (a - 1)[/]_[//]X) by apply eq_symmetric; apply inj_Q_div. + apply div_wd. + stepl (inj_Q IR a[-]inj_Q IR 1) by apply eq_symmetric; apply inj_Q_minus. + apply bin_op_wd_unfolded. + apply eq_reflexive. + apply un_op_wd_unfolded. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). + stepl (inj_Q IR a[+]inj_Q IR 1) by apply eq_symmetric; apply inj_Q_plus. apply bin_op_wd_unfolded. apply eq_reflexive. - apply un_op_wd_unfolded. rstepr (nring 1:IR). apply (inj_Q_nring IR 1). -stepl (inj_Q IR a[+]inj_Q IR 1) by - apply eq_symmetric; apply inj_Q_plus. -apply bin_op_wd_unfolded. - apply eq_reflexive. -rstepr (nring 1:IR). -apply (inj_Q_nring IR 1). Qed. Lemma rational_ln_slow_correct' : forall (a:Q) Ha, (@rational_ln_slow a Ha == IRasCR (Log (inj_Q IR a) (Qpos_adaptor Ha)))%CR. Proof. -intros. -apply rational_ln_slow_correct. + intros. + apply rational_ln_slow_correct. Qed. (** Efficeny of ln is imporved by scaling the input by a power of two @@ -170,107 +162,106 @@ Definition ln2 : CR := rational_ln_slow (pos_two Q_as_COrdField). Lemma ln2_correct : (ln2 == IRasCR (Log Two (pos_two IR)))%CR. Proof. -unfold ln2. -rewrite rational_ln_slow_correct'. -apply IRasCR_wd. -apply Log_wd. -apply (inj_Q_nring IR 2). + unfold ln2. + rewrite rational_ln_slow_correct'. + apply IRasCR_wd. + apply Log_wd. + apply (inj_Q_nring IR 2). Qed. Lemma ln_scale_by_two_power_adapt : forall (n:Z) q, 0 < q -> 0 < (2^n*q). Proof. -intros n q H. -apply: mult_resp_pos; simpl; try assumption. -assert (H2:0 < 2) by constructor. -pose (twopos := mkQpos H2). -setoid_replace (2%positive:Q) with (twopos:Q) by reflexivity. -apply Qpos_power_pos. + intros n q H. + apply: mult_resp_pos; simpl; try assumption. + assert (H2:0 < 2) by constructor. + pose (twopos := mkQpos H2). + setoid_replace (2%positive:Q) with (twopos:Q) by reflexivity. + apply Qpos_power_pos. Qed. Lemma ln_scale_by_two_power : forall (n:Z) q (Hq:0 < q), (rational_ln_slow Hq + scale n ln2 == rational_ln_slow (ln_scale_by_two_power_adapt n Hq))%CR. Proof. -intros n q Hq. -rewrite ln2_correct. -do 2 rewrite rational_ln_slow_correct'. -rewrite <- CRmult_scale. -rewrite <- IR_inj_Q_as_CR. -rewrite <- IR_mult_as_CR. -rewrite <- IR_plus_as_CR. -apply IRasCR_wd. -assert (X:Zero[<](Two[//](two_ap_zero IR))[^^]n). - apply zexp_pos. - apply pos_two. -stepl (Log _ (Qpos_adaptor Hq)[+]Log _ X). - assert (Y:Zero[<](inj_Q IR q)[*](Two[//](two_ap_zero IR))[^^]n). - apply mult_resp_pos. - apply (Qpos_adaptor Hq). - assumption. - stepl (Log _ Y). - apply Log_wd. - assert (Z:(inj_Q IR (2:Q))[#]Zero). - stepr (inj_Q IR (0:Q)). - apply inj_Q_ap. - discriminate. - apply (inj_Q_nring IR 0). - csetoid_replace ((Two[//]two_ap_zero IR)[^^](n)) - (((inj_Q IR (2:Q))[//]Z)[^^]n). - stepr (inj_Q IR q[*]inj_Q IR (2^n)). - apply mult_wdr. + intros n q Hq. + rewrite ln2_correct. + do 2 rewrite rational_ln_slow_correct'. + rewrite <- CRmult_scale. + rewrite <- IR_inj_Q_as_CR. + rewrite <- IR_mult_as_CR. + rewrite <- IR_plus_as_CR. + apply IRasCR_wd. + assert (X:Zero[<](Two[//](two_ap_zero IR))[^^]n). + apply zexp_pos. + apply pos_two. + stepl (Log _ (Qpos_adaptor Hq)[+]Log _ X). + assert (Y:Zero[<](inj_Q IR q)[*](Two[//](two_ap_zero IR))[^^]n). + apply mult_resp_pos. + apply (Qpos_adaptor Hq). + assumption. + stepl (Log _ Y). + apply Log_wd. + assert (Z:(inj_Q IR (2:Q))[#]Zero). + stepr (inj_Q IR (0:Q)). + apply inj_Q_ap. + discriminate. + apply (inj_Q_nring IR 0). + csetoid_replace ((Two[//]two_ap_zero IR)[^^](n)) (((inj_Q IR (2:Q))[//]Z)[^^]n). + stepr (inj_Q IR q[*]inj_Q IR (2^n)). + apply mult_wdr. + apply eq_symmetric. + apply inj_Q_power_Z. + rstepl (inj_Q IR (2 ^ n)[*]inj_Q IR q). apply eq_symmetric. - apply inj_Q_power_Z. - rstepl (inj_Q IR (2 ^ n)[*]inj_Q IR q). + apply (inj_Q_mult IR (2^n) q). + apply zexp_wd. apply eq_symmetric. - apply (inj_Q_mult IR (2^n) q). - apply zexp_wd. - apply eq_symmetric. - apply (inj_Q_nring IR 2). - apply Log_mult. -apply bin_op_wd_unfolded. - apply eq_reflexive. -astepl ((zring n)[*]Log Two (pos_two IR)). -apply mult_wdl. -Transparent inj_Q. -unfold inj_Q. -simpl. -rational. + apply (inj_Q_nring IR 2). + apply Log_mult. + apply bin_op_wd_unfolded. + apply eq_reflexive. + astepl ((zring n)[*]Log Two (pos_two IR)). + apply mult_wdl. + Transparent inj_Q. + unfold inj_Q. + simpl. + rational. Qed. Definition ln_scale_power_factor q (Hq:0 < q) : Z. -intros [[|n|n] d] Hq; try - abstract discriminate Hq. -exact (Zpred (log_inf d - (log_sup n)))%Z. + intros [[|n|n] d] Hq; try abstract discriminate Hq. +Proof. + exact (Zpred (log_inf d - (log_sup n)))%Z. Defined. -Definition rational_ln (a:Q) (p: 0 < a) : CR := +Definition rational_ln (a:Q) (p: 0 < a) : CR := let n := ln_scale_power_factor p in (rational_ln_slow (ln_scale_by_two_power_adapt n p) + scale (-n)%Z ln2)%CR. Lemma rational_ln_correct : forall (a:Q) Ha Ha0, (@rational_ln a Ha == IRasCR (Log (inj_Q IR a) Ha0))%CR. Proof. -intros a Ha Ha0. -unfold rational_ln. -rewrite <- ln_scale_by_two_power. -do 2 rewrite <- CRmult_scale. -change (((- ln_scale_power_factor Ha)%Z):Q) with ((- ln_scale_power_factor Ha)%Q). -rewrite <- CRopp_Qopp. -ring_simplify. -apply rational_ln_slow_correct. + intros a Ha Ha0. + unfold rational_ln. + rewrite <- ln_scale_by_two_power. + do 2 rewrite <- CRmult_scale. + change (((- ln_scale_power_factor Ha)%Z):Q) with ((- ln_scale_power_factor Ha)%Q). + rewrite <- CRopp_Qopp. + ring_simplify. + apply rational_ln_slow_correct. Qed. Lemma rational_ln_correct' : forall (a:Q) Ha, (@rational_ln a Ha == IRasCR (Log (inj_Q IR a) (Qpos_adaptor Ha)))%CR. Proof. -intros. -apply rational_ln_correct. + intros. + apply rational_ln_correct. Qed. (** [ln] is uniformly continuous on any close strictly positive interval. *) Lemma ln_uc_prf_pos : forall (c:Qpos) (x:Q), (0 < Qmax c x). Proof. -intros c x. -simpl. -apply Qlt_le_trans with c; auto with *. + intros c x. + simpl. + apply Qlt_le_trans with c; auto with *. Qed. Definition rational_ln_modulus (c:Qpos) (e:Qpos) : QposInf := @@ -278,67 +269,63 @@ Qpos2QposInf (c*e). Lemma ln_pos_uc_prf (c:Qpos) : is_UniformlyContinuousFunction (fun x => rational_ln (ln_uc_prf_pos c x)) (rational_ln_modulus c). Proof. -intros c. -set (lnf := fun x => match (Qlt_le_dec 0 x) with - | left p => rational_ln p - | right _ => ('0)%CR - end). -apply (is_UniformlyContinuousFunction_wd) with (fun x : Q_as_MetricSpace => lnf (QboundBelow_uc c x)) (Qscale_modulus (Qpos_inv c)). - intros x. - unfold lnf. + intros c. + set (lnf := fun x => match (Qlt_le_dec 0 x) with | left p => rational_ln p | right _ => ('0)%CR end). + apply (is_UniformlyContinuousFunction_wd) with (fun x : Q_as_MetricSpace => lnf (QboundBelow_uc c x)) (Qscale_modulus (Qpos_inv c)). + intros x. + unfold lnf. destruct (Qlt_le_dec 0 (QboundBelow_uc c x)). - do 2 rewrite rational_ln_correct'. - apply IRasCR_wd. - algebra. - elim (Qle_not_lt _ _ q). - apply: ln_uc_prf_pos. - intros [xn xd]; apply: Qle_refl. -assert (Z:Derivative (closel (inj_Q IR (c:Q))) CI Logarithm {1/}FId). - apply (Included_imp_Derivative (openl Zero) CI). - Deriv. - intros x Hx. - simpl. - apply less_leEq_trans with (inj_Q IR (c:Q)); try assumption. - stepl (inj_Q IR 0). - apply inj_Q_less. - simpl; auto with *. - apply (inj_Q_nring IR 0). -apply (is_UniformlyContinuousD (Some (c:Q)) None I _ _ Z lnf). - intros q Hq Hc. - unfold lnf. - destruct (Qlt_le_dec 0 q). - apply rational_ln_correct. - elim (Qle_not_lt _ _ q0). - apply Qlt_le_trans with c; auto with *. - apply leEq_inj_Q with IR. - assumption. -intros x Hx Hc. -apply AbsSmall_imp_AbsIR. -apply leEq_imp_AbsSmall. - apply: shift_leEq_div. + do 2 rewrite rational_ln_correct'. + apply IRasCR_wd. + algebra. + elim (Qle_not_lt _ _ q). + apply: ln_uc_prf_pos. + intros [xn xd]; apply: Qle_refl. + assert (Z:Derivative (closel (inj_Q IR (c:Q))) CI Logarithm {1/}FId). + apply (Included_imp_Derivative (openl Zero) CI). + Deriv. + intros x Hx. + simpl. apply less_leEq_trans with (inj_Q IR (c:Q)); try assumption. stepl (inj_Q IR 0). apply inj_Q_less. simpl; auto with *. apply (inj_Q_nring IR 0). - rstepl (Zero:IR). - apply less_leEq. - apply pos_one. -stepr (One[/]_[//](Greater_imp_ap _ _ _ (Qpos_adaptor (Qpos_prf c)))). - apply: recip_resp_leEq; try assumption. - stepl (inj_Q IR 0). - apply inj_Q_less. - simpl; auto with *. - apply (inj_Q_nring IR 0). -stepl (((inj_Q IR 1)[/]_[//] - Greater_imp_ap IR (inj_Q IR (c:Q)) Zero (Qpos_adaptor (Qpos_prf c)))). - change (inj_Q IR ((Qpos_inv c):Q)) with (inj_Q IR (1/c)). - apply eq_symmetric. - apply inj_Q_div. -apply div_wd. - rstepr (nring 1:IR). - apply (inj_Q_nring IR 1). -apply eq_reflexive. + apply (is_UniformlyContinuousD (Some (c:Q)) None I _ _ Z lnf). + intros q Hq Hc. + unfold lnf. + destruct (Qlt_le_dec 0 q). + apply rational_ln_correct. + elim (Qle_not_lt _ _ q0). + apply Qlt_le_trans with c; auto with *. + apply leEq_inj_Q with IR. + assumption. + intros x Hx Hc. + apply AbsSmall_imp_AbsIR. + apply leEq_imp_AbsSmall. + apply: shift_leEq_div. + apply less_leEq_trans with (inj_Q IR (c:Q)); try assumption. + stepl (inj_Q IR 0). + apply inj_Q_less. + simpl; auto with *. + apply (inj_Q_nring IR 0). + rstepl (Zero:IR). + apply less_leEq. + apply pos_one. + stepr (One[/]_[//](Greater_imp_ap _ _ _ (Qpos_adaptor (Qpos_prf c)))). + apply: recip_resp_leEq; try assumption. + stepl (inj_Q IR 0). + apply inj_Q_less. + simpl; auto with *. + apply (inj_Q_nring IR 0). + stepl (((inj_Q IR 1)[/]_[//] Greater_imp_ap IR (inj_Q IR (c:Q)) Zero (Qpos_adaptor (Qpos_prf c)))). + change (inj_Q IR ((Qpos_inv c):Q)) with (inj_Q IR (1/c)). + apply eq_symmetric. + apply inj_Q_div. + apply div_wd. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). + apply eq_reflexive. Qed. Definition ln_pos_uc (c:Qpos) : Q_as_MetricSpace --> CR := @@ -348,36 +335,36 @@ Definition CRln_pos (c:Qpos) : CR --> CR := (Cbind QPrelengthSpace (ln_pos_uc c) Lemma CRln_pos_correct : forall (c:Qpos) x Hx, closel (inj_Q _ (c:Q)) x -> (IRasCR (Log x Hx)==CRln_pos c (IRasCR x))%CR. Proof. -intros c x Hx Hx0. -assert (Z:Continuous (closel (inj_Q IR (c:Q))) Logarithm). - apply (Included_imp_Continuous (openl Zero)). - Contin. - clear - c. - intros x Hx. + intros c x Hx Hx0. + assert (Z:Continuous (closel (inj_Q IR (c:Q))) Logarithm). + apply (Included_imp_Continuous (openl Zero)). + Contin. + clear - c. + intros x Hx. + simpl. + apply less_leEq_trans with (inj_Q IR (c:Q)); try assumption. + stepl (inj_Q IR 0). + apply inj_Q_less. + simpl; auto with *. + apply (inj_Q_nring IR 0). + apply (fun x => @ContinuousCorrect _ x Logarithm Z); auto with *. + constructor. + intros q Hq H. + change (CRln_pos c (' q) == IRasCR (Log (inj_Q IR q) Hq))%CR. + transitivity (ln_pos_uc c q);[|]. + unfold CRln_pos. + change (' q)%CR with (Cunit_fun _ q). + rewrite (Cbind_correct QPrelengthSpace (ln_pos_uc c) (Cunit_fun Q_as_MetricSpace q)). + apply: BindLaw1. simpl. - apply less_leEq_trans with (inj_Q IR (c:Q)); try assumption. - stepl (inj_Q IR 0). - apply inj_Q_less. - simpl; auto with *. - apply (inj_Q_nring IR 0). -apply (fun x => @ContinuousCorrect _ x Logarithm Z); auto with *. - constructor. -intros q Hq H. -change (CRln_pos c (' q) == IRasCR (Log (inj_Q IR q) Hq))%CR. -transitivity (ln_pos_uc c q);[|]. - unfold CRln_pos. - change (' q)%CR with (Cunit_fun _ q). - rewrite (Cbind_correct QPrelengthSpace (ln_pos_uc c) (Cunit_fun Q_as_MetricSpace q)). - apply: BindLaw1. -simpl. -rewrite rational_ln_correct'. -apply IRasCR_wd. -apply Log_wd. -apply inj_Q_wd. -simpl. -rewrite <- Qle_max_r. -apply leEq_inj_Q with IR. -assumption. + rewrite rational_ln_correct'. + apply IRasCR_wd. + apply Log_wd. + apply inj_Q_wd. + simpl. + rewrite <- Qle_max_r. + apply leEq_inj_Q with IR. + assumption. Qed. Definition CRln (x:CR) (Hx:('0 < x)%CR) : CR := @@ -387,60 +374,60 @@ Implicit Arguments CRln []. (* end hide *) Lemma CRln_correct : forall x Hx Hx0, (IRasCR (Log x Hx)==CRln (IRasCR x) Hx0)%CR. Proof. -intros x Hx [c Hc]. -apply CRln_pos_correct. -change ((inj_Q IR (c:Q))[<=]x). -rewrite IR_leEq_as_CR. -rewrite IR_inj_Q_as_CR. -setoid_replace (IRasCR x) with (IRasCR x - '0)%CR by ring. -assumption. + intros x Hx [c Hc]. + apply CRln_pos_correct. + change ((inj_Q IR (c:Q))[<=]x). + rewrite IR_leEq_as_CR. + rewrite IR_inj_Q_as_CR. + setoid_replace (IRasCR x) with (IRasCR x - '0)%CR by ring. + assumption. Qed. Lemma CRln_pos_ln : forall (c:Qpos) (x:CR) Hx, ('c <= x -> CRln_pos c x == CRln x Hx)%CR. Proof. -intros c x Hx Hc. -assert (X:Zero[<](CRasIR x)). - apply CR_less_as_IR. - apply CRlt_wd with ('0)%CR x; try assumption. - rewrite IR_Zero_as_CR. - reflexivity. - rewrite CRasIRasCR_id. - reflexivity. -destruct Hx as [d Hd]. -unfold CRln. -rewrite <- (CRasIRasCR_id x). -rewrite <- (CRln_pos_correct c _ X). - rewrite <- (CRln_pos_correct d _ X). + intros c x Hx Hc. + assert (X:Zero[<](CRasIR x)). + apply CR_less_as_IR. + apply CRlt_wd with ('0)%CR x; try assumption. + rewrite IR_Zero_as_CR. + reflexivity. + rewrite CRasIRasCR_id. reflexivity. - change (inj_Q IR (d:Q)[<=](CRasIR x)). + destruct Hx as [d Hd]. + unfold CRln. + rewrite <- (CRasIRasCR_id x). + rewrite <- (CRln_pos_correct c _ X). + rewrite <- (CRln_pos_correct d _ X). + reflexivity. + change (inj_Q IR (d:Q)[<=](CRasIR x)). + rewrite IR_leEq_as_CR. + autorewrite with IRtoCR. + rewrite CRasIRasCR_id. + ring_simplify in Hd. + assumption. + change (inj_Q IR (c:Q)[<=](CRasIR x)). rewrite IR_leEq_as_CR. autorewrite with IRtoCR. rewrite CRasIRasCR_id. - ring_simplify in Hd. assumption. -change (inj_Q IR (c:Q)[<=](CRasIR x)). -rewrite IR_leEq_as_CR. -autorewrite with IRtoCR. -rewrite CRasIRasCR_id. -assumption. Qed. Lemma CRln_wd : forall (x y:CR) Hx Hy, (x == y -> CRln x Hx == CRln y Hy)%CR. Proof. -intros x y [c Hc] Hy Hxy. -unfold CRln at 1. + intros x y [c Hc] Hy Hxy. + unfold CRln at 1. rewrite Hxy. -apply CRln_pos_ln. -rewrite <- Hxy. -ring_simplify in Hc. -assumption. + apply CRln_pos_ln. + rewrite <- Hxy. + ring_simplify in Hc. + assumption. Qed. Lemma CRln_irrelvent : forall x Hx Hx0, (CRln x Hx == CRln x Hx0)%CR. Proof. -intros. -apply CRln_wd. -reflexivity. + intros. + apply CRln_wd. + reflexivity. Qed. diff --git a/reals/fast/CRpi.v b/reals/fast/CRpi.v index 0c66d9d9f..d58702680 100644 --- a/reals/fast/CRpi.v +++ b/reals/fast/CRpi.v @@ -5,7 +5,8 @@ Require Export CRpi_fast. Require Import CRsign. Lemma CRpi_pos : ('0 < CRpi)%CR. -exists (3#1)%Qpos. -apply CRpos_nonNeg. -CR_solve_pos (1#10)%Qpos. +Proof. + exists (3#1)%Qpos. + apply CRpos_nonNeg. + CR_solve_pos (1#10)%Qpos. Qed. diff --git a/reals/fast/CRpi_slow.v b/reals/fast/CRpi_slow.v index aa8aed94e..b261ab6b2 100644 --- a/reals/fast/CRpi_slow.v +++ b/reals/fast/CRpi_slow.v @@ -50,27 +50,27 @@ Pi is defined as Lemma small_per_23 : (0 <= (1#(23%positive)) <= 1)%Q. Proof. -split; discriminate. + split; discriminate. Qed. Lemma small_per_182 : (0 <= (1#(182%positive)) <= 1)%Q. Proof. -split; discriminate. + split; discriminate. Qed. Lemma small_per_5118 : (0 <= (1#(5118%positive)) <= 1)%Q. Proof. -split; discriminate. + split; discriminate. Qed. Lemma small_per_6072 : (0 <= (1#(6072%positive)) <= 1)%Q. Proof. -split; discriminate. + split; discriminate. Qed. -Definition r_pi (r:Q) : CR := +Definition r_pi (r:Q) : CR := ((scale (68%Z*r) (rational_arctan_small_pos small_per_23) + - scale (32%Z*r) (rational_arctan_small_pos small_per_182)) + + scale (32%Z*r) (rational_arctan_small_pos small_per_182)) + (scale (40%Z*r) (rational_arctan_small_pos small_per_5118) + scale (20%Z*r) (rational_arctan_small_pos small_per_6072)))%CR. @@ -78,260 +78,234 @@ Definition r_pi (r:Q) : CR := The problem is that the arctan sum law only works for input between -1 and 1. We use reflect to show that our use of arctan sum law always satifies this restriction. *) -Let f (a b:Q) : Q := - let (x,y) := a in +Let f (a b:Q) : Q := + let (x,y) := a in let (z,w) := b in Qred ((x*w + y*z)%Z/(y*w-x*z)%Z). Lemma f_char : forall a b, f a b == (a+b)/(1-a*b). Proof. -intros [x y] [w z]. -unfold f. -rewrite Qred_correct. -destruct (Z_eq_dec (y*z) (x*w)) as [H|H]. - unfold Qmult. - simpl ((Qnum (x # y) * Qnum (w # z) # Qden (x # y) * Qden (w # z))). - repeat rewrite <- H. - replace (y * z - y * z)%Z with 0%Z by ring. - setoid_replace (1-(y * z # y * z)) with 0. - change ((x * z + y * w)%Z * 0 == ((x # y) + (w # z)) * 0). + intros [x y] [w z]. + unfold f. + rewrite Qred_correct. + destruct (Z_eq_dec (y*z) (x*w)) as [H|H]. + unfold Qmult. + simpl ((Qnum (x # y) * Qnum (w # z) # Qden (x # y) * Qden (w # z))). + repeat rewrite <- H. + replace (y * z - y * z)%Z with 0%Z by ring. + setoid_replace (1-(y * z # y * z)) with 0. + change ((x * z + y * w)%Z * 0 == ((x # y) + (w # z)) * 0). + ring. + rewrite (Qmake_Qdiv (y*z)). + change (1 - (y * z)%positive / (y * z)%positive == 0). + field; discriminate. + unfold Zminus. + repeat rewrite injz_plus. + change (((x * z) + (y * w)) / (y * z - x * w) == ((x # y) + (w # z)) / (1 - (x #y)*(w # z))). + repeat rewrite Qmake_Qdiv. + field. + repeat split; try discriminate. + cut (~(y * z)%Z == (x * w)%Z). + intros X Y. + apply X. + replace RHS with ((x * w)%Z + 0) by ring. + rewrite <- Y. + change ((y * z) == (x * w) + (y * z - x * w)). ring. - rewrite (Qmake_Qdiv (y*z)). - change (1 - (y * z)%positive / (y * z)%positive == 0). - field; discriminate. -unfold Zminus. -repeat rewrite injz_plus. -change (((x * z) + (y * w)) / (y * z - x * w) == -((x # y) + (w # z)) / (1 - (x #y)*(w # z))). -repeat rewrite Qmake_Qdiv. -field. -repeat split; try discriminate. -cut (~(y * z)%Z == (x * w)%Z). - intros X Y. - apply X. - replace RHS with ((x * w)%Z + 0) by ring. - rewrite <- Y. - change ((y * z) == (x * w) + (y * z - x * w)). + intros X; apply H. + unfold Qeq in X. + simpl in X. + rewrite Pmult_1_r in X. + change ((y * z)%Z = (x * w * 1)%Z) in X. + rewrite X. ring. -intros X; apply H. -unfold Qeq in X. -simpl in X. -rewrite Pmult_1_r in X. -change ((y * z)%Z = (x * w * 1)%Z) in X. -rewrite X. -ring. Qed. Lemma ArcTan_plus_ArcTan_Q : forall x y, -(1) <= x <= 1 -> -(1) <= y <= 1 -> ~1-x*y==0 -> (ArcTan (inj_Q _ x)[+]ArcTan (inj_Q _ y)[=]ArcTan (inj_Q _ (f x y))). Proof. -intros x y [Hx0 Hx1] [Hy0 Hy1] H. -assert (X:forall z, -(1) <= z -> [--]One[<=]inj_Q IR z). - intros z Hz. - stepl ((inj_Q IR (-(1)))). - apply inj_Q_leEq; assumption. - eapply eq_transitive. - apply (inj_Q_inv IR (1)). - apply un_op_wd_unfolded. - rstepr (nring 1:IR). - apply (inj_Q_nring IR 1). -assert (X0:forall z, z <= 1 -> inj_Q IR z[<=]One). - intros z Hz. - stepr ((inj_Q IR ((1)))). - apply inj_Q_leEq; assumption. - rstepr (nring 1:IR). - apply (inj_Q_nring IR 1). -assert (One[-](inj_Q IR x)[*](inj_Q IR y)[#]Zero). - stepl (inj_Q IR (1[-]x[*]y)). - (stepr (inj_Q IR Zero) by apply (inj_Q_nring IR 0)). + intros x y [Hx0 Hx1] [Hy0 Hy1] H. + assert (X:forall z, -(1) <= z -> [--]One[<=]inj_Q IR z). + intros z Hz. + stepl ((inj_Q IR (-(1)))). + apply inj_Q_leEq; assumption. + eapply eq_transitive. + apply (inj_Q_inv IR (1)). + apply un_op_wd_unfolded. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). + assert (X0:forall z, z <= 1 -> inj_Q IR z[<=]One). + intros z Hz. + stepr ((inj_Q IR ((1)))). + apply inj_Q_leEq; assumption. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). + assert (One[-](inj_Q IR x)[*](inj_Q IR y)[#]Zero). + stepl (inj_Q IR (1[-]x[*]y)). + (stepr (inj_Q IR Zero) by apply (inj_Q_nring IR 0)). + apply inj_Q_ap; assumption. + eapply eq_transitive. + apply inj_Q_minus. + apply bin_op_wd_unfolded. + rstepr (nring 1:IR); apply (inj_Q_nring IR 1). + apply un_op_wd_unfolded. + apply inj_Q_mult. + apply eq_transitive with (ArcTan (inj_Q IR x[+]inj_Q IR y[/](One[-]inj_Q IR x[*]inj_Q IR y)[//]X1)). + apply ArcTan_plus_ArcTan; first [apply X; assumption |apply X0; assumption]. + apply ArcTan_wd. + stepl (inj_Q IR ((x[+]y)/(One[-]x*y))). + apply inj_Q_wd. + simpl. + symmetry. + apply f_char. + assert (H0:(inj_Q IR (One[-]x * y))[#]Zero). + (stepr (inj_Q IR 0) by apply (inj_Q_nring IR 0)). apply inj_Q_ap; assumption. + apply eq_transitive with (inj_Q IR (x[+]y)[/]inj_Q IR (One[-]x * y)[//]H0). + apply (inj_Q_div). + apply div_wd. + apply inj_Q_plus. eapply eq_transitive. apply inj_Q_minus. apply bin_op_wd_unfolded. - rstepr (nring 1:IR); apply (inj_Q_nring IR 1). + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). apply un_op_wd_unfolded. apply inj_Q_mult. -apply eq_transitive with - (ArcTan (inj_Q IR x[+]inj_Q IR y[/](One[-]inj_Q IR x[*]inj_Q IR y)[//]X1)). - apply ArcTan_plus_ArcTan; - first [apply X; assumption - |apply X0; assumption]. -apply ArcTan_wd. -stepl (inj_Q IR ((x[+]y)/(One[-]x*y))). - apply inj_Q_wd. - simpl. - symmetry. - apply f_char. -assert (H0:(inj_Q IR (One[-]x * y))[#]Zero). - (stepr (inj_Q IR 0) by apply (inj_Q_nring IR 0)). - apply inj_Q_ap; assumption. -apply eq_transitive with - (inj_Q IR (x[+]y)[/]inj_Q IR (One[-]x * y)[//]H0). - apply (inj_Q_div). -apply div_wd. - apply inj_Q_plus. -eapply eq_transitive. - apply inj_Q_minus. -apply bin_op_wd_unfolded. - rstepr (nring 1:IR). - apply (inj_Q_nring IR 1). -apply un_op_wd_unfolded. -apply inj_Q_mult. Qed. Definition ArcTan_multiple : forall x, -(1) <= x <= 1 -> forall n, {True} + {(nring n)[*]ArcTan (inj_Q _ x)[=]ArcTan (inj_Q _ (iter_nat n _ (f x) 0))}. -intros x Hx. -induction n. +Proof. + intros x Hx. + induction n. + right. + abstract ( rstepl (Zero:IR); (stepl (ArcTan Zero) by apply ArcTan_zero); apply ArcTan_wd; + apply eq_symmetric; apply (inj_Q_nring IR 0)). + simpl. + destruct (IHn) as [H|H]. + left; constructor. + set (y:=(iter_nat n Q (f x) 0)) in *. + destruct (Qlt_le_dec_fast 1 y) as [_|Y0]. + left; constructor. + destruct (Qlt_le_dec_fast y (-(1))) as [_|Y1]. + left; constructor. + destruct (Qeq_dec (1-x*y) 0) as [_|Y2]. + left; constructor. right. - abstract ( - rstepl (Zero:IR); - (stepl (ArcTan Zero) by apply ArcTan_zero); - apply ArcTan_wd; - apply eq_symmetric; - apply (inj_Q_nring IR 0)). -simpl. -destruct (IHn) as [H|H]. - left; constructor. -set (y:=(iter_nat n Q (f x) 0)) in *. -destruct (Qlt_le_dec_fast 1 y) as [_|Y0]. - left; constructor. -destruct (Qlt_le_dec_fast y (-(1))) as [_|Y1]. - left; constructor. -destruct (Qeq_dec (1-x*y) 0) as [_|Y2]. - left; constructor. -right. -abstract ( -rstepl (ArcTan (inj_Q IR x)[+](nring n[*]ArcTan (inj_Q IR x))); -csetoid_rewrite H; -apply ArcTan_plus_ArcTan_Q; try assumption; split; assumption). + abstract ( rstepl (ArcTan (inj_Q IR x)[+](nring n[*]ArcTan (inj_Q IR x))); csetoid_rewrite H; + apply ArcTan_plus_ArcTan_Q; try assumption; split; assumption). Defined. Lemma reflect_right : forall A B (x:{A}+{B}), (if x then False else True) -> B. Proof. -intros A B x. -elim x. - contradiction. -trivial. + intros A B x. + elim x. + contradiction. + trivial. Qed. -Lemma Pi_Formula : +Lemma Pi_Formula : (((nring 17)[*]ArcTan (inj_Q IR (1 / 23%Z))[+] (nring 8)[*]ArcTan (inj_Q IR (1 / 182%Z))[+] (nring 10)[*]ArcTan (inj_Q IR (1 / 5118%Z))[+] (nring 5)[*]ArcTan (inj_Q IR (1 / 6072%Z)))[=] Pi[/]FourNZ). Proof. -assert (H0:-(1) <= (1/(23%Z)) <= 1). - split; discriminate. -assert (H1:-(1) <= (1/(182%Z)) <= 1). - split; discriminate. -assert (H2:-(1) <= (1/(5118%Z)) <= 1). - split; discriminate. -assert (H3:-(1) <= (1/(6072%Z)) <= 1). - split; discriminate. -set (y0:=(iter_nat 17 _ (f (1/23%Z)) 0)). -set (y1:=(iter_nat 8 _ (f (1/182%Z)) 0)). -set (y2:=(iter_nat 10 _ (f (1/5118%Z)) 0)). -set (y3:=(iter_nat 5 _ (f (1/6072%Z)) 0)). -rstepl (nring 17[*]ArcTan (inj_Q IR (1 / 23%positive))[+] -nring 8[*]ArcTan (inj_Q IR (1 / 182%positive))[+] -(nring 10[*]ArcTan (inj_Q IR (1 / 5118%positive))[+] -nring 5[*]ArcTan (inj_Q IR (1 / 6072%positive)))). -csetoid_replace ((nring 17)[*]ArcTan (inj_Q IR (1 / 23%positive))) - (ArcTan (inj_Q IR y0)); - [|apply (reflect_right (ArcTan_multiple H0 17)); - lazy beta delta iota zeta; constructor]. -csetoid_replace ((nring 8)[*]ArcTan (inj_Q IR (1 / 182%positive))) - (ArcTan (inj_Q IR y1)); - [|apply (reflect_right (ArcTan_multiple H1 8)); - lazy beta delta iota zeta; constructor]. -csetoid_replace ((nring 10)[*]ArcTan (inj_Q IR (1 / 5118%positive))) - (ArcTan (inj_Q IR y2)); - [|apply (reflect_right (ArcTan_multiple H2 10)); - lazy beta delta iota zeta; constructor]. -csetoid_replace ((nring 5)[*]ArcTan (inj_Q IR (1 / 6072%positive))) - (ArcTan (inj_Q IR y3)); - [|apply (reflect_right (ArcTan_multiple H3 5)); - lazy beta delta iota zeta; constructor]. -compute in y0. -compute in y1. -compute in y2. -compute in y3. -csetoid_replace (ArcTan (inj_Q IR y0)[+]ArcTan (inj_Q IR y1)) - (ArcTan (inj_Q IR (f y0 y1))); - [|apply ArcTan_plus_ArcTan_Q; try split; - lazy beta delta iota zeta; discriminate]. -csetoid_replace (ArcTan (inj_Q IR y2)[+]ArcTan (inj_Q IR y3)) - (ArcTan (inj_Q IR (f y2 y3))); - [|apply ArcTan_plus_ArcTan_Q; try split; - lazy beta delta iota zeta; discriminate]. -set (z0 := (f y0 y1)). -set (z1 := (f y2 y3)). -compute in z0. -compute in z1. -csetoid_replace (ArcTan (inj_Q IR z0)[+]ArcTan (inj_Q IR z1)) - (ArcTan (inj_Q IR (f z0 z1))); - [|apply ArcTan_plus_ArcTan_Q; try split; - lazy beta delta iota zeta; discriminate]. -set (z3:= (f z0 z1)). -compute in z3. -eapply eq_transitive;[|apply ArcTan_one]. -apply ArcTan_wd. -rstepr (nring 1:IR). -apply (inj_Q_nring IR 1). + assert (H0:-(1) <= (1/(23%Z)) <= 1). + split; discriminate. + assert (H1:-(1) <= (1/(182%Z)) <= 1). + split; discriminate. + assert (H2:-(1) <= (1/(5118%Z)) <= 1). + split; discriminate. + assert (H3:-(1) <= (1/(6072%Z)) <= 1). + split; discriminate. + set (y0:=(iter_nat 17 _ (f (1/23%Z)) 0)). + set (y1:=(iter_nat 8 _ (f (1/182%Z)) 0)). + set (y2:=(iter_nat 10 _ (f (1/5118%Z)) 0)). + set (y3:=(iter_nat 5 _ (f (1/6072%Z)) 0)). + rstepl (nring 17[*]ArcTan (inj_Q IR (1 / 23%positive))[+] + nring 8[*]ArcTan (inj_Q IR (1 / 182%positive))[+] + (nring 10[*]ArcTan (inj_Q IR (1 / 5118%positive))[+] + nring 5[*]ArcTan (inj_Q IR (1 / 6072%positive)))). + csetoid_replace ((nring 17)[*]ArcTan (inj_Q IR (1 / 23%positive))) (ArcTan (inj_Q IR y0)); + [|apply (reflect_right (ArcTan_multiple H0 17)); lazy beta delta iota zeta; constructor]. + csetoid_replace ((nring 8)[*]ArcTan (inj_Q IR (1 / 182%positive))) (ArcTan (inj_Q IR y1)); + [|apply (reflect_right (ArcTan_multiple H1 8)); lazy beta delta iota zeta; constructor]. + csetoid_replace ((nring 10)[*]ArcTan (inj_Q IR (1 / 5118%positive))) (ArcTan (inj_Q IR y2)); + [|apply (reflect_right (ArcTan_multiple H2 10)); lazy beta delta iota zeta; constructor]. + csetoid_replace ((nring 5)[*]ArcTan (inj_Q IR (1 / 6072%positive))) (ArcTan (inj_Q IR y3)); + [|apply (reflect_right (ArcTan_multiple H3 5)); lazy beta delta iota zeta; constructor]. + compute in y0. + compute in y1. + compute in y2. + compute in y3. + csetoid_replace (ArcTan (inj_Q IR y0)[+]ArcTan (inj_Q IR y1)) (ArcTan (inj_Q IR (f y0 y1))); + [|apply ArcTan_plus_ArcTan_Q; try split; lazy beta delta iota zeta; discriminate]. + csetoid_replace (ArcTan (inj_Q IR y2)[+]ArcTan (inj_Q IR y3)) (ArcTan (inj_Q IR (f y2 y3))); + [|apply ArcTan_plus_ArcTan_Q; try split; lazy beta delta iota zeta; discriminate]. + set (z0 := (f y0 y1)). + set (z1 := (f y2 y3)). + compute in z0. + compute in z1. + csetoid_replace (ArcTan (inj_Q IR z0)[+]ArcTan (inj_Q IR z1)) (ArcTan (inj_Q IR (f z0 z1))); + [|apply ArcTan_plus_ArcTan_Q; try split; lazy beta delta iota zeta; discriminate]. + set (z3:= (f z0 z1)). + compute in z3. + eapply eq_transitive;[|apply ArcTan_one]. + apply ArcTan_wd. + rstepr (nring 1:IR). + apply (inj_Q_nring IR 1). Qed. Lemma r_pi_correct : forall r, (r_pi r == IRasCR ((inj_Q IR r)[*]Pi))%CR. Proof. -intros r. -unfold r_pi. -repeat rewrite <- (CRmult_scale). -setoid_replace ((68*r)) with ((4*r*17)) by ring. -setoid_replace (32*r) with (4*r*8) by ring. -setoid_replace (40*r) with (4*r*10) by ring. -setoid_replace (20*r) with (4*r*5) by ring. -repeat rewrite <- CRmult_Qmult. -transitivity ('4 * 'r *(' 17 * rational_arctan_small_pos small_per_23 + - ' 8 * rational_arctan_small_pos small_per_182 + - (' 10 * rational_arctan_small_pos small_per_5118 + - ' 5 * rational_arctan_small_pos small_per_6072)))%CR. - ring. -repeat (rewrite (rational_arctan_small_pos_correct); - [|constructor]). -repeat rewrite <- IR_inj_Q_as_CR. -repeat (rewrite <- IR_mult_as_CR || rewrite <- IR_plus_as_CR). -apply IRasCR_wd. -rstepr (Four[*]inj_Q IR r[*]Pi[/]FourNZ). -apply mult_wd. - apply mult_wdl. - apply (inj_Q_nring IR 4). -eapply eq_transitive;[|apply Pi_Formula]. -rstepr (nring 17[*]ArcTan (inj_Q IR (1 / 23%positive))[+] -nring 8[*]ArcTan (inj_Q IR (1 / 182%positive))[+] -(nring 10[*]ArcTan (inj_Q IR (1 / 5118%positive))[+] -nring 5[*]ArcTan (inj_Q IR (1 / 6072%positive)))). -repeat apply bin_op_wd_unfolded; try apply eq_reflexive. - apply (inj_Q_nring IR 17). - apply (inj_Q_nring IR 8). - apply (inj_Q_nring IR 10). -apply (inj_Q_nring IR 5). + intros r. + unfold r_pi. + repeat rewrite <- (CRmult_scale). + setoid_replace ((68*r)) with ((4*r*17)) by ring. + setoid_replace (32*r) with (4*r*8) by ring. + setoid_replace (40*r) with (4*r*10) by ring. + setoid_replace (20*r) with (4*r*5) by ring. + repeat rewrite <- CRmult_Qmult. + transitivity ('4 * 'r *(' 17 * rational_arctan_small_pos small_per_23 + + ' 8 * rational_arctan_small_pos small_per_182 + (' 10 * rational_arctan_small_pos small_per_5118 + + ' 5 * rational_arctan_small_pos small_per_6072)))%CR. + ring. + repeat (rewrite (rational_arctan_small_pos_correct); [|constructor]). + repeat rewrite <- IR_inj_Q_as_CR. + repeat (rewrite <- IR_mult_as_CR || rewrite <- IR_plus_as_CR). + apply IRasCR_wd. + rstepr (Four[*]inj_Q IR r[*]Pi[/]FourNZ). + apply mult_wd. + apply mult_wdl. + apply (inj_Q_nring IR 4). + eapply eq_transitive;[|apply Pi_Formula]. + rstepr (nring 17[*]ArcTan (inj_Q IR (1 / 23%positive))[+] + nring 8[*]ArcTan (inj_Q IR (1 / 182%positive))[+] + (nring 10[*]ArcTan (inj_Q IR (1 / 5118%positive))[+] + nring 5[*]ArcTan (inj_Q IR (1 / 6072%positive)))). + repeat apply bin_op_wd_unfolded; try apply eq_reflexive. + apply (inj_Q_nring IR 17). + apply (inj_Q_nring IR 8). + apply (inj_Q_nring IR 10). + apply (inj_Q_nring IR 5). Qed. Definition CRpi : CR := (r_pi 1). Lemma CRpi_correct : (IRasCR Pi == CRpi)%CR. Proof. -unfold CRpi. -rewrite r_pi_correct. -apply IRasCR_wd. -rstepl ((nring 1)[*]Pi). -apply mult_wdl. -apply eq_symmetric. -apply (inj_Q_nring IR 1). + unfold CRpi. + rewrite r_pi_correct. + apply IRasCR_wd. + rstepl ((nring 1)[*]Pi). + apply mult_wdl. + apply eq_symmetric. + apply (inj_Q_nring IR 1). Qed. End Pi. (* begin hide *) Hint Rewrite CRpi_correct : IRtoCR. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/reals/fast/CRpower.v b/reals/fast/CRpower.v index 61842b415..3f5112665 100644 --- a/reals/fast/CRpower.v +++ b/reals/fast/CRpower.v @@ -46,105 +46,105 @@ Qpos2QposInf (e/((p#1)*c^(Zpred p))). Lemma Qpower_positive_correct : forall p q, (inj_Q IR (Qpower_positive q p)[=]((FId{^}(nat_of_P p)) (inj_Q IR q) CI)). Proof. -clear p. -intros p. -destruct (p_is_some_anti_convert p) as [n Hn]. -simpl. -rewrite Hn. -clear Hn. -intros q. -induction n. -simpl. -algebra. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ in IHn. -change (P_of_succ_nat (S n)) with (Psucc (P_of_succ_nat n)). -simpl in *. -rewrite Pplus_one_succ_r. -stepl (inj_Q IR (Qpower_positive q (P_of_succ_nat n))[*](inj_Q IR q)). -csetoid_rewrite IHn. -apply eq_reflexive. -stepl (inj_Q IR (Qpower_positive q (P_of_succ_nat n)*q)). -apply inj_Q_wd. -simpl. -rewrite Qpower_plus_positive. -reflexivity. -apply inj_Q_mult. + clear p. + intros p. + destruct (p_is_some_anti_convert p) as [n Hn]. + simpl. + rewrite Hn. + clear Hn. + intros q. + induction n. + simpl. + algebra. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ in IHn. + change (P_of_succ_nat (S n)) with (Psucc (P_of_succ_nat n)). + simpl in *. + rewrite Pplus_one_succ_r. + stepl (inj_Q IR (Qpower_positive q (P_of_succ_nat n))[*](inj_Q IR q)). + csetoid_rewrite IHn. + apply eq_reflexive. + stepl (inj_Q IR (Qpower_positive q (P_of_succ_nat n)*q)). + apply inj_Q_wd. + simpl. + rewrite Qpower_plus_positive. + reflexivity. + apply inj_Q_mult. Qed. Let IRpower_p : PartFunct IR := FId{^}(nat_of_P p). Lemma Qpower_positive_uc_prf (c:Qpos) : is_UniformlyContinuousFunction (fun x => Qpower_positive (QboundAbs c x) p) (Qpower_positive_modulus c). Proof. -intros c. -destruct (p_is_some_anti_convert p) as [n Hn]. -assert (X:=(fun I pI => Derivative_nth I pI _ _ (Derivative_id I pI) n)). -assert (-c < c)%Q. -rewrite Qlt_minus_iff. -ring_simplify. -change (0 < ((2#1)*c)%Qpos). -apply Qpos_prf. -apply (fun x => @is_UniformlyContinuousFunction_wd _ _ (fun x : Q_as_MetricSpace => Qpower_positive (QboundAbs c x) p) x (Qscale_modulus ((p#1)*c^(Zpred p))%Qpos)). - reflexivity. - intros x. - unfold Qpower_positive_modulus. - generalize ((p # 1) * c ^ Zpred p)%Qpos. - intros [qn qd]. - simpl. - autorewrite with QposElim. - rewrite Qmult_sym. - apply Qle_refl. -apply (is_UniformlyContinuousD_Q (Some (-c)) (Some (c:Q)) H _ _ (X _ _) (fun x => Qpower_positive x p)). - simpl. - intros q _ Hq. - csetoid_rewrite (Qpower_positive_correct p q). + intros c. + destruct (p_is_some_anti_convert p) as [n Hn]. + assert (X:=(fun I pI => Derivative_nth I pI _ _ (Derivative_id I pI) n)). + assert (-c < c)%Q. + rewrite Qlt_minus_iff. + ring_simplify. + change (0 < ((2#1)*c)%Qpos). + apply Qpos_prf. + apply (fun x => @is_UniformlyContinuousFunction_wd _ _ (fun x : Q_as_MetricSpace => Qpower_positive (QboundAbs c x) p) x (Qscale_modulus ((p#1)*c^(Zpred p))%Qpos)). + reflexivity. + intros x. + unfold Qpower_positive_modulus. + generalize ((p # 1) * c ^ Zpred p)%Qpos. + intros [qn qd]. + simpl. + autorewrite with QposElim. + rewrite Qmult_sym. + apply Qle_refl. + apply (is_UniformlyContinuousD_Q (Some (-c)) (Some (c:Q)) H _ _ (X _ _) (fun x => Qpower_positive x p)). + simpl. + intros q _ Hq. + csetoid_rewrite (Qpower_positive_correct p q). + simpl. + rewrite Hn. + simpl. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + apply eq_reflexive. simpl. + intros x _ Hx. + change (AbsIR ((nring (R:=IR) (S n))[*](One[*]nexp IR n (inj_Q IR x)))[<=] + inj_Q IR (((p # 1)[*]((c ^ Zpred p)%Qpos:Q)))). + stepr ((inj_Q IR ((p # 1))[*](inj_Q IR ((c ^ Zpred p)%Qpos:Q)))) by + (apply eq_symmetric; apply inj_Q_mult). + stepl ((nring (R:=IR) (S n)[*]AbsIR (One[*]nexp IR n (inj_Q IR x)))) by apply AbsIR_mult;apply nring_nonneg; auto with *. + apply mult_resp_leEq_both. + apply nring_nonneg; auto with *. + apply AbsIR_nonneg. + stepl (inj_Q IR (nring (S n))) by apply inj_Q_nring. + apply inj_Q_leEq. + rewrite Hn. + rewrite <- POS_anti_convert. + stepl ((S n):Q) by apply eq_symmetric; apply nring_Q. + apply leEq_reflexive. + stepl (One[*](AbsIR (nexp IR n (inj_Q IR x)))) by apply AbsIR_mult; apply less_leEq; apply pos_one. + stepl (AbsIR (nexp IR n (inj_Q _ x))) by apply eq_symmetric; apply one_mult. + stepl (nexp IR n (AbsIR (inj_Q _ x))) by apply eq_symmetric; apply AbsIR_nexp. + stepr (inj_Q IR (c ^ Zpred p)) by apply inj_Q_wd; simpl; rewrite Q_Qpos_power; reflexivity. rewrite Hn. + rewrite <- POS_anti_convert. + rewrite inj_S. + rewrite <- Zpred_succ. + destruct n. + change (One[<=]inj_Q IR (nring 1)). + stepr (nring (R:=IR) 1) by apply eq_symmetric; apply inj_Q_nring. + stepr (One:IR). + apply leEq_reflexive. + simpl; algebra. + rewrite <- (nat_of_P_o_P_of_succ_nat_eq_succ n). + rewrite convert_is_POS. simpl. - rewrite nat_of_P_o_P_of_succ_nat_eq_succ. - apply eq_reflexive. -simpl. -intros x _ Hx. -change (AbsIR ((nring (R:=IR) (S n))[*](One[*]nexp IR n (inj_Q IR x)))[<=] -inj_Q IR (((p # 1)[*]((c ^ Zpred p)%Qpos:Q)))). -stepr ((inj_Q IR ((p # 1))[*](inj_Q IR ((c ^ Zpred p)%Qpos:Q)))) by -(apply eq_symmetric; apply inj_Q_mult). -stepl ((nring (R:=IR) (S n)[*]AbsIR (One[*]nexp IR n (inj_Q IR x)))) by apply AbsIR_mult;apply nring_nonneg; auto with *. -apply mult_resp_leEq_both. - apply nring_nonneg; auto with *. + stepr ((FId{^}(nat_of_P (P_of_succ_nat n))) (inj_Q IR (c:Q)) CI) by apply eq_symmetric; apply Qpower_positive_correct. + simpl. + apply: power_resp_leEq. apply AbsIR_nonneg. - stepl (inj_Q IR (nring (S n))) by apply inj_Q_nring. - apply inj_Q_leEq. - rewrite Hn. - rewrite <- POS_anti_convert. - stepl ((S n):Q) by apply eq_symmetric; apply nring_Q. - apply leEq_reflexive. -stepl (One[*](AbsIR (nexp IR n (inj_Q IR x)))) by apply AbsIR_mult; apply less_leEq; apply pos_one. -stepl (AbsIR (nexp IR n (inj_Q _ x))) by apply eq_symmetric; apply one_mult. -stepl (nexp IR n (AbsIR (inj_Q _ x))) by apply eq_symmetric; apply AbsIR_nexp. -stepr (inj_Q IR (c ^ Zpred p)) by apply inj_Q_wd; simpl; rewrite Q_Qpos_power; reflexivity. -rewrite Hn. -rewrite <- POS_anti_convert. -rewrite inj_S. -rewrite <- Zpred_succ. -destruct n. - change (One[<=]inj_Q IR (nring 1)). - stepr (nring (R:=IR) 1) by apply eq_symmetric; apply inj_Q_nring. - stepr (One:IR). - apply leEq_reflexive. - simpl; algebra. -rewrite <- (nat_of_P_o_P_of_succ_nat_eq_succ n). -rewrite convert_is_POS. -simpl. -stepr ((FId{^}(nat_of_P (P_of_succ_nat n))) (inj_Q IR (c:Q)) CI) by apply eq_symmetric; apply Qpower_positive_correct. -simpl. -apply: power_resp_leEq. - apply AbsIR_nonneg. -apply AbsSmall_imp_AbsIR. -destruct Hx; split; try assumption. -stepl (inj_Q IR (-c)). - assumption. -apply inj_Q_inv. + apply AbsSmall_imp_AbsIR. + destruct Hx; split; try assumption. + stepl (inj_Q IR (-c)). + assumption. + apply inj_Q_inv. Qed. Definition Qpower_positive_uc (c:Qpos) : Q_as_MetricSpace --> Q_as_MetricSpace := @@ -156,66 +156,66 @@ Cmap QPrelengthSpace (Qpower_positive_uc c). Lemma CRpower_positive_bounded_correct : forall (c:Qpos) x, AbsSmall (inj_Q _ (c:Q)) x -> (IRasCR (x[^](nat_of_P p))==CRpower_positive_bounded c (IRasCR x))%CR. Proof. -intros c x Hx. -pose (I:=(clcr [--](inj_Q IR (c:Q)) (inj_Q IR (c:Q)))). -assert (Hc: Zero[<]inj_Q IR (c:Q)). - stepl (inj_Q IR Zero). - apply inj_Q_less. - apply Qpos_prf. - apply (inj_Q_nring IR 0). -assert (HI:proper I). - simpl. - apply shift_zero_less_minus'. - rstepr (inj_Q IR (c:Q)[+]inj_Q IR (c:Q)). - apply plus_resp_pos; assumption. -change (x[^](nat_of_P p)) with ((FId{^}(nat_of_P p)) x CI). -destruct Hx as [Hx0 Hx1]. -apply (ContinuousCorrect HI (Continuous_nth I FId (Continuous_id I) (nat_of_P p)));[|split;assumption]. -intros q [] Hq. -transitivity (IRasCR (inj_Q IR (Qpower_positive q p))). - rewrite IR_inj_Q_as_CR. - simpl. - change (' q)%CR with (Cunit_fun _ q). - rewrite Cmap_fun_correct. - rewrite MonadLaw3. - rewrite CReq_Qeq. - simpl. - setoid_replace (Qmin c q) with q. - setoid_replace (Qmax (- c) q) with q. - reflexivity. - rewrite <- Qle_max_r. + intros c x Hx. + pose (I:=(clcr [--](inj_Q IR (c:Q)) (inj_Q IR (c:Q)))). + assert (Hc: Zero[<]inj_Q IR (c:Q)). + stepl (inj_Q IR Zero). + apply inj_Q_less. + apply Qpos_prf. + apply (inj_Q_nring IR 0). + assert (HI:proper I). + simpl. + apply shift_zero_less_minus'. + rstepr (inj_Q IR (c:Q)[+]inj_Q IR (c:Q)). + apply plus_resp_pos; assumption. + change (x[^](nat_of_P p)) with ((FId{^}(nat_of_P p)) x CI). + destruct Hx as [Hx0 Hx1]. + apply (ContinuousCorrect HI (Continuous_nth I FId (Continuous_id I) (nat_of_P p)));[|split;assumption]. + intros q [] Hq. + transitivity (IRasCR (inj_Q IR (Qpower_positive q p))). + rewrite IR_inj_Q_as_CR. + simpl. + change (' q)%CR with (Cunit_fun _ q). + rewrite Cmap_fun_correct. + rewrite MonadLaw3. + rewrite CReq_Qeq. + simpl. + setoid_replace (Qmin c q) with q. + setoid_replace (Qmax (- c) q) with q. + reflexivity. + rewrite <- Qle_max_r. + apply leEq_inj_Q with IR. + stepl [--](inj_Q IR (c:Q)) by apply eq_symmetric; apply inj_Q_inv. + destruct Hq; assumption. + rewrite <- Qle_min_r. apply leEq_inj_Q with IR. - stepl [--](inj_Q IR (c:Q)) by apply eq_symmetric; apply inj_Q_inv. destruct Hq; assumption. - rewrite <- Qle_min_r. - apply leEq_inj_Q with IR. - destruct Hq; assumption. -apply IRasCR_wd. -apply Qpower_positive_correct. + apply IRasCR_wd. + apply Qpower_positive_correct. Qed. Lemma CRpower_positive_bounded_weaken : forall (c1 c2:Qpos) x, ((AbsSmall ('c1) x) -> (c1 <= c2)%Q -> CRpower_positive_bounded c1 x == CRpower_positive_bounded c2 x)%CR. Proof. -intros c1 c2 x Hx Hc. -simpl in x. -rewrite <- (CRasIRasCR_id x). -transitivity (IRasCR ((CRasIR x)[^](nat_of_P p))). - symmetry. + intros c1 c2 x Hx Hc. + simpl in x. + rewrite <- (CRasIRasCR_id x). + transitivity (IRasCR ((CRasIR x)[^](nat_of_P p))). + symmetry. + apply CRpower_positive_bounded_correct. + rewrite IR_AbsSmall_as_CR. + stepl ('c1)%CR by simpl; symmetry; apply IR_inj_Q_as_CR. + stepr x by simpl; symmetry; apply CRasIRasCR_id. + assumption. apply CRpower_positive_bounded_correct. + apply AbsSmall_leEq_trans with (inj_Q IR (c1:Q)). + apply inj_Q_leEq. + assumption. rewrite IR_AbsSmall_as_CR. stepl ('c1)%CR by simpl; symmetry; apply IR_inj_Q_as_CR. stepr x by simpl; symmetry; apply CRasIRasCR_id. assumption. -apply CRpower_positive_bounded_correct. -apply AbsSmall_leEq_trans with (inj_Q IR (c1:Q)). - apply inj_Q_leEq. - assumption. -rewrite IR_AbsSmall_as_CR. -stepl ('c1)%CR by simpl; symmetry; apply IR_inj_Q_as_CR. -stepr x by simpl; symmetry; apply CRasIRasCR_id. -assumption. Qed. (** [CRpower_positive_bounded] is should be used when a known bound @@ -226,39 +226,39 @@ Lemma CRpositive_power_bounded_positive_power : forall (c:Qpos) (x:CR), ((AbsSmall ('c) x) -> CRpower_positive_bounded c x == CRpower_positive x)%CR. Proof. -intros c x Hc. -assert (Hx:(AbsSmall ('(CR_b (1#1) x)) x)%CR). - split; simpl. - rewrite CRopp_Qopp. - apply CR_b_lowerBound. - apply CR_b_upperBound. -unfold CRpower_positive. -generalize (CR_b (1#1) x) Hx. -clear Hx. -intros d Hd. -destruct (Qle_total c d);[|symmetry]; apply CRpower_positive_bounded_weaken; assumption. + intros c x Hc. + assert (Hx:(AbsSmall ('(CR_b (1#1) x)) x)%CR). + split; simpl. + rewrite CRopp_Qopp. + apply CR_b_lowerBound. + apply CR_b_upperBound. + unfold CRpower_positive. + generalize (CR_b (1#1) x) Hx. + clear Hx. + intros d Hd. + destruct (Qle_total c d);[|symmetry]; apply CRpower_positive_bounded_weaken; assumption. Qed. Lemma CRpower_positive_correct : forall x, (IRasCR (x[^](nat_of_P p))==CRpower_positive (IRasCR x))%CR. Proof. -intros x. -apply CRpower_positive_bounded_correct. -rewrite IR_AbsSmall_as_CR. -stepl ('(CR_b (1#1) (IRasCR x)))%CR by simpl; symmetry; apply IR_inj_Q_as_CR. -split; simpl. - rewrite CRopp_Qopp. - apply CR_b_lowerBound. -apply CR_b_upperBound. + intros x. + apply CRpower_positive_bounded_correct. + rewrite IR_AbsSmall_as_CR. + stepl ('(CR_b (1#1) (IRasCR x)))%CR by simpl; symmetry; apply IR_inj_Q_as_CR. + split; simpl. + rewrite CRopp_Qopp. + apply CR_b_lowerBound. + apply CR_b_upperBound. Qed. End CRpower_positive. -Lemma CRpower_positive_correct' : forall n x, +Lemma CRpower_positive_correct' : forall n x, (IRasCR (x[^]S n)==CRpower_positive (P_of_succ_nat n) (IRasCR x))%CR. Proof. -intros n x. -rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ. -apply CRpower_positive_correct. + intros n x. + rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ. + apply CRpower_positive_correct. Qed. Hint Rewrite CRpower_positive_correct' : IRtoCR. @@ -266,14 +266,14 @@ Hint Rewrite CRpower_positive_correct' : IRtoCR. (* begin hide *) Add Parametric Morphism p : (@CRpower_positive p) with signature (@st_eq _) ==> (@st_eq _) as CRpower_positive_wd. Proof. -intros x1 x2 Hx. -transitivity (CRpower_positive_bounded p (CR_b (1 # 1) x1) x2). - change (ucFun (CRpower_positive_bounded p (CR_b (1#1) x1)) x1==ucFun (CRpower_positive_bounded p (CR_b (1#1) x1)) x2)%CR. - apply uc_wd; assumption. -apply CRpositive_power_bounded_positive_power. -split; simpl; rewrite <- Hx. - rewrite CRopp_Qopp. - apply CR_b_lowerBound. -apply CR_b_upperBound. + intros x1 x2 Hx. + transitivity (CRpower_positive_bounded p (CR_b (1 # 1) x1) x2). + change (ucFun (CRpower_positive_bounded p (CR_b (1#1) x1)) x1==ucFun (CRpower_positive_bounded p (CR_b (1#1) x1)) x2)%CR. + apply uc_wd; assumption. + apply CRpositive_power_bounded_positive_power. + split; simpl; rewrite <- Hx. + rewrite CRopp_Qopp. + apply CR_b_lowerBound. + apply CR_b_upperBound. Qed. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/reals/fast/CRroot.v b/reals/fast/CRroot.v index abce3069e..45a81f7fb 100644 --- a/reals/fast/CRroot.v +++ b/reals/fast/CRroot.v @@ -60,130 +60,126 @@ Definition root_has_error (e:Qpos) (b:Q) := a <= (b+e)^2 /\ (b-e)^2 <= a. (* begin hide *) Add Morphism root_has_error with signature QposEq ==> Qeq ==> iff as root_has_error_wd. Proof. -intros x1 x2 Hx y1 y2 Hy. -unfold root_has_error. -rewrite Hy. -unfold QposEq in Hx. -rewrite Hx. -reflexivity. + intros x1 x2 Hx y1 y2 Hy. + unfold root_has_error. + rewrite Hy. + unfold QposEq in Hx. + rewrite Hx. + reflexivity. Qed. (* end hide *) Lemma root_has_error_le : forall (e1 e2:Qpos) (b:Q), e2 <= b -> e1 <= e2 -> root_has_error e1 b -> root_has_error e2 b. Proof. -intros e1 e2 b Hb He [H0 H1]. -rewrite -> Qle_minus_iff in *. -split; rewrite Qle_minus_iff. - replace RHS with (((b + e1) ^ 2 + - a) + (e2 + - e1)*(2*(b + - e2 + e2) + e2 + e1)) by ring. + intros e1 e2 b Hb He [H0 H1]. + rewrite -> Qle_minus_iff in *. + split; rewrite Qle_minus_iff. + replace RHS with (((b + e1) ^ 2 + - a) + (e2 + - e1)*(2*(b + - e2 + e2) + e2 + e1)) by ring. + Qauto_nonneg. + replace RHS with ((a + - (b-e1)^2) + (e2 + -e1)*((e2 + - e1) + 2*(b + - e2))) by ring. Qauto_nonneg. -replace RHS with ((a + - (b-e1)^2) + (e2 + -e1)*((e2 + - e1) + 2*(b + - e2))) by ring. -Qauto_nonneg. Qed. Lemma root_error_bnd : forall (e:Qpos) b, e <= 1 -> 1 <= b -> (root_has_error e b) -> b <= 2 + e. Proof. -intros e b He Hb [H0 H1]. -destruct Ha as [Ha0 Ha1]. -rewrite -> Qle_minus_iff in *. -assert (X:0 < 2 + b - e). - apply Qlt_le_trans with 2. - constructor. - rewrite Qle_minus_iff. - replace RHS with ((b + -(1)) + (1 + - e)) by ring. + intros e b He Hb [H0 H1]. + destruct Ha as [Ha0 Ha1]. + rewrite -> Qle_minus_iff in *. + assert (X:0 < 2 + b - e). + apply Qlt_le_trans with 2. + constructor. + rewrite Qle_minus_iff. + replace RHS with ((b + -(1)) + (1 + - e)) by ring. + Qauto_nonneg. + replace RHS with (((4 + - a) + (a + - (b - e)^2))/(2 + b - e)) by field; auto with *. + apply Qle_shift_div_l. + assumption. + replace LHS with 0 by ring. Qauto_nonneg. -replace RHS with (((4 + - a) + (a + - (b - e)^2))/(2 + b - e)) by - field; auto with *. -apply Qle_shift_div_l. - assumption. -replace LHS with 0 by ring. -Qauto_nonneg. Qed. Lemma root_has_error_ball : forall (e1 e2:Qpos) (b1 b2:Q), (e1 + e2<=1) -> (1 <= b1) -> (1 <= b2) -> root_has_error e1 b1 -> Qball e2 b1 b2 -> root_has_error (e1+e2) b2. Proof. -intros e1 e2 b1 b2 He Hb1 Hb2 [H0 H1] [H2 H3]. -simpl in H2, H3. -clear Ha. -rewrite -> Qle_minus_iff in *. -unfold root_has_error. -autorewrite with QposElim. -split; rewrite Qle_minus_iff. - replace RHS with (((b1 + e1)^2 + - a) + (b2 + - (1) + e1 + e2 + (b1 + -(1)) + 2 + e1)*(e2 - (b1 - b2))) by ring. + intros e1 e2 b1 b2 He Hb1 Hb2 [H0 H1] [H2 H3]. + simpl in H2, H3. + clear Ha. + rewrite -> Qle_minus_iff in *. + unfold root_has_error. + autorewrite with QposElim. + split; rewrite Qle_minus_iff. + replace RHS with (((b1 + e1)^2 + - a) + (b2 + - (1) + e1 + e2 + (b1 + -(1)) + 2 + e1)*(e2 - (b1 - b2))) by ring. + Qauto_nonneg. + replace RHS with ((a + - (b1 - e1)^2) + (b1 - b2 + - - e2)*((b1 + -(1)) + (1 + - (e1 + e2)) + e2 + (b2 + -(1)) + (1 + - (e1 + e2)))) by ring. Qauto_nonneg. -replace RHS with ((a + - (b1 - e1)^2) + (b1 - b2 + - - e2)*((b1 + -(1)) + (1 + - (e1 + e2)) + e2 + (b2 + -(1)) + (1 + - (e1 + e2)))) by ring. -Qauto_nonneg. Qed. Lemma ball_root_has_error : forall (e1 e2:Qpos) (b1 b2:Q), ((e1 + e2)<=1) -> (1<=b1) -> (1<=b2) -> root_has_error e1 b1 -> root_has_error e2 b2 -> Qball (e1+e2) b1 b2. Proof. -intros e1 e2 b1 b2 He Hb1 Hb2 [H0 H1] [H2 H3]. -clear Ha. -rewrite -> Qle_minus_iff in *. -split; simpl; autorewrite with QposElim; rewrite Qle_minus_iff. - assert (A0:0 < (b1 + e1 + b2 - e2)). + intros e1 e2 b1 b2 He Hb1 Hb2 [H0 H1] [H2 H3]. + clear Ha. + rewrite -> Qle_minus_iff in *. + split; simpl; autorewrite with QposElim; rewrite Qle_minus_iff. + assert (A0:0 < (b1 + e1 + b2 - e2)). + apply Qlt_le_trans with 1;[constructor|]. + rewrite Qle_minus_iff. + replace RHS with (b1 + - (1) + (b2 + - (1)) + 2 * e1 + (1 - (e1 + e2))) by ring. + Qauto_nonneg. + replace RHS with ((((b1 + e1)^2 + - a) + (a + - (b2 - e2)^2))/(b1 + e1 +b2 - e2)) by (field; auto with *). + Qauto_nonneg. + assert (A0:0 < (b2 + e2 + b1 - e1)). apply Qlt_le_trans with 1;[constructor|]. rewrite Qle_minus_iff. - replace RHS with (b1 + - (1) + (b2 + - (1)) + 2 * e1 + (1 - (e1 + e2))) by ring. + replace RHS with (b2 + - (1) + (b1 + - (1)) + 2 * e2 + (1 - (e1 + e2))) by ring. Qauto_nonneg. - replace RHS with ((((b1 + e1)^2 + - a) + (a + - (b2 - e2)^2))/(b1 + e1 +b2 - e2)) by (field; auto with *). - Qauto_nonneg. -assert (A0:0 < (b2 + e2 + b1 - e1)). - apply Qlt_le_trans with 1;[constructor|]. - rewrite Qle_minus_iff. - replace RHS with (b2 + - (1) + (b1 + - (1)) + 2 * e2 + (1 - (e1 + e2))) by ring. + replace RHS with (((a + -(b1 - e1)^2) + ((b2 + e2)^2 + - a))/(b2 + e2 + b1 - e1)) by (field;auto with *). Qauto_nonneg. -replace RHS with (((a + -(b1 - e1)^2) + ((b2 + e2)^2 + - a))/(b2 + e2 + b1 - e1)) by (field;auto with *). -Qauto_nonneg. Qed. Lemma root_step_error : forall b (e:Qpos), (1 <= b) -> (e <= 1) -> root_has_error e b -> root_has_error ((1#2)*(e*e)) (root_step b). Proof. -intros b e Hb He [H0 H1]. -unfold root_step. -assert (A0:0 < b). - apply Qlt_le_trans with 1; try assumption. - Qauto_pos. -assert (A1:(0 <= b - e^2)). - replace RHS with (b + - e^2) by ring. - rewrite <- Qle_minus_iff. - apply Qle_trans with ((1:Q)[^]2); try assumption. - replace LHS with ((e:Q)[^]2) by (simpl; unfold QONE; ring). - apply: (power_resp_leEq);simpl; try assumption. - apply Qpos_nonneg. -assert (A2:(0 <= a)). - eapply Qle_trans;[|apply H1]. - replace RHS with ((b-e)[^]2) by (simpl; unfold QONE; ring). - apply: sqr_nonneg. -split. - apply Qle_trans with ((b / 2 + a / (2 * b))^2); - [|Qauto_le]. - field_simplify (b / 2 + a / (2 * b)); - auto with *. + intros b e Hb He [H0 H1]. + unfold root_step. + assert (A0:0 < b). + apply Qlt_le_trans with 1; try assumption. + Qauto_pos. + assert (A1:(0 <= b - e^2)). + replace RHS with (b + - e^2) by ring. + rewrite <- Qle_minus_iff. + apply Qle_trans with ((1:Q)[^]2); try assumption. + replace LHS with ((e:Q)[^]2) by (simpl; unfold QONE; ring). + apply: (power_resp_leEq);simpl; try assumption. + apply Qpos_nonneg. + assert (A2:(0 <= a)). + eapply Qle_trans;[|apply H1]. + replace RHS with ((b-e)[^]2) by (simpl; unfold QONE; ring). + apply: sqr_nonneg. + split. + apply Qle_trans with ((b / 2 + a / (2 * b))^2); [|Qauto_le]. + field_simplify (b / 2 + a / (2 * b)); auto with *. + rewrite Qdiv_power. + apply Qle_shift_div_l. + Qauto_pos. + rewrite Qle_minus_iff. + replace RHS with ((b^2 - a)[^]2) by (simpl; unfold QONE; ring). + apply: sqr_nonneg. + field_simplify (b / 2 + a / (2 * b) - ((1#2)*e * e)); auto with *. rewrite Qdiv_power. - apply Qle_shift_div_l. + apply Qle_shift_div_r. Qauto_pos. - rewrite Qle_minus_iff. - replace RHS with ((b^2 - a)[^]2) by (simpl; unfold QONE; ring). - apply: sqr_nonneg. -field_simplify (b / 2 + a / (2 * b) - ((1#2)*e * e)); - auto with *. -rewrite Qdiv_power. -apply Qle_shift_div_r. - Qauto_pos. -replace LHS with ((a + b^2 - b*e^2)^2) by ring. -apply Qle_trans with ((a + b^2 - e^2)^2). - replace RHS with ((a + b ^ 2 - e ^ 2)[^]2) by (simpl; unfold QONE; ring). - replace LHS with ((a + b ^ 2 - b * e ^ 2)[^]2) by (simpl; unfold QONE; ring). - apply: (power_resp_leEq). - replace RHS with (a + b*(b-e^2)) by ring. + replace LHS with ((a + b^2 - b*e^2)^2) by ring. + apply Qle_trans with ((a + b^2 - e^2)^2). + replace RHS with ((a + b ^ 2 - e ^ 2)[^]2) by (simpl; unfold QONE; ring). + replace LHS with ((a + b ^ 2 - b * e ^ 2)[^]2) by (simpl; unfold QONE; ring). + apply: (power_resp_leEq). + replace RHS with (a + b*(b-e^2)) by ring. + Qauto_nonneg. + rewrite -> Qle_minus_iff;ring_simplify. + replace RHS with ((b-1)*((e:Q)[^]2)) by (simpl; unfold QONE; ring). + rewrite -> Qle_minus_iff in Hb. Qauto_nonneg. - rewrite -> Qle_minus_iff;ring_simplify. - replace RHS with ((b-1)*((e:Q)[^]2)) by (simpl; unfold QONE; ring). - rewrite -> Qle_minus_iff in Hb. - Qauto_nonneg. -rewrite Qle_minus_iff. -replace RHS with ((a-(b-e)^2)*((b+e)^2-a)) by ring. -rewrite -> Qle_minus_iff in *|-. -apply: mult_resp_nonneg; assumption. + rewrite Qle_minus_iff. + replace RHS with ((a-(b-e)^2)*((b+e)^2-a)) by ring. + rewrite -> Qle_minus_iff in *|-. + apply: mult_resp_nonneg; assumption. Qed. (** Our initial estimate is (a+1)/2 with an error of 1/2 *) @@ -191,52 +187,52 @@ Definition initial_root :Q := ((1#2)*(a+1)). Lemma initial_root_error : root_has_error (1#2) initial_root. Proof. -destruct Ha as [Ha0 Ha1]. -unfold initial_root, root_has_error. -autorewrite with QposElim. -split. - Qauto_le. -rewrite Qle_minus_iff. -assert (A0:(0<=1 + -((1#4)*a))). - rewrite <- Qle_minus_iff. - replace LHS with (a/4) by (field; discriminate). - apply Qle_shift_div_r; try assumption. - Qauto_pos. -rewrite -> Qle_minus_iff in Ha0. -replace RHS with ((a + -(1) + 1)*(1 +- ((1#4)*a))) by ring. -Qauto_nonneg. + destruct Ha as [Ha0 Ha1]. + unfold initial_root, root_has_error. + autorewrite with QposElim. + split. + Qauto_le. + rewrite Qle_minus_iff. + assert (A0:(0<=1 + -((1#4)*a))). + rewrite <- Qle_minus_iff. + replace LHS with (a/4) by (field; discriminate). + apply Qle_shift_div_r; try assumption. + Qauto_pos. + rewrite -> Qle_minus_iff in Ha0. + replace RHS with ((a + -(1) + 1)*(1 +- ((1#4)*a))) by ring. + Qauto_nonneg. Qed. Lemma root_step_one_le : forall b, (1 <= b)-> (1 <= root_step b). Proof. -intros b Hb. -assert (A0:0 Qle_minus_iff in *. -field_simplify (b / 2 + a / (2 * b) + -(1));auto with *. -apply Qle_shift_div_l. - Qauto_pos. -ring_simplify. -replace RHS with (((b -1) ^ 2 + (a + -(1)))) by ring. -Qauto_nonneg. + intros b Hb. + assert (A0:0 Qle_minus_iff in *. + field_simplify (b / 2 + a / (2 * b) + -(1));auto with *. + apply Qle_shift_div_l. + Qauto_pos. + ring_simplify. + replace RHS with (((b -1) ^ 2 + (a + -(1)))) by ring. + Qauto_nonneg. Qed. Lemma initial_root_one_le : (1 <= initial_root). Proof. -destruct Ha as [Ha0 Ha1]. -unfold initial_root. -rewrite -> Qle_minus_iff in *. -replace RHS with ((1#2)*(a + - (1))) by ring. -Qauto_nonneg. + destruct Ha as [Ha0 Ha1]. + unfold initial_root. + rewrite -> Qle_minus_iff in *. + replace RHS with ((1#2)*(a + - (1))) by ring. + Qauto_nonneg. Qed. (** Each step squares the error *) Fixpoint root_loop (e:Qpos) (n:nat) (b:Q) (err:positive) {struct n} : Q := -match n with +match n with | O => b -| S n' => if (Qlt_le_dec_fast e (1#err)) +| S n' => if (Qlt_le_dec_fast e (1#err)) then let err':= (err*err)%positive in root_loop e n' (approximateQ (root_step b) (2*err')) err' else b end. @@ -245,106 +241,102 @@ Opaque root_step. Lemma root_loop_one_le : forall e n b err, (1 <= b)-> (1 <= root_loop e n b err). Proof. -intros e n. -induction n; auto with *. -simpl. -intros b err Hb. -destruct (Qlt_le_dec_fast e (1 # err)) as [A|A]; try assumption. -apply IHn. -apply approximateQ_big. -apply root_step_one_le. -assumption. + intros e n. + induction n; auto with *. + simpl. + intros b err Hb. + destruct (Qlt_le_dec_fast e (1 # err)) as [A|A]; try assumption. + apply IHn. + apply approximateQ_big. + apply root_step_one_le. + assumption. Qed. -Lemma root_loop_error : forall (e:Qpos) n b err, (1 <= b) -> root_has_error (1#err) b -> (1#(iter_nat n _ (fun x => (x * x)%positive) err))<=e -> +Lemma root_loop_error : forall (e:Qpos) n b err, (1 <= b) -> root_has_error (1#err) b -> (1#(iter_nat n _ (fun x => (x * x)%positive) err))<=e -> root_has_error (Qpos_min (1 # err) e) (root_loop e n b err). Proof. -induction n. + induction n. + intros b err Hb0 Hb1 He. + simpl in *. + setoid_replace (Qpos_min (1 # err) e) with (1#err)%Qpos; try assumption. + unfold QposEq. + rewrite <- Qpos_le_min_l. + assumption. intros b err Hb0 Hb1 He. simpl in *. + destruct (Qlt_le_dec_fast e (1 # err)) as [A|A]. + apply root_has_error_le with (Qpos_min (1#(err*err)) e). + apply Qle_trans with 1. + apply Qle_trans with (1#err); auto with *. + apply Qpos_min_lb_l. + apply root_loop_one_le. + apply approximateQ_big. + apply root_step_one_le; assumption. + apply Qpos_min_glb. + apply Qle_trans with (1#err*err). + apply Qpos_min_lb_l. + change (1*err <= err*err)%Z; auto with *. + apply Qpos_min_lb_r. + apply IHn; try assumption. + apply approximateQ_big. + apply root_step_one_le; assumption. + setoid_replace (1#err*err)%Qpos with ((1#(2*(err * err)))+(1#(2*(err * err))))%Qpos. + apply root_has_error_ball with (root_step b). + autorewrite with QposElim. + ring_simplify. + unfold Qmult, Qle; simpl. + auto with *. + apply root_step_one_le; assumption. + apply approximateQ_big. + apply root_step_one_le; assumption. + apply (root_step_error b (1#err)); try assumption. + unfold Qle; simpl; auto with *. + apply approximateQ_correct. + unfold QposEq. + autorewrite with QposElim. + ring_simplify. + constructor. + replace (iter_nat n positive (fun x : positive => (x * x)%positive) (err * err)%positive) + with (iter_nat n positive (fun x : positive => (x * x)%positive) err * + iter_nat n positive (fun x : positive => (x * x)%positive) err)%positive. + assumption. + clear - n. + induction n; try constructor. + simpl in *. + rewrite IHn. + reflexivity. setoid_replace (Qpos_min (1 # err) e) with (1#err)%Qpos; try assumption. unfold QposEq. rewrite <- Qpos_le_min_l. assumption. -intros b err Hb0 Hb1 He. -simpl in *. -destruct (Qlt_le_dec_fast e (1 # err)) as [A|A]. - apply root_has_error_le with (Qpos_min (1#(err*err)) e). - apply Qle_trans with 1. - apply Qle_trans with (1#err); auto with *. - apply Qpos_min_lb_l. - apply root_loop_one_le. - apply approximateQ_big. - apply root_step_one_le; assumption. - apply Qpos_min_glb. - apply Qle_trans with (1#err*err). - apply Qpos_min_lb_l. - change (1*err <= err*err)%Z; auto with *. - apply Qpos_min_lb_r. - apply IHn; try assumption. - apply approximateQ_big. - apply root_step_one_le; assumption. - setoid_replace (1#err*err)%Qpos with ((1#(2*(err * err)))+(1#(2*(err * err))))%Qpos. - apply root_has_error_ball with (root_step b). - autorewrite with QposElim. - ring_simplify. - unfold Qmult, Qle; simpl. - auto with *. - apply root_step_one_le; assumption. - apply approximateQ_big. - apply root_step_one_le; assumption. - apply (root_step_error b (1#err)); try assumption. - unfold Qle; simpl; auto with *. - apply approximateQ_correct. - unfold QposEq. - autorewrite with QposElim. - ring_simplify. - constructor. - replace (iter_nat n positive (fun x : positive => (x * x)%positive) - (err * err)%positive) - with (iter_nat n positive (fun x : positive => (x * x)%positive) err * - iter_nat n positive (fun x : positive => (x * x)%positive) err)%positive. - assumption. - clear - n. - induction n; try constructor. - simpl in *. - rewrite IHn. - reflexivity. -setoid_replace (Qpos_min (1 # err) e) with (1#err)%Qpos; try assumption. -unfold QposEq. -rewrite <- Qpos_le_min_l. -assumption. Qed. (** Find a bound on the number of iterations we need to take. *) Lemma root_max_steps : forall (n d:positive), (1#(iter_nat (S (Psize d)) _ (fun x => (x * x)%positive) 2%positive))<=(n#d)%Qpos. Proof. -intros n d. -apply Qle_trans with (1#d). - clear - d. + intros n d. + apply Qle_trans with (1#d). + clear - d. + unfold Qle; simpl. + cut ((d <= iter_nat (S (Psize d)) positive (fun x : positive => (x * x)%positive) + 2%positive)%Z/\(4 <= iter_nat (S (Psize d)) positive (fun x : positive => (x * x)%positive) + 2%positive)%Z). + tauto. + induction d; split; try discriminate; destruct IHd as [A B]; + set (t:=iter_nat (S (Psize d)) positive (fun x : positive => (x * x)%positive) 2%positive) in *. + rewrite Zpos_xI. + apply Zle_trans with (4*d)%Z; auto with *. + apply (Zmult_le_compat 4 d t t); auto with *. + change (4%Z) with (2*2)%Z. + apply (Zmult_le_compat 2 2 t t); auto with *. + rewrite Zpos_xO. + apply Zle_trans with (4*d)%Z; auto with *. + apply (Zmult_le_compat 4 d t t); auto with *. + change (4%Z) with (2*2)%Z. + apply (Zmult_le_compat 2 2 t t); auto with *. unfold Qle; simpl. - cut ((d <= - iter_nat (S (Psize d)) positive (fun x : positive => (x * x)%positive) - 2%positive)%Z/\(4 <= - iter_nat (S (Psize d)) positive (fun x : positive => (x * x)%positive) - 2%positive)%Z). - tauto. - induction d; split; try discriminate; destruct IHd as [A B]; - set (t:=iter_nat (S (Psize d)) positive (fun x : positive => (x * x)%positive) - 2%positive) in *. - rewrite Zpos_xI. - apply Zle_trans with (4*d)%Z; auto with *. - apply (Zmult_le_compat 4 d t t); auto with *. - change (4%Z) with (2*2)%Z. - apply (Zmult_le_compat 2 2 t t); auto with *. - rewrite Zpos_xO. - apply Zle_trans with (4*d)%Z; auto with *. - apply (Zmult_le_compat 4 d t t); auto with *. - change (4%Z) with (2*2)%Z. - apply (Zmult_le_compat 2 2 t t); auto with *. -unfold Qle; simpl. -change (1*d <= n*d)%Z. -auto with *. + change (1*d <= n*d)%Z. + auto with *. Qed. (** Square root on [[1,4]]. *) @@ -356,166 +348,159 @@ end. Lemma sqrt_regular : is_RegularFunction sqrt_raw. Proof. -intros e1 e2. -apply ball_weak_le with (Qpos_min (1#2) e1 + Qpos_min (1#2) e2)%Qpos. - autorewrite with QposElim. - apply: plus_resp_leEq_both; simpl; auto with *. -apply ball_root_has_error; - try first [apply root_loop_one_le; apply initial_root_one_le - |apply root_loop_error; try first - [apply initial_root_one_le - |apply initial_root_error - |(destruct e1; destruct e2); apply root_max_steps]]. -setoid_replace (1:Q) with ((1#2)%Qpos + (1#2)%Qpos) by QposRing. -apply: plus_resp_leEq_both; apply Qpos_min_lb_l. + intros e1 e2. + apply ball_weak_le with (Qpos_min (1#2) e1 + Qpos_min (1#2) e2)%Qpos. + autorewrite with QposElim. + apply: plus_resp_leEq_both; simpl; auto with *. + apply ball_root_has_error; try first [apply root_loop_one_le; apply initial_root_one_le + |apply root_loop_error; try first [apply initial_root_one_le |apply initial_root_error + |(destruct e1; destruct e2); apply root_max_steps]]. + setoid_replace (1:Q) with ((1#2)%Qpos + (1#2)%Qpos) by QposRing. + apply: plus_resp_leEq_both; apply Qpos_min_lb_l. Qed. Definition rational_sqrt_mid : CR := Build_RegularFunction sqrt_regular. Lemma rational_sqrt_mid_err : forall (e:Qpos), (e <= 1) -> root_has_error e (approximate rational_sqrt_mid e). Proof. -intros e He. -change (root_has_error e (sqrt_raw e)). -unfold sqrt_raw. -eapply root_has_error_le;[| |apply root_loop_error]. - eapply Qle_trans;[apply He|]. - apply root_loop_one_le; apply initial_root_one_le. - apply Qpos_min_lb_r. - apply initial_root_one_le. - apply initial_root_error. -destruct e; apply root_max_steps. + intros e He. + change (root_has_error e (sqrt_raw e)). + unfold sqrt_raw. + eapply root_has_error_le;[| |apply root_loop_error]. + eapply Qle_trans;[apply He|]. + apply root_loop_one_le; apply initial_root_one_le. + apply Qpos_min_lb_r. + apply initial_root_one_le. + apply initial_root_error. + destruct e; apply root_max_steps. Qed. Lemma rational_sqrt_mid_one_le : forall (e:QposInf), 1 <= (approximate rational_sqrt_mid e). Proof. -intros [e|];[|apply Qle_refl]. -apply: root_loop_one_le. -apply initial_root_one_le. + intros [e|];[|apply Qle_refl]. + apply: root_loop_one_le. + apply initial_root_one_le. Qed. Lemma rational_sqrt_mid_le_3 : forall (e:QposInf), (approximate rational_sqrt_mid e) <= 3. Proof. -intros [e|];[|discriminate]. -change (sqrt_raw e <= 3). -unfold sqrt_raw. -set (n:= (S (Psize (Qden e)))). -assert (root_has_error (Qpos_min (1 # 2) e) (root_loop e n initial_root 2)). - apply root_loop_error. + intros [e|];[|discriminate]. + change (sqrt_raw e <= 3). + unfold sqrt_raw. + set (n:= (S (Psize (Qden e)))). + assert (root_has_error (Qpos_min (1 # 2) e) (root_loop e n initial_root 2)). + apply root_loop_error. + apply initial_root_one_le. + apply initial_root_error. + destruct e; apply root_max_steps. + eapply Qle_trans. + apply root_error_bnd;[| |apply H]. + eapply Qle_trans. + apply Qpos_min_lb_l. + discriminate. + apply root_loop_one_le. apply initial_root_one_le. - apply initial_root_error. -destruct e; apply root_max_steps. -eapply Qle_trans. -apply root_error_bnd;[| |apply H]. - eapply Qle_trans. - apply Qpos_min_lb_l. - discriminate. - apply root_loop_one_le. - apply initial_root_one_le. -assert (X:=Qpos_min_lb_l (1#2) e). -rewrite -> Qle_minus_iff in *. -replace RHS with ((1#2)%Qpos + - Qpos_min (1 # 2) e + (1#2)). - Qauto_nonneg. -autorewrite with QposElim. -ring. + assert (X:=Qpos_min_lb_l (1#2) e). + rewrite -> Qle_minus_iff in *. + replace RHS with ((1#2)%Qpos + - Qpos_min (1 # 2) e + (1#2)). + Qauto_nonneg. + autorewrite with QposElim. + ring. Qed. Opaque root_loop. Lemma rational_sqrt_mid_correct0 : (CRpower_positive 2 rational_sqrt_mid == ' a)%CR. Proof. -assert (H:AbsSmall (R:=CRasCOrdField) (' (3 # 1)%Qpos)%CR rational_sqrt_mid). -split; simpl. + assert (H:AbsSmall (R:=CRasCOrdField) (' (3 # 1)%Qpos)%CR rational_sqrt_mid). + split; simpl. + intros e. + change (-e <= sqrt_raw (Qpos2QposInf ((1#2)*e)) + - - (3#1)). + apply Qle_trans with 0. + rewrite Qle_minus_iff. + ring_simplify. + auto with *. + rewrite <- Qle_minus_iff. + apply Qle_trans with 1. + discriminate. + apply rational_sqrt_mid_one_le. intros e. - change (-e <= sqrt_raw (Qpos2QposInf ((1#2)*e)) + - - (3#1)). + change (-e <= 3 + - sqrt_raw (Qpos2QposInf ((1#2)*e))). apply Qle_trans with 0. rewrite Qle_minus_iff. ring_simplify. auto with *. rewrite <- Qle_minus_iff. - apply Qle_trans with 1. - discriminate. - apply rational_sqrt_mid_one_le. - intros e. - change (-e <= 3 + - sqrt_raw (Qpos2QposInf ((1#2)*e))). - apply Qle_trans with 0. - rewrite Qle_minus_iff. - ring_simplify. - auto with *. - rewrite <- Qle_minus_iff. - apply rational_sqrt_mid_le_3. -rewrite <- (CRpositive_power_bounded_positive_power 2 (3#1));[|assumption]. -apply (regFunEq_e_small (X:=Q_as_MetricSpace) (CRpower_positive_bounded 2 (3 # 1) rational_sqrt_mid) (' a)%CR (1#1)). -intros e He. -set (d:=(e / (6#1))%Qpos). -change (Qball (e + e) - ((Qmax (- (3#1)) (Qmin (3#1) - (approximate rational_sqrt_mid d)))^2) a). -setoid_replace (Qmin (3#1) (approximate rational_sqrt_mid d)) - with ((approximate rational_sqrt_mid d)) by - (rewrite <- Qle_min_r;destruct H;apply rational_sqrt_mid_le_3). -setoid_replace (Qmax (-3#1) (approximate rational_sqrt_mid d)) - with ((approximate rational_sqrt_mid d)) - by (rewrite <- Qle_max_r;destruct H;eapply Qle_trans;[|apply rational_sqrt_mid_one_le];discriminate). -assert (Z:root_has_error d (approximate rational_sqrt_mid d)). - apply rational_sqrt_mid_err. - unfold d. - autorewrite with QposElim. - change ((e/(6#1)) <= 1). - apply Qle_shift_div_r. - constructor. - eapply Qle_trans. - apply He. - discriminate. -set (z:=approximate rational_sqrt_mid d) in *. -assert (X:z <= 3). - apply rational_sqrt_mid_le_3. -assert (X0:d^2 <= e). - unfold d. - autorewrite with QposElim in *. - change ((e*(1#6))^2 <= e). - rewrite -> Qle_minus_iff in *. - replace RHS with (e*(1 + -e + (35#36)* e)) by ring. - Qauto_nonneg. -destruct Z; split; simpl; - rewrite -> Qle_minus_iff in *; - autorewrite with QposElim in *. - replace RHS with (((z+d)^2 + - a) + 2*(3 + -z)*d + (e + - d^2)) + apply rational_sqrt_mid_le_3. + rewrite <- (CRpositive_power_bounded_positive_power 2 (3#1));[|assumption]. + apply (regFunEq_e_small (X:=Q_as_MetricSpace) (CRpower_positive_bounded 2 (3 # 1) rational_sqrt_mid) (' a)%CR (1#1)). + intros e He. + set (d:=(e / (6#1))%Qpos). + change (Qball (e + e) ((Qmax (- (3#1)) (Qmin (3#1) (approximate rational_sqrt_mid d)))^2) a). + setoid_replace (Qmin (3#1) (approximate rational_sqrt_mid d)) + with ((approximate rational_sqrt_mid d)) by + (rewrite <- Qle_min_r;destruct H;apply rational_sqrt_mid_le_3). + setoid_replace (Qmax (-3#1) (approximate rational_sqrt_mid d)) + with ((approximate rational_sqrt_mid d)) + by (rewrite <- Qle_max_r;destruct H;eapply Qle_trans;[|apply rational_sqrt_mid_one_le];discriminate). + assert (Z:root_has_error d (approximate rational_sqrt_mid d)). + apply rational_sqrt_mid_err. + unfold d. + autorewrite with QposElim. + change ((e/(6#1)) <= 1). + apply Qle_shift_div_r. + constructor. + eapply Qle_trans. + apply He. + discriminate. + set (z:=approximate rational_sqrt_mid d) in *. + assert (X:z <= 3). + apply rational_sqrt_mid_le_3. + assert (X0:d^2 <= e). + unfold d. + autorewrite with QposElim in *. + change ((e*(1#6))^2 <= e). + rewrite -> Qle_minus_iff in *. + replace RHS with (e*(1 + -e + (35#36)* e)) by ring. + Qauto_nonneg. + destruct Z; split; simpl; rewrite -> Qle_minus_iff in *; autorewrite with QposElim in *. + replace RHS with (((z+d)^2 + - a) + 2*(3 + -z)*d + (e + - d^2)) + by (unfold d; autorewrite with QposElim;field;discriminate). + Qauto_nonneg. + replace RHS with (a + - (z-d)^2 + 2*(3 + - z)*d + d^2 + e) by (unfold d; autorewrite with QposElim;field;discriminate). Qauto_nonneg. -replace RHS with (a + - (z-d)^2 + 2*(3 + - z)*d + d^2 + e) - by (unfold d; autorewrite with QposElim;field;discriminate). -Qauto_nonneg. Qed. Lemma rational_sqrt_mid_correct1 : ('0 <= rational_sqrt_mid)%CR. Proof. -intros e. -apply Qle_trans with 1. - Qauto_le. -change (1 <= sqrt_raw ((1#2)%Qpos*e) - 0). -ring_simplify. -apply rational_sqrt_mid_one_le. + intros e. + apply Qle_trans with 1. + Qauto_le. + change (1 <= sqrt_raw ((1#2)%Qpos*e) - 0). + ring_simplify. + apply rational_sqrt_mid_one_le. Qed. Lemma rational_sqrt_mid_correct : forall H, (rational_sqrt_mid == IRasCR (sqrt (inj_Q IR a) H))%CR. Proof. -intros H. -rewrite <- (CRasIRasCR_id rational_sqrt_mid). -apply IRasCR_wd. -assert (X:Zero[<=](CRasIR rational_sqrt_mid)[^]2). - apply sqr_nonneg. -stepl (sqrt _ X). - apply sqrt_wd. - rewrite IR_eq_as_CR. - rewrite (CRpower_positive_correct 2). - rewrite IR_inj_Q_as_CR. - rewrite (CRasIRasCR_id). - apply rational_sqrt_mid_correct0. -apply sqrt_to_nonneg. -rewrite IR_leEq_as_CR. -rewrite IR_Zero_as_CR. -rewrite CRasIRasCR_id. -apply rational_sqrt_mid_correct1. + intros H. + rewrite <- (CRasIRasCR_id rational_sqrt_mid). + apply IRasCR_wd. + assert (X:Zero[<=](CRasIR rational_sqrt_mid)[^]2). + apply sqr_nonneg. + stepl (sqrt _ X). + apply sqrt_wd. + rewrite IR_eq_as_CR. + rewrite (CRpower_positive_correct 2). + rewrite IR_inj_Q_as_CR. + rewrite (CRasIRasCR_id). + apply rational_sqrt_mid_correct0. + apply sqrt_to_nonneg. + rewrite IR_leEq_as_CR. + rewrite IR_Zero_as_CR. + rewrite CRasIRasCR_id. + apply rational_sqrt_mid_correct1. Qed. End SquareRoot. @@ -523,207 +508,196 @@ End SquareRoot. (** By scaling the input the range of square root can be extened upto 4^n. *) Definition rational_sqrt_big_bounded (n:nat) a (Ha:1 <= a <= (4^n)%Z) : CR. -fix 1. -intros n. -destruct n as [|n]. - intros _ _. - exact ('1)%CR. -intros a H. -destruct (Qle_total a 4). +Proof. + fix 1. + intros n. + destruct n as [|n]. + intros _ _. + exact ('1)%CR. + intros a H. + destruct (Qle_total a 4). + clear rational_sqrt_big_bounded. + refine (@rational_sqrt_mid a _). + abstract (destruct H; tauto). + refine (scale 2 _). + refine (@rational_sqrt_big_bounded n (a/4) _). clear rational_sqrt_big_bounded. - refine (@rational_sqrt_mid a _). - abstract (destruct H; tauto). -refine (scale 2 _). -refine (@rational_sqrt_big_bounded n (a/4) _). -clear rational_sqrt_big_bounded. -abstract ( -destruct H; -split;[apply Qle_shift_div_l;[constructor|assumption]|]; -apply Qle_shift_div_r;[constructor|]; -rewrite -> Zpower_Qpower in *; try auto with *; -change (a <= (4^n)*4^1); -rewrite <- Qpower_plus; try discriminate; -change (n+1)%Z with (Zsucc n); -rewrite <- inj_S; -assumption). + abstract ( destruct H; split;[apply Qle_shift_div_l;[constructor|assumption]|]; + apply Qle_shift_div_r;[constructor|]; rewrite -> Zpower_Qpower in *; try auto with *; + change (a <= (4^n)*4^1); rewrite <- Qpower_plus; try discriminate; change (n+1)%Z with (Zsucc n); + rewrite <- inj_S; assumption). Defined. Lemma rational_sqrt_big_bounded_correct : forall n a Ha H, (@rational_sqrt_big_bounded n a Ha == IRasCR (sqrt (inj_Q IR a) H))%CR. Proof. -induction n. + induction n. + intros a Ha H. + simpl. + rewrite <- IR_inj_Q_as_CR. + apply IRasCR_wd. + assert (X:Zero[<=](inj_Q IR 1:IR)[^]2) by apply sqr_nonneg. + stepl (sqrt _ X). + apply sqrt_wd. + rstepl (inj_Q IR 1[*]inj_Q IR 1). + stepl (inj_Q IR (1*1)) by apply (inj_Q_mult IR). + apply inj_Q_wd. + simpl. + rewrite Qeq_le_def. + assumption. + apply sqrt_to_nonneg. + stepr (nring 1:IR) by (apply eq_symmetric; apply (inj_Q_nring IR 1)). + rstepr (One:IR). + apply less_leEq; apply pos_one. intros a Ha H. simpl. + destruct (Qle_total a 4%positive). + apply rational_sqrt_mid_correct. + change (scale 2 (rational_sqrt_big_bounded n (a / 4%positive)(rational_sqrt_big_bounded_subproof0 n a Ha q)) == + IRasCR (sqrt (inj_Q IR a) H))%CR. + assert (X:Zero[<=]inj_Q IR (a/4%positive)). + change (a/4%positive) with (a*(1#4)). + stepr (inj_Q IR a[*]inj_Q IR (1#4)) by apply eq_symmetric; apply (inj_Q_mult IR). + apply mult_resp_nonneg. + assumption. + stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). + apply inj_Q_leEq. + discriminate. + set (X0:= (rational_sqrt_big_bounded_subproof0 n a Ha q)). + rewrite (IHn (a/4%positive) X0 X). + rewrite <- CRmult_scale. rewrite <- IR_inj_Q_as_CR. + rewrite <- IR_mult_as_CR. apply IRasCR_wd. - assert (X:Zero[<=](inj_Q IR 1:IR)[^]2) by apply sqr_nonneg. - stepl (sqrt _ X). + assert (X1:Zero[<=](inj_Q IR (4:Q))). + stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). + apply inj_Q_leEq. + discriminate. + csetoid_replace (inj_Q IR (2:Q)) (sqrt _ X1). + assert (X2:Zero[<=](inj_Q IR (4:Q)[*]inj_Q IR (a/4%positive))). + apply mult_resp_nonneg;assumption. + astepl (sqrt _ X2). apply sqrt_wd. - rstepl (inj_Q IR 1[*]inj_Q IR 1). - stepl (inj_Q IR (1*1)) by apply (inj_Q_mult IR). + csetoid_rewrite_rev (inj_Q_mult IR (4:Q) (a/4%positive)). apply inj_Q_wd. simpl. - rewrite Qeq_le_def. - assumption. - apply sqrt_to_nonneg. - stepr (nring 1:IR) by (apply eq_symmetric; apply (inj_Q_nring IR 1)). - rstepr (One:IR). - apply less_leEq; apply pos_one. -intros a Ha H. -simpl. -destruct (Qle_total a 4%positive). - apply rational_sqrt_mid_correct. -change (scale 2 (rational_sqrt_big_bounded n (a / 4%positive)(rational_sqrt_big_bounded_subproof0 n a Ha q)) == - IRasCR (sqrt (inj_Q IR a) H))%CR. -assert (X:Zero[<=]inj_Q IR (a/4%positive)). - change (a/4%positive) with (a*(1#4)). - stepr (inj_Q IR a[*]inj_Q IR (1#4)) by - apply eq_symmetric; apply (inj_Q_mult IR). - apply mult_resp_nonneg. - assumption. - stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). - apply inj_Q_leEq. - discriminate. -set (X0:= (rational_sqrt_big_bounded_subproof0 n a Ha q)). -rewrite (IHn (a/4%positive) X0 X). -rewrite <- CRmult_scale. -rewrite <- IR_inj_Q_as_CR. -rewrite <- IR_mult_as_CR. -apply IRasCR_wd. -assert (X1:Zero[<=](inj_Q IR (4:Q))). - stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). - apply inj_Q_leEq. - discriminate. -csetoid_replace (inj_Q IR (2:Q)) (sqrt _ X1). - assert (X2:Zero[<=](inj_Q IR (4:Q)[*]inj_Q IR (a/4%positive))). - apply mult_resp_nonneg;assumption. - astepl (sqrt _ X2). + field; discriminate. + change (inj_Q IR (4:Q)) with (inj_Q IR ((2:Q)[*](2:Q))). + assert (X2:Zero[<=](inj_Q IR (2:Q))[^]2). + apply sqr_nonneg. + stepr (sqrt _ X2). + apply eq_symmetric; apply sqrt_to_nonneg. + stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). + apply inj_Q_leEq. + discriminate. apply sqrt_wd. - csetoid_rewrite_rev (inj_Q_mult IR (4:Q) (a/4%positive)). - apply inj_Q_wd. - simpl. - field; discriminate. -change (inj_Q IR (4:Q)) with (inj_Q IR ((2:Q)[*](2:Q))). -assert (X2:Zero[<=](inj_Q IR (2:Q))[^]2). - apply sqr_nonneg. -stepr (sqrt _ X2). - apply eq_symmetric; apply sqrt_to_nonneg. - stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). - apply inj_Q_leEq. - discriminate. -apply sqrt_wd. -rstepl ((inj_Q IR (2:Q))[*](inj_Q IR (2:Q))). -apply eq_symmetric. -apply (inj_Q_mult IR (2:Q) (2:Q)). + rstepl ((inj_Q IR (2:Q))[*](inj_Q IR (2:Q))). + apply eq_symmetric. + apply (inj_Q_mult IR (2:Q) (2:Q)). Qed. (** By scaling the other direction we can extend the range down to 4^(-n). *) Definition rational_sqrt_small_bounded (n:nat) a (Ha:/(4^n)%Z <= a <= 4) : CR. -fix 1. -intros n. -destruct n as [|n]. - clear rational_sqrt_small_bounded. - refine (@rational_sqrt_mid). -intros a H. -destruct (Qle_total a 1). - refine (scale (1#2) _). - refine (@rational_sqrt_small_bounded n (4*a) _). +Proof. + fix 1. + intros n. + destruct n as [|n]. + clear rational_sqrt_small_bounded. + refine (@rational_sqrt_mid). + intros a H. + destruct (Qle_total a 1). + refine (scale (1#2) _). + refine (@rational_sqrt_small_bounded n (4*a) _). + clear rational_sqrt_small_bounded. + abstract ( destruct H; split;[ rewrite -> Zpower_Qpower in *; auto with *; + replace (Z_of_nat n) with ((S n) + (-1))%Z by (rewrite inj_S; ring); + rewrite Qpower_plus; try discriminate; change (4%positive^(-1)) with (/4); + rewrite Qinv_mult_distr; change (//4) with (4:Q); rewrite Qmult_comm + |replace RHS with (4*1) by constructor]; + (apply: mult_resp_leEq_lft;simpl;[assumption|discriminate])). clear rational_sqrt_small_bounded. - abstract ( - destruct H; - split;[ - rewrite -> Zpower_Qpower in *; auto with *; - replace (Z_of_nat n) with ((S n) + (-1))%Z by (rewrite inj_S; ring); - rewrite Qpower_plus; try discriminate; - change (4%positive^(-1)) with (/4); - rewrite Qinv_mult_distr; - change (//4) with (4:Q); - rewrite Qmult_comm - |replace RHS with (4*1) by constructor]; - (apply: mult_resp_leEq_lft;simpl;[assumption|discriminate])). -clear rational_sqrt_small_bounded. -refine (@rational_sqrt_mid a _). -abstract (destruct H; tauto). + refine (@rational_sqrt_mid a _). + abstract (destruct H; tauto). Defined. Lemma rational_sqrt_small_bounded_correct : forall n a Ha H, (@rational_sqrt_small_bounded n a Ha == IRasCR (sqrt (inj_Q IR a) H))%CR. Proof. -induction n; try apply rational_sqrt_mid_correct. -intros a Ha H. -simpl. -destruct (Qle_total a 1); try apply rational_sqrt_mid_correct. -change (scale (1#2) (rational_sqrt_small_bounded n (4%positive*a) (rational_sqrt_small_bounded_subproof n a Ha q)) == - IRasCR (sqrt (inj_Q IR a) H))%CR. -assert (X:Zero[<=]inj_Q IR (4%positive*a)). - stepr (inj_Q IR (4%positive:Q)[*]inj_Q IR a) by - apply eq_symmetric; apply (inj_Q_mult IR). - apply mult_resp_nonneg. + induction n; try apply rational_sqrt_mid_correct. + intros a Ha H. + simpl. + destruct (Qle_total a 1); try apply rational_sqrt_mid_correct. + change (scale (1#2) (rational_sqrt_small_bounded n (4%positive*a) (rational_sqrt_small_bounded_subproof n a Ha q)) == + IRasCR (sqrt (inj_Q IR a) H))%CR. + assert (X:Zero[<=]inj_Q IR (4%positive*a)). + stepr (inj_Q IR (4%positive:Q)[*]inj_Q IR a) by apply eq_symmetric; apply (inj_Q_mult IR). + apply mult_resp_nonneg. + stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). + apply inj_Q_leEq. + discriminate. + assumption. + set (X0:= (rational_sqrt_small_bounded_subproof n a Ha q)). + rewrite (IHn (4%positive*a) X0 X). + rewrite <- CRmult_scale. + rewrite <- IR_inj_Q_as_CR. + rewrite <- IR_mult_as_CR. + apply IRasCR_wd. + assert (X1:Zero[<=](inj_Q IR (1#4))). + stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). + apply inj_Q_leEq. + discriminate. + csetoid_replace (inj_Q IR (1#2)) (sqrt _ X1). + assert (X2:Zero[<=](inj_Q IR (1#4)[*]inj_Q IR (4%positive*a))). + apply mult_resp_nonneg;assumption. + astepl (sqrt _ X2). + apply sqrt_wd. + csetoid_rewrite_rev (inj_Q_mult IR (1#4) (4%positive*a)). + apply inj_Q_wd. + simpl. + field; discriminate. + change (inj_Q IR (1#4)) with (inj_Q IR ((1#2)[*](1#2))). + assert (X2:Zero[<=](inj_Q IR (1#2))[^]2). + apply sqr_nonneg. + stepr (sqrt _ X2). + apply eq_symmetric; apply sqrt_to_nonneg. stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). apply inj_Q_leEq. discriminate. - assumption. -set (X0:= (rational_sqrt_small_bounded_subproof n a Ha q)). -rewrite (IHn (4%positive*a) X0 X). -rewrite <- CRmult_scale. -rewrite <- IR_inj_Q_as_CR. -rewrite <- IR_mult_as_CR. -apply IRasCR_wd. -assert (X1:Zero[<=](inj_Q IR (1#4))). - stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). - apply inj_Q_leEq. - discriminate. -csetoid_replace (inj_Q IR (1#2)) (sqrt _ X1). - assert (X2:Zero[<=](inj_Q IR (1#4)[*]inj_Q IR (4%positive*a))). - apply mult_resp_nonneg;assumption. - astepl (sqrt _ X2). apply sqrt_wd. - csetoid_rewrite_rev (inj_Q_mult IR (1#4) (4%positive*a)). - apply inj_Q_wd. - simpl. - field; discriminate. -change (inj_Q IR (1#4)) with (inj_Q IR ((1#2)[*](1#2))). -assert (X2:Zero[<=](inj_Q IR (1#2))[^]2). - apply sqr_nonneg. -stepr (sqrt _ X2). - apply eq_symmetric; apply sqrt_to_nonneg. - stepl (inj_Q IR 0) by (apply (inj_Q_nring IR 0)). - apply inj_Q_leEq. - discriminate. -apply sqrt_wd. -rstepl ((inj_Q IR (1#2))[*](inj_Q IR (1#2))). -apply eq_symmetric. -apply (inj_Q_mult IR). + rstepl ((inj_Q IR (1#2))[*](inj_Q IR (1#2))). + apply eq_symmetric. + apply (inj_Q_mult IR). Qed. (** And hence it is defined for all postive numbers. *) Definition rational_sqrt_pos a (Ha:0 rational_sqrt_pos a H |right _ => (' 0)%CR @@ -732,26 +706,26 @@ end. Lemma rational_sqrt_correct : forall a H, (@rational_sqrt a == IRasCR (sqrt (inj_Q IR a) H))%CR. Proof. -intros a H. -unfold rational_sqrt. -destruct (Qlt_le_dec_fast 0 a). - apply rational_sqrt_pos_correct. -rewrite <- (IR_nring_as_CR 0). -apply IRasCR_wd. -simpl. -assert (X:Zero [<=] (Zero[^]2:IR)). - rstepr (Zero:IR). - apply leEq_reflexive. -stepl (sqrt _ X). - apply sqrt_wd. - rstepl (Zero:IR). - apply leEq_imp_eq. + intros a H. + unfold rational_sqrt. + destruct (Qlt_le_dec_fast 0 a). + apply rational_sqrt_pos_correct. + rewrite <- (IR_nring_as_CR 0). + apply IRasCR_wd. + simpl. + assert (X:Zero [<=] (Zero[^]2:IR)). + rstepr (Zero:IR). + apply leEq_reflexive. + stepl (sqrt _ X). + apply sqrt_wd. + rstepl (Zero:IR). + apply leEq_imp_eq. + assumption. + stepr (inj_Q IR 0) by apply (inj_Q_nring IR 0). + apply inj_Q_leEq. assumption. - stepr (inj_Q IR 0) by apply (inj_Q_nring IR 0). - apply inj_Q_leEq. - assumption. -apply sqrt_to_nonneg. -apply leEq_reflexive. + apply sqrt_to_nonneg. + apply leEq_reflexive. Qed. (** Square root is uniformly continuous everywhere. *) @@ -759,101 +733,120 @@ Definition sqrt_modulus (e:Qpos) : QposInf := Qpos2QposInf (e*e). Lemma sqrt_uc_prf : is_UniformlyContinuousFunction rational_sqrt sqrt_modulus. Proof. -intros e a. -cut (forall a b, (0 <= a) -> (0 <= b) -> - ball_ex (X:=Q_as_MetricSpace) (sqrt_modulus e) a b -> - ball (m:=CR) e (rational_sqrt a) (rational_sqrt b)). - intros X b Hab. - destruct (Qle_total 0 a) as [Ha|Ha]. + intros e a. + cut (forall a b, (0 <= a) -> (0 <= b) -> ball_ex (X:=Q_as_MetricSpace) (sqrt_modulus e) a b -> + ball (m:=CR) e (rational_sqrt a) (rational_sqrt b)). + intros X b Hab. + destruct (Qle_total 0 a) as [Ha|Ha]. + destruct (Qle_total 0 b) as [Hb|Hb]. + apply X; assumption. + unfold rational_sqrt at 2. + destruct (Qlt_le_dec_fast 0 b) as [Z|_]. + elim (Qle_not_lt _ _ Hb Z). + change (' 0)%CR with (rational_sqrt 0). + apply X; try assumption. + apply Qle_refl. + destruct Hab. + split; simpl in *. + rewrite -> Qle_minus_iff in *. + replace RHS with ((a + - 0) + (e*e)%Qpos) by ring. + Qauto_nonneg. + rewrite -> Qle_minus_iff in *. + replace RHS with ((e*e)%Qpos + - (a - b) + (0 + - b)) by ring. + Qauto_nonneg. + unfold rational_sqrt at 1. + destruct (Qlt_le_dec_fast 0 a) as [Z0|_]. + elim (Qle_not_lt _ _ Ha Z0). + change (' 0)%CR with (rational_sqrt 0). destruct (Qle_total 0 b) as [Hb|Hb]. - apply X; assumption. + apply X; try assumption. + apply Qle_refl. + destruct Hab. + split; simpl in *. + rewrite -> Qle_minus_iff in *. + replace RHS with ((a - b) + - - (e*e)%Qpos + (0 + - a)) by ring. + Qauto_nonneg. + rewrite -> Qle_minus_iff in *. + replace RHS with ((e*e)%Qpos + (b + - 0)) by ring. + Qauto_nonneg. unfold rational_sqrt at 2. - destruct (Qlt_le_dec_fast 0 b) as [Z|_]. - elim (Qle_not_lt _ _ Hb Z). + destruct (Qlt_le_dec_fast 0 b) as [Z0|_]. + elim (Qle_not_lt _ _ Hb Z0). change (' 0)%CR with (rational_sqrt 0). - apply X; try assumption. - apply Qle_refl. - destruct Hab. - split; simpl in *. - rewrite -> Qle_minus_iff in *. - replace RHS with ((a + - 0) + (e*e)%Qpos) by ring. - Qauto_nonneg. - rewrite -> Qle_minus_iff in *. - replace RHS with ((e*e)%Qpos + - (a - b) + (0 + - b)) by ring. - Qauto_nonneg. - unfold rational_sqrt at 1. - destruct (Qlt_le_dec_fast 0 a) as [Z0|_]. - elim (Qle_not_lt _ _ Ha Z0). - change (' 0)%CR with (rational_sqrt 0). - destruct (Qle_total 0 b) as [Hb|Hb]. - apply X; try assumption. - apply Qle_refl. + apply ball_refl. + clear a. + intros a b Ha Hb Hab. + assert (Z:Zero[<=]inj_Q IR a). + stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). + apply inj_Q_leEq. + assumption. + rewrite (rational_sqrt_correct _ Z). + assert (Z0:Zero[<=]inj_Q IR b). + stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). + apply inj_Q_leEq. + assumption. + rewrite (rational_sqrt_correct _ Z0). + rewrite <- CRAbsSmall_ball. + cut (AbsSmall (R:=CRasCOrdField) (IRasCR (inj_Q IR (e:Q)))%CR + (IRasCR (sqrt (inj_Q IR a) Z[-](sqrt (inj_Q IR b) Z0)))). + intros [A B]. + unfold cg_minus. + split; (simpl; rewrite <- (IR_inj_Q_as_CR e); rewrite <- (IR_opp_as_CR (sqrt _ Z0)); + rewrite <- (IR_plus_as_CR); assumption). + rewrite <- IR_AbsSmall_as_CR. + assert (Z1:AbsSmall (inj_Q IR (e*e)) ((inj_Q IR a)[-](inj_Q IR b))). destruct Hab. - split; simpl in *. - rewrite -> Qle_minus_iff in *. - replace RHS with ((a - b) + - - (e*e)%Qpos + (0 + - a)) by ring. - Qauto_nonneg. - rewrite -> Qle_minus_iff in *. - replace RHS with ((e*e)%Qpos + (b + - 0)) by ring. - Qauto_nonneg. - unfold rational_sqrt at 2. - destruct (Qlt_le_dec_fast 0 b) as [Z0|_]. - elim (Qle_not_lt _ _ Hb Z0). - change (' 0)%CR with (rational_sqrt 0). - apply ball_refl. - -clear a. -intros a b Ha Hb Hab. -assert (Z:Zero[<=]inj_Q IR a). - stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). - apply inj_Q_leEq. - assumption. -rewrite (rational_sqrt_correct _ Z). -assert (Z0:Zero[<=]inj_Q IR b). - stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). - apply inj_Q_leEq. - assumption. -rewrite (rational_sqrt_correct _ Z0). -rewrite <- CRAbsSmall_ball. -cut (AbsSmall (R:=CRasCOrdField) (IRasCR (inj_Q IR (e:Q)))%CR - (IRasCR (sqrt (inj_Q IR a) Z[-](sqrt (inj_Q IR b) Z0)))). - intros [A B]. - unfold cg_minus. - split; - (simpl; - rewrite <- (IR_inj_Q_as_CR e); - rewrite <- (IR_opp_as_CR (sqrt _ Z0)); - rewrite <- (IR_plus_as_CR); - assumption). -rewrite <- IR_AbsSmall_as_CR. -assert (Z1:AbsSmall (inj_Q IR (e*e)) ((inj_Q IR a)[-](inj_Q IR b))). - destruct Hab. - split. - stepl (inj_Q IR (-(e*e))) by apply (inj_Q_inv IR). - stepr (inj_Q IR (a - b)) by apply (inj_Q_minus IR). + split. + stepl (inj_Q IR (-(e*e))) by apply (inj_Q_inv IR). + stepr (inj_Q IR (a - b)) by apply (inj_Q_minus IR). + apply inj_Q_leEq. + assumption. + stepl (inj_Q IR (a - b)) by apply (inj_Q_minus IR). apply inj_Q_leEq. assumption. - stepl (inj_Q IR (a - b)) by apply (inj_Q_minus IR). - apply inj_Q_leEq. - assumption. -clear Hab. -set (e':=(inj_Q IR (e:Q))). -set (a':=(sqrt (inj_Q IR a) Z)). -set (b':=(sqrt (inj_Q IR b) Z0)). -assert (He:Zero[<]e'). - stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). - apply inj_Q_less. - simpl; auto with *. -split. + clear Hab. + set (e':=(inj_Q IR (e:Q))). + set (a':=(sqrt (inj_Q IR a) Z)). + set (b':=(sqrt (inj_Q IR b) Z0)). + assert (He:Zero[<]e'). + stepl (inj_Q IR 0) by apply (inj_Q_nring IR 0). + apply inj_Q_less. + simpl; auto with *. + split. + refine (mult_cancel_leEq _ _ _ (e'[+]a'[+]b') _ _). + rstepl (Zero[+]Zero[+]Zero:IR). + do 2 (apply plus_resp_less_leEq; try apply sqrt_nonneg). + assumption. + rstepl (([--](e'[*]e'))[+](e')[*]([--]a'[-]b')). + rstepr ((a'[^]2[-]b'[^]2)[+](e')[*](a'[-]b')). + apply plus_resp_leEq_both. + stepr (inj_Q IR a[-]inj_Q IR b). + stepl ([--](inj_Q IR (e*e))). + destruct Z1; assumption. + unfold e'. + csetoid_rewrite_rev (inj_Q_mult IR (e:Q) (e:Q)). + apply eq_reflexive. + unfold a', b'. + unfold cg_minus. + csetoid_rewrite (sqrt_sqr (inj_Q IR a) Z). + csetoid_rewrite (sqrt_sqr (inj_Q IR b) Z0). + apply eq_reflexive. + apply mult_resp_leEq_lft;[|apply less_leEq;assumption]. + apply minus_resp_leEq. + apply shift_leEq_rht. + rstepr (Two[*]a'). + apply mult_resp_nonneg. + apply less_leEq; apply pos_two. + apply sqrt_nonneg. refine (mult_cancel_leEq _ _ _ (e'[+]a'[+]b') _ _). rstepl (Zero[+]Zero[+]Zero:IR). do 2 (apply plus_resp_less_leEq; try apply sqrt_nonneg). assumption. - rstepl (([--](e'[*]e'))[+](e')[*]([--]a'[-]b')). - rstepr ((a'[^]2[-]b'[^]2)[+](e')[*](a'[-]b')). + rstepr (((e'[*]e'))[+](e')[*](a'[+]b')). + rstepl ((a'[^]2[-]b'[^]2)[+](e')[*](a'[-]b')). apply plus_resp_leEq_both. - stepr (inj_Q IR a[-]inj_Q IR b). - stepl ([--](inj_Q IR (e*e))). + stepl (inj_Q IR a[-]inj_Q IR b). + stepr (inj_Q IR (e*e)). destruct Z1; assumption. unfold e'. csetoid_rewrite_rev (inj_Q_mult IR (e:Q) (e:Q)). @@ -864,38 +857,13 @@ split. csetoid_rewrite (sqrt_sqr (inj_Q IR b) Z0). apply eq_reflexive. apply mult_resp_leEq_lft;[|apply less_leEq;assumption]. - apply minus_resp_leEq. + unfold cg_minus. + apply plus_resp_leEq_lft. apply shift_leEq_rht. - rstepr (Two[*]a'). + rstepr (Two[*]b'). apply mult_resp_nonneg. apply less_leEq; apply pos_two. apply sqrt_nonneg. -refine (mult_cancel_leEq _ _ _ (e'[+]a'[+]b') _ _). - rstepl (Zero[+]Zero[+]Zero:IR). - do 2 (apply plus_resp_less_leEq; try apply sqrt_nonneg). - assumption. -rstepr (((e'[*]e'))[+](e')[*](a'[+]b')). -rstepl ((a'[^]2[-]b'[^]2)[+](e')[*](a'[-]b')). -apply plus_resp_leEq_both. - stepl (inj_Q IR a[-]inj_Q IR b). - stepr (inj_Q IR (e*e)). - destruct Z1; assumption. - unfold e'. - csetoid_rewrite_rev (inj_Q_mult IR (e:Q) (e:Q)). - apply eq_reflexive. - unfold a', b'. - unfold cg_minus. - csetoid_rewrite (sqrt_sqr (inj_Q IR a) Z). - csetoid_rewrite (sqrt_sqr (inj_Q IR b) Z0). - apply eq_reflexive. -apply mult_resp_leEq_lft;[|apply less_leEq;assumption]. -unfold cg_minus. -apply plus_resp_leEq_lft. -apply shift_leEq_rht. -rstepr (Two[*]b'). -apply mult_resp_nonneg. - apply less_leEq; apply pos_two. -apply sqrt_nonneg. Qed. Open Local Scope uc_scope. @@ -908,23 +876,23 @@ Definition CRsqrt : CR --> CR := Cbind QPrelengthSpace sqrt_uc. Lemma CRsqrt_correct : forall x H, (IRasCR (sqrt x H) == CRsqrt (IRasCR x))%CR. Proof. -intros x H. -assert (X:Dom (FNRoot FId 2 (lt_O_Sn 1)) x). - simpl; split; auto. -transitivity (IRasCR (FNRoot FId 2 (lt_O_Sn 1) x X)). - apply IRasCR_wd. - apply: NRoot_wd. - apply eq_reflexive. -apply (ContinuousCorrect (CI:proper (closel Zero))); try assumption. - apply Continuous_NRoot. - Contin. - intros; assumption. -intros q Hq Y. -transitivity (rational_sqrt q);[|apply: rational_sqrt_correct]. -unfold CRsqrt. -rewrite (Cbind_correct QPrelengthSpace sqrt_uc ('q)%CR). -apply: BindLaw1. + intros x H. + assert (X:Dom (FNRoot FId 2 (lt_O_Sn 1)) x). + simpl; split; auto. + transitivity (IRasCR (FNRoot FId 2 (lt_O_Sn 1) x X)). + apply IRasCR_wd. + apply: NRoot_wd. + apply eq_reflexive. + apply (ContinuousCorrect (CI:proper (closel Zero))); try assumption. + apply Continuous_NRoot. + Contin. + intros; assumption. + intros q Hq Y. + transitivity (rational_sqrt q);[|apply: rational_sqrt_correct]. + unfold CRsqrt. + rewrite (Cbind_correct QPrelengthSpace sqrt_uc ('q)%CR). + apply: BindLaw1. Qed. (* begin hide *) Hint Rewrite CRsqrt_correct : IRtoCR. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/reals/fast/CRseries.v b/reals/fast/CRseries.v index 622b41816..3e25901e7 100644 --- a/reals/fast/CRseries.v +++ b/reals/fast/CRseries.v @@ -47,72 +47,69 @@ Cons (hd s) (everyOther (tl (tl s))). (** It preserves [DecreasingNonNegative]. *) Lemma everyOther_dnn : forall (a : Stream Q), - (DecreasingNonNegative a) -> + (DecreasingNonNegative a) -> (DecreasingNonNegative (everyOther a)). Proof. -intros a Ha. -rewrite <- dnn_alt_iff_dnn. -generalize a Ha; clear a Ha. -cofix. -intros [a [b [c [d x]]]] [[_ [_ [H0 _]]] [_ Ha]]. -constructor;[assumption|]. -apply: everyOther_dnn. -apply Ha. + intros a Ha. + rewrite <- dnn_alt_iff_dnn. + generalize a Ha; clear a Ha. + cofix. + intros [a [b [c [d x]]]] [[_ [_ [H0 _]]] [_ Ha]]. + constructor;[assumption|]. + apply: everyOther_dnn. + apply Ha. Qed. (** It preserves limits. *) Lemma everyOther_nbz : forall (a : Stream Q) x, (NearBy 0 x a) -> NearBy 0 x (everyOther a). -cofix. -intros [a [b r]] x [H [_ Ha]]. -constructor;[|apply: everyOther_nbz];assumption. +Proof. + cofix. + intros [a [b r]] x [H [_ Ha]]. + constructor;[|apply: everyOther_nbz];assumption. Qed. Lemma everyOther_zl : forall (a : Stream Q), (Limit a 0) -> Limit (everyOther a) 0. Proof. -intros x Hx e. -assert (H:=Hx e). -generalize x H; clear x Hx H. -fix 2. -intros x [H|H]. - left. - apply everyOther_nbz. - assumption. -case (H tt);[intros X |intros X]. - right; left. - clear - x X. - abstract ( - destruct x as [a [b x]]; - destruct X; - apply: everyOther_nbz; - assumption). -right; intros _. -apply: everyOther_zl. -apply X. -constructor. + intros x Hx e. + assert (H:=Hx e). + generalize x H; clear x Hx H. + fix 2. + intros x [H|H]. + left. + apply everyOther_nbz. + assumption. + case (H tt);[intros X |intros X]. + right; left. + clear - x X. + abstract ( destruct x as [a [b x]]; destruct X; apply: everyOther_nbz; assumption). + right; intros _. + apply: everyOther_zl. + apply X. + constructor. Defined. (** Its characterization. *) Lemma Str_nth_tl_everyOther : forall n A (a:Stream A), Str_nth_tl n (everyOther a) = everyOther (Str_nth_tl (2*n) a). Proof. -induction n. - reflexivity. -intros A [a0 [a1 a]]. -simpl. -rewrite IHn. -replace (n + S (n + 0))%nat with (S (2*n))%nat. - reflexivity. -ring. + induction n. + reflexivity. + intros A [a0 [a1 a]]. + simpl. + rewrite IHn. + replace (n + S (n + 0))%nat with (S (2*n))%nat. + reflexivity. + ring. Qed. Lemma Str_nth_everyOther : forall n A (a:Stream A), Str_nth n (everyOther a) = (Str_nth (2*n) a). Proof. -intros n A a. -unfold Str_nth. -rewrite Str_nth_tl_everyOther. -destruct (Str_nth_tl (2 * n) a). -reflexivity. + intros n A a. + unfold Str_nth. + rewrite Str_nth_tl_everyOther. + destruct (Str_nth_tl (2 * n) a). + reflexivity. Qed. (** @@ -125,79 +122,71 @@ Definition mult_Streams := zipWith (Qmult). Lemma mult_Streams_nbz : forall (a b : Stream Q) x, (NearBy 0 x a) -> forall y, NearBy 0 y b -> NearBy 0 (x*y) (mult_Streams a b). Proof. -unfold NearBy. -cofix. -intros a b x [Ha0 Ha] y [Hb0 Hb]. -constructor;[|apply (mult_Streams_nbz (tl a) (tl b)); assumption]. -destruct x as [x|];[|constructor]. -destruct y as [y|];[|constructor]. -simpl. -unfold Qball. -stepr ((hd a-0)*(hd b-0)) by (simpl;ring). -autorewrite with QposElim. -apply mult_AbsSmall; assumption. + unfold NearBy. + cofix. + intros a b x [Ha0 Ha] y [Hb0 Hb]. + constructor;[|apply (mult_Streams_nbz (tl a) (tl b)); assumption]. + destruct x as [x|];[|constructor]. + destruct y as [y|];[|constructor]. + simpl. + unfold Qball. + stepr ((hd a-0)*(hd b-0)) by (simpl;ring). + autorewrite with QposElim. + apply mult_AbsSmall; assumption. Qed. Lemma ForAll_True : forall X (S:Stream X), ForAll (fun x => True) S. Proof. -cofix. -intros. -constructor. -constructor. -auto. + cofix. + intros. + constructor. + constructor. + auto. Qed. Lemma mult_Streams_zl : forall (a b : Stream Q), (Limit a 0) -> forall (x:Qpos), NearBy 0 x b -> Limit (mult_Streams a b) 0. Proof. -intros a b Ha x Hb e. -assert (H:=Ha (e * (Qpos_inv x))%QposInf). -generalize b Hb. -clear b Hb. -induction H; intros b Hb. - -left. -abstract ( -destruct e as [e|];[|apply ForAll_True]; -assert (Heq:e==((e*Qpos_inv x)*x)%Qpos);[ - autorewrite with QposElim; - field; - apply Qpos_nonzero -|rewrite (NearBy_comp _ 0 0 (Qeq_refl 0) Heq ); - apply (mult_Streams_nbz H Hb)] -). - -right. -simpl. -rename H0 into IHExists. -intros. -apply (IHExists tt). -apply Limit_tl; assumption. -destruct Hb; assumption. + intros a b Ha x Hb e. + assert (H:=Ha (e * (Qpos_inv x))%QposInf). + generalize b Hb. + clear b Hb. + induction H; intros b Hb. + left. + abstract ( destruct e as [e|];[|apply ForAll_True]; assert (Heq:e==((e*Qpos_inv x)*x)%Qpos);[ + autorewrite with QposElim; field; apply Qpos_nonzero + |rewrite (NearBy_comp _ 0 0 (Qeq_refl 0) Heq ); apply (mult_Streams_nbz H Hb)] ). + right. + simpl. + rename H0 into IHExists. + intros. + apply (IHExists tt). + apply Limit_tl; assumption. + destruct Hb; assumption. Defined. (** It preserves [DecreasingNonNegative]. *) Lemma mult_Streams_dnn : forall (a b : Stream Q), - (DecreasingNonNegative a) -> + (DecreasingNonNegative a) -> (DecreasingNonNegative b) -> (DecreasingNonNegative (mult_Streams a b)). Proof. -intros a b. -repeat rewrite <- dnn_alt_iff_dnn. -generalize a b; clear a b. -cofix. -intros a b [[Ha1 Ha2] Ha'] [[Hb1 Hb2] Hb']. -constructor. -simpl. -split. -apply: mult_resp_nonneg; assumption. -apply: mult_resp_leEq_both; assumption. -simpl. -apply mult_Streams_dnn; assumption. + intros a b. + repeat rewrite <- dnn_alt_iff_dnn. + generalize a b; clear a b. + cofix. + intros a b [[Ha1 Ha2] Ha'] [[Hb1 Hb2] Hb']. + constructor. + simpl. + split. + apply: mult_resp_nonneg; assumption. + apply: mult_resp_leEq_both; assumption. + simpl. + apply mult_Streams_dnn; assumption. Qed. -(** -*** [StreamBounds] +(** +*** [StreamBounds] [StreamBounds] says that one stream pointwise bounds the absolute value of the other. *) Definition StreamBounds (a b : Stream Q) := ForAll (fun (x:Stream (Q*Q)) => let (a,b):=(hd x) in AbsSmall a b) (zipWith (@pair _ _) a b). @@ -205,71 +194,72 @@ Definition StreamBounds (a b : Stream Q) := ForAll (fun (x:Stream (Q*Q)) => let (** If the bounding stream goes to 0, so does the bounded stream. *) Lemma Stream_Bound_nbz : forall a b e, (StreamBounds a b) -> NearBy 0 e a -> NearBy 0 e b. Proof. -cofix. -intros a b e Hb Ha. -constructor. -destruct Hb as [[Hb1 Hb2] _]. -destruct e as [e|];[|constructor]. -destruct Ha as [[Ha1 Ha2] _]. -simpl in *. -split. -apply Qle_trans with (-(hd a -0)). -apply Qopp_le_compat. -assumption. -ring_simplify. -assumption. -apply Qle_trans with (hd a - 0). -ring_simplify. -assumption. -assumption. -apply: Stream_Bound_nbz. -destruct Hb as [_ Hb]. -change (StreamBounds (tl a) (tl b)) in Hb. -apply Hb. -destruct Ha as [_ Ha]. -assumption. + cofix. + intros a b e Hb Ha. + constructor. + destruct Hb as [[Hb1 Hb2] _]. + destruct e as [e|];[|constructor]. + destruct Ha as [[Ha1 Ha2] _]. + simpl in *. + split. + apply Qle_trans with (-(hd a -0)). + apply Qopp_le_compat. + assumption. + ring_simplify. + assumption. + apply Qle_trans with (hd a - 0). + ring_simplify. + assumption. + assumption. + apply: Stream_Bound_nbz. + destruct Hb as [_ Hb]. + change (StreamBounds (tl a) (tl b)) in Hb. + apply Hb. + destruct Ha as [_ Ha]. + assumption. Qed. Lemma Stream_Bound_zl : forall a b, (StreamBounds a b) -> Limit a 0 -> Limit b 0. Proof. -intros a b H Ha e. -assert (Ha':=(Ha e)); clear Ha. -generalize b H; clear b H. -induction Ha'; intros b Hb. -left. -apply Stream_Bound_nbz with x; assumption. -right. -rename H0 into IHHa'. -intros _. -apply (IHHa' tt). -destruct Hb; assumption. + intros a b H Ha e. + assert (Ha':=(Ha e)); clear Ha. + generalize b H; clear b H. + induction Ha'; intros b Hb. + left. + apply Stream_Bound_nbz with x; assumption. + right. + rename H0 into IHHa'. + intros _. + apply (IHHa' tt). + destruct Hb; assumption. Defined. (** If one stream is [DecreasingNonNegative] and the other is a [GeometricSeries], then the result is a [GeometricSeries]. *) Lemma mult_Streams_Gs : forall a (x y : Stream Q), - (DecreasingNonNegative x) -> + (DecreasingNonNegative x) -> (GeometricSeries a y) -> (GeometricSeries a (mult_Streams x y)). -cofix. -intros a x y Hx Hy. -constructor. - destruct Hy as [Hy _]. - destruct Hx as [[[Hx2 _] [[Hx0 Hx1] _]] _]. - simpl. - rewrite Qabs_Qmult. - apply Qle_trans with (Qabs (hd x) * Qabs (hd (tl y))). - apply Qmult_le_compat_r. - do 2 (rewrite Qabs_pos; try assumption). +Proof. + cofix. + intros a x y Hx Hy. + constructor. + destruct Hy as [Hy _]. + destruct Hx as [[[Hx2 _] [[Hx0 Hx1] _]] _]. + simpl. + rewrite Qabs_Qmult. + apply Qle_trans with (Qabs (hd x) * Qabs (hd (tl y))). + apply Qmult_le_compat_r. + do 2 (rewrite Qabs_pos; try assumption). + apply Qabs_nonneg. + rewrite Qabs_Qmult. + replace LHS with (Qabs (hd (tl y))*Qabs (hd x)) by ring. + replace RHS with (a * (Qabs (hd y)) * Qabs (hd x)) by ring. + apply Qmult_le_compat_r; try assumption. apply Qabs_nonneg. - rewrite Qabs_Qmult. - replace LHS with (Qabs (hd (tl y))*Qabs (hd x)) by ring. - replace RHS with (a * (Qabs (hd y)) * Qabs (hd x)) by ring. - apply Qmult_le_compat_r; try assumption. - apply Qabs_nonneg. -apply: mult_Streams_Gs. - destruct Hx; assumption. -destruct Hy; assumption. + apply: mult_Streams_Gs. + destruct Hx; assumption. + destruct Hy; assumption. Qed. Section Powers. @@ -286,55 +276,53 @@ Definition powers := powers_help 1. Lemma Str_nth_powers_help : forall n x, Str_nth n (powers_help x) == x*a^n. Proof. -induction n. - -intros c. -unfold Str_nth. -simpl. -ring. - -intros c. -unfold Str_nth in *. -rewrite inj_S. -simpl. - -rewrite IHn. -unfold Zsucc. -destruct (Qeq_dec a 0). -rewrite q. -rewrite (Qpower_0 (n+1)); auto with *. -ring. -rewrite Qpower_plus;[|assumption]. -ring. + induction n. + intros c. + unfold Str_nth. + simpl. + ring. + intros c. + unfold Str_nth in *. + rewrite inj_S. + simpl. + rewrite IHn. + unfold Zsucc. + destruct (Qeq_dec a 0). + rewrite q. + rewrite (Qpower_0 (n+1)); auto with *. + ring. + rewrite Qpower_plus;[|assumption]. + ring. Qed. Lemma Str_nth_powers : forall n, Str_nth n powers == a^n. Proof. -intros n. -unfold powers. -rewrite Str_nth_powers_help. -ring. + intros n. + unfold powers. + rewrite Str_nth_powers_help. + ring. Qed. (** [powers] is a [GeometricSeries]. *) Lemma powers_help_Gs : (0 <= a) -> forall c, (GeometricSeries a (powers_help c)). -intros Ha. -cofix. -intros c. -constructor. - simpl. - rewrite Qmult_comm. - rewrite Qabs_Qmult. - rewrite Qabs_pos; try assumption. - apply Qle_refl. -apply: powers_help_Gs. +Proof. + intros Ha. + cofix. + intros c. + constructor. + simpl. + rewrite Qmult_comm. + rewrite Qabs_Qmult. + rewrite Qabs_pos; try assumption. + apply Qle_refl. + apply: powers_help_Gs. Qed. - + Lemma powers_Gs : (0 <= a) -> (GeometricSeries a powers). Proof. -intros Ha. -apply (powers_help_Gs Ha). + intros Ha. + apply (powers_help_Gs Ha). Qed. Hypothesis Ha : 0 <= a <= 1. @@ -342,55 +330,53 @@ Hypothesis Ha : 0 <= a <= 1. (** It is decreasing an nonnegative when a is between 0 and 1. *) Lemma powers_help_dnn : forall x, (0 <= x) -> DecreasingNonNegative (powers_help x). Proof. -intros x Hx. -destruct Ha as [Ha0 Ha1]. -apply dnn_alt_dnn. -generalize x Hx; clear x Hx. -cofix. -intros b Hb. -constructor. -simpl. -split. -apply: mult_resp_nonneg; assumption. -replace RHS with (b*1) by ring. -apply: mult_resp_leEq_lft; assumption. - -simpl. -apply powers_help_dnn. -apply: mult_resp_nonneg; assumption. + intros x Hx. + destruct Ha as [Ha0 Ha1]. + apply dnn_alt_dnn. + generalize x Hx; clear x Hx. + cofix. + intros b Hb. + constructor. + simpl. + split. + apply: mult_resp_nonneg; assumption. + replace RHS with (b*1) by ring. + apply: mult_resp_leEq_lft; assumption. + simpl. + apply powers_help_dnn. + apply: mult_resp_nonneg; assumption. Qed. Lemma powers_dnn : DecreasingNonNegative powers. Proof. -apply powers_help_dnn. -discriminate. + apply powers_help_dnn. + discriminate. Qed. Lemma powers_help_nbz : forall x, 0 <= x <= 1 -> NearBy 0 (1#1)%Qpos (powers_help x). Proof. -cofix. -intros b [Hb0 Hb1]. -destruct Ha as [Ha0 Ha1]. -constructor. -simpl. -unfold Qball. -stepr b by (simpl;ring). -split;simpl. -apply Qle_trans with 0;[discriminate|assumption]. -assumption. - -simpl. -apply powers_help_nbz. -split. -apply: mult_resp_nonneg; assumption. -replace RHS with (1*1) by ring. -apply: mult_resp_leEq_both; assumption. + cofix. + intros b [Hb0 Hb1]. + destruct Ha as [Ha0 Ha1]. + constructor. + simpl. + unfold Qball. + stepr b by (simpl;ring). + split;simpl. + apply Qle_trans with 0;[discriminate|assumption]. + assumption. + simpl. + apply powers_help_nbz. + split. + apply: mult_resp_nonneg; assumption. + replace RHS with (1*1) by ring. + apply: mult_resp_leEq_both; assumption. Qed. Lemma powers_nbz : NearBy 0 (1#1)%Qpos powers. Proof. -apply powers_help_nbz. -split; discriminate. + apply powers_help_nbz. + split; discriminate. Qed. End Powers. @@ -406,22 +392,22 @@ Definition positives := positives_help 1. Lemma Str_nth_positives : forall n, Str_nth n positives = P_of_succ_nat n. Proof. -intros n. -unfold positives. -apply nat_of_P_inj. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ. -change (S n) with ((nat_of_P 1) + n)%nat. -generalize 1%positive. -induction n. -intros c. -rewrite plus_comm. -reflexivity. -intros c. -unfold Str_nth in *. -simpl. -rewrite IHn. -rewrite nat_of_P_succ_morphism. -apply plus_n_Sm. + intros n. + unfold positives. + apply nat_of_P_inj. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ. + change (S n) with ((nat_of_P 1) + n)%nat. + generalize 1%positive. + induction n. + intros c. + rewrite plus_comm. + reflexivity. + intros c. + unfold Str_nth in *. + simpl. + rewrite IHn. + rewrite nat_of_P_succ_morphism. + apply plus_n_Sm. Qed. (** @@ -432,92 +418,77 @@ Definition recip_positives := map (fun x => 1#x) positives. Lemma Str_nth_recip_positives : forall n, Str_nth n recip_positives = 1#(P_of_succ_nat n). Proof. -intros n. -unfold recip_positives. -rewrite Str_nth_map. -rewrite Str_nth_positives. -reflexivity. + intros n. + unfold recip_positives. + rewrite Str_nth_map. + rewrite Str_nth_positives. + reflexivity. Qed. (** The limit of [recip_positives] is 0. *) Lemma recip_positives_help_nbz : forall (n d q:positive), (d <= q)%Z -> NearBy 0 (n#d)%Qpos (map (fun x => 1#x) (positives_help q)). -cofix. -intros n d q Hpq. -constructor. -simpl. -unfold Qball. -stepr (1#q) by (simpl;ring). -apply (AbsSmall_leEq_trans _ (1#q)). -change (1*d <= n*q)%Z. -apply Zmult_le_compat; auto with *. -apply AbsSmall_reflexive. -discriminate. -apply: recip_positives_help_nbz. -rewrite Zpos_succ_morphism. -auto with *. +Proof. + cofix. + intros n d q Hpq. + constructor. + simpl. + unfold Qball. + stepr (1#q) by (simpl;ring). + apply (AbsSmall_leEq_trans _ (1#q)). + change (1*d <= n*q)%Z. + apply Zmult_le_compat; auto with *. + apply AbsSmall_reflexive. + discriminate. + apply: recip_positives_help_nbz. + rewrite Zpos_succ_morphism. + auto with *. Qed. Lemma recip_positives_help_Exists : forall P n p, LazyExists P (map (fun x => (1#x)) (positives_help (Pplus_LazyNat p n))) -> LazyExists P (map (fun x => (1#x)) (positives_help p)). Proof. -induction n; intros p H0. -exact H0. - -right. -intros _. -apply: (H tt). -apply H0. + induction n; intros p H0. + exact H0. + right. + intros _. + apply: (H tt). + apply H0. Defined. Lemma recip_positives_zl : Limit recip_positives 0. Proof. -intros [[n d]|];[|left;apply ForAll_True]. -unfold recip_positives. -unfold positives. -apply recip_positives_help_Exists with (LazyPred (LazyNat_of_P d)). -left. - -abstract ( -apply recip_positives_help_nbz; -induction d using Pind;[simpl;auto with *|]; -autorewrite with UnLazyNat in *; -rewrite nat_of_P_succ_morphism; -assert (H:=lt_O_nat_of_P d); -destruct (nat_of_P d);[elimtype False;auto with *|]; -simpl in *; -replace (Pplus_LazyNat 2 (LazifyNat n0)) with (Psucc (Pplus_LazyNat 1 (LazifyNat n0)));[ - repeat rewrite Zpos_succ_morphism; - auto with * -|]; -clear -n0; -change 2%positive with (Psucc 1); -generalize 1%positive; -induction n0;intros p;[reflexivity|]; -simpl in *; -rewrite IHn0; -reflexivity -). + intros [[n d]|];[|left;apply ForAll_True]. + unfold recip_positives. + unfold positives. + apply recip_positives_help_Exists with (LazyPred (LazyNat_of_P d)). + left. + abstract ( apply recip_positives_help_nbz; induction d using Pind;[simpl;auto with *|]; + autorewrite with UnLazyNat in *; rewrite nat_of_P_succ_morphism; assert (H:=lt_O_nat_of_P d); + destruct (nat_of_P d);[elimtype False;auto with *|]; simpl in *; + replace (Pplus_LazyNat 2 (LazifyNat n0)) with (Psucc (Pplus_LazyNat 1 (LazifyNat n0)));[ + repeat rewrite Zpos_succ_morphism; auto with * |]; clear -n0; + change 2%positive with (Psucc 1); generalize 1%positive; + induction n0;intros p;[reflexivity|]; simpl in *; rewrite IHn0; reflexivity ). Defined. (** [recip_positives] is [DecreasingNonNegative]. *) Lemma recip_positives_dnn : DecreasingNonNegative recip_positives. Proof. -apply dnn_alt_dnn. -unfold recip_positives. -unfold positives. -cut (forall p, DecreasingNonNegative_alt - (map (fun x : positive => 1 # x) (positives_help p))). -auto. -cofix. -intros p. -constructor. -simpl. -split. -discriminate. -change (p <= Psucc p)%Z. -repeat rewrite Zpos_succ_morphism. -auto with *. -simpl. -apply recip_positives_dnn. + apply dnn_alt_dnn. + unfold recip_positives. + unfold positives. + cut (forall p, DecreasingNonNegative_alt (map (fun x : positive => 1 # x) (positives_help p))). + auto. + cofix. + intros p. + constructor. + simpl. + split. + discriminate. + change (p <= Psucc p)%Z. + repeat rewrite Zpos_succ_morphism. + auto with *. + simpl. + apply recip_positives_dnn. Qed. (** @@ -531,52 +502,49 @@ Definition factorials := factorials_help 1 1. Lemma Str_nth_factorials : forall n, nat_of_P (Str_nth n factorials) = fac n. Proof. -unfold factorials. -intros n. -pose (ONE:=1%positive). -replace (fac n) with ((nat_of_P 1)*fac (pred (nat_of_P ONE) + n))%nat by (simpl;auto). -replace (nat_of_P (Str_nth n (factorials_help 1 1))) - with ((fac (pred (nat_of_P ONE)))*(nat_of_P (Str_nth n (factorials_help ONE 1))))%nat by (simpl; auto with *). -change (factorials_help 1 1) with (factorials_help ONE 1). -generalize ONE. -generalize 1%positive. -unfold ONE; clear ONE. - -induction n. -intros a b. -unfold Str_nth. -simpl. -rewrite plus_comm. -auto with *. - -intros a b. -unfold Str_nth in *. -simpl. -assert (X:=IHn (b*a)%positive (Psucc b)). -clear IHn. -rewrite nat_of_P_succ_morphism in X. -rewrite <- plus_n_Sm. -apply surj_eq. -apply Zmult_reg_l with (nat_of_P b:Z); - [rewrite inject_nat_convert; auto with *|]. -do 2 rewrite <- (inj_mult (nat_of_P b)). -apply inj_eq. -rewrite (mult_assoc (nat_of_P b) (nat_of_P a)). -rewrite <- nat_of_P_mult_morphism. -rewrite <- pred_Sn in X. -change (S (pred (nat_of_P b) + n))%nat with (S (pred (nat_of_P b)) + n)%nat. -assert (Z:S (pred (nat_of_P b)) = nat_of_P b). -apply S_predn. -intros H. -symmetry in H. -apply (lt_not_le _ _ (lt_O_nat_of_P b)). -auto with *. -rewrite Z. -rewrite <- X. -replace (fac (nat_of_P b)) with (fac (S (pred (nat_of_P b)))) by congruence. -change (fac (S (pred (nat_of_P b)))) with ((S (pred (nat_of_P b)))*(fac (pred (nat_of_P b))))%nat. -rewrite Z. -ring. + unfold factorials. + intros n. + pose (ONE:=1%positive). + replace (fac n) with ((nat_of_P 1)*fac (pred (nat_of_P ONE) + n))%nat by (simpl;auto). + replace (nat_of_P (Str_nth n (factorials_help 1 1))) + with ((fac (pred (nat_of_P ONE)))*(nat_of_P (Str_nth n (factorials_help ONE 1))))%nat by (simpl; auto with *). + change (factorials_help 1 1) with (factorials_help ONE 1). + generalize ONE. + generalize 1%positive. + unfold ONE; clear ONE. + induction n. + intros a b. + unfold Str_nth. + simpl. + rewrite plus_comm. + auto with *. + intros a b. + unfold Str_nth in *. + simpl. + assert (X:=IHn (b*a)%positive (Psucc b)). + clear IHn. + rewrite nat_of_P_succ_morphism in X. + rewrite <- plus_n_Sm. + apply surj_eq. + apply Zmult_reg_l with (nat_of_P b:Z); [rewrite inject_nat_convert; auto with *|]. + do 2 rewrite <- (inj_mult (nat_of_P b)). + apply inj_eq. + rewrite (mult_assoc (nat_of_P b) (nat_of_P a)). + rewrite <- nat_of_P_mult_morphism. + rewrite <- pred_Sn in X. + change (S (pred (nat_of_P b) + n))%nat with (S (pred (nat_of_P b)) + n)%nat. + assert (Z:S (pred (nat_of_P b)) = nat_of_P b). + apply S_predn. + intros H. + symmetry in H. + apply (lt_not_le _ _ (lt_O_nat_of_P b)). + auto with *. + rewrite Z. + rewrite <- X. + replace (fac (nat_of_P b)) with (fac (S (pred (nat_of_P b)))) by congruence. + change (fac (S (pred (nat_of_P b)))) with ((S (pred (nat_of_P b)))*(fac (pred (nat_of_P b))))%nat. + rewrite Z. + ring. Qed. (** *** [recip_factorials] @@ -586,62 +554,60 @@ Definition recip_factorials := map (fun x => 1#x) factorials. Lemma Str_nth_recip_factorials : forall n, (Str_nth n recip_factorials) = 1#(P_of_succ_nat (pred (fac n))). Proof. -intros n. -unfold recip_factorials. -rewrite Str_nth_map. -rewrite <- Str_nth_factorials. -rewrite <- anti_convert_pred_convert. -reflexivity. + intros n. + unfold recip_factorials. + rewrite Str_nth_map. + rewrite <- Str_nth_factorials. + rewrite <- anti_convert_pred_convert. + reflexivity. Qed. (** [recip_factorials] is [DecreasingNonNegative]. *) Lemma recip_factorials_dnn : DecreasingNonNegative recip_factorials. Proof. -unfold recip_factorials. -unfold factorials. -apply dnn_alt_dnn. -cut (forall a b, DecreasingNonNegative_alt - (map (fun x : positive => 1 # x) (factorials_help a b))). -auto. -cofix. -intros a b. -constructor. -simpl. -split. -discriminate. -change (b <= a*b)%Z. -auto with *. - -simpl. -apply recip_factorials_dnn. + unfold recip_factorials. + unfold factorials. + apply dnn_alt_dnn. + cut (forall a b, DecreasingNonNegative_alt (map (fun x : positive => 1 # x) (factorials_help a b))). + auto. + cofix. + intros a b. + constructor. + simpl. + split. + discriminate. + change (b <= a*b)%Z. + auto with *. + simpl. + apply recip_factorials_dnn. Qed. (** The limit of [recip_factorial] is 0. *) Lemma recip_factorial_bounded : StreamBounds recip_positives (tl recip_factorials). Proof. -unfold recip_positives, recip_factorials, positives, factorials. -cut (forall (p q:positive), StreamBounds (map (fun x : positive => 1 # x) (positives_help p)) - (tl (map (fun x : positive => 1 # x) (factorials_help p q)))). -intros H. -apply (H 1%positive 1%positive). -auto with *. -cofix. -constructor. -simpl. -split. -discriminate. -change (p <= p * q)%Z. -auto with *. -simpl in *. -apply recip_factorial_bounded. + unfold recip_positives, recip_factorials, positives, factorials. + cut (forall (p q:positive), StreamBounds (map (fun x : positive => 1 # x) (positives_help p)) + (tl (map (fun x : positive => 1 # x) (factorials_help p q)))). + intros H. + apply (H 1%positive 1%positive). + auto with *. + cofix. + constructor. + simpl. + split. + discriminate. + change (p <= p * q)%Z. + auto with *. + simpl in *. + apply recip_factorial_bounded. Qed. Lemma recip_factorials_zl : Limit recip_factorials 0. Proof. -intros e. -right. -intros _. -apply: Stream_Bound_zl. -apply recip_factorial_bounded. -apply recip_positives_zl. + intros e. + right. + intros _. + apply: Stream_Bound_zl. + apply recip_factorial_bounded. + apply recip_positives_zl. Defined. diff --git a/reals/fast/CRsign.v b/reals/fast/CRsign.v index 57a8f58c7..eee0c8c4e 100644 --- a/reals/fast/CRsign.v +++ b/reals/fast/CRsign.v @@ -34,7 +34,7 @@ Definition CR_epsilon_sign_dec (e:Qpos) (x:CR) : comparison := let z := (approximate x e) in match (Qle_total z (2*e)) with | right p => Gt - | left _ => + | left _ => match (Qle_total (-(2)*e) z) with | right p => Lt | left _ => Eq @@ -43,16 +43,13 @@ let z := (approximate x e) in (** This helper lemma reduces a CRpos problem to a sigma type with a simple equality proposition. *) -Lemma CR_epsilon_sign_dec_pos : forall x, +Lemma CR_epsilon_sign_dec_pos : forall x, {e:Qpos | CR_epsilon_sign_dec e x = Gt} -> CRpos x. Proof. -intros x [e H]. -apply (@CRpos_char e). -abstract ( -unfold CR_epsilon_sign_dec in H; -destruct (Qle_total (approximate x e) (2 * e)) as [A|A]; - [destruct (Qle_total (- (2) * e) (approximate x e)) as [B|B]; discriminate H|]; -assumption). + intros x [e H]. + apply (@CRpos_char e). + abstract ( unfold CR_epsilon_sign_dec in H; destruct (Qle_total (approximate x e) (2 * e)) as [A|A]; + [destruct (Qle_total (- (2) * e) (approximate x e)) as [B|B]; discriminate H|]; assumption). Defined. (** Automatically solve the goal [{e:Qpos | CR_epsilon_sign_dec e x = Gt}] @@ -61,7 +58,7 @@ the problem is solved. (This tactic may not terminate.) *) Ltac CR_solve_pos_loop e := (exists e; vm_compute; - match goal with + match goal with | |- Gt = Gt => reflexivity | |- Lt = Gt => fail 2 "CR number is negative" end) @@ -71,10 +68,10 @@ Ltac CR_solve_pos_loop e := It tries to clear the context to make sure that e is a closed term. Then it applies the helper lemma and runs [CR_solve_pos_loop]. *) Ltac CR_solve_pos e := - repeat (match goal with + repeat (match goal with | H:_ |-_ => clear H end); - match goal with + match goal with | H:_ |-_ => fail 1 "Context cannot be cleared" | |-_ => idtac end; @@ -84,11 +81,11 @@ Ltac CR_solve_pos e := (** This tactic is used to transform an inequality over IR into an problem bout CRpos over CR. Some fancy work needs to be done because autorewrite will not in CRpos, because it is in Type and not Prop. *) -Ltac IR_dec_precompute := +Ltac IR_dec_precompute := try apply less_leEq; apply CR_less_as_IR; unfold CRlt; - match goal with + match goal with | |- CRpos ?X => let X0 := fresh "IR_dec" in set (X0:=X); let XH := fresh "IR_dec" in diff --git a/reals/fast/CRsin.v b/reals/fast/CRsin.v index 1720c332a..236f52990 100644 --- a/reals/fast/CRsin.v +++ b/reals/fast/CRsin.v @@ -57,21 +57,21 @@ Definition sinSequence := (mult_Streams (everyOther (tl recip_factorials)) (powe Lemma Str_nth_sinSequence : forall n, (Str_nth n sinSequence == (1#P_of_succ_nat (pred (fac (1+2*n))))*a^(1+2*n)%nat)%Q. Proof. -intros n. -unfold sinSequence. -unfold mult_Streams. -rewrite Str_nth_zipWith. -rewrite Str_nth_everyOther. -change (tl recip_factorials) with (Str_nth_tl 1 recip_factorials). -rewrite Str_nth_plus. -rewrite plus_comm. -rewrite Str_nth_recip_factorials. -rewrite Str_nth_powers_help. -rewrite <- Qpower_mult. -rewrite inj_plus. -rewrite Qpower_plus';[|rewrite <- inj_plus; auto with *]. -rewrite inj_mult. -reflexivity. + intros n. + unfold sinSequence. + unfold mult_Streams. + rewrite Str_nth_zipWith. + rewrite Str_nth_everyOther. + change (tl recip_factorials) with (Str_nth_tl 1 recip_factorials). + rewrite Str_nth_plus. + rewrite plus_comm. + rewrite Str_nth_recip_factorials. + rewrite Str_nth_powers_help. + rewrite <- Qpower_mult. + rewrite inj_plus. + rewrite Qpower_plus';[|rewrite <- inj_plus; auto with *]. + rewrite inj_mult. + reflexivity. Qed. (** Sine is first defined on [[0,1]]. *) @@ -79,177 +79,171 @@ Hypothesis Ha: 0 <= a <= 1. Lemma square_zero_one : 0 <= a^2 <= 1. Proof. -split. - replace RHS with ((1*a)*a) by ring. - apply (sqr_nonneg _ a). -rewrite Qle_minus_iff. -replace RHS with ((1-a)*(1+a)) by ring. -destruct Ha as [Ha0 Ha1]. -apply: mult_resp_nonneg; - [unfold Qminus|replace RHS with (a + - (-(1))) by ring]; - rewrite <- Qle_minus_iff; - try assumption. -apply Qle_trans with 0. - discriminate. -assumption. + split. + replace RHS with ((1*a)*a) by ring. + apply (sqr_nonneg _ a). + rewrite Qle_minus_iff. + replace RHS with ((1-a)*(1+a)) by ring. + destruct Ha as [Ha0 Ha1]. + apply: mult_resp_nonneg; [unfold Qminus|replace RHS with (a + - (-(1))) by ring]; + rewrite <- Qle_minus_iff; try assumption. + apply Qle_trans with 0. + discriminate. + assumption. Qed. Lemma sinSequence_dnn : DecreasingNonNegative sinSequence. Proof. -apply mult_Streams_dnn. - apply everyOther_dnn. - apply dnn_tl. - apply recip_factorials_dnn. -apply powers_help_dnn. - apply square_zero_one; assumption. -destruct Ha; assumption. + apply mult_Streams_dnn. + apply everyOther_dnn. + apply dnn_tl. + apply recip_factorials_dnn. + apply powers_help_dnn. + apply square_zero_one; assumption. + destruct Ha; assumption. Qed. Lemma sinSequence_zl : Limit sinSequence 0. Proof. -unfold sinSequence. -apply mult_Streams_zl with (1#1)%Qpos. - apply everyOther_zl. - apply Limit_tl. - apply recip_factorials_zl. -apply powers_help_nbz; try - apply square_zero_one; assumption. + unfold sinSequence. + apply mult_Streams_zl with (1#1)%Qpos. + apply everyOther_zl. + apply Limit_tl. + apply recip_factorials_zl. + apply powers_help_nbz; try apply square_zero_one; assumption. Defined. End SinSeries. -Definition rational_sin_small_pos (a:Q) (p: 0 <= a <= 1) : CR := +Definition rational_sin_small_pos (a:Q) (p: 0 <= a <= 1) : CR := InfiniteAlternatingSum (sinSequence_dnn p) (sinSequence_zl p). Lemma rational_sin_small_pos_correct : forall (a:Q) Ha, (@rational_sin_small_pos a Ha == IRasCR (Sin (inj_Q IR a)))%CR. Proof. -intros a Ha. -unfold rational_sin_small_pos. -simpl. -generalize (fun_series_conv_imp_conv (inj_Q IR a) (inj_Q IR a) - (leEq_reflexive IR (inj_Q IR a)) sin_ps - (sin_conv (inj_Q IR a) (inj_Q IR a) (leEq_reflexive IR (inj_Q IR a)) - (compact_single_iprop realline (inj_Q IR a) CI)) (inj_Q IR a) + intros a Ha. + unfold rational_sin_small_pos. + simpl. + generalize (fun_series_conv_imp_conv (inj_Q IR a) (inj_Q IR a) + (leEq_reflexive IR (inj_Q IR a)) sin_ps + (sin_conv (inj_Q IR a) (inj_Q IR a) (leEq_reflexive IR (inj_Q IR a)) + (compact_single_iprop realline (inj_Q IR a) CI)) (inj_Q IR a) (compact_single_prop (inj_Q IR a)) - (fun_series_inc_IR realline sin_ps sin_conv (inj_Q IR a) CI)). -intros H. -rewrite InfiniteAlternatingSum_correct'. -apply IRasCR_wd. -unfold series_sum. -apply Lim_seq_eq_Lim_subseq with (fun n => 2*n)%nat. - intros; omega. - intros n; exists (S n); omega. -intros n. -induction n. - apply eq_reflexive. -replace (2*(S n))%nat with (S (S (2*n)))%nat by omega. -set (n':=(2*n)%nat) in *. -simpl in *. -rstepr (seq_part_sum - (fun n0 : nat => + (fun_series_inc_IR realline sin_ps sin_conv (inj_Q IR a) CI)). + intros H. + rewrite InfiniteAlternatingSum_correct'. + apply IRasCR_wd. + unfold series_sum. + apply Lim_seq_eq_Lim_subseq with (fun n => 2*n)%nat. + intros; omega. + intros n; exists (S n); omega. + intros n. + induction n. + apply eq_reflexive. + replace (2*(S n))%nat with (S (S (2*n)))%nat by omega. + set (n':=(2*n)%nat) in *. + simpl in *. + rstepr (seq_part_sum (fun n0 : nat => (sin_seq n0[/]nring (R:=IR) (fac n0)[//]nring_fac_ap_zero IR n0)[*] - nexp IR n0 (inj_Q IR a[-]Zero)) n'[+]( -(sin_seq n'[/]nring (R:=IR) (fac n')[//]nring_fac_ap_zero IR n')[*] -nexp IR n' (inj_Q IR a[-]Zero)[+] -(sin_seq (S n')[/]nring (R:=IR) (fac n' + n' * fac n')[//] - nring_fac_ap_zero IR (S n'))[*] -(nexp IR n' (inj_Q IR a[-]Zero)[*](inj_Q IR a[-]Zero)))). -apply bin_op_wd_unfolded. - assumption. -rstepl (Zero[+]inj_Q IR ((- (1)) ^ n * Str_nth n (sinSequence a))). -unfold sin_seq. -apply bin_op_wd_unfolded. - destruct (even_or_odd_plus n') as [m [Hm|Hm]]; simpl. + nexp IR n0 (inj_Q IR a[-]Zero)) n'[+]( + (sin_seq n'[/]nring (R:=IR) (fac n')[//]nring_fac_ap_zero IR n')[*] + nexp IR n' (inj_Q IR a[-]Zero)[+] (sin_seq (S n')[/]nring (R:=IR) (fac n' + n' * fac n')[//] + nring_fac_ap_zero IR (S n'))[*] (nexp IR n' (inj_Q IR a[-]Zero)[*](inj_Q IR a[-]Zero)))). + apply bin_op_wd_unfolded. + assumption. + rstepl (Zero[+]inj_Q IR ((- (1)) ^ n * Str_nth n (sinSequence a))). + unfold sin_seq. + apply bin_op_wd_unfolded. + destruct (even_or_odd_plus n') as [m [Hm|Hm]]; simpl. rational. - elim (not_even_and_odd n'). - apply (even_mult_l 2 n). - repeat constructor. - rewrite Hm. - constructor. - replace (m + m)%nat with (2*m)%nat by omega. - apply (even_mult_l 2 m). - repeat constructor. -destruct (even_or_odd_plus (S n')) as [m [Hm|Hm]]; simpl. - elim (not_even_and_odd (S n')). + elim (not_even_and_odd n'). + apply (even_mult_l 2 n). + repeat constructor. rewrite Hm. + constructor. replace (m + m)%nat with (2*m)%nat by omega. apply (even_mult_l 2 m). repeat constructor. - constructor. - apply (even_mult_l 2 n). - repeat constructor. -inversion Hm. -unfold n' in H1. -replace m with n by omega. -clear Hm H1. -stepl ((inj_Q IR ((-(1))^n))[*](inj_Q IR (Str_nth n (sinSequence a)))) by - (apply eq_symmetric; apply inj_Q_mult). -change (inj_Q IR ((- (1)) ^ n)[*]inj_Q IR (Str_nth n (sinSequence a))[=] -(nexp IR n [--]One[/]nring (R:=IR) (fac (S n'))[//]nring_fac_ap_zero IR (S n'))[*] -(nexp IR (S n') (inj_Q IR a[-]Zero))). -rstepr ((nexp IR n [--]One[*](nexp IR (S n') (inj_Q IR a[-]Zero)[/]nring (R:=IR) (fac (S n'))[//] - nring_fac_ap_zero IR (S n')))). -apply mult_wd. - stepr ((inj_Q IR (-(1)))[^]n). - apply inj_Q_power. - apply nexp_wd. - stepr ([--](inj_Q IR 1)). - apply inj_Q_inv. - apply un_op_wd_unfolded. - rstepr (nring 1:IR). - apply (inj_Q_nring IR 1). -stepr (inj_Q IR ((1/P_of_succ_nat (pred (fac (1+2*n))))*a^(1+2*n)%nat)). - apply inj_Q_wd. - simpl. - rewrite Str_nth_sinSequence. - rewrite Qmake_Qdiv. - reflexivity. -rstepr ((nring 1[/]nring (R:=IR) (fac (S n'))[//] - nring_fac_ap_zero IR (S n'))[*](nexp IR (S n') (inj_Q IR a[-]Zero))). -change (1+2*n)%nat with (S n'). -stepr ((inj_Q IR (1 / P_of_succ_nat (pred (fac (S n'))))[*](inj_Q IR (a^S n')))). - apply inj_Q_mult. -apply mult_wd. - rewrite <- POS_anti_convert. - assert (X:inj_Q IR (inject_Z (Z_of_nat (S (pred (fac (S n'))))))[#]Zero). - stepr (inj_Q IR Zero). - assert (inject_Z (Z_of_nat (S (pred (fac (S n')))))[#]Zero). - discriminate. - destruct (ap_imp_less _ _ _ X). - apply less_imp_ap. - apply inj_Q_less. - assumption. - apply Greater_imp_ap. - apply inj_Q_less. - assumption. - apply (inj_Q_nring IR 0). - stepr ((inj_Q IR 1)[/](inj_Q IR (inject_Z (Z_of_nat (S (pred (fac (S n')))))))[//]X). - apply inj_Q_div. - apply div_wd. + destruct (even_or_odd_plus (S n')) as [m [Hm|Hm]]; simpl. + elim (not_even_and_odd (S n')). + rewrite Hm. + replace (m + m)%nat with (2*m)%nat by omega. + apply (even_mult_l 2 m). + repeat constructor. + constructor. + apply (even_mult_l 2 n). + repeat constructor. + inversion Hm. + unfold n' in H1. + replace m with n by omega. + clear Hm H1. + stepl ((inj_Q IR ((-(1))^n))[*](inj_Q IR (Str_nth n (sinSequence a)))) by + (apply eq_symmetric; apply inj_Q_mult). + change (inj_Q IR ((- (1)) ^ n)[*]inj_Q IR (Str_nth n (sinSequence a))[=] + (nexp IR n [--]One[/]nring (R:=IR) (fac (S n'))[//]nring_fac_ap_zero IR (S n'))[*] + (nexp IR (S n') (inj_Q IR a[-]Zero))). + rstepr ((nexp IR n [--]One[*](nexp IR (S n') (inj_Q IR a[-]Zero)[/]nring (R:=IR) (fac (S n'))[//] + nring_fac_ap_zero IR (S n')))). + apply mult_wd. + stepr ((inj_Q IR (-(1)))[^]n). + apply inj_Q_power. + apply nexp_wd. + stepr ([--](inj_Q IR 1)). + apply inj_Q_inv. + apply un_op_wd_unfolded. + rstepr (nring 1:IR). apply (inj_Q_nring IR 1). - stepl (inj_Q IR (nring (fac (S n')))). - apply inj_Q_nring. - assert (Y:=nat_fac_gtzero (S n')). - apply inj_Q_wd. - stepr ((fac (S n')):Q). - clear - n'. - induction (fac (S n')). - simpl; reflexivity. - rewrite inj_S. - unfold Zsucc. - simpl in *. - rewrite IHn0. - rewrite injz_plus. + stepr (inj_Q IR ((1/P_of_succ_nat (pred (fac (1+2*n))))*a^(1+2*n)%nat)). + apply inj_Q_wd. + simpl. + rewrite Str_nth_sinSequence. + rewrite Qmake_Qdiv. reflexivity. - destruct (fac (S n')). - elimtype False; auto with *. - simpl; reflexivity. -stepr ((inj_Q IR a)[^](S n')). - apply inj_Q_power. -change (inj_Q IR a[^]S n'[=](inj_Q IR a[-]Zero)[^]S n'). -apply nexp_wd. -rational. + rstepr ((nring 1[/]nring (R:=IR) (fac (S n'))[//] + nring_fac_ap_zero IR (S n'))[*](nexp IR (S n') (inj_Q IR a[-]Zero))). + change (1+2*n)%nat with (S n'). + stepr ((inj_Q IR (1 / P_of_succ_nat (pred (fac (S n'))))[*](inj_Q IR (a^S n')))). + apply inj_Q_mult. + apply mult_wd. + rewrite <- POS_anti_convert. + assert (X:inj_Q IR (inject_Z (Z_of_nat (S (pred (fac (S n'))))))[#]Zero). + stepr (inj_Q IR Zero). + assert (inject_Z (Z_of_nat (S (pred (fac (S n')))))[#]Zero). + discriminate. + destruct (ap_imp_less _ _ _ X). + apply less_imp_ap. + apply inj_Q_less. + assumption. + apply Greater_imp_ap. + apply inj_Q_less. + assumption. + apply (inj_Q_nring IR 0). + stepr ((inj_Q IR 1)[/](inj_Q IR (inject_Z (Z_of_nat (S (pred (fac (S n')))))))[//]X). + apply inj_Q_div. + apply div_wd. + apply (inj_Q_nring IR 1). + stepl (inj_Q IR (nring (fac (S n')))). + apply inj_Q_nring. + assert (Y:=nat_fac_gtzero (S n')). + apply inj_Q_wd. + stepr ((fac (S n')):Q). + clear - n'. + induction (fac (S n')). + simpl; reflexivity. + rewrite inj_S. + unfold Zsucc. + simpl in *. + rewrite IHn0. + rewrite injz_plus. + reflexivity. + destruct (fac (S n')). + elimtype False; auto with *. + simpl; reflexivity. + stepr ((inj_Q IR a)[^](S n')). + apply inj_Q_power. + change (inj_Q IR a[^]S n'[=](inj_Q IR a[-]Zero)[^]S n'). + apply nexp_wd. + rational. Qed. (** Sine's range can then be extended to [[0,3^n]] by [n] applications @@ -261,154 +255,156 @@ Definition sin_poly_fun (x:Q) :Q := x*(3 - 4*x*x). Lemma sin_poly_fun_correct : forall (q:Q), inj_Q IR (sin_poly_fun q)[=]Three[*]inj_Q IR q[-]Four[*](inj_Q IR q[^]3). Proof. -intros q. -unfold sin_poly_fun. -stepr (inj_Q IR (3*q-4*q^3)). - apply inj_Q_wd. - simpl; ring. -stepr (inj_Q IR (Three[*]q)[-]inj_Q IR (Four[*]q ^ 3))%Q. - apply inj_Q_minus. -apply cg_minus_wd. - stepr (inj_Q IR Three[*]inj_Q IR q). + intros q. + unfold sin_poly_fun. + stepr (inj_Q IR (3*q-4*q^3)). + apply inj_Q_wd. + simpl; ring. + stepr (inj_Q IR (Three[*]q)[-]inj_Q IR (Four[*]q ^ 3))%Q. + apply inj_Q_minus. + apply cg_minus_wd. + stepr (inj_Q IR Three[*]inj_Q IR q). + apply inj_Q_mult. + apply mult_wdl. + apply (inj_Q_nring IR 3). + stepr (inj_Q IR Four[*]inj_Q IR (q^3)). apply inj_Q_mult. - apply mult_wdl. - apply (inj_Q_nring IR 3). -stepr (inj_Q IR Four[*]inj_Q IR (q^3)). - apply inj_Q_mult. -apply mult_wd. - apply (inj_Q_nring IR 4). -apply (inj_Q_power IR q 3). + apply mult_wd. + apply (inj_Q_nring IR 4). + apply (inj_Q_power IR q 3). Qed. Definition sin_poly_modulus (e:Qpos) := Qpos2QposInf ((1#9)*e). Let X:((-(1))<1)%Q. -constructor. +Proof. + constructor. Qed. Let D : Derivative (clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q))) (inj_Q_less _ _ _ X) ((Three:IR){**}FId{-}(Four:IR){**}FId{^}3) ((Three:IR){**}[-C-](One:IR){-}(Four:IR){**}((nring 3){**}([-C-]One{*}FId{^}2))). -apply Derivative_minus. +Proof. + apply Derivative_minus. + apply Derivative_scal. + apply Derivative_id. apply Derivative_scal. + apply Derivative_nth. apply Derivative_id. -apply Derivative_scal. -apply Derivative_nth. -apply Derivative_id. Qed. Lemma sin_poly_prf : is_UniformlyContinuousFunction (fun x => sin_poly_fun (QboundAbs (1#1) x)) sin_poly_modulus. Proof. -apply (fun a => is_UniformlyContinuousD_Q (Some (-(1))%Q) (Some (1:Q)) X _ _ D sin_poly_fun a (9#1)). - simpl; intros q _ _. - apply sin_poly_fun_correct. -simpl; intros x' _ [Hx0 Hx1]. -set (x:=(inj_Q IR x')) in *. -stepr (Nine:IR) by (apply eq_symmetric; apply (inj_Q_nring IR 9)). -stepl (ABSIR (Three[-]Twelve[*]x[*]x)) by (apply AbsIR_wd; rational). -apply AbsSmall_imp_AbsIR. -split. - apply shift_zero_leEq_minus'. - rstepr (Twelve[*]((nring 1)[-]x)[*](x[-][--](nring 1))). - repeat apply mult_resp_nonneg. - apply (nring_nonneg IR 12). + apply (fun a => is_UniformlyContinuousD_Q (Some (-(1))%Q) (Some (1:Q)) X _ _ D sin_poly_fun a (9#1)). + simpl; intros q _ _. + apply sin_poly_fun_correct. + simpl; intros x' _ [Hx0 Hx1]. + set (x:=(inj_Q IR x')) in *. + stepr (Nine:IR) by (apply eq_symmetric; apply (inj_Q_nring IR 9)). + stepl (ABSIR (Three[-]Twelve[*]x[*]x)) by (apply AbsIR_wd; rational). + apply AbsSmall_imp_AbsIR. + split. + apply shift_zero_leEq_minus'. + rstepr (Twelve[*]((nring 1)[-]x)[*](x[-][--](nring 1))). + repeat apply mult_resp_nonneg. + apply (nring_nonneg IR 12). + apply shift_zero_leEq_minus. + stepr (inj_Q IR (nring 1)) by apply inj_Q_nring. + assumption. apply shift_zero_leEq_minus. - stepr (inj_Q IR (nring 1)) by apply inj_Q_nring. - assumption. - apply shift_zero_leEq_minus. - stepl (inj_Q IR (-(1))). - assumption. - stepr ([--](inj_Q IR 1)). - apply inj_Q_inv. - apply un_op_wd_unfolded. - apply (inj_Q_nring IR 1). + stepl (inj_Q IR (-(1))). + assumption. + stepr ([--](inj_Q IR 1)). + apply inj_Q_inv. + apply un_op_wd_unfolded. + apply (inj_Q_nring IR 1). rstepr (Nine[-]Zero:IR). -apply minus_resp_leEq_both. - apply nring_leEq. - omega. -rstepr (Twelve[*]x[^]2). -apply mult_resp_nonneg. - apply (nring_leEq IR 0 12). - omega. -apply sqr_nonneg. + apply minus_resp_leEq_both. + apply nring_leEq. + omega. + rstepr (Twelve[*]x[^]2). + apply mult_resp_nonneg. + apply (nring_leEq IR 0 12). + omega. + apply sqr_nonneg. Qed. -Definition sin_poly_uc : Q_as_MetricSpace --> Q_as_MetricSpace := +Definition sin_poly_uc : Q_as_MetricSpace --> Q_as_MetricSpace := Build_UniformlyContinuousFunction sin_poly_prf. Definition sin_poly : CR --> CR := uc_compose compress (Cmap QPrelengthSpace sin_poly_uc). Lemma sin_poly_correct : forall x, AbsSmall (inj_Q IR (1)) x -> (IRasCR (Three[*]x[-]Four[*]x[^]3)==sin_poly (IRasCR x))%CR. Proof. -intros x Hx. -assert (Y:Continuous (clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q))) ((Three:IR){**}FId{-}(Four:IR){**}FId{^}3)). - eapply Derivative_imp_Continuous. - apply D. -apply: (ContinuousCorrect (I:=(clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q)))) (inj_Q_less _ _ _ X) Y); - [|repeat constructor|]. - intros q Hq Hq0. - transitivity (IRasCR (inj_Q IR (sin_poly_fun q)));[|apply IRasCR_wd; apply sin_poly_fun_correct]. - simpl. - change (' q)%CR with (Cunit_fun _ q). - rewrite compress_fun_correct. - rewrite Cmap_fun_correct. - rewrite MonadLaw3. - rewrite IR_inj_Q_as_CR. - rewrite CReq_Qeq. - simpl. - unfold sin_poly_fun. - setoid_replace (Qmax (- (1 # 1)%Qpos) (Qmin (1 # 1)%Qpos q)) with q. - reflexivity. - setoid_replace (Qmin (1 # 1)%Qpos q) with q. - rewrite <- Qle_max_r. + intros x Hx. + assert (Y:Continuous (clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q))) ((Three:IR){**}FId{-}(Four:IR){**}FId{^}3)). + eapply Derivative_imp_Continuous. + apply D. + apply: (ContinuousCorrect (I:=(clcr (inj_Q IR (-(1))) (inj_Q IR (1:Q)))) (inj_Q_less _ _ _ X) Y); + [|repeat constructor|]. + intros q Hq Hq0. + transitivity (IRasCR (inj_Q IR (sin_poly_fun q)));[|apply IRasCR_wd; apply sin_poly_fun_correct]. + simpl. + change (' q)%CR with (Cunit_fun _ q). + rewrite compress_fun_correct. + rewrite Cmap_fun_correct. + rewrite MonadLaw3. + rewrite IR_inj_Q_as_CR. + rewrite CReq_Qeq. + simpl. + unfold sin_poly_fun. + setoid_replace (Qmax (- (1 # 1)%Qpos) (Qmin (1 # 1)%Qpos q)) with q. + reflexivity. + setoid_replace (Qmin (1 # 1)%Qpos q) with q. + rewrite <- Qle_max_r. + apply leEq_inj_Q with IR. + destruct Hq0; assumption. + rewrite <- Qle_min_r. apply leEq_inj_Q with IR. destruct Hq0; assumption. - rewrite <- Qle_min_r. - apply leEq_inj_Q with IR. - destruct Hq0; assumption. -destruct Hx; split;[stepl [--](inj_Q IR (1:Q)) by apply eq_symmetric; apply inj_Q_inv|];assumption. + destruct Hx; split;[stepl [--](inj_Q IR (1:Q)) by apply eq_symmetric; apply inj_Q_inv|];assumption. Qed. Lemma Sin_triple_angle : forall x, (Sin(Three[*]x)[=]Three[*]Sin x[-]Four[*]Sin x[^]3). Proof. -intros x. -assert (H:Three[*]x[=]x[+]x[+]x) by rational. -csetoid_rewrite H. -csetoid_rewrite (Sin_plus (x[+]x) x). -csetoid_rewrite (Sin_plus x x). -csetoid_rewrite (Cos_plus x x). -set (sx:=Sin x). -set (cx:=Cos x). -rstepl ((cx[^]2)[*](Three[*]sx)[-]sx[^]3). -unfold cg_minus. -csetoid_replace (cx[^]2) (One[-]sx[^]2). - rational. -apply cg_inv_unique_2. -rstepl ((cx[^]2[+]sx[^]2)[-]One). -apply x_minus_x. -apply FFT. + intros x. + assert (H:Three[*]x[=]x[+]x[+]x) by rational. + csetoid_rewrite H. + csetoid_rewrite (Sin_plus (x[+]x) x). + csetoid_rewrite (Sin_plus x x). + csetoid_rewrite (Cos_plus x x). + set (sx:=Sin x). + set (cx:=Cos x). + rstepl ((cx[^]2)[*](Three[*]sx)[-]sx[^]3). + unfold cg_minus. + csetoid_replace (cx[^]2) (One[-]sx[^]2). + rational. + apply cg_inv_unique_2. + rstepl ((cx[^]2[+]sx[^]2)[-]One). + apply x_minus_x. + apply FFT. Qed. Lemma shrink_by_three : forall n a, 0 <= a <= (3^(S n))%Z -> 0 <= a/3 <= (3^n)%Z. Proof. -intros n a [H0 H1]. -split. - apply: mult_resp_nonneg. - assumption. - discriminate. -apply Qmult_lt_0_le_reg_r with 3. - constructor. -rewrite Zpower_Qpower; auto with *. -rewrite (inj_S n) in H1. -replace RHS with (3%positive^n*3^1) by ring. -rewrite <- Qpower_plus;[|discriminate]. -replace LHS with a by (field; discriminate). -rewrite -> Zpower_Qpower in H1; auto with *. + intros n a [H0 H1]. + split. + apply: mult_resp_nonneg. + assumption. + discriminate. + apply Qmult_lt_0_le_reg_r with 3. + constructor. + rewrite Zpower_Qpower; auto with *. + rewrite (inj_S n) in H1. + replace RHS with (3%positive^n*3^1) by ring. + rewrite <- Qpower_plus;[|discriminate]. + replace LHS with a by (field; discriminate). + rewrite -> Zpower_Qpower in H1; auto with *. Qed. Fixpoint rational_sin_pos_bounded (n:nat) (a:Q) : 0 <= a <= (3^n)%Z -> CR := -match n return 0 <= a <= (3^n)%Z -> CR with +match n return 0 <= a <= (3^n)%Z -> CR with | O => @rational_sin_small_pos a -| S n' => +| S n' => match (Qlt_le_dec_fast 1 a) with | left _ => fun H => sin_poly (rational_sin_pos_bounded n' (shrink_by_three n' H)) | right H' => fun H => rational_sin_small_pos (conj (proj1 H) H') @@ -418,32 +414,30 @@ end. Lemma rational_sin_pos_bounded_correct : forall n (a:Q) Ha, (@rational_sin_pos_bounded n a Ha == IRasCR (Sin (inj_Q IR a)))%CR. Proof. -induction n. - apply rational_sin_small_pos_correct. -intros a Ha. -unfold rational_sin_pos_bounded; fold rational_sin_pos_bounded. -destruct (Qlt_le_dec_fast 1 a);[|apply rational_sin_small_pos_correct]. -rewrite IHn. -rewrite <- sin_poly_correct; - [|apply AbsIR_imp_AbsSmall; - (stepr (nring 1:IR) by apply eq_symmetric; apply (inj_Q_nring IR 1)); - rstepr (One:IR); - apply AbsIR_Sin_leEq_One]. -apply IRasCR_wd. -stepl (Sin (inj_Q IR (a/3*3))). - apply Sin_wd. - apply inj_Q_wd. - simpl; field; discriminate. -generalize (a/3). -intros b; clear -b. -stepr (Sin (Three[*](inj_Q IR b))). - apply Sin_wd. - stepr ((inj_Q IR b)[*](inj_Q IR (3:Q))). - apply inj_Q_mult. - csetoid_replace (inj_Q IR (3:Q)) (Three:IR). - rational. - apply (inj_Q_nring IR 3). -apply Sin_triple_angle. + induction n. + apply rational_sin_small_pos_correct. + intros a Ha. + unfold rational_sin_pos_bounded; fold rational_sin_pos_bounded. + destruct (Qlt_le_dec_fast 1 a);[|apply rational_sin_small_pos_correct]. + rewrite IHn. + rewrite <- sin_poly_correct; [|apply AbsIR_imp_AbsSmall; + (stepr (nring 1:IR) by apply eq_symmetric; apply (inj_Q_nring IR 1)); rstepr (One:IR); + apply AbsIR_Sin_leEq_One]. + apply IRasCR_wd. + stepl (Sin (inj_Q IR (a/3*3))). + apply Sin_wd. + apply inj_Q_wd. + simpl; field; discriminate. + generalize (a/3). + intros b; clear -b. + stepr (Sin (Three[*](inj_Q IR b))). + apply Sin_wd. + stepr ((inj_Q IR b)[*](inj_Q IR (3:Q))). + apply inj_Q_mult. + csetoid_replace (inj_Q IR (3:Q)) (Three:IR). + rational. + apply (inj_Q_nring IR 3). + apply Sin_triple_angle. Qed. End Sin_Poly. @@ -455,7 +449,7 @@ Definition rational_sin_pos (a:Q) (Ha:0 <= a) : CR := Lemma rational_sin_pos_correct : forall (a:Q) Ha, (@rational_sin_pos a Ha == IRasCR (Sin (inj_Q IR a)))%CR. Proof. -intros; apply rational_sin_pos_bounded_correct. + intros; apply rational_sin_pos_bounded_correct. Qed. (** By symmetry sin is extented to its entire range. *) @@ -468,44 +462,44 @@ end. Lemma rational_sin_correct : forall (a:Q), (@rational_sin a == IRasCR (Sin (inj_Q IR a)))%CR. Proof. -intros a. -unfold rational_sin. -destruct (Qle_total 0 a). - apply rational_sin_pos_correct. -rewrite rational_sin_pos_correct. -rewrite <- IR_opp_as_CR. -apply IRasCR_wd. -csetoid_rewrite_rev (Sin_inv (inj_Q IR (-a))). -apply Sin_wd. -csetoid_rewrite_rev (inj_Q_inv IR (-a)). -apply inj_Q_wd. -simpl. -ring. + intros a. + unfold rational_sin. + destruct (Qle_total 0 a). + apply rational_sin_pos_correct. + rewrite rational_sin_pos_correct. + rewrite <- IR_opp_as_CR. + apply IRasCR_wd. + csetoid_rewrite_rev (Sin_inv (inj_Q IR (-a))). + apply Sin_wd. + csetoid_rewrite_rev (inj_Q_inv IR (-a)). + apply inj_Q_wd. + simpl. + ring. Qed. (** Sine is uniformly continuous everywhere. *) Definition sin_uc_prf : is_UniformlyContinuousFunction rational_sin Qpos2QposInf. Proof. -apply (is_UniformlyContinuousFunction_wd) with (fun x => rational_sin x) (Qscale_modulus (1#1)). - reflexivity. - intros x. - simpl. - autorewrite with QposElim. - change (/1) with 1. - replace RHS with (x:Q) by ring. - apply Qle_refl. -apply (is_UniformlyContinuousD None None I Sine Cosine (Derivative_Sin CI) rational_sin). - intros q [] _. - apply rational_sin_correct. -intros x [] _. -stepr (One:IR). - apply: AbsIR_Cos_leEq_One. -rstepl (nring 1:IR). -apply eq_symmetric. -apply (inj_Q_nring IR 1). + apply (is_UniformlyContinuousFunction_wd) with (fun x => rational_sin x) (Qscale_modulus (1#1)). + reflexivity. + intros x. + simpl. + autorewrite with QposElim. + change (/1) with 1. + replace RHS with (x:Q) by ring. + apply Qle_refl. + apply (is_UniformlyContinuousD None None I Sine Cosine (Derivative_Sin CI) rational_sin). + intros q [] _. + apply rational_sin_correct. + intros x [] _. + stepr (One:IR). + apply: AbsIR_Cos_leEq_One. + rstepl (nring 1:IR). + apply eq_symmetric. + apply (inj_Q_nring IR 1). Qed. -Definition sin_uc : Q_as_MetricSpace --> CR := +Definition sin_uc : Q_as_MetricSpace --> CR := Build_UniformlyContinuousFunction sin_uc_prf. Definition sin_slow : CR --> CR := Cbind QPrelengthSpace sin_uc. @@ -513,14 +507,13 @@ Definition sin_slow : CR --> CR := Cbind QPrelengthSpace sin_uc. Lemma sin_slow_correct : forall x, (IRasCR (Sin x) == sin_slow (IRasCR x))%CR. Proof. -intros x. -apply: (ContinuousCorrect (CI:proper realline)); - [apply Continuous_Sin | | constructor]. -intros q [] _. -transitivity (rational_sin q);[|apply rational_sin_correct]. -unfold sin_slow. -rewrite (Cbind_fun_correct QPrelengthSpace sin_uc). -apply: BindLaw1. + intros x. + apply: (ContinuousCorrect (CI:proper realline)); [apply Continuous_Sin | | constructor]. + intros q [] _. + transitivity (rational_sin q);[|apply rational_sin_correct]. + unfold sin_slow. + rewrite (Cbind_fun_correct QPrelengthSpace sin_uc). + apply: BindLaw1. Qed. Definition sin (x:CR) := sin_slow (x - (compress (scale (2*Qceiling (approximate (x*(CRinv_pos (6#1) (scale 2 CRpi))) (1#2)%Qpos -(1#2))) CRpi)))%CR. @@ -528,29 +521,27 @@ Definition sin (x:CR) := sin_slow (x - (compress (scale (2*Qceiling (approximate Lemma sin_correct : forall x, (IRasCR (Sin x) == sin (IRasCR x))%CR. Proof. -intros x. -unfold sin. -generalize (Qceiling - (approximate (IRasCR x * CRinv_pos (6 # 1) (scale 2 CRpi)) - (1 # 2)%Qpos - (1 # 2)))%CR. -intros z. -rewrite compress_correct. -rewrite <- CRpi_correct, <- CRmult_scale, - <- IR_inj_Q_as_CR, <- IR_mult_as_CR, - <- IR_minus_as_CR, <- sin_slow_correct. -apply IRasCR_wd. -rewrite inj_Q_mult. -change (2:Q) with (Two:Q). -rewrite inj_Q_nring. -rstepr (Sin (x[+]([--](inj_Q IR z))[*](Two[*]Pi))). -setoid_replace (inj_Q IR z) with (zring z:IR). - rewrite <- zring_inv. - symmetry; apply Sin_periodic_Z. -rewrite <- inj_Q_zring. -apply inj_Q_wd. -symmetry; apply zring_Q. + intros x. + unfold sin. + generalize (Qceiling (approximate (IRasCR x * CRinv_pos (6 # 1) (scale 2 CRpi)) + (1 # 2)%Qpos - (1 # 2)))%CR. + intros z. + rewrite compress_correct. + rewrite <- CRpi_correct, <- CRmult_scale, <- IR_inj_Q_as_CR, <- IR_mult_as_CR, + <- IR_minus_as_CR, <- sin_slow_correct. + apply IRasCR_wd. + rewrite inj_Q_mult. + change (2:Q) with (Two:Q). + rewrite inj_Q_nring. + rstepr (Sin (x[+]([--](inj_Q IR z))[*](Two[*]Pi))). + setoid_replace (inj_Q IR z) with (zring z:IR). + rewrite <- zring_inv. + symmetry; apply Sin_periodic_Z. + rewrite <- inj_Q_zring. + apply inj_Q_wd. + symmetry; apply zring_Q. Qed. (* begin hide *) Hint Rewrite sin_correct : IRtoCR. -(* end hide *) \ No newline at end of file +(* end hide *) diff --git a/reals/fast/CRsum.v b/reals/fast/CRsum.v index 757f791d3..5c48c54df 100644 --- a/reals/fast/CRsum.v +++ b/reals/fast/CRsum.v @@ -39,161 +39,144 @@ end Lemma CRsum_list_prf : forall l, is_RegularFunction (CRsum_list_raw l). Proof. -intros [|a t] e1 e2. - apply ball_refl. -unfold CRsum_list_raw. -simpl. -set (p:=P_of_succ_nat (@length (RegularFunction Q_as_MetricSpace) t)). -set (e1':=((1 # p) * e1)%Qpos). -set (e2':=((1 # p) * e2)%Qpos). -assert (Qball (e1' + e2') (0 + approximate a e1') (0 + approximate a e2')). - ring_simplify. - apply (regFun_prf a). -assert (X:forall e:Qpos, ((1 # p) * e)%Qpos*(length t) + ((1 # p) * e)%Qpos <= e). - intros e. - autorewrite with QposElim. - replace LHS with (((1#p)*(length t) + (1#p))*e) by ring. - rewrite Qmake_Qdiv. - field_simplify (1%positive / p * length t + 1%positive / p);[|unfold Qeq; auto with *]. - setoid_replace ((length t + 1) / p) with 1. - auto with *. - unfold p. - change 1 with (1%nat:Q). - rewrite <- injz_plus. - rewrite <- inj_plus. - rewrite plus_comm. + intros [|a t] e1 e2. + apply ball_refl. + unfold CRsum_list_raw. simpl. - field. - discriminate. -generalize (X e1) (X e2). -fold e1' e2'. -unfold e1' at 1 3. -unfold e2' at 1 3. -generalize ((1 # p) * e1)%Qpos ((1 # p) * e2)%Qpos e1' e2' (0 + approximate a e1') (0 + approximate a e2') H. -clear - t. -induction t; intros e1'' e2'' e1' e2' x y Hxy H1 H2. + set (p:=P_of_succ_nat (@length (RegularFunction Q_as_MetricSpace) t)). + set (e1':=((1 # p) * e1)%Qpos). + set (e2':=((1 # p) * e2)%Qpos). + assert (Qball (e1' + e2') (0 + approximate a e1') (0 + approximate a e2')). + ring_simplify. + apply (regFun_prf a). + assert (X:forall e:Qpos, ((1 # p) * e)%Qpos*(length t) + ((1 # p) * e)%Qpos <= e). + intros e. + autorewrite with QposElim. + replace LHS with (((1#p)*(length t) + (1#p))*e) by ring. + rewrite Qmake_Qdiv. + field_simplify (1%positive / p * length t + 1%positive / p);[|unfold Qeq; auto with *]. + setoid_replace ((length t + 1) / p) with 1. + auto with *. + unfold p. + change 1 with (1%nat:Q). + rewrite <- injz_plus. + rewrite <- inj_plus. + rewrite plus_comm. + simpl. + field. + discriminate. + generalize (X e1) (X e2). + fold e1' e2'. + unfold e1' at 1 3. + unfold e2' at 1 3. + generalize ((1 # p) * e1)%Qpos ((1 # p) * e2)%Qpos e1' e2' (0 + approximate a e1') (0 + approximate a e2') H. + clear - t. + induction t; intros e1'' e2'' e1' e2' x y Hxy H1 H2. + simpl in *. + ring_simplify in H1. + ring_simplify in H2. + apply (@ball_weak_le Q_as_MetricSpace (e1' + e2')); auto. + autorewrite with QposElim. + apply Qplus_le_compat; auto. simpl in *. + change ('P_of_succ_nat (length t))%Z with (Z_of_nat (1+(length t))) in H1. + change ('P_of_succ_nat (length t))%Z with (Z_of_nat (1+(length t))) in H2. + rewrite -> inj_plus in *. + rewrite -> injz_plus in *. ring_simplify in H1. ring_simplify in H2. - apply (@ball_weak_le Q_as_MetricSpace (e1' + e2')); auto. + apply (IHt e1'' e2'' (e1'' + e1')%Qpos (e2'' + e2')%Qpos); + try (autorewrite with QposElim; ring_simplify; assumption). + unfold Qball. autorewrite with QposElim. - apply Qplus_le_compat; auto. -simpl in *. -change ('P_of_succ_nat (length t))%Z with (Z_of_nat (1+(length t))) in H1. -change ('P_of_succ_nat (length t))%Z with (Z_of_nat (1+(length t))) in H2. -rewrite -> inj_plus in *. -rewrite -> injz_plus in *. -ring_simplify in H1. -ring_simplify in H2. -apply (IHt e1'' e2'' (e1'' + e1')%Qpos (e2'' + e2')%Qpos); - try (autorewrite with QposElim; ring_simplify; assumption). -unfold Qball. -autorewrite with QposElim. -replace RHS with ((x - y) + (approximate a e1'' - approximate a e2'')) by ring. -replace LHS with ((e1' + e2') + (e1'' + e2'')) by ring. -apply AbsSmall_plus. - auto. -apply: (regFun_prf a). + replace RHS with ((x - y) + (approximate a e1'' - approximate a e2'')) by ring. + replace LHS with ((e1' + e2') + (e1'' + e2'')) by ring. + apply AbsSmall_plus. + auto. + apply: (regFun_prf a). Qed. Definition CRsum_list (l:list CR) : CR := Build_RegularFunction (CRsum_list_prf l). Lemma CRsum_correct : forall l, (CRsum_list l == fold_right (fun x y => x + y) ('0) l)%CR. Proof. -induction l. + induction l. + apply: regFunEq_e; intros e. + apply ball_refl. + simpl (fold_right (fun x y : CR => (x + y)%CR) (' 0)%CR (a :: l)). + rewrite <- IHl. + clear -l. apply: regFunEq_e; intros e. - apply ball_refl. -simpl (fold_right (fun x y : CR => (x + y)%CR) (' 0)%CR (a :: l)). -rewrite <- IHl. -clear -l. -apply: regFunEq_e; intros e. -simpl. -unfold Cap_raw. -simpl. -unfold CRsum_list_raw. -simpl. -destruct l; simpl. - ring_simplify. - setoid_replace (e+e)%Qpos with ((1 # 1) *e + (1 # 2) * e + (1 # 2) * e)%Qpos by QposRing. - apply: ball_weak. - apply regFun_prf. -set (n:= (@length (RegularFunction Q_as_MetricSpace) l)). -cut (forall (z1:Q) (e3 e5 e1 e2 e4 e6:Qpos) (z2 z3:Q), - ball e5 z1 z2 -> - (z3 == approximate a e3 + z1) -> - (e1*n + e2*n +e3 +e4 + e5 <= e6) -> - Qball e6 - (fold_left Qplus - (map - (fun x : RegularFunction Q_as_MetricSpace => - approximate x e1) l) - z3) - (approximate a e4 + - fold_left Qplus - (map - (fun x : RegularFunction Q_as_MetricSpace => - approximate x e2) - l) - z2)). - intros H. - apply (H (approximate s ((1 # Psucc (P_of_succ_nat n)) * e)%Qpos) - ((1 # Psucc (P_of_succ_nat n)) * e)%Qpos - ((1 # Psucc (P_of_succ_nat n)) * e + - (1 # P_of_succ_nat n) * ((1 # 2) * e))%Qpos). + unfold Cap_raw. + simpl. + unfold CRsum_list_raw. + simpl. + destruct l; simpl. + ring_simplify. + setoid_replace (e+e)%Qpos with ((1 # 1) *e + (1 # 2) * e + (1 # 2) * e)%Qpos by QposRing. + apply: ball_weak. + apply regFun_prf. + set (n:= (@length (RegularFunction Q_as_MetricSpace) l)). + cut (forall (z1:Q) (e3 e5 e1 e2 e4 e6:Qpos) (z2 z3:Q), ball e5 z1 z2 -> + (z3 == approximate a e3 + z1) -> (e1*n + e2*n +e3 +e4 + e5 <= e6) -> Qball e6 (fold_left Qplus + (map (fun x : RegularFunction Q_as_MetricSpace => approximate x e1) l) z3) (approximate a e4 + + fold_left Qplus (map (fun x : RegularFunction Q_as_MetricSpace => approximate x e2) l) z2)). + intros H. + apply (H (approximate s ((1 # Psucc (P_of_succ_nat n)) * e)%Qpos) + ((1 # Psucc (P_of_succ_nat n)) * e)%Qpos ((1 # Psucc (P_of_succ_nat n)) * e + + (1 # P_of_succ_nat n) * ((1 # 2) * e))%Qpos). simpl. rewrite Qplus_0_l. apply: regFun_prf. - ring. - autorewrite with QposElim. - replace LHS with ((1 # Psucc (P_of_succ_nat n)) * (2+n) *e + - ((1 # P_of_succ_nat n) * (1 + n) * ((1 # 2) * e) + (1 # 2) * e)) by ring. - repeat rewrite Qmake_Qdiv. - change (Zpos (Psucc (P_of_succ_nat n))) with (Z_of_nat (1+1+n)). - change (Zpos (P_of_succ_nat n)) with (Z_of_nat (1+n)). - repeat rewrite inj_plus. - repeat rewrite injz_plus. - field_simplify. - apply Qle_shift_div_r; auto with *. + ring. + autorewrite with QposElim. + replace LHS with ((1 # Psucc (P_of_succ_nat n)) * (2+n) *e + + ((1 # P_of_succ_nat n) * (1 + n) * ((1 # 2) * e) + (1 # 2) * e)) by ring. + repeat rewrite Qmake_Qdiv. + change (Zpos (Psucc (P_of_succ_nat n))) with (Z_of_nat (1+1+n)). + change (Zpos (P_of_succ_nat n)) with (Z_of_nat (1+n)). + repeat rewrite inj_plus. + repeat rewrite injz_plus. field_simplify. - apply Qle_refl. - clear - n. - rewrite <- (injz_plus 1 n). - rewrite <- (injz_plus 2 n). - assert (forall (z:Z), ~z=0%Z -> ~z==0). - intros [|z|z]; - auto with *. - auto with *. -unfold n. -clear n. -induction l; - intros z1 e3 e5 e1 e2 e4 e6 z2 z3 Hz H0 H. - simpl in *. - ring_simplify in H. - ring_simplify. - rewrite H0. - unfold Qball. - replace RHS with ((approximate a e3 - approximate a e4) + (z1 - z2)) by ring. - apply AbsSmall_leEq_trans with (e3 + e4 + e5); auto. - apply AbsSmall_plus; auto. - apply: (regFun_prf a). -simpl. -apply (IHl (z1 + approximate a0 e1) e3 (e5 + (e1 + e2))%Qpos). - simpl. + apply Qle_shift_div_r; auto with *. + field_simplify. + apply Qle_refl. + clear - n. + rewrite <- (injz_plus 1 n). + rewrite <- (injz_plus 2 n). + assert (forall (z:Z), ~z=0%Z -> ~z==0). + intros [|z|z]; auto with *. + auto with *. + unfold n. + clear n. + induction l; intros z1 e3 e5 e1 e2 e4 e6 z2 z3 Hz H0 H. + simpl in *. + ring_simplify in H. + ring_simplify. + rewrite H0. unfold Qball. - replace RHS with ((z1 - z2) + (approximate a0 e1 - approximate a0 e2)) by ring. - rewrite Q_Qpos_plus. - apply AbsSmall_plus. - auto. - apply (regFun_prf a0). - rewrite H0. - ring. -autorewrite with QposElim. -simpl in H. -set (n:= (@length (RegularFunction Q_as_MetricSpace) l)) in *. -change (Zpos (P_of_succ_nat n)) with (Z_of_nat (1+n)) in H. -rewrite inj_plus in H. -rewrite -> injz_plus in H. -replace LHS with (e1 * (1 + n) + e2 * (1 + n) + e3 + e4 + e5) by ring. -auto. + replace RHS with ((approximate a e3 - approximate a e4) + (z1 - z2)) by ring. + apply AbsSmall_leEq_trans with (e3 + e4 + e5); auto. + apply AbsSmall_plus; auto. + apply: (regFun_prf a). + simpl. + apply (IHl (z1 + approximate a0 e1) e3 (e5 + (e1 + e2))%Qpos). + simpl. + unfold Qball. + replace RHS with ((z1 - z2) + (approximate a0 e1 - approximate a0 e2)) by ring. + rewrite Q_Qpos_plus. + apply AbsSmall_plus. + auto. + apply (regFun_prf a0). + rewrite H0. + ring. + autorewrite with QposElim. + simpl in H. + set (n:= (@length (RegularFunction Q_as_MetricSpace) l)) in *. + change (Zpos (P_of_succ_nat n)) with (Z_of_nat (1+n)) in H. + rewrite inj_plus in H. + rewrite -> injz_plus in H. + replace LHS with (e1 * (1 + n) + e2 * (1 + n) + e3 + e4 + e5) by ring. + auto. Qed. diff --git a/reals/fast/Compress.v b/reals/fast/Compress.v index 50fb0c413..ef84e2e62 100644 --- a/reals/fast/Compress.v +++ b/reals/fast/Compress.v @@ -46,50 +46,50 @@ let (n,d) := x in (Zdiv (n*p) d#p). Lemma approximateQ_correct : forall x p, ball (1#p) x (approximateQ x p). Proof. -intros [n d] p. -split; simpl; unfold Qle; simpl. - apply Zle_trans with 0%Z. - discriminate. - apply Zmult_le_0_compat; auto with *. - replace RHS with (n * p - ((n * p / d) * d))%Z by ring. - apply Zle_minus_le_0. - rewrite Zmult_comm. - apply Z_mult_div_ge; auto with *. + intros [n d] p. + split; simpl; unfold Qle; simpl. + apply Zle_trans with 0%Z. + discriminate. + apply Zmult_le_0_compat; auto with *. + replace RHS with (n * p - ((n * p / d) * d))%Z by ring. + apply Zle_minus_le_0. + rewrite Zmult_comm. + apply Z_mult_div_ge; auto with *. rewrite Zpos_mult_morphism. apply Zmult_le_compat_r; auto with *. -replace LHS with ((n*p) mod d)%Z. - destruct (Z_mod_lt (n*p) d); auto with *. -transitivity (n * p - (d*(n * p / d)))%Z;[ring|]. -symmetry. -apply -> Zeq_plus_swap. -rewrite Zplus_comm. -symmetry. -apply Z_div_mod_eq. -auto with *. + replace LHS with ((n*p) mod d)%Z. + destruct (Z_mod_lt (n*p) d); auto with *. + transitivity (n * p - (d*(n * p / d)))%Z;[ring|]. + symmetry. + apply -> Zeq_plus_swap. + rewrite Zplus_comm. + symmetry. + apply Z_div_mod_eq. + auto with *. Qed. Lemma approximateQ_big : forall (z:Z) a p, (z <= a) -> z <= approximateQ a p. Proof. -intros z [n d] p Ha. -unfold approximateQ. -unfold Qle in *. -simpl in *. -apply Zlt_succ_le. -unfold Zsucc. -apply Zmult_gt_0_lt_reg_r with d. - auto with *. -replace RHS with (d* (n*p/d) + (Zmod (n*p) d) - (Zmod (n*p) d) + d)%Z by ring. -rewrite <- (Z_div_mod_eq (n*p) d); try auto with *. -apply Zle_lt_trans with (n*1*p)%Z. - replace LHS with (z*d*p)%Z by ring. - apply Zmult_lt_0_le_compat_r; auto with *. -apply Zlt_0_minus_lt. -replace RHS with (d - (Zmod (n*p) d))%Z by ring. -rewrite <- Zlt_plus_swap. -ring_simplify. -assert (X:(d >0)%Z) by auto with *. -destruct (Z_mod_lt (n*p) _ X). -assumption. + intros z [n d] p Ha. + unfold approximateQ. + unfold Qle in *. + simpl in *. + apply Zlt_succ_le. + unfold Zsucc. + apply Zmult_gt_0_lt_reg_r with d. + auto with *. + replace RHS with (d* (n*p/d) + (Zmod (n*p) d) - (Zmod (n*p) d) + d)%Z by ring. + rewrite <- (Z_div_mod_eq (n*p) d); try auto with *. + apply Zle_lt_trans with (n*1*p)%Z. + replace LHS with (z*d*p)%Z by ring. + apply Zmult_lt_0_le_compat_r; auto with *. + apply Zlt_0_minus_lt. + replace RHS with (d - (Zmod (n*p) d))%Z by ring. + rewrite <- Zlt_plus_swap. + ring_simplify. + assert (X:(d >0)%Z) by auto with *. + destruct (Z_mod_lt (n*p) _ X). + assumption. Qed. (** Compress doubles the requried precision and uses the extra leway to @@ -98,59 +98,59 @@ Definition compress_raw (x:CR) (e:QposInf) : Q := match e with | QposInfinity => approximate x e | Qpos2QposInf e => - let (n,d) := e in - match (Zsucc (Zdiv (2*d) n)) with + let (n,d) := e in + match (Zsucc (Zdiv (2*d) n)) with Zpos p => approximateQ (approximate x (Qpos2QposInf (1#p))) p - |_ => approximate x e + |_ => approximate x e end end. Lemma compress_raw_prop : forall x e, ball e x (Cunit (compress_raw x e)). Proof. -intros x [n d]. -simpl. -case_eq (Zsucc (xO d / n));try (intros; apply: ball_approx_r). -intros p Hp. -apply ball_weak_le with (2#p)%Qpos. - unfold Qle. + intros x [n d]. simpl. - rewrite Zpos_mult_morphism. - rewrite <- Hp. - unfold Zsucc. - rewrite Zmult_plus_distr_r. - apply Zle_0_minus_le. - replace RHS with (n - (xO d - n * (xO d / n)))%Z by ring. - apply Zle_minus_le_0. - replace LHS with ((xO d) mod n)%Z. - destruct (Z_mod_lt (xO d) n); auto with *. - transitivity (xO d - (n*(xO d / n)))%Z;[ring|]. - symmetry; apply -> Zeq_plus_swap. - rewrite Zplus_comm. - symmetry. - apply Z_div_mod_eq. - auto with *. -setoid_replace (2#p)%Qpos with ((1#p)+(1#p))%Qpos. - eapply ball_triangle with (Cunit (approximate x (1#p)%Qpos)). - apply: ball_approx_r. - Transparent CR. - change (ball (m:=Complete Q_as_MetricSpace) (1 # p) (Cunit (approximate x (1 # p)%Qpos)) - (Cunit (approximateQ (approximate x (1 # p)%Qpos) p))). - rewrite ball_Cunit. - apply approximateQ_correct. -unfold QposEq. -autorewrite with QposElim. -repeat rewrite Qmake_Qdiv. -unfold Qdiv. -ring. + case_eq (Zsucc (xO d / n));try (intros; apply: ball_approx_r). + intros p Hp. + apply ball_weak_le with (2#p)%Qpos. + unfold Qle. + simpl. + rewrite Zpos_mult_morphism. + rewrite <- Hp. + unfold Zsucc. + rewrite Zmult_plus_distr_r. + apply Zle_0_minus_le. + replace RHS with (n - (xO d - n * (xO d / n)))%Z by ring. + apply Zle_minus_le_0. + replace LHS with ((xO d) mod n)%Z. + destruct (Z_mod_lt (xO d) n); auto with *. + transitivity (xO d - (n*(xO d / n)))%Z;[ring|]. + symmetry; apply -> Zeq_plus_swap. + rewrite Zplus_comm. + symmetry. + apply Z_div_mod_eq. + auto with *. + setoid_replace (2#p)%Qpos with ((1#p)+(1#p))%Qpos. + eapply ball_triangle with (Cunit (approximate x (1#p)%Qpos)). + apply: ball_approx_r. + Transparent CR. + change (ball (m:=Complete Q_as_MetricSpace) (1 # p) (Cunit (approximate x (1 # p)%Qpos)) + (Cunit (approximateQ (approximate x (1 # p)%Qpos) p))). + rewrite ball_Cunit. + apply approximateQ_correct. + unfold QposEq. + autorewrite with QposElim. + repeat rewrite Qmake_Qdiv. + unfold Qdiv. + ring. Qed. Lemma compress_raw_prf : forall x, is_RegularFunction (compress_raw x). Proof. -intros x e1 e2. -rewrite <- ball_Cunit. -eapply ball_triangle;[|apply compress_raw_prop]. -apply ball_sym. -apply compress_raw_prop. + intros x e1 e2. + rewrite <- ball_Cunit. + eapply ball_triangle;[|apply compress_raw_prop]. + apply ball_sym. + apply compress_raw_prop. Qed. Definition compress_fun (x:CR) : CR := @@ -159,22 +159,22 @@ Build_RegularFunction (compress_raw_prf x). (** Compress is equivalent to the identity function. *) Lemma compress_fun_correct : forall x, (compress_fun x==x)%CR. Proof. -intros x. -apply: regFunEq_e. -intros e. -unfold compress_fun. -unfold approximate at 1. -rewrite <- ball_Cunit. -eapply ball_triangle;[|apply ball_approx_r]. -apply ball_sym. -apply compress_raw_prop. + intros x. + apply: regFunEq_e. + intros e. + unfold compress_fun. + unfold approximate at 1. + rewrite <- ball_Cunit. + eapply ball_triangle;[|apply ball_approx_r]. + apply ball_sym. + apply compress_raw_prop. Qed. Lemma compress_uc : is_UniformlyContinuousFunction compress_fun Qpos2QposInf. Proof. -intros e x y H. -do 2 rewrite compress_fun_correct. -assumption. + intros e x y H. + do 2 rewrite compress_fun_correct. + assumption. Qed. Definition compress : CR --> CR := @@ -182,6 +182,6 @@ Build_UniformlyContinuousFunction compress_uc. Lemma compress_correct : forall x, (compress x==x)%CR. Proof. -intros x. -apply compress_fun_correct. -Qed. \ No newline at end of file + intros x. + apply compress_fun_correct. +Qed. diff --git a/reals/fast/ContinuousCorrect.v b/reals/fast/ContinuousCorrect.v index 7978afb71..2ed211668 100644 --- a/reals/fast/ContinuousCorrect.v +++ b/reals/fast/ContinuousCorrect.v @@ -42,43 +42,43 @@ on CR. Lemma Q_dense_in_compact : forall a b (Hab : a[<=]b) x, a[<]b -> Compact Hab x -> forall e, Zero[<]e -> {q:Q | Compact Hab (inj_Q IR q) | AbsSmall e (x[-]inj_Q IR q)}. Proof. -intros a b Hab x Hab0 Hx e He. -set (l:=Max a (x[-]e)). -set (r:=Min b (x[+]e)). -assert (Hlr:l[<]r). -destruct Hx as [Hx0 Hx1]. -apply less_Min; apply Max_less. - assumption. - apply shift_minus_less. - rstepl (x[+]Zero). + intros a b Hab x Hab0 Hx e He. + set (l:=Max a (x[-]e)). + set (r:=Min b (x[+]e)). + assert (Hlr:l[<]r). + destruct Hx as [Hx0 Hx1]. + apply less_Min; apply Max_less. + assumption. + apply shift_minus_less. + rstepl (x[+]Zero). + apply plus_resp_leEq_less; assumption. + rstepl (a[+]Zero). apply plus_resp_leEq_less; assumption. - rstepl (a[+]Zero). - apply plus_resp_leEq_less; assumption. - apply shift_zero_less_minus'. - rstepr (e[+]e). - apply plus_resp_pos; assumption. -destruct (Q_dense_in_CReals' _ _ _ Hlr) as [q Hlq Hqr]. -exists q; split. + apply shift_zero_less_minus'. + rstepr (e[+]e). + apply plus_resp_pos; assumption. + destruct (Q_dense_in_CReals' _ _ _ Hlr) as [q Hlq Hqr]. + exists q; split. + eapply leEq_transitive. + apply lft_leEq_Max. + apply less_leEq; unfold l in Hlq; apply Hlq. eapply leEq_transitive. - apply lft_leEq_Max. - apply less_leEq; unfold l in Hlq; apply Hlq. + apply less_leEq;apply Hqr. + apply Min_leEq_lft. + apply shift_zero_leEq_minus'. + rstepr ((x[+]e)[-]inj_Q IR q). + apply shift_zero_leEq_minus. eapply leEq_transitive. - apply less_leEq;apply Hqr. - apply Min_leEq_lft. + apply less_leEq. + apply Hqr. + apply Min_leEq_rht. apply shift_zero_leEq_minus'. - rstepr ((x[+]e)[-]inj_Q IR q). + rstepr (inj_Q IR q[-](x[-]e)). apply shift_zero_leEq_minus. eapply leEq_transitive. - apply less_leEq. - apply Hqr. - apply Min_leEq_rht. -apply shift_zero_leEq_minus'. -rstepr (inj_Q IR q[-](x[-]e)). -apply shift_zero_leEq_minus. -eapply leEq_transitive. - apply rht_leEq_Max. -apply less_leEq. -unfold l in Hlq; apply Hlq. + apply rht_leEq_Max. + apply less_leEq. + unfold l in Hlq; apply Hlq. Qed. Section ContinuousCorrect. @@ -94,83 +94,79 @@ Hypothesis Hg : forall (q:Q) Hq, I (inj_Q IR q) -> (g (' q) == IRasCR (f (inj_Q Lemma ContinuousCorrect : forall (x:IR) Hx, I x -> (IRasCR (f x Hx) == g (IRasCR x))%CR. Proof. -intros x Hx H. -set (J:=compact_in_interval I HI x H). -apply ball_eq. -intros e. -assert (HJ:compact_ J) by - apply compact_compact_in_interval. -destruct Hf as [Hf1 Hf0]. -clear Hf. -assert (X:Continuous_I (Lend_leEq_Rend J HJ) f). - apply Hf0. - eapply included_trans;[|apply included_compact_in_interval]. - unfold J; apply iprop_compact_in_interval_inc1. -clear Hf0. -destruct X as [_ X]. -assert (He : Zero[<](inj_Q IR (((1#2)*e)%Qpos:Q))). - stepl (inj_Q IR (nring 0)) by apply (inj_Q_nring IR 0). - apply inj_Q_less. - apply Qpos_prf. -destruct (X _ He) as [d0 Hd0 Hf]. -clear X. -set (d1:=mu g ((1#2)*e)). -set (Hab := (Lend_leEq_Rend J HJ)) in *. -set (a:= (@Lend J HJ)) in *. -set (b:= (@Rend J HJ)) in *. -assert (HJ':included (Compact Hab) I). - eapply included_trans. - unfold Hab, a, b, J; apply iprop_compact_in_interval_inc1. - apply included_compact_in_interval. -assert (Hab0: a[<]b). - apply proper_compact_in_interval'. -assert (HJx:(Compact Hab) x). - apply iprop_compact_in_interval'. -clearbody Hab a b. -clear J HJ. -pose (d:=match d1 with - | Qpos2QposInf q => Min (inj_Q IR (q:Q)) d0 - | QposInfinity => d0 - end). -assert (H0d : Zero[<]d). - destruct d1; try assumption. - apply less_Min; try assumption. - stepl (inj_Q IR Zero). + intros x Hx H. + set (J:=compact_in_interval I HI x H). + apply ball_eq. + intros e. + assert (HJ:compact_ J) by apply compact_compact_in_interval. + destruct Hf as [Hf1 Hf0]. + clear Hf. + assert (X:Continuous_I (Lend_leEq_Rend J HJ) f). + apply Hf0. + eapply included_trans;[|apply included_compact_in_interval]. + unfold J; apply iprop_compact_in_interval_inc1. + clear Hf0. + destruct X as [_ X]. + assert (He : Zero[<](inj_Q IR (((1#2)*e)%Qpos:Q))). + stepl (inj_Q IR (nring 0)) by apply (inj_Q_nring IR 0). apply inj_Q_less. apply Qpos_prf. - apply (inj_Q_nring IR 0). -destruct (Q_dense_in_compact Hab0 HJx _ H0d) as [q Hq0 Hq1]. -setoid_replace e with ((1#2)*e+(1#2)*e)%Qpos by QposRing. -assert (Hfq : Dom f (inj_Q IR q)). - apply Hf1. - apply HJ'. - assumption. -apply ball_triangle with (IRasCR (f (inj_Q IR q) Hfq)). + destruct (X _ He) as [d0 Hd0 Hf]. + clear X. + set (d1:=mu g ((1#2)*e)). + set (Hab := (Lend_leEq_Rend J HJ)) in *. + set (a:= (@Lend J HJ)) in *. + set (b:= (@Rend J HJ)) in *. + assert (HJ':included (Compact Hab) I). + eapply included_trans. + unfold Hab, a, b, J; apply iprop_compact_in_interval_inc1. + apply included_compact_in_interval. + assert (Hab0: a[<]b). + apply proper_compact_in_interval'. + assert (HJx:(Compact Hab) x). + apply iprop_compact_in_interval'. + clearbody Hab a b. + clear J HJ. + pose (d:=match d1 with | Qpos2QposInf q => Min (inj_Q IR (q:Q)) d0 | QposInfinity => d0 end). + assert (H0d : Zero[<]d). + destruct d1; try assumption. + apply less_Min; try assumption. + stepl (inj_Q IR Zero). + apply inj_Q_less. + apply Qpos_prf. + apply (inj_Q_nring IR 0). + destruct (Q_dense_in_compact Hab0 HJx _ H0d) as [q Hq0 Hq1]. + setoid_replace e with ((1#2)*e+(1#2)*e)%Qpos by QposRing. + assert (Hfq : Dom f (inj_Q IR q)). + apply Hf1. + apply HJ'. + assumption. + apply ball_triangle with (IRasCR (f (inj_Q IR q) Hfq)). + rewrite <- CRAbsSmall_ball. + stepr (IRasCR (f x Hx[-]f (inj_Q IR q) Hfq)) by (simpl; apply IR_minus_as_CR). + stepl (IRasCR (inj_Q IR (((1 # 2) * e)%Qpos:Q))) by (simpl; apply IR_inj_Q_as_CR). + rewrite <- IR_AbsSmall_as_CR. + apply AbsIR_imp_AbsSmall. + apply Hf; try assumption. + eapply leEq_transitive. + apply AbsSmall_imp_AbsIR. + apply Hq1. + destruct d1. + apply Min_leEq_rht. + apply leEq_reflexive. + rewrite <- Hg;[|apply HJ';assumption]. + apply uc_prf. + fold d1. + destruct d1; try constructor. + simpl. + rewrite <- IR_inj_Q_as_CR. rewrite <- CRAbsSmall_ball. - stepr (IRasCR (f x Hx[-]f (inj_Q IR q) Hfq)) by (simpl; apply IR_minus_as_CR). - stepl (IRasCR (inj_Q IR (((1 # 2) * e)%Qpos:Q))) by (simpl; apply IR_inj_Q_as_CR). - rewrite <- IR_AbsSmall_as_CR. - apply AbsIR_imp_AbsSmall. - apply Hf; try assumption. - eapply leEq_transitive. - apply AbsSmall_imp_AbsIR. - apply Hq1. - destruct d1. - apply Min_leEq_rht. - apply leEq_reflexive. -rewrite <- Hg;[|apply HJ';assumption]. -apply uc_prf. -fold d1. -destruct d1; try constructor. -simpl. -rewrite <- IR_inj_Q_as_CR. -rewrite <- CRAbsSmall_ball. stepr (IRasCR (inj_Q IR q[-]x)) by (simpl; apply IR_minus_as_CR). -stepl (IRasCR (inj_Q IR (q0:Q))) by (simpl; apply IR_inj_Q_as_CR). -rewrite <- IR_AbsSmall_as_CR. -apply AbsSmall_minus. -eapply AbsSmall_leEq_trans;[|apply Hq1]. -apply Min_leEq_lft. + stepl (IRasCR (inj_Q IR (q0:Q))) by (simpl; apply IR_inj_Q_as_CR). + rewrite <- IR_AbsSmall_as_CR. + apply AbsSmall_minus. + eapply AbsSmall_leEq_trans;[|apply Hq1]. + apply Min_leEq_lft. Qed. End ContinuousCorrect. diff --git a/reals/fast/Integration.v b/reals/fast/Integration.v index 4ed05605f..bfe9c4cba 100644 --- a/reals/fast/Integration.v +++ b/reals/fast/Integration.v @@ -66,24 +66,24 @@ identity function, [stepSample]. *) Lemma oddGluePoint (p:positive) : 0 < Psucc p # xI p /\ Psucc p # xI p < 1. Proof. -intros p. -split; unfold Qlt. - constructor. -simpl. -rewrite Pmult_comm. -simpl. -apply Zlt_left_rev. -rewrite Zpos_succ_morphism Zpos_xI. -unfold Zsucc. -ring_simplify. -auto with *. + intros p. + split; unfold Qlt. + constructor. + simpl. + rewrite Pmult_comm. + simpl. + apply Zlt_left_rev. + rewrite Zpos_succ_morphism Zpos_xI. + unfold Zsucc. + ring_simplify. + auto with *. Qed. Open Local Scope setoid_scope. Open Local Scope sfstscope. Open Local Scope StepQ_scope. -Definition stepSample : positive -> StepQ := positive_rect2 +Definition stepSample : positive -> StepQ := positive_rect2 (fun _ => StepQ) (fun p rec1 rec2 => glue (Build_OpenUnit (oddGluePoint p)) (constStepF (Psucc p#xI p:QS) * rec1) ((constStepF (1#(xI p):QS))*(constStepF (Psucc p:QS) + constStepF (p:QS)*rec2))) (fun p rec => glue (ou (1#2)) (constStepF (1#2:QS) * rec) (constStepF (1#2:QS) * (constStepF (1:QS) + rec))) @@ -101,381 +101,356 @@ Section id01. Lemma SupDistanceToLinearBase_pos : forall (l r:Q) (H:l Qlt_minus_iff in H0. + intros l r H x. + destruct (Qlt_le_dec_fast l x) as [H0|H0]. + rewrite -> Qlt_minus_iff in H0. + unfold Qminus. + eapply Qlt_le_trans; [|apply Qmax_ub_l]. + assumption. + rewrite -> Qlt_minus_iff in H. + eapply Qlt_le_trans; [|apply Qmax_ub_r]. + eapply Qlt_le_trans. + apply H. unfold Qminus. - eapply Qlt_le_trans; [|apply Qmax_ub_l]. - assumption. -rewrite -> Qlt_minus_iff in H. -eapply Qlt_le_trans; [|apply Qmax_ub_r]. -eapply Qlt_le_trans. - apply H. -unfold Qminus. -apply: plus_resp_leEq_lft;simpl;auto with *. + apply: plus_resp_leEq_lft;simpl;auto with *. Qed. -Definition SupDistanceToLinear := StepFfold - (fun (x:QS) (l r:Q) (H:l < r) => mkQpos (SupDistanceToLinearBase_pos H x)) +Definition SupDistanceToLinear := StepFfold + (fun (x:QS) (l r:Q) (H:l < r) => mkQpos (SupDistanceToLinearBase_pos H x)) (fun b f g l r H => (Qpos_max (f _ _ (affineCombo_gt (OpenUnitDual b) H)) (g _ _ (affineCombo_lt (OpenUnitDual b) H)))). (** Various properties of [SupDistanceToLinear] *) -Lemma SupDistanceToLinear_glue : forall o l r a b (H:a < b), +Lemma SupDistanceToLinear_glue : forall o l r a b (H:a < b), (SupDistanceToLinear (glue o l r) H == Qmax (SupDistanceToLinear l (affineCombo_gt (OpenUnitDual o) H)) (SupDistanceToLinear r (affineCombo_lt (OpenUnitDual o) H)))%Q. Proof. -intros o l r a b H. -unfold SupDistanceToLinear at 1. -simpl. -autorewrite with QposElim. -reflexivity. + intros o l r a b H. + unfold SupDistanceToLinear at 1. + simpl. + autorewrite with QposElim. + reflexivity. Qed. Lemma SupDistanceToLinear_wd1 : forall x l1 r1 (H1:l1 < r1) l2 r2 (H2:l2 < r2), (l1 == l2 -> r1 == r2 -> SupDistanceToLinear x H1 == SupDistanceToLinear x H2)%Q. Proof. -induction x using StepF_ind; - intros l1 r1 H1 l2 r2 H2 Hl Hr. - unfold SupDistanceToLinear. - simpl. - autorewrite with QposElim. - rewrite Hl. - rewrite Hr. - reflexivity. -do 2 rewrite SupDistanceToLinear_glue. -assert (X:(affineCombo (OpenUnitDual o) l1 r1==affineCombo (OpenUnitDual o) l2 r2)%Q). - rewrite Hl. - rewrite Hr. - reflexivity. -apply Qmax_compat. - apply IHx1; auto. -apply IHx2; auto. + induction x using StepF_ind; intros l1 r1 H1 l2 r2 H2 Hl Hr. + unfold SupDistanceToLinear. + simpl. + autorewrite with QposElim. + rewrite Hl. + rewrite Hr. + reflexivity. + do 2 rewrite SupDistanceToLinear_glue. + assert (X:(affineCombo (OpenUnitDual o) l1 r1==affineCombo (OpenUnitDual o) l2 r2)%Q). + rewrite Hl. + rewrite Hr. + reflexivity. + apply Qmax_compat. + apply IHx1; auto. + apply IHx2; auto. Qed. Lemma Qmax_affineCombo : forall x a b o, a < b -> (Qmax (Qmax (x - a) (affineCombo o a b - x)) (Qmax (x - affineCombo o a b) (b - x)) == Qmax (x - a) (b - x))%Q. Proof. -intros x a b o H. -rewrite <- Qmax_assoc. -rewrite (Qmax_assoc (affineCombo o a b - x)). -rewrite (Qmax_comm (affineCombo o a b - x)). -rewrite <- (Qmax_assoc (x - affineCombo o a b)). -rewrite Qmax_assoc. -apply Qmax_compat. - rewrite <- Qle_max_l. - apply: plus_resp_leEq_lft;simpl; auto with *. -rewrite <- Qle_max_r. -apply: plus_resp_leEq;simpl;auto with *. + intros x a b o H. + rewrite <- Qmax_assoc. + rewrite (Qmax_assoc (affineCombo o a b - x)). + rewrite (Qmax_comm (affineCombo o a b - x)). + rewrite <- (Qmax_assoc (x - affineCombo o a b)). + rewrite Qmax_assoc. + apply Qmax_compat. + rewrite <- Qle_max_l. + apply: plus_resp_leEq_lft;simpl; auto with *. + rewrite <- Qle_max_r. + apply: plus_resp_leEq;simpl;auto with *. Qed. Lemma SupDistanceToLinear_split : - forall x o a b c (H0:a < c) (H1:c < b), + forall x o a b c (H0:a < c) (H1:c < b), (c == affineCombo (OpenUnitDual o) a b)%Q -> (Qmax (SupDistanceToLinear (SplitL x o) H0) (SupDistanceToLinear (SplitR x o) H1) == SupDistanceToLinear x (Qlt_trans _ _ _ H0 H1))%Q. Proof. -induction x using StepF_ind. - intros o a b c H0 H1 Hc. - unfold SupDistanceToLinear. - simpl. - autorewrite with QposElim. - rewrite Hc. - apply Qmax_affineCombo; auto with *. - apply Qlt_trans with c; assumption. -intros p a b c H0 H1 Hc. -apply SplitLR_glue_ind; intros H. + induction x using StepF_ind. + intros o a b c H0 H1 Hc. + unfold SupDistanceToLinear. + simpl. + autorewrite with QposElim. + rewrite Hc. + apply Qmax_affineCombo; auto with *. + apply Qlt_trans with c; assumption. + intros p a b c H0 H1 Hc. + apply SplitLR_glue_ind; intros H. + do 2 rewrite SupDistanceToLinear_glue. + rewrite Qmax_assoc. + rewrite IHx1. + apply Qmax_compat; apply SupDistanceToLinear_wd1; try reflexivity; rewrite Hc; unfold affineCombo; + simpl; field; auto with *. + rewrite Hc. + unfold affineCombo. + simpl. + field; auto with *. do 2 rewrite SupDistanceToLinear_glue. - rewrite Qmax_assoc. - rewrite IHx1. - apply Qmax_compat; - apply SupDistanceToLinear_wd1; try reflexivity; - rewrite Hc; - unfold affineCombo; - simpl; - field; auto with *. + rewrite <- Qmax_assoc. + rewrite IHx2. + apply Qmax_compat; apply SupDistanceToLinear_wd1; try reflexivity; rewrite Hc; unfold affineCombo; + simpl; field; auto with *. rewrite Hc. unfold affineCombo. simpl. field; auto with *. - do 2 rewrite SupDistanceToLinear_glue. - rewrite <- Qmax_assoc. - rewrite IHx2. - apply Qmax_compat; - apply SupDistanceToLinear_wd1; try reflexivity; - rewrite Hc; - unfold affineCombo; - simpl; - field; auto with *. - rewrite Hc. - unfold affineCombo. - simpl. - field; auto with *. -rewrite SupDistanceToLinear_glue. -apply Qmax_compat; - apply SupDistanceToLinear_wd1; try reflexivity; - rewrite Hc; - unfold affineCombo; - simpl; - rewrite H; - field; auto with *. + rewrite SupDistanceToLinear_glue. + apply Qmax_compat; apply SupDistanceToLinear_wd1; try reflexivity; rewrite Hc; unfold affineCombo; + simpl; rewrite H; field; auto with *. Qed. Lemma SupDistanceToLinear_wd2 : forall x1 x2 a b (H: a < b), x1 == x2 -> (SupDistanceToLinear x1 H == SupDistanceToLinear x2 H)%Q. Proof. -induction x1 using StepF_ind. - induction x2 using StepF_ind. + induction x1 using StepF_ind. + induction x2 using StepF_ind. + intros a b H Hx. + unfold SupDistanceToLinear. + simpl in *. + autorewrite with QposElim. + change (x == x0)%Q in Hx. + rewrite Hx. + reflexivity. intros a b H Hx. + destruct Hx as [H0 H1] using (eq_glue_ind x2_1). + rewrite SupDistanceToLinear_glue. + rewrite <- IHx2_1; auto with *. + rewrite <- IHx2_2; auto with *. unfold SupDistanceToLinear. - simpl in *. + simpl. autorewrite with QposElim. - change (x == x0)%Q in Hx. - rewrite Hx. - reflexivity. - intros a b H Hx. - destruct Hx as [H0 H1] using (eq_glue_ind x2_1). + rewrite <- Qmax_assoc. + rewrite (Qmax_assoc (affineCombo (OpenUnitDual o) a b - x)). + rewrite (Qmax_comm (affineCombo (OpenUnitDual o) a b - x)). + rewrite <- (Qmax_assoc (x - affineCombo (OpenUnitDual o) a b)). + rewrite Qmax_assoc. + symmetry. + apply Qmax_compat. + rewrite <- Qle_max_l. + apply: plus_resp_leEq_lft;simpl;auto with *. + rewrite <- Qle_max_r. + apply: plus_resp_leEq;simpl; auto with *. + intros x2 a b H Hx. + destruct Hx as [H0 H1] using (glue_eq_ind x1_1). rewrite SupDistanceToLinear_glue. - rewrite <- IHx2_1; auto with *. - rewrite <- IHx2_2; auto with *. - unfold SupDistanceToLinear. - simpl. - autorewrite with QposElim. - rewrite <- Qmax_assoc. - rewrite (Qmax_assoc (affineCombo (OpenUnitDual o) a b - x)). - rewrite (Qmax_comm (affineCombo (OpenUnitDual o) a b - x)). - rewrite <- (Qmax_assoc (x - affineCombo (OpenUnitDual o) a b)). - rewrite Qmax_assoc. - symmetry. - apply Qmax_compat. - rewrite <- Qle_max_l. - apply: plus_resp_leEq_lft;simpl;auto with *. - rewrite <- Qle_max_r. - apply: plus_resp_leEq;simpl; auto with *. -intros x2 a b H Hx. -destruct Hx as [H0 H1] using (glue_eq_ind x1_1). -rewrite SupDistanceToLinear_glue. -rewrite (IHx1_1 _ _ _ (affineCombo_gt (OpenUnitDual o) H) H0). -rewrite (IHx1_2 _ _ _ (affineCombo_lt (OpenUnitDual o) H) H1). -rewrite SupDistanceToLinear_split; [|reflexivity]. -apply SupDistanceToLinear_wd1; try reflexivity. + rewrite (IHx1_1 _ _ _ (affineCombo_gt (OpenUnitDual o) H) H0). + rewrite (IHx1_2 _ _ _ (affineCombo_lt (OpenUnitDual o) H) H1). + rewrite SupDistanceToLinear_split; [|reflexivity]. + apply SupDistanceToLinear_wd1; try reflexivity. Qed. Lemma SupDistanceToLinear_translate : forall x c a b (H:a < b) (H0:a+c < b + c), (SupDistanceToLinear x H == SupDistanceToLinear (constStepF (c:QS) + x) H0)%Q. Proof. -induction x using StepF_ind. - intros; unfold SupDistanceToLinear; simpl. - autorewrite with QposElim. - apply Qmax_compat; ring. -intros c a b H H0. -change (constStepF (X:=QS) c + glue o x1 x2) - with (glue o (constStepF (c:QS) + x1) (constStepF (c:QS) + x2)). -do 2 rewrite SupDistanceToLinear_glue. -set (A:=(affineCombo_gt (OpenUnitDual o) H)). -apply Qmax_compat. + induction x using StepF_ind. + intros; unfold SupDistanceToLinear; simpl. + autorewrite with QposElim. + apply Qmax_compat; ring. + intros c a b H H0. + change (constStepF (X:=QS) c + glue o x1 x2) + with (glue o (constStepF (c:QS) + x1) (constStepF (c:QS) + x2)). + do 2 rewrite SupDistanceToLinear_glue. + set (A:=(affineCombo_gt (OpenUnitDual o) H)). + apply Qmax_compat. + eapply Seq_trans. + apply Q_Setoid. + apply (IHx1 c _ _ A (Qplus_resp_Qlt _ _ A c)). + apply SupDistanceToLinear_wd1; try reflexivity. + unfold affineCombo; ring. + set (B:=(affineCombo_lt (OpenUnitDual o) H)). eapply Seq_trans. - apply Q_Setoid. - apply (IHx1 c _ _ A (Qplus_resp_Qlt _ _ A c)). + apply Q_Setoid. + apply (IHx2 c _ _ B (Qplus_resp_Qlt _ _ B c)). apply SupDistanceToLinear_wd1; try reflexivity. unfold affineCombo; ring. -set (B:=(affineCombo_lt (OpenUnitDual o) H)). -eapply Seq_trans. - apply Q_Setoid. -apply (IHx2 c _ _ B (Qplus_resp_Qlt _ _ B c)). -apply SupDistanceToLinear_wd1; try reflexivity. -unfold affineCombo; ring. Qed. Lemma SupDistanceToLinear_scale : forall x c a b (H:a < b) (H0:c*a < c*b), (c*SupDistanceToLinear x H == SupDistanceToLinear (constStepF (c:QS) * x) H0)%Q. Proof. -intros x c a b H H0. -assert (X:0 < c). - rewrite -> Qlt_minus_iff in *|-. - apply: (mult_cancel_less _ 0 c (b + - a))%Q; simpl; auto with *. - replace LHS with 0 by ring. - replace RHS with (c* b + - (c*a))%Q by ring. - assumption. -revert c a b H H0 X. -induction x using StepF_ind. - intros; unfold SupDistanceToLinear; simpl. - autorewrite with QposElim. - rewrite Qmax_mult_pos_distr_r; auto with *. - apply Qmax_compat; ring. -intros c a b H H0 X. -change (constStepF (X:=QS) c * glue o x1 x2) - with (glue o (constStepF (c:QS) * x1) (constStepF (c:QS) * x2)). -do 2 rewrite SupDistanceToLinear_glue. -eapply Seq_trans. - apply Q_Setoid. - apply Qmax_mult_pos_distr_r; auto with *. -set (A:=(affineCombo_gt (OpenUnitDual o) H)). -apply Qmax_compat. + intros x c a b H H0. + assert (X:0 < c). + rewrite -> Qlt_minus_iff in *|-. + apply: (mult_cancel_less _ 0 c (b + - a))%Q; simpl; auto with *. + replace LHS with 0 by ring. + replace RHS with (c* b + - (c*a))%Q by ring. + assumption. + revert c a b H H0 X. + induction x using StepF_ind. + intros; unfold SupDistanceToLinear; simpl. + autorewrite with QposElim. + rewrite Qmax_mult_pos_distr_r; auto with *. + apply Qmax_compat; ring. + intros c a b H H0 X. + change (constStepF (X:=QS) c * glue o x1 x2) + with (glue o (constStepF (c:QS) * x1) (constStepF (c:QS) * x2)). + do 2 rewrite SupDistanceToLinear_glue. eapply Seq_trans. - apply Q_Setoid. - apply (IHx1 c _ _ A (mult_resp_less_lft _ _ _ _ A X)); auto with *. + apply Q_Setoid. + apply Qmax_mult_pos_distr_r; auto with *. + set (A:=(affineCombo_gt (OpenUnitDual o) H)). + apply Qmax_compat. + eapply Seq_trans. + apply Q_Setoid. + apply (IHx1 c _ _ A (mult_resp_less_lft _ _ _ _ A X)); auto with *. + apply SupDistanceToLinear_wd1; try reflexivity. + unfold affineCombo; ring. + set (B:=(affineCombo_lt (OpenUnitDual o) H)). + eapply Seq_trans. + apply Q_Setoid. + apply (IHx2 c _ _ B (mult_resp_less_lft _ _ _ _ B X)); auto with *. apply SupDistanceToLinear_wd1; try reflexivity. unfold affineCombo; ring. -set (B:=(affineCombo_lt (OpenUnitDual o) H)). -eapply Seq_trans. - apply Q_Setoid. -apply (IHx2 c _ _ B (mult_resp_less_lft _ _ _ _ B X)); auto with *. -apply SupDistanceToLinear_wd1; try reflexivity. -unfold affineCombo; ring. Qed. (** This is the "transitivity" of the [SupDistanceToLinear] function. *) Lemma SupDistanceToLinear_trans : forall x y a b (H:a < b), StepFSupBall (SupDistanceToLinear x H + SupDistanceToLinear y H) x y. Proof. -apply: StepF_ind2. - intros s s0 t t0 Hs Ht H a b Hab. - rewrite <- Hs, <- Ht at 2. - setoid_replace (SupDistanceToLinear s0 Hab + SupDistanceToLinear t0 Hab)%Qpos - with (SupDistanceToLinear s Hab + SupDistanceToLinear t Hab)%Qpos. - apply H. - unfold QposEq. + apply: StepF_ind2. + intros s s0 t t0 Hs Ht H a b Hab. + rewrite <- Hs, <- Ht at 2. + setoid_replace (SupDistanceToLinear s0 Hab + SupDistanceToLinear t0 Hab)%Qpos + with (SupDistanceToLinear s Hab + SupDistanceToLinear t Hab)%Qpos. + apply H. + unfold QposEq. + autorewrite with QposElim. + apply Qplus_wd; apply SupDistanceToLinear_wd2; auto. + intros x x0 a b H. + unfold StepFSupBall, StepFfoldProp. + simpl. + rewrite Qball_Qabs. + unfold SupDistanceToLinear. + simpl. autorewrite with QposElim. - apply Qplus_wd; - apply SupDistanceToLinear_wd2; auto. - intros x x0 a b H. - unfold StepFSupBall, StepFfoldProp. - simpl. - rewrite Qball_Qabs. - unfold SupDistanceToLinear. - simpl. - autorewrite with QposElim. - apply Qabs_case; intros H0. - setoid_replace (x - x0)%Q with ((x - a) + (a - b) + (b - x0))%Q by ring. + apply Qabs_case; intros H0. + setoid_replace (x - x0)%Q with ((x - a) + (a - b) + (b - x0))%Q by ring. + apply: plus_resp_leEq_both; simpl; auto with *. + replace RHS with (Qmax (x-a) (b-x) + 0)%Q by ring. + apply: plus_resp_leEq_both; simpl; auto with *. + apply Qlt_le_weak. + rewrite -> Qlt_minus_iff in *. + replace RHS with (b + -a)%Q by ring. + assumption. + setoid_replace (-(x - x0))%Q with ((b - x) + - (b - a) + (x0 - a))%Q by ring. apply: plus_resp_leEq_both; simpl; auto with *. replace RHS with (Qmax (x-a) (b-x) + 0)%Q by ring. apply: plus_resp_leEq_both; simpl; auto with *. apply Qlt_le_weak. - rewrite -> Qlt_minus_iff in *. + rewrite -> Qlt_minus_iff in *. replace RHS with (b + -a)%Q by ring. assumption. - setoid_replace (-(x - x0))%Q with ((b - x) + - (b - a) + (x0 - a))%Q by ring. - apply: plus_resp_leEq_both; simpl; auto with *. - replace RHS with (Qmax (x-a) (b-x) + 0)%Q by ring. - apply: plus_resp_leEq_both; simpl; auto with *. - apply Qlt_le_weak. - rewrite -> Qlt_minus_iff in *. - replace RHS with (b + -a)%Q by ring. - assumption. -intros o s s0 t t0 H0 H1 a b H. -assert (X:forall (o : OpenUnit) (l r : StepQ) (a b : Q) (H : a < b), - QposEq (SupDistanceToLinear (glue o l r) H) + intros o s s0 t t0 H0 H1 a b H. + assert (X:forall (o : OpenUnit) (l r : StepQ) (a b : Q) (H : a < b), + QposEq (SupDistanceToLinear (glue o l r) H) (Qpos_max (SupDistanceToLinear l (affineCombo_gt (OpenUnitDual o) H)) (SupDistanceToLinear r (affineCombo_lt (OpenUnitDual o) H)))%Q). - intros. - unfold QposEq. - autorewrite with QposElim. - reflexivity. -do 2 rewrite X. -rewrite StepFSupBallGlueGlue. -split. - apply: ball_weak_le;[|simpl; apply H0]. + intros. + unfold QposEq. + autorewrite with QposElim. + reflexivity. + do 2 rewrite X. + rewrite StepFSupBallGlueGlue. + split. + apply: ball_weak_le;[|simpl; apply H0]. + autorewrite with QposElim. + apply Qplus_le_compat; apply Qpos_max_ub_l. + apply: ball_weak_le;[|simpl; apply H1]. autorewrite with QposElim. - apply Qplus_le_compat; - apply Qpos_max_ub_l. -apply: ball_weak_le;[|simpl; apply H1]. -autorewrite with QposElim. -apply Qplus_le_compat; - apply Qpos_max_ub_r. + apply Qplus_le_compat; apply Qpos_max_ub_r. Qed. (** The [stepSample p] is as close to the virtual identity function as we excpet. *) Lemma stepSampleDistanceToId : (forall p, QposEq (@SupDistanceToLinear (stepSample p) 0 1 (@pos_one _)) (1#(2*p))). Proof. -unfold QposEq. -induction p using positive_rect2. - replace (stepSample (xI p)) - with (glue (Build_OpenUnit (oddGluePoint p)) (constStepF (Psucc p#xI p:QS) * (stepSample (Psucc p))) ((constStepF (1#(xI p):QS))*(constStepF (Psucc p:QS) + constStepF (p:QS)*(stepSample p)))) - by (symmetry;apply: positive_rect2_red1). + unfold QposEq. + induction p using positive_rect2. + replace (stepSample (xI p)) + with (glue (Build_OpenUnit (oddGluePoint p)) (constStepF (Psucc p#xI p:QS) * (stepSample (Psucc p))) ((constStepF (1#(xI p):QS))*(constStepF (Psucc p:QS) + constStepF (p:QS)*(stepSample p)))) + by (symmetry;apply: positive_rect2_red1). + rewrite SupDistanceToLinear_glue. + generalize (@affineCombo_gt (OpenUnitDual (Build_OpenUnit (oddGluePoint p))) 0 1 (pos_one Q_as_COrdField)) + (@affineCombo_lt (OpenUnitDual (Build_OpenUnit (oddGluePoint p))) 0 1 (pos_one Q_as_COrdField)). + intros A B. + set (C:=(pos_one Q_as_COrdField)) in *. + transitivity (Qmax (1#2*xI p) (1#2*xI p))%Q;[|apply Qmax_idem]. + apply Qmax_compat. + set (LHS := (SupDistanceToLinear (constStepF (X:=QS) (Psucc p # xI p) * stepSample (Psucc p)) A)). + transitivity ((Psucc p#xI p)*(SupDistanceToLinear (stepSample (Psucc p)) C))%Q; [|rewrite IHp; + change ((Psucc p * 1 * (2 * (2* p + 1)) = 2* (Psucc p + p * (2* (Psucc p))))%Z); + repeat rewrite Zpos_succ_morphism; ring]. + assert (X:(Psucc p # xI p) *0 < (Psucc p # xI p) *1). + constructor. + rewrite (fun a => SupDistanceToLinear_scale a C X). + apply SupDistanceToLinear_wd1. + simpl; ring. + unfold affineCombo; simpl; unfold QONE; ring. + set (LHS := (SupDistanceToLinear (constStepF (X:=QS) (1 # xI p) * + (constStepF (X:=QS) (Psucc p) + constStepF (X:=QS) p * stepSample p)) B)%Q). + transitivity ((1#xI p)*(p*(SupDistanceToLinear (stepSample (p)) C)))%Q; [|rewrite IHp0; + change ((p * 1 * (2 * (2* p + 1)) = 2* (p + p * (2* p)))%Z); ring]. + assert (X0:(p *0 < p *1)). + constructor. + rewrite (fun a => SupDistanceToLinear_scale a C X0). + assert (X1:(p*0 + Psucc p < p*1 + Psucc p)). + apply: plus_resp_less_rht. + assumption. + rewrite (fun a => SupDistanceToLinear_translate a X0 X1). + assert (X2:((1# xI p)*(p*0 + Psucc p) < (1#xI p)*(p*1 + Psucc p))). + apply: mult_resp_less_lft;simpl; auto with *. + rewrite (fun a => SupDistanceToLinear_scale a X1 X2). + apply SupDistanceToLinear_wd1. + unfold affineCombo; simpl; unfold QONE. + repeat rewrite Zpos_succ_morphism; repeat rewrite Qmake_Qdiv; repeat rewrite Zpos_xI; + field; auto with *. + change (2*(p*1) + 1 = ((p*1*1 + Psucc p*1)*1))%Z. + rewrite Zpos_succ_morphism; ring. + change (1#2*xO p)%Q with ((1#2)*(1#(2*p)))%Q. + replace (stepSample (xO p)) with (glue (ou (1#2)) (constStepF (1#2:QS) * (stepSample p)) + (constStepF (1#2:QS) * (constStepF (1:QS) + (stepSample p)))) + by (symmetry;apply: positive_rect2_red2). rewrite SupDistanceToLinear_glue. - generalize (@affineCombo_gt (OpenUnitDual (Build_OpenUnit (oddGluePoint p))) 0 1 (pos_one Q_as_COrdField)) - (@affineCombo_lt (OpenUnitDual (Build_OpenUnit (oddGluePoint p))) 0 1 (pos_one Q_as_COrdField)). + generalize (@affineCombo_gt (OpenUnitDual (ou (1#2))) 0 1 (pos_one Q_as_COrdField)) + (@affineCombo_lt (OpenUnitDual (ou (1#2))) 0 1 (pos_one Q_as_COrdField)). intros A B. set (C:=(pos_one Q_as_COrdField)) in *. - transitivity (Qmax (1#2*xI p) (1#2*xI p))%Q;[|apply Qmax_idem]. + transitivity (Qmax ((1#2)*(1#2 * p)) ((1#2)*(1#2 * p)))%Q;[|apply Qmax_idem]. + set (D1:=(SupDistanceToLinear (constStepF (X:=QS) (1 # 2) * stepSample p) A)). + set (D2:=(SupDistanceToLinear + (constStepF (X:=QS) (1 # 2) * (constStepF (X:=QS) 1 + stepSample p)) B)). + rewrite <- IHp. apply Qmax_compat. - set (LHS := (SupDistanceToLinear - (constStepF (X:=QS) (Psucc p # xI p) * stepSample (Psucc p)) A)). - transitivity ((Psucc p#xI p)*(SupDistanceToLinear (stepSample (Psucc p)) C))%Q; - [|rewrite IHp; - change ((Psucc p * 1 * (2 * (2* p + 1)) = 2* (Psucc p + p * (2* (Psucc p))))%Z); - repeat rewrite Zpos_succ_morphism; ring]. - assert (X:(Psucc p # xI p) *0 < (Psucc p # xI p) *1). + assert (X:((1#2) *0 < (1#2) *1)). constructor. - rewrite (fun a => SupDistanceToLinear_scale a C X). - apply SupDistanceToLinear_wd1. - simpl; ring. - unfold affineCombo; simpl; unfold QONE; ring. - set (LHS := (SupDistanceToLinear - (constStepF (X:=QS) (1 # xI p) * - (constStepF (X:=QS) (Psucc p) + constStepF (X:=QS) p * stepSample p)) B)%Q). - transitivity ((1#xI p)*(p*(SupDistanceToLinear (stepSample (p)) C)))%Q; - [|rewrite IHp0; - change ((p * 1 * (2 * (2* p + 1)) = 2* (p + p * (2* p)))%Z); ring]. - assert (X0:(p *0 < p *1)). + rewrite (fun a c => SupDistanceToLinear_scale a c X). + apply SupDistanceToLinear_wd1; constructor. + assert (X0:0 + 1 < 1 +1). constructor. - rewrite (fun a => SupDistanceToLinear_scale a C X0). - assert (X1:(p*0 + Psucc p < p*1 + Psucc p)). - apply: plus_resp_less_rht. - assumption. - rewrite (fun a => SupDistanceToLinear_translate a X0 X1). - assert (X2:((1# xI p)*(p*0 + Psucc p) < (1#xI p)*(p*1 + Psucc p))). - apply: mult_resp_less_lft;simpl; auto with *. - rewrite (fun a => SupDistanceToLinear_scale a X1 X2). - apply SupDistanceToLinear_wd1. - unfold affineCombo; simpl; unfold QONE. - repeat rewrite Zpos_succ_morphism; - repeat rewrite Qmake_Qdiv; - repeat rewrite Zpos_xI; - field; auto with *. - change (2*(p*1) + 1 = ((p*1*1 + Psucc p*1)*1))%Z. - rewrite Zpos_succ_morphism; ring. - change (1#2*xO p)%Q with ((1#2)*(1#(2*p)))%Q. - replace (stepSample (xO p)) - with (glue (ou (1#2)) - (constStepF (1#2:QS) * (stepSample p)) - (constStepF (1#2:QS) * (constStepF (1:QS) + (stepSample p)))) - by (symmetry;apply: positive_rect2_red2). - rewrite SupDistanceToLinear_glue. - generalize (@affineCombo_gt (OpenUnitDual (ou (1#2))) 0 1 (pos_one Q_as_COrdField)) - (@affineCombo_lt (OpenUnitDual (ou (1#2))) 0 1 (pos_one Q_as_COrdField)). - intros A B. - set (C:=(pos_one Q_as_COrdField)) in *. - transitivity (Qmax ((1#2)*(1#2 * p)) ((1#2)*(1#2 * p)))%Q;[|apply Qmax_idem]. - set (D1:=(SupDistanceToLinear (constStepF (X:=QS) (1 # 2) * stepSample p) A)). - set (D2:=(SupDistanceToLinear - (constStepF (X:=QS) (1 # 2) * (constStepF (X:=QS) 1 + stepSample p)) B)). - rewrite <- IHp. - apply Qmax_compat. - assert (X:((1#2) *0 < (1#2) *1)). + rewrite (fun a c => SupDistanceToLinear_translate a c X0). + assert (X1:(1#2)*(0 + 1) < (1#2)*(1 +1)). constructor. - rewrite (fun a c => SupDistanceToLinear_scale a c X). + rewrite (fun a => SupDistanceToLinear_scale a X0 X1). apply SupDistanceToLinear_wd1; constructor. - assert (X0:0 + 1 < 1 +1). - constructor. - rewrite (fun a c => SupDistanceToLinear_translate a c X0). - assert (X1:(1#2)*(0 + 1) < (1#2)*(1 +1)). - constructor. - rewrite (fun a => SupDistanceToLinear_scale a X0 X1). - apply SupDistanceToLinear_wd1; constructor. -reflexivity. + reflexivity. Qed. (** Given a requested error of q, what is smallest n for [stepFunction n] that will satifiy this error requirement. *) -Definition id01_raw_help (q:QposInf) : positive := +Definition id01_raw_help (q:QposInf) : positive := match q with |QposInfinity => 1%positive |Qpos2QposInf q => @@ -488,19 +463,19 @@ end. Lemma id01_raw_help_le : forall (q:Qpos), ((1#2*id01_raw_help q) <= q)%Q. Proof. -intros q. -simpl. -assert (X:=Qle_ceiling ((1#2)/q)%Qpos). -revert X. -generalize (Qceiling ((1#2)/q)%Qpos). -intros [|p|p] H; try solve [elim (Qle_not_lt _ _ H); auto with *]. -autorewrite with QposElim in *. -rewrite -> Qmake_Qdiv in *. -rewrite Zpos_xO. -rewrite -> Qle_minus_iff in *. -change ((2%positive * p)%Z:Q) with (2%positive * p)%Q. -replace RHS with (((2*q)/(2*p))*(p - 1%positive/2%positive*/q))%Q by (field; split; discriminate). -apply: mult_resp_nonneg; simpl; auto with *. + intros q. + simpl. + assert (X:=Qle_ceiling ((1#2)/q)%Qpos). + revert X. + generalize (Qceiling ((1#2)/q)%Qpos). + intros [|p|p] H; try solve [elim (Qle_not_lt _ _ H); auto with *]. + autorewrite with QposElim in *. + rewrite -> Qmake_Qdiv in *. + rewrite Zpos_xO. + rewrite -> Qle_minus_iff in *. + change ((2%positive * p)%Z:Q) with (2%positive * p)%Q. + replace RHS with (((2*q)/(2*p))*(p - 1%positive/2%positive*/q))%Q by (field; split; discriminate). + apply: mult_resp_nonneg; simpl; auto with *. Qed. (** Now define id01, the identity funciton on [[0,1]] as a bounded function, @@ -509,15 +484,14 @@ Definition id01_raw (q:QposInf) : StepQ := stepSample (id01_raw_help q). Lemma id01_prf : is_RegularFunction (id01_raw:QposInf -> LinfStepQ). Proof. -intros a b. -unfold id01_raw. -apply ball_weak_le with ((1#2*(id01_raw_help a)) + (1#2*(id01_raw_help b)))%Qpos. - autorewrite with QposElim. - apply: plus_resp_leEq_both; - apply id01_raw_help_le. -simpl (ball (m:=LinfStepQ)). -do 2 rewrite <- stepSampleDistanceToId. -apply SupDistanceToLinear_trans. + intros a b. + unfold id01_raw. + apply ball_weak_le with ((1#2*(id01_raw_help a)) + (1#2*(id01_raw_help b)))%Qpos. + autorewrite with QposElim. + apply: plus_resp_leEq_both; apply id01_raw_help_le. + simpl (ball (m:=LinfStepQ)). + do 2 rewrite <- stepSampleDistanceToId. + apply SupDistanceToLinear_trans. Qed. Definition id01 : BoundedFunction := @@ -535,20 +509,17 @@ StepFunction.Map (fun z => approximate z e) x. Lemma distribComplete_prf : forall (x:StepF CR), is_RegularFunction (distribComplete_raw x). Proof. -unfold distribComplete_raw. -intros x a b. -induction x using StepF_ind. - apply: regFun_prf. -simpl (ball (m:=LinfStepQ)). -set (f:=(fun z : RegularFunction Q_as_MetricSpace => approximate z a)) in *. -set (g:=(fun z : RegularFunction Q_as_MetricSpace => approximate z b)) in *. -change (Map f (glue o x1 x2)) - with (glue o (Map f x1:StepQ) (Map f x2)). -change (Map g (glue o x1 x2)) - with (glue o (Map g x1:StepQ) (Map g - x2)). -rewrite StepFSupBallGlueGlue. -auto. + unfold distribComplete_raw. + intros x a b. + induction x using StepF_ind. + apply: regFun_prf. + simpl (ball (m:=LinfStepQ)). + set (f:=(fun z : RegularFunction Q_as_MetricSpace => approximate z a)) in *. + set (g:=(fun z : RegularFunction Q_as_MetricSpace => approximate z b)) in *. + change (Map f (glue o x1 x2)) with (glue o (Map f x1:StepQ) (Map f x2)). + change (Map g (glue o x1 x2)) with (glue o (Map g x1:StepQ) (Map g x2)). + rewrite StepFSupBallGlueGlue. + auto. Qed. Definition distribComplete (x:StepF CR) : BoundedFunction := @@ -560,7 +531,7 @@ Open Local Scope uc_scope. the composition f o g is a bounded function. The map from g to f o g is uniformly continuous with modulus [mu f]. -The same thing does not work for integrable functions becuase +The same thing does not work for integrable functions becuase The map from g to f o g may not be uniformly continuous with modulus [mu f]. However, I have not found a counter example where f o g is not uniformly continuous. In fact, when f is lipschitz, then the map from g to @@ -571,49 +542,45 @@ Definition ComposeContinuous_raw (f:Q_as_MetricSpace-->CR) (z:LinfStepQ) : Bound (* begin hide *) Add Parametric Morphism f : (@ComposeContinuous_raw f) with signature (@st_eq _) ==> (@st_eq _) as ComposeContinuous_raw_wd. Proof. -intros x1 x2 Hx. -unfold ComposeContinuous_raw. -rewrite Hx. -reflexivity. + intros x1 x2 Hx. + unfold ComposeContinuous_raw. + rewrite Hx. + reflexivity. Qed. (* end hide *) Lemma ComposeContinuous_prf (f:Q_as_MetricSpace --> CR) : is_UniformlyContinuousFunction (ComposeContinuous_raw f) (mu f). Proof. -intros f e a b. -revert a b e. -apply: StepF_ind2. - intros s s0 t t0 Hs Ht H e H0. - change (st_car LinfStepQ) in s, s0, t, t0. - rewrite <- Hs, <- Ht. - apply H. - destruct (mu f e); try constructor. - change (ball q s t). - rewrite Hs Ht. + intros f e a b. + revert a b e. + apply: StepF_ind2. + intros s s0 t t0 Hs Ht H e H0. + change (st_car LinfStepQ) in s, s0, t, t0. + rewrite <- Hs, <- Ht. + apply H. + destruct (mu f e); try constructor. + change (ball q s t). + rewrite Hs Ht. + assumption. + intros x y e H. + change (ball e (f x) (f y)). + apply uc_prf. + destruct (mu f e); try solve [constructor]. + simpl. assumption. - intros x y e H. - change (ball e (f x) (f y)). - apply uc_prf. - destruct (mu f e); try solve [constructor]. + intros o s s0 t t0 H0 H1 e H. + unfold ComposeContinuous_raw in *. + repeat rewrite MapGlue dist_glue. + intros d1 d2. + apply ball_weak_le with (((1#2)*((1#2)*d1)) + e + ((1#2)*((1#2)*d2)))%Qpos. + autorewrite with QposElim. + Qauto_le. simpl. - assumption. -intros o s s0 t t0 H0 H1 e H. -unfold ComposeContinuous_raw in *. -repeat rewrite MapGlue dist_glue. -intros d1 d2. -apply ball_weak_le with (((1#2)*((1#2)*d1)) + e + ((1#2)*((1#2)*d2)))%Qpos. - autorewrite with QposElim. - Qauto_le. -simpl. -unfold Cap_slow_raw. -simpl. -rewrite StepFSupBallGlueGlue. -split; - [apply H0 | apply H1]; - destruct (mu f e); try constructor; - simpl in *; - rewrite -> StepFSupBallGlueGlue in H; - tauto. + unfold Cap_slow_raw. + simpl. + rewrite StepFSupBallGlueGlue. + split; [apply H0 | apply H1]; destruct (mu f e); try constructor; simpl in *; + rewrite -> StepFSupBallGlueGlue in H; tauto. Qed. Definition ComposeContinuous (f:Q_as_MetricSpace --> CR) : LinfStepQ --> BoundedFunction := @@ -639,189 +606,194 @@ Definition ContinuousSup01 f := (** Our integral on [[0,1]] is correct. *) Lemma Integrate01_correct : forall F (H01:Zero[<=](One:IR)) (HF:Continuous_I H01 F) (f:Q_as_MetricSpace --> CR), - (forall (o:Q) H, (0 <= o <= 1) -> (f o == IRasCR (F (inj_Q IR o) H)))%CR -> + (forall (o:Q) H, (0 <= o <= 1) -> (f o == IRasCR (F (inj_Q IR o) H)))%CR -> (IRasCR (integral Zero One H01 F HF)==Integrate01 f)%CR. Proof. -intros F H01' HF' f Hf. -assert (H01:(inj_Q IR 0)[<=](inj_Q IR 1)). - apply inj_Q_leEq. - discriminate. -assert (HF:Continuous_I H01 F). - apply (included_imp_contin _ _ H01'). - apply included_compact. - apply (compact_wd _ _ H01' Zero). - apply compact_inc_lft. + intros F H01' HF' f Hf. + assert (H01:(inj_Q IR 0)[<=](inj_Q IR 1)). + apply inj_Q_leEq. + discriminate. + assert (HF:Continuous_I H01 F). + apply (included_imp_contin _ _ H01'). + apply included_compact. + apply (compact_wd _ _ H01' Zero). + apply compact_inc_lft. + apply eq_symmetric; apply (inj_Q_nring IR 0). + apply (compact_wd _ _ H01' One). + apply compact_inc_rht. + rstepl (nring 1:IR). + apply eq_symmetric; apply (inj_Q_nring IR 1). + assumption. + transitivity (IRasCR (integral _ _ H01 F HF)). + apply IRasCR_wd. + apply integral_wd'. apply eq_symmetric; apply (inj_Q_nring IR 0). - apply (compact_wd _ _ H01' One). - apply compact_inc_rht. rstepl (nring 1:IR). - apply eq_symmetric; apply (inj_Q_nring IR 1). - assumption. -transitivity (IRasCR (integral _ _ H01 F HF)). - apply IRasCR_wd. - apply integral_wd'. - apply eq_symmetric; apply (inj_Q_nring IR 0). - rstepl (nring 1:IR). - apply eq_symmetric; apply (inj_Q_nring IR 1). -clear H01' HF'. -apply ball_eq. -intros e. -setoid_replace e with ((1#2)*e + (1#2)*e)%Qpos by QposRing. -generalize ((1#2)*e)%Qpos. -clear e. -intros e. -eapply ball_triangle; - [|apply (@ball_approx_l Q_as_MetricSpace)]. -change (Cunit (approximate (Integrate01 f) e)) - with ('(approximate (Integrate01 f) e))%CR. -setoid_replace ('(approximate (Integrate01 f) e))%CR - with ('((1-0)*(approximate (Integrate01 f) e)))%CR - by ring. -rewrite <- CRAbsSmall_ball. -stepl ('((1-0)*e))%CR - by (apply inject_Q_wd; ring). -set (z:=(integral (inj_Q IR 0) (inj_Q IR 1) H01 F HF)). -simpl. -unfold Cjoin_raw. -simpl. -unfold distribComplete_raw. -unfold id01_raw. -assert (X:=stepSampleDistanceToId (id01_raw_help (mu f ((1 # 2) * e)))). -revert X. -generalize (stepSample (id01_raw_help (mu f ((1 # 2) * e)))). -intros s Hs. -assert (X:QposInf_le (SupDistanceToLinear s (pos_one Q_as_COrdField)) (mu f ((1 # 2) * e))). - destruct (mu f ((1#2) *e)); try constructor. - unfold QposEq in Hs. - simpl. - rewrite Hs. - apply id01_raw_help_le. -clear Hs. -rename X into Hs. -revert s Hs. -generalize (pos_one Q_as_COrdField). -intros c s Hs. -simpl in c, Hs. -revert c s Hs. -unfold z. -clear z. -revert H01 HF. -revert Hf. -unfold QONE. -generalize 0 1. -intros a b Hf Hab HF Hab0 s Hs. -destruct (Qpos_lt_plus Hab0) as [ba Hba]. -stepl ('(ba*e)%Qpos)%CR - by (apply inject_Q_wd; rewrite Hba; QposRing). -revert a b Hab0 ba Hba F Hab HF Hf Hs. - -induction s using StepF_ind; - intros a b Hab0 ba Hba F Hab HF Hf Hs. - change (AbsSmall (R:=CRasCOrdField) ('(ba*e)%Qpos)%CR - (IRasCR (integral _ _ Hab F HF)[-] - ('((b-a)*(approximate (f x) ((1 # 2) * e)%Qpos)))%CR)). - rewrite CRAbsSmall_ball. - rewrite <- IR_inj_Q_as_CR. + apply eq_symmetric; apply (inj_Q_nring IR 1). + clear H01' HF'. + apply ball_eq. + intros e. + setoid_replace e with ((1#2)*e + (1#2)*e)%Qpos by QposRing. + generalize ((1#2)*e)%Qpos. + clear e. + intros e. + eapply ball_triangle; [|apply (@ball_approx_l Q_as_MetricSpace)]. + change (Cunit (approximate (Integrate01 f) e)) with ('(approximate (Integrate01 f) e))%CR. + setoid_replace ('(approximate (Integrate01 f) e))%CR + with ('((1-0)*(approximate (Integrate01 f) e)))%CR by ring. rewrite <- CRAbsSmall_ball. - unfold cg_minus. + stepl ('((1-0)*e))%CR by (apply inject_Q_wd; ring). + set (z:=(integral (inj_Q IR 0) (inj_Q IR 1) H01 F HF)). + simpl. + unfold Cjoin_raw. simpl. - eapply AbsSmall_wdr;[|apply IR_minus_as_CR]. - eapply AbsSmall_wdl;[|apply IR_inj_Q_as_CR]. - rewrite <- IR_AbsSmall_as_CR. - unfold SupDistanceToLinear in Hs. - simpl in Hs. - set (a0:=inj_Q IR (approximate (f x) ((1 # 2) * e)%Qpos)). - set (e':=(inj_Q IR (e:Q))). - assert (X:forall y : IR, Compact Hab y -> forall Hy : Dom F y, - AbsSmall e' ((F y Hy)[-]a0)). - intros y Hy Hyf. - rewrite IR_AbsSmall_as_CR. - unfold e'. - apply AbsSmall_wdr with (IRasCR (F y Hyf)[-]IRasCR a0)%CR;[|apply eq_symmetric; apply IR_minus_as_CR]. - eapply AbsSmall_wdl;[|apply eq_symmetric; apply IR_inj_Q_as_CR]. + unfold distribComplete_raw. + unfold id01_raw. + assert (X:=stepSampleDistanceToId (id01_raw_help (mu f ((1 # 2) * e)))). + revert X. + generalize (stepSample (id01_raw_help (mu f ((1 # 2) * e)))). + intros s Hs. + assert (X:QposInf_le (SupDistanceToLinear s (pos_one Q_as_COrdField)) (mu f ((1 # 2) * e))). + destruct (mu f ((1#2) *e)); try constructor. + unfold QposEq in Hs. + simpl. + rewrite Hs. + apply id01_raw_help_le. + clear Hs. + rename X into Hs. + revert s Hs. + generalize (pos_one Q_as_COrdField). + intros c s Hs. + simpl in c, Hs. + revert c s Hs. + unfold z. + clear z. + revert H01 HF. + revert Hf. + unfold QONE. + generalize 0 1. + intros a b Hf Hab HF Hab0 s Hs. + destruct (Qpos_lt_plus Hab0) as [ba Hba]. + stepl ('(ba*e)%Qpos)%CR by (apply inject_Q_wd; rewrite Hba; QposRing). + revert a b Hab0 ba Hba F Hab HF Hf Hs. + induction s using StepF_ind; intros a b Hab0 ba Hba F Hab HF Hf Hs. + change (AbsSmall (R:=CRasCOrdField) ('(ba*e)%Qpos)%CR (IRasCR (integral _ _ Hab F HF)[-] + ('((b-a)*(approximate (f x) ((1 # 2) * e)%Qpos)))%CR)). rewrite CRAbsSmall_ball. - unfold a0; rewrite IR_inj_Q_as_CR. - assert (X0:(forall (q : Q) (Hq : Dom F (inj_Q IR q)), - clcr (inj_Q IR a) (inj_Q IR b) (inj_Q IR q) -> - (Cbind QPrelengthSpace f (' q) == IRasCR (F (inj_Q IR q) Hq))%CR)). - intros q Hq [Hq0 H1]. - rewrite (Cbind_correct QPrelengthSpace f (' q))%CR. - rewrite (BindLaw1 f). - apply Hf. - split. - apply (leEq_inj_Q IR). - auto. - apply (leEq_inj_Q IR). - auto. - assert (X:=@ContinuousCorrect (clcr (inj_Q IR a) (inj_Q IR b)) (inj_Q_less _ _ _ Hab0) F (Continuous_Int (clcr (inj_Q IR a) (inj_Q IR b)) Hab Hab F HF) - (Cbind QPrelengthSpace f) X0 y Hyf Hy). - set (z:=(' approximate (f x) ((1 # 2) * e)%Qpos)%CR). - rewrite X. - setoid_replace e with ((1#2)*e + (1#2)*e)%Qpos by QposRing. - apply ball_triangle with (f x); - [|apply ball_approx_r]. - rewrite <- (BindLaw1 f). - rewrite <- (Cbind_correct QPrelengthSpace f (Cunit_fun Q_as_MetricSpace x)). - set (z0:=(Cbind QPrelengthSpace f (Cunit_fun Q_as_MetricSpace x))). - apply: uc_prf. - clear z X X0 Hyf. - set (z:=(mu f ((1#2)*e)%Qpos)) in *. - change (@mu CR CR (@Cbind Q_as_MetricSpace Q_as_MetricSpace QPrelengthSpace f) - (Qpos_mult (QposMake xH (xO xH)) e)) - with z. - destruct z as [z|];[|constructor]. - unfold ball_ex. - eapply ball_weak_le. - apply Hs. - change (Cunit_fun Q_as_MetricSpace x) with ('x)%CR. rewrite <- IR_inj_Q_as_CR. rewrite <- CRAbsSmall_ball. - autorewrite with QposElim. - unfold cg_minus; simpl. + unfold cg_minus. + simpl. eapply AbsSmall_wdr;[|apply IR_minus_as_CR]. eapply AbsSmall_wdl;[|apply IR_inj_Q_as_CR]. rewrite <- IR_AbsSmall_as_CR. - apply AbsIR_imp_AbsSmall. - assert(X:=leEq_or_leEq _ (inj_Q IR x) y). - rewrite leEq_def. - intros Y. - apply X. - clear X. - intros X. - revert Y. - change (Not (inj_Q IR (Qmax (x - a) (b - x))[<]AbsIR (y[-]inj_Q IR x))). - rewrite <- leEq_def. - apply AbsSmall_imp_AbsIR. - destruct X as [X|X]. + unfold SupDistanceToLinear in Hs. + simpl in Hs. + set (a0:=inj_Q IR (approximate (f x) ((1 # 2) * e)%Qpos)). + set (e':=(inj_Q IR (e:Q))). + assert (X:forall y : IR, Compact Hab y -> forall Hy : Dom F y, AbsSmall e' ((F y Hy)[-]a0)). + intros y Hy Hyf. + rewrite IR_AbsSmall_as_CR. + unfold e'. + apply AbsSmall_wdr with (IRasCR (F y Hyf)[-]IRasCR a0)%CR;[|apply eq_symmetric; apply IR_minus_as_CR]. + eapply AbsSmall_wdl;[|apply eq_symmetric; apply IR_inj_Q_as_CR]. + rewrite CRAbsSmall_ball. + unfold a0; rewrite IR_inj_Q_as_CR. + assert (X0:(forall (q : Q) (Hq : Dom F (inj_Q IR q)), clcr (inj_Q IR a) (inj_Q IR b) (inj_Q IR q) -> + (Cbind QPrelengthSpace f (' q) == IRasCR (F (inj_Q IR q) Hq))%CR)). + intros q Hq [Hq0 H1]. + rewrite (Cbind_correct QPrelengthSpace f (' q))%CR. + rewrite (BindLaw1 f). + apply Hf. + split. + apply (leEq_inj_Q IR). + auto. + apply (leEq_inj_Q IR). + auto. + assert (X:=@ContinuousCorrect (clcr (inj_Q IR a) (inj_Q IR b)) (inj_Q_less _ _ _ Hab0) F (Continuous_Int (clcr (inj_Q IR a) (inj_Q IR b)) Hab Hab F HF) + (Cbind QPrelengthSpace f) X0 y Hyf Hy). + set (z:=(' approximate (f x) ((1 # 2) * e)%Qpos)%CR). + rewrite X. + setoid_replace e with ((1#2)*e + (1#2)*e)%Qpos by QposRing. + apply ball_triangle with (f x); [|apply ball_approx_r]. + rewrite <- (BindLaw1 f). + rewrite <- (Cbind_correct QPrelengthSpace f (Cunit_fun Q_as_MetricSpace x)). + set (z0:=(Cbind QPrelengthSpace f (Cunit_fun Q_as_MetricSpace x))). + apply: uc_prf. + clear z X X0 Hyf. + set (z:=(mu f ((1#2)*e)%Qpos)) in *. + change (@mu CR CR (@Cbind Q_as_MetricSpace Q_as_MetricSpace QPrelengthSpace f) + (Qpos_mult (QposMake xH (xO xH)) e)) with z. + destruct z as [z|];[|constructor]. + unfold ball_ex. + eapply ball_weak_le. + apply Hs. + change (Cunit_fun Q_as_MetricSpace x) with ('x)%CR. + rewrite <- IR_inj_Q_as_CR. + rewrite <- CRAbsSmall_ball. + autorewrite with QposElim. + unfold cg_minus; simpl. + eapply AbsSmall_wdr;[|apply IR_minus_as_CR]. + eapply AbsSmall_wdl;[|apply IR_inj_Q_as_CR]. + rewrite <- IR_AbsSmall_as_CR. + apply AbsIR_imp_AbsSmall. + assert(X:=leEq_or_leEq _ (inj_Q IR x) y). + rewrite leEq_def. + intros Y. + apply X. + clear X. + intros X. + revert Y. + change (Not (inj_Q IR (Qmax (x - a) (b - x))[<]AbsIR (y[-]inj_Q IR x))). + rewrite <- leEq_def. + apply AbsSmall_imp_AbsIR. + destruct X as [X|X]. + apply leEq_imp_AbsSmall. + apply shift_leEq_lft; assumption. + apply leEq_transitive with (inj_Q IR (b - x)%Q). + stepr ((inj_Q IR b)[-](inj_Q IR x)) by (apply eq_symmetric; apply inj_Q_minus). + apply minus_resp_leEq. + destruct Hy; assumption. + apply inj_Q_leEq. + apply Qmax_ub_r. + apply AbsSmall_minus. apply leEq_imp_AbsSmall. apply shift_leEq_lft; assumption. - apply leEq_transitive with (inj_Q IR (b - x)%Q). - stepr ((inj_Q IR b)[-](inj_Q IR x)) by (apply eq_symmetric; apply inj_Q_minus). - apply minus_resp_leEq. + apply leEq_transitive with (inj_Q IR (x - a)%Q). + stepr ((inj_Q IR x)[-](inj_Q IR a)) by (apply eq_symmetric; apply inj_Q_minus). + apply minus_resp_leEq_rht. destruct Hy; assumption. apply inj_Q_leEq. - apply Qmax_ub_r. - apply AbsSmall_minus. - apply leEq_imp_AbsSmall. - apply shift_leEq_lft; assumption. - apply leEq_transitive with (inj_Q IR (x - a)%Q). - stepr ((inj_Q IR x)[-](inj_Q IR a)) by (apply eq_symmetric; apply inj_Q_minus). - apply minus_resp_leEq_rht. - destruct Hy; assumption. - apply inj_Q_leEq. - apply Qmax_ub_l. - split. - apply shift_leEq_minus. - stepl (([--]e'[+]a0)[*](inj_Q IR b[-]inj_Q IR a)). - apply lb_integral. + apply Qmax_ub_l. + split. + apply shift_leEq_minus. + stepl (([--]e'[+]a0)[*](inj_Q IR b[-]inj_Q IR a)). + apply lb_integral. + intros y Hy Hyf. + apply shift_plus_leEq. + destruct (X y Hy Hyf); assumption. + rstepl ([--]((inj_Q IR b[-]inj_Q IR a)[*]e') [+] (inj_Q IR b[-]inj_Q IR a)[*]a0). + csetoid_replace (inj_Q IR b[-]inj_Q IR a) (inj_Q IR (b-a)%Q); + [|apply eq_symmetric; apply inj_Q_minus]. + apply bin_op_wd_unfolded. + apply un_op_wd_unfolded. + unfold e'. + stepl (inj_Q IR ((b-a)*e)%Q) by apply inj_Q_mult. + apply: inj_Q_wd;simpl. + autorewrite with QposElim. + rewrite Hba. + ring. + apply eq_symmetric; apply inj_Q_mult. + apply shift_minus_leEq. + stepr ((e'[+]a0)[*](inj_Q IR b[-]inj_Q IR a)). + apply ub_integral. intros y Hy Hyf. - apply shift_plus_leEq. + apply shift_leEq_plus. destruct (X y Hy Hyf); assumption. - rstepl ([--]((inj_Q IR b[-]inj_Q IR a)[*]e') [+] (inj_Q IR b[-]inj_Q IR a)[*]a0). + rstepl (((inj_Q IR b[-]inj_Q IR a)[*]e') [+] (inj_Q IR b[-]inj_Q IR a)[*]a0). csetoid_replace (inj_Q IR b[-]inj_Q IR a) (inj_Q IR (b-a)%Q); - [|apply eq_symmetric; apply inj_Q_minus]. + [|apply eq_symmetric; apply inj_Q_minus]. apply bin_op_wd_unfolded. - apply un_op_wd_unfolded. unfold e'. stepl (inj_Q IR ((b-a)*e)%Q) by apply inj_Q_mult. apply: inj_Q_wd;simpl. @@ -829,126 +801,97 @@ induction s using StepF_ind; rewrite Hba. ring. apply eq_symmetric; apply inj_Q_mult. - apply shift_minus_leEq. - stepr ((e'[+]a0)[*](inj_Q IR b[-]inj_Q IR a)). - apply ub_integral. - intros y Hy Hyf. - apply shift_leEq_plus. - destruct (X y Hy Hyf); assumption. - rstepl (((inj_Q IR b[-]inj_Q IR a)[*]e') [+] (inj_Q IR b[-]inj_Q IR a)[*]a0). - csetoid_replace (inj_Q IR b[-]inj_Q IR a) (inj_Q IR (b-a)%Q); - [|apply eq_symmetric; apply inj_Q_minus]. - apply bin_op_wd_unfolded. - unfold e'. - stepl (inj_Q IR ((b-a)*e)%Q) by apply inj_Q_mult. - apply: inj_Q_wd;simpl. + set (z:=(IntegralQ (glue o (Map (fun z : RegularFunction Q_as_MetricSpace => + approximate z ((1 # 2) * e)%Qpos) (Map f s1):StepQ) (Map + (fun z : RegularFunction Q_as_MetricSpace => approximate z ((1 # 2) * e)%Qpos) (Map f s2))))). + change (AbsSmall (R:=CRasCOrdField) ('(ba* e)%Qpos)%CR + (IRasCR (integral _ _ Hab F HF)[-]'((b-a)*z))%CR). + rewrite CRAbsSmall_ball. + set (c:=(affineCombo (OpenUnitDual o) a b:Q)). + assert (Hac:inj_Q IR a[<=]inj_Q IR c). + unfold c. + apply inj_Q_leEq. + simpl; auto with *. + assert (Hcb:inj_Q IR c[<=]inj_Q IR b). + unfold c. + apply inj_Q_leEq. + simpl; auto with *. + assert (HFl :Continuous_I Hac F). + revert HF. + apply included_imp_contin. + intros x [Hxl Hxr]. + split; auto. + apply leEq_transitive with (inj_Q IR c); auto. + assert (HFr :Continuous_I Hcb F). + revert HF. + apply included_imp_contin. + intros x [Hxl Hxr]. + split; auto. + apply leEq_transitive with (inj_Q IR c); auto. + setoid_replace (IRasCR (integral _ _ Hab F HF)) + with (IRasCR (integral _ _ Hac F HFl)+IRasCR (integral _ _ Hcb F HFr))%CR + by (rewrite <- IR_plus_as_CR;apply IRasCR_wd; apply eq_symmetric; apply integral_plus_integral). + unfold z. + rewrite Integral_glue. + clear z. + set (zl:=IntegralQ (Map (fun z : RegularFunction Q_as_MetricSpace => + approximate z ((1 # 2) * e)%Qpos) (Map f s1))). + set (zr:=IntegralQ (Map (fun z : RegularFunction Q_as_MetricSpace => + approximate z ((1 # 2) * e)%Qpos) (Map f s2))). + setoid_replace ((b - a) * (o * zl + (1 - o) * zr))%Q with ((c - a)*zl + (b - c)*zr)%Q + by (unfold c, affineCombo, OpenUnitDual; simpl; ring). + assert (Hac0: a < c). + unfold c; auto with*. + assert (Hcb0: c < b). + unfold c; auto with*. + destruct (Qpos_lt_plus Hac0) as [ca Hca]. + destruct (Qpos_lt_plus Hcb0) as [bc Hbc]. + assert (Z:(QposEq ba (ca + bc))%Qpos). + unfold QposEq. autorewrite with QposElim. - rewrite Hba. + rewrite -> Hba in Hbc. + rewrite -> Hca in Hbc. + replace LHS with (- a + (a + ba))%Q by ring. + rewrite Hbc. ring. - apply eq_symmetric; apply inj_Q_mult. - -set (z:=(IntegralQ - (glue o - (Map - (fun z : RegularFunction Q_as_MetricSpace => - approximate z ((1 # 2) * e)%Qpos) (Map f s1):StepQ) - (Map - (fun z : RegularFunction Q_as_MetricSpace => - approximate z ((1 # 2) * e)%Qpos) (Map f s2))))). -change (AbsSmall (R:=CRasCOrdField) ('(ba* e)%Qpos)%CR - (IRasCR (integral _ _ Hab F HF)[-]'((b-a)*z))%CR). -rewrite CRAbsSmall_ball. -set (c:=(affineCombo (OpenUnitDual o) a b:Q)). -assert (Hac:inj_Q IR a[<=]inj_Q IR c). - unfold c. - apply inj_Q_leEq. - simpl; auto with *. -assert (Hcb:inj_Q IR c[<=]inj_Q IR b). - unfold c. - apply inj_Q_leEq. - simpl; auto with *. -assert (HFl :Continuous_I Hac F). - revert HF. - apply included_imp_contin. - intros x [Hxl Hxr]. - split; auto. - apply leEq_transitive with (inj_Q IR c); auto. -assert (HFr :Continuous_I Hcb F). - revert HF. - apply included_imp_contin. - intros x [Hxl Hxr]. - split; auto. - apply leEq_transitive with (inj_Q IR c); auto. -setoid_replace (IRasCR (integral _ _ Hab F HF)) - with (IRasCR (integral _ _ Hac F HFl)+IRasCR (integral _ _ Hcb F HFr))%CR - by (rewrite <- IR_plus_as_CR;apply IRasCR_wd; apply eq_symmetric; apply integral_plus_integral). -unfold z. -rewrite Integral_glue. -clear z. -set (zl:=IntegralQ - (Map - (fun z : RegularFunction Q_as_MetricSpace => - approximate z ((1 # 2) * e)%Qpos) (Map f s1))). -set (zr:=IntegralQ - (Map - (fun z : RegularFunction Q_as_MetricSpace => - approximate z ((1 # 2) * e)%Qpos) (Map f s2))). -setoid_replace ((b - a) * (o * zl + (1 - o) * zr))%Q - with ((c - a)*zl + (b - c)*zr)%Q - by (unfold c, affineCombo, OpenUnitDual; simpl; ring). -assert (Hac0: a < c). - unfold c; auto with*. -assert (Hcb0: c < b). - unfold c; auto with*. -destruct (Qpos_lt_plus Hac0) as [ca Hca]. -destruct (Qpos_lt_plus Hcb0) as [bc Hbc]. -assert (Z:(QposEq ba (ca + bc))%Qpos). - unfold QposEq. - autorewrite with QposElim. - rewrite -> Hba in Hbc. - rewrite -> Hca in Hbc. - replace LHS with (- a + (a + ba))%Q by ring. - rewrite Hbc. - ring. -rewrite Z. -clear Z. -setoid_replace ((ca + bc)*e)%Qpos with (ca*e + bc*e)%Qpos by QposRing. -rewrite <- CRAbsSmall_ball. -stepr ((IRasCR (integral (inj_Q IR a) (inj_Q IR c) Hac F HFl)[-]('((c-a)*zl)))+ - ((IRasCR (integral (inj_Q IR c) (inj_Q IR b) Hcb F HFr)[-]('((b - c) * zr)))))%CR. - stepl ('(ca * e)%Qpos + '(bc * e)%Qpos)%CR. - apply: AbsSmall_plus. - apply (IHs1 _ _ Hac0); auto. + rewrite Z. + clear Z. + setoid_replace ((ca + bc)*e)%Qpos with (ca*e + bc*e)%Qpos by QposRing. + rewrite <- CRAbsSmall_ball. + stepr ((IRasCR (integral (inj_Q IR a) (inj_Q IR c) Hac F HFl)[-]('((c-a)*zl)))+ + ((IRasCR (integral (inj_Q IR c) (inj_Q IR b) Hcb F HFr)[-]('((b - c) * zr)))))%CR. + stepl ('(ca * e)%Qpos + '(bc * e)%Qpos)%CR. + apply: AbsSmall_plus. + apply (IHs1 _ _ Hac0); auto. + intros o0 H [H0 H1]. + apply Hf. + split; eauto with qarith. + destruct (mu f ((1#2)*e)) as [q|];[|constructor]. + simpl in Hs|-*. + eapply Qle_trans;[|apply Hs]. + rewrite SupDistanceToLinear_glue. + replace LHS with (SupDistanceToLinear s1 (affineCombo_gt (OpenUnitDual o) Hab0):Q). + apply Qmax_ub_l. + apply SupDistanceToLinear_wd1; reflexivity. + apply (IHs2 _ _ Hcb0); auto. intros o0 H [H0 H1]. apply Hf. + clear - H0 H1 Hac0. split; eauto with qarith. destruct (mu f ((1#2)*e)) as [q|];[|constructor]. simpl in Hs|-*. eapply Qle_trans;[|apply Hs]. rewrite SupDistanceToLinear_glue. - replace LHS with (SupDistanceToLinear s1 (affineCombo_gt (OpenUnitDual o) Hab0):Q). - apply Qmax_ub_l. + replace LHS with (SupDistanceToLinear s2 (affineCombo_lt (OpenUnitDual o) Hab0):Q). + apply Qmax_ub_r. apply SupDistanceToLinear_wd1; reflexivity. - apply (IHs2 _ _ Hcb0); auto. - intros o0 H [H0 H1]. - apply Hf. - clear - H0 H1 Hac0. - split; eauto with qarith. - destruct (mu f ((1#2)*e)) as [q|];[|constructor]. - simpl in Hs|-*. - eapply Qle_trans;[|apply Hs]. - rewrite SupDistanceToLinear_glue. - replace LHS with (SupDistanceToLinear s2 (affineCombo_lt (OpenUnitDual o) Hab0):Q). - apply Qmax_ub_r. - apply SupDistanceToLinear_wd1; reflexivity. - change (' (ca * e)%Qpos + ' (bc * e)%Qpos==(' (ca * e + bc * e)%Qpos))%CR. - autorewrite with QposElim. + change (' (ca * e)%Qpos + ' (bc * e)%Qpos==(' (ca * e + bc * e)%Qpos))%CR. + autorewrite with QposElim. + ring. + generalize (IRasCR (integral (inj_Q IR a) (inj_Q IR c) Hac F HFl)) + (IRasCR (integral (inj_Q IR c) (inj_Q IR b) Hcb F HFr)). + intros x y. + clear - x y. + change ((x-' ((c - a) * zl) + (y-' ((b - c) * zr)))== (x + y)-(' ((c - a) * zl + (b - c) * zr)))%CR. ring. -generalize (IRasCR (integral (inj_Q IR a) (inj_Q IR c) Hac F HFl)) - (IRasCR (integral (inj_Q IR c) (inj_Q IR b) Hcb F HFr)). -intros x y. -clear - x y. -change ((x-' ((c - a) * zl) + (y-' ((b - c) * zr)))== -(x + y)-(' ((c - a) * zl + (b - c) * zr)))%CR. -ring. Qed. diff --git a/reals/fast/Interval.v b/reals/fast/Interval.v index d57e7605d..bbfb2084b 100644 --- a/reals/fast/Interval.v +++ b/reals/fast/Interval.v @@ -50,90 +50,89 @@ Let f n (i:Z) := l + ((r-l)*(2*i+1#1))/(2*Z_of_nat n#1). (** [UniformPartition] produces a set of n points uniformly distributed inside the interval [[l, r]]. *) -Definition UniformPartition (n:nat) := +Definition UniformPartition (n:nat) := map (f n) (iterateN Zsucc 0%Z n). Lemma UniformPartitionZ : forall n z, In z (iterateN Zsucc 0%Z n) <-> (0 <= z < n)%Z. Proof. -intros n z. -change (0 <= z < n)%Z with (0 <= z < 0 + n)%Z. -generalize 0%Z. -induction n; intros a. - split; intros H. - contradiction. - apply (Zle_not_lt a a); auto with *. - rewrite Zplus_comm in H. - simpl in H. - apply Zle_lt_trans with z; auto with *. -split. - intros [H | H]. - rewrite H. + intros n z. + change (0 <= z < n)%Z with (0 <= z < 0 + n)%Z. + generalize 0%Z. + induction n; intros a. + split; intros H. + contradiction. + apply (Zle_not_lt a a); auto with *. + rewrite Zplus_comm in H. + simpl in H. + apply Zle_lt_trans with z; auto with *. + split. + intros [H | H]. + rewrite H. + rewrite inj_S. + auto with *. + change (In z (iterateN Zsucc (Zsucc a) n)) in H. + rewrite -> IHn in H. rewrite inj_S. auto with *. - change (In z (iterateN Zsucc (Zsucc a) n)) in H. - rewrite -> IHn in H. - rewrite inj_S. - auto with *. -intros [H0 H1]. -destruct (Zle_lt_or_eq _ _ H0) as [H2 | H2]. - simpl. - right. - rewrite IHn. - rewrite inj_S in H1. - auto with *. -rewrite H2. -left. -reflexivity. + intros [H0 H1]. + destruct (Zle_lt_or_eq _ _ H0) as [H2 | H2]. + simpl. + right. + rewrite IHn. + rewrite inj_S in H1. + auto with *. + rewrite H2. + left. + reflexivity. Qed. Lemma UniformPartition_inside : forall n x, In x (UniformPartition n) -> l <= x <= r. Proof. -intros n x. -unfold UniformPartition. -cut (forall z, In z (iterateN Zsucc 0%Z n) -> (0 <= z < n)%Z). - destruct n. - contradiction. - generalize (iterateN Zsucc 0%Z (S n)). - intros s Hs H. - induction s. - contradiction. - destruct H as [H | H];auto with *. - rewrite <- H. - destruct (Hs a) as [Hz0 Hz1]; auto with *. - clear - Hz0 Hz1 Hlr. - split. + intros n x. + unfold UniformPartition. + cut (forall z, In z (iterateN Zsucc 0%Z n) -> (0 <= z < n)%Z). + destruct n. + contradiction. + generalize (iterateN Zsucc 0%Z (S n)). + intros s Hs H. + induction s. + contradiction. + destruct H as [H | H];auto with *. + rewrite <- H. + destruct (Hs a) as [Hz0 Hz1]; auto with *. + clear - Hz0 Hz1 Hlr. + split. + rewrite Qle_minus_iff. + unfold f, Qdiv. + replace RHS with ((r + - l) * ((2 * a + 1 # 1) * / (2 * (S n) # 1))) by ring. + apply: mult_resp_nonneg. + rewrite ->Qle_minus_iff in Hlr; auto. + apply Qle_shift_div_l; auto with *. + replace LHS with 0 by (simpl; ring). + change (0 <= (2*a + 1)*1)%Z. + auto with *. rewrite Qle_minus_iff. - unfold f, Qdiv. - replace RHS with ((r + - l) * ((2 * a + 1 # 1) * / (2 * (S n) # 1))) by ring. - apply: mult_resp_nonneg. - rewrite ->Qle_minus_iff in Hlr; auto. + unfold f. + replace RHS with (((r-l)*((2*S n#1) + - (2 * a + 1 # 1))) / (2 * S n # 1)) by (field; discriminate). apply Qle_shift_div_l; auto with *. - replace LHS with 0 by (simpl; ring). - change (0 <= (2*a + 1)*1)%Z. + replace LHS with 0 by ring. + apply: mult_resp_nonneg. + rewrite -> Qle_minus_iff in Hlr; auto. + change (0 <= ((2*S n)*1 + - (2*a + 1)*1)*1)%Z. auto with *. - rewrite Qle_minus_iff. - unfold f. - replace RHS with (((r-l)*((2*S n#1) + - (2 * a + 1 # 1))) / (2 * S n # 1)) - by (field; discriminate). - apply Qle_shift_div_l; auto with *. - replace LHS with 0 by ring. - apply: mult_resp_nonneg. - rewrite -> Qle_minus_iff in Hlr; auto. - change (0 <= ((2*S n)*1 + - (2*a + 1)*1)*1)%Z. + clear - n. + intros z. + change (0 <= z < n)%Z with (0 <= z < 0 + n)%Z. + revert z. + generalize 0%Z. + induction n. + contradiction. + intros z x Hx. + destruct Hx as [Hx | Hx]. + rewrite <- Hx; split; simpl; auto with *. + destruct (IHn (Zsucc z) x Hx). + rewrite inj_S. auto with *. -clear - n. -intros z. -change (0 <= z < n)%Z with (0 <= z < 0 + n)%Z. -revert z. -generalize 0%Z. -induction n. - contradiction. -intros z x Hx. -destruct Hx as [Hx | Hx]. - rewrite <- Hx; split; simpl; auto with *. -destruct (IHn (Zsucc z) x Hx). -rewrite inj_S. -auto with *. Qed. (** Given a point [x] in the interval [[l, r]], one can find a @@ -142,224 +141,190 @@ Definition rasterize1 n (x:Q) := Qfloor ((Z_of_nat n)*(x-l)/(r-l)). Lemma rasterize1_close : l < r -> forall n (x:Q), Qabs (x - f (S n) (rasterize1 (S n) x)) <= ((r-l)/(2*(S n))). Proof. -clear Hlr. -intros Hlr' n x. -rewrite -> Qlt_minus_iff in Hlr'. -assert (A:~ r - l == 0 /\ ~ S n == 0) - by (split;auto with *;discriminate). -replace RHS with ((1#2)/((S n)/(r - l))) by (field;auto). -apply Qle_shift_div_l. - apply Qlt_shift_div_l; auto with *. -rewrite <- (Qabs_pos (S n/(r-l))); - [|apply Qle_shift_div_l; auto with *]. -rewrite <- Qabs_Qmult. -unfold f. -change (2*S n # 1) with (2*S n). -setoid_replace ((x - (l + (r - l) * (2 * rasterize1 (S n) x + 1 # 1) / (2 * S n))) * - (S n / (r - l))) - with ((S n)*(x-l)/(r-l) - (2*rasterize1 (S n) x + 1 # 1)/2) - by (field; auto). -rewrite Qmake_Qdiv. -rewrite injz_plus. -setoid_replace ((2 * rasterize1 (S n) x + 1%positive) / 1%positive / 2) - with (rasterize1 (S n) x + (1#2)). -2:field. -unfold rasterize1. -generalize (S n * (x - l) / (r - l)). -intros q. -clear - q. -apply Qabs_case; intros H; - rewrite Qle_minus_iff. - replace RHS with (Qfloor q + 1 + - q) by ring. + clear Hlr. + intros Hlr' n x. + rewrite -> Qlt_minus_iff in Hlr'. + assert (A:~ r - l == 0 /\ ~ S n == 0) by (split;auto with *;discriminate). + replace RHS with ((1#2)/((S n)/(r - l))) by (field;auto). + apply Qle_shift_div_l. + apply Qlt_shift_div_l; auto with *. + rewrite <- (Qabs_pos (S n/(r-l))); [|apply Qle_shift_div_l; auto with *]. + rewrite <- Qabs_Qmult. + unfold f. + change (2*S n # 1) with (2*S n). + setoid_replace ((x - (l + (r - l) * (2 * rasterize1 (S n) x + 1 # 1) / (2 * S n))) * (S n / (r - l))) + with ((S n)*(x-l)/(r-l) - (2*rasterize1 (S n) x + 1 # 1)/2) by (field; auto). + rewrite Qmake_Qdiv. + rewrite injz_plus. + setoid_replace ((2 * rasterize1 (S n) x + 1%positive) / 1%positive / 2) + with (rasterize1 (S n) x + (1#2)). + 2:field. + unfold rasterize1. + generalize (S n * (x - l) / (r - l)). + intros q. + clear - q. + apply Qabs_case; intros H; rewrite Qle_minus_iff. + replace RHS with (Qfloor q + 1 + - q) by ring. + rewrite <- Qle_minus_iff. + apply Qlt_le_weak. + rewrite <- (injz_plus (Qfloor q) 1). + apply Qlt_floor. + replace RHS with (q + -Qfloor q) by ring. rewrite <- Qle_minus_iff. - apply Qlt_le_weak. - rewrite <- (injz_plus (Qfloor q) 1). - apply Qlt_floor. -replace RHS with (q + -Qfloor q) by ring. -rewrite <- Qle_minus_iff. -apply Qfloor_le. + apply Qfloor_le. Qed. Definition rasterize1_boundL : forall n (x:Q), l <= x -> (0 <= rasterize1 n x)%Z. -intros n x Hx. -change 0%Z with (Qfloor 0). -apply Qfloor_resp_le. -destruct (Qle_lt_or_eq _ _ Hlr) as [Hlr' | Hlr']. - rewrite -> Qlt_minus_iff in Hlr'. - rewrite -> Qle_minus_iff in Hx. - apply Qle_shift_div_l; auto with *. - replace LHS with 0 by ring. - apply: mult_resp_nonneg; simpl; auto with *. - unfold Qle;simpl. +Proof. + intros n x Hx. + change 0%Z with (Qfloor 0). + apply Qfloor_resp_le. + destruct (Qle_lt_or_eq _ _ Hlr) as [Hlr' | Hlr']. + rewrite -> Qlt_minus_iff in Hlr'. + rewrite -> Qle_minus_iff in Hx. + apply Qle_shift_div_l; auto with *. + replace LHS with 0 by ring. + apply: mult_resp_nonneg; simpl; auto with *. + unfold Qle;simpl. + auto with *. + rewrite -> Hlr'. + setoid_replace (r-r) with 0 by ring. + unfold Qdiv. + change (/0) with 0. + ring_simplify. auto with *. -rewrite -> Hlr'. -setoid_replace (r-r) with 0 by ring. -unfold Qdiv. -change (/0) with 0. -ring_simplify. -auto with *. Qed. Definition rasterize1_boundR : forall n (x:Q), x < r -> (rasterize1 (S n) x < (S n))%Z. -intros n x Hx. -cut (rasterize1 (S n) x < (S n)). - generalize (S n). - intros m. - unfold Qlt. - simpl. - auto with *. -unfold rasterize1. -eapply Qle_lt_trans. - apply Qfloor_le. -destruct (Qle_lt_or_eq _ _ Hlr) as [Hlr' | Hlr']. - rewrite -> Qlt_minus_iff in Hlr'. - apply Qlt_shift_div_r. +Proof. + intros n x Hx. + cut (rasterize1 (S n) x < (S n)). + generalize (S n). + intros m. + unfold Qlt. + simpl. auto with *. - apply: mult_resp_less_lft;simpl; auto with *. - rewrite Qlt_minus_iff. - replace RHS with (r + - x) by ring. - rewrite <- Qlt_minus_iff; auto. -rewrite Hlr'. -setoid_replace (r-r) with 0 by ring. -unfold Qdiv. -change (/0) with 0. -replace LHS with 0 by ring. -auto with *. + unfold rasterize1. + eapply Qle_lt_trans. + apply Qfloor_le. + destruct (Qle_lt_or_eq _ _ Hlr) as [Hlr' | Hlr']. + rewrite -> Qlt_minus_iff in Hlr'. + apply Qlt_shift_div_r. + auto with *. + apply: mult_resp_less_lft;simpl; auto with *. + rewrite Qlt_minus_iff. + replace RHS with (r + - x) by ring. + rewrite <- Qlt_minus_iff; auto. + rewrite Hlr'. + setoid_replace (r-r) with 0 by ring. + unfold Qdiv. + change (/0) with 0. + replace LHS with 0 by ring. + auto with *. Qed. -Lemma UniformPartition_fine : forall n x, +Lemma UniformPartition_fine : forall n x, l <= x <= r -> {y | In y (UniformPartition (S n)) /\ Qabs (x - y) <= ((r-l)/(2*(S n)))}. Proof. -intros n x Hx. -destruct (Qlt_le_dec_fast x r). - exists (f (S n) (rasterize1 (S n) x)). - abstract ( - destruct Hx as [Hlx Hxr]; - split; - [apply in_map; - rewrite UniformPartitionZ; - split; - [apply rasterize1_boundL; auto - |apply rasterize1_boundR; auto] - |apply rasterize1_close; - apply Qle_lt_trans with x; auto]). -exists (f (S n) n). -abstract ( -split; -[apply: in_map; - rewrite UniformPartitionZ; - rewrite inj_S; - auto with *|]; -destruct Hx as [_ Hx]; -(setoid_replace x with r - by apply Qle_antisym; auto with *); -unfold f; -change (2*S n #1) with (2*S n); -change (2*n + 1#1) with ((2*n + 1)%Z:Q); -rewrite (inj_S n); -unfold Zsucc; -do 2 rewrite injz_plus; -(setoid_replace ((2%positive * n)%Z:Q) with (2*n) - by unfold Qeq; simpl; auto with *); -(setoid_replace (r - (l + (r - l) * (2 * n + 1%positive) / (2 * (n + 1%positive)))) - with (((r-l) / (2 * (n + 1%positive)))) - by field; unfold Qeq; simpl; auto with *); -rewrite Qabs_pos;[apply Qle_refl|]; -apply Qle_shift_div_l; -[apply: mult_resp_pos; simpl;auto with *; - unfold Qlt; simpl; auto with *|]; -(replace LHS with 0 by ring); -rewrite -> Qle_minus_iff in Hlr; -auto). + intros n x Hx. + destruct (Qlt_le_dec_fast x r). + exists (f (S n) (rasterize1 (S n) x)). + abstract ( destruct Hx as [Hlx Hxr]; split; [apply in_map; rewrite UniformPartitionZ; split; + [apply rasterize1_boundL; auto |apply rasterize1_boundR; auto] |apply rasterize1_close; + apply Qle_lt_trans with x; auto]). + exists (f (S n) n). + abstract ( split; [apply: in_map; rewrite UniformPartitionZ; rewrite inj_S; auto with *|]; + destruct Hx as [_ Hx]; (setoid_replace x with r by apply Qle_antisym; auto with *); unfold f; + change (2*S n #1) with (2*S n); change (2*n + 1#1) with ((2*n + 1)%Z:Q); rewrite (inj_S n); + unfold Zsucc; do 2 rewrite injz_plus; (setoid_replace ((2%positive * n)%Z:Q) with (2*n) + by unfold Qeq; simpl; auto with *); + (setoid_replace (r - (l + (r - l) * (2 * n + 1%positive) / (2 * (n + 1%positive)))) + with (((r-l) / (2 * (n + 1%positive)))) by field; unfold Qeq; simpl; auto with *); + rewrite Qabs_pos;[apply Qle_refl|]; apply Qle_shift_div_l; + [apply: mult_resp_pos; simpl;auto with *; unfold Qlt; simpl; auto with *|]; + (replace LHS with 0 by ring); rewrite -> Qle_minus_iff in Hlr; auto). Defined. (** Construct the compact set. *) Lemma CompactIntervalQ_nat : forall (e:Qpos), (0 <= Qceiling ((r-l)/(2*e)))%Z. Proof. -intros e. -change (0%Z) with (Qceiling 0). -apply Qceiling_resp_le. -apply Qle_shift_div_l. - auto with *. -rewrite -> Qle_minus_iff in Hlr. -Qauto_le. + intros e. + change (0%Z) with (Qceiling 0). + apply Qceiling_resp_le. + apply Qle_shift_div_l. + auto with *. + rewrite -> Qle_minus_iff in Hlr. + Qauto_le. Qed. Definition CompactIntervalQ_raw (e:QposInf) : FinEnum stableQ := match e with | QposInfinity => nil -| Qpos2QposInf e' => +| Qpos2QposInf e' => UniformPartition (max 1 (Z_to_nat (CompactIntervalQ_nat e'))) end. Lemma CompactIntervalQ_prf : is_RegularFunction CompactIntervalQ_raw. Proof. -cut (forall e1 e2, - hemiMetric Q_as_MetricSpace (e1 + e2) - (fun a : Q_as_MetricSpace => - InFinEnumC a (CompactIntervalQ_raw e1)) - (fun a : Q_as_MetricSpace => - InFinEnumC a (CompactIntervalQ_raw e2))). - intros Z e1 e2. - split. - apply Z. - eapply hemiMetric_wd1;[|apply Z]. - QposRing. -intros e1 e2 a Ha. -assert (l <= a <= r). - unfold CompactIntervalQ_raw in Ha. - set (e1':=(max 1 (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e1))) - (CompactIntervalQ_nat e1)))) in *. - assert (L:=UniformPartition_inside e1'). - induction (UniformPartition e1'). - contradiction. - destruct (Qeq_dec a a0) as [A|A]. - rewrite A. - auto with *. - apply IHl0; auto with *. - destruct Ha as [G | Ha | Ha] using orC_ind. - auto using InFinEnumC_stable. - elim A. + cut (forall e1 e2, hemiMetric Q_as_MetricSpace (e1 + e2) (fun a : Q_as_MetricSpace => + InFinEnumC a (CompactIntervalQ_raw e1)) (fun a : Q_as_MetricSpace => + InFinEnumC a (CompactIntervalQ_raw e2))). + intros Z e1 e2. + split. + apply Z. + eapply hemiMetric_wd1;[|apply Z]. + QposRing. + intros e1 e2 a Ha. + assert (l <= a <= r). + unfold CompactIntervalQ_raw in Ha. + set (e1':=(max 1 (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e1))) + (CompactIntervalQ_nat e1)))) in *. + assert (L:=UniformPartition_inside e1'). + induction (UniformPartition e1'). + contradiction. + destruct (Qeq_dec a a0) as [A|A]. + rewrite A. + auto with *. + apply IHl0; auto with *. + destruct Ha as [G | Ha | Ha] using orC_ind. + auto using InFinEnumC_stable. + elim A. + assumption. assumption. - assumption. -unfold CompactIntervalQ_raw. -set (e2':=(max 1 (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) - (CompactIntervalQ_nat e2)))). -assert (L:=UniformPartition_fine (pred e2') H). -rewrite S_predn in L; -[|intros Z; symmetry in Z;revert Z; - apply lt_O_neq; - unfold e2'; - apply lt_le_trans with 1%nat; auto with *]. -destruct L as [y [Hy0 Hy1]]. -apply existsWeaken. -exists y. -split. - auto using InFinEnumC_weaken. -simpl. -rewrite Qball_Qabs. -eapply Qle_trans;[apply Hy1|]. -apply Qle_trans with e2. - apply Qle_shift_div_r. - destruct e2'; auto with *. - replace RHS with (e2'*(2%positive*e2)) by ring. - rewrite <- (Qinv_involutive (2%positive*e2)). - apply Qle_shift_div_l; auto with *. - change ( (r - l) / (2%positive * e2) <= e2'). - unfold e2'. - generalize (CompactIntervalQ_nat e2). - generalize ((r - l) / (2%positive * e2)). - intros q He. - apply Qle_trans with (Qceiling q); auto with *. - rewrite inj_max. - unfold Qle. + unfold CompactIntervalQ_raw. + set (e2':=(max 1 (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) (CompactIntervalQ_nat e2)))). + assert (L:=UniformPartition_fine (pred e2') H). + rewrite S_predn in L; [|intros Z; symmetry in Z;revert Z; apply lt_O_neq; unfold e2'; + apply lt_le_trans with 1%nat; auto with *]. + destruct L as [y [Hy0 Hy1]]. + apply existsWeaken. + exists y. + split. + auto using InFinEnumC_weaken. simpl. - ring_simplify. - eapply Zle_trans;[|apply Zle_max_r]. - rewrite <- Z_to_nat_correct. - auto with *. -autorewrite with QposElim. -Qauto_le. + rewrite Qball_Qabs. + eapply Qle_trans;[apply Hy1|]. + apply Qle_trans with e2. + apply Qle_shift_div_r. + destruct e2'; auto with *. + replace RHS with (e2'*(2%positive*e2)) by ring. + rewrite <- (Qinv_involutive (2%positive*e2)). + apply Qle_shift_div_l; auto with *. + change ( (r - l) / (2%positive * e2) <= e2'). + unfold e2'. + generalize (CompactIntervalQ_nat e2). + generalize ((r - l) / (2%positive * e2)). + intros q He. + apply Qle_trans with (Qceiling q); auto with *. + rewrite inj_max. + unfold Qle. + simpl. + ring_simplify. + eapply Zle_trans;[|apply Zle_max_r]. + rewrite <- Z_to_nat_correct. + auto with *. + autorewrite with QposElim. + Qauto_le. Qed. Definition CompactIntervalQ : Compact stableQ := @@ -373,23 +338,49 @@ Opaque max. Lemma CompactIntervalQ_correct1 : forall (x:CR), inCompact x CompactIntervalQ -> ('l <= x /\ x <= 'r). Proof. -intros x Hx. -split. + intros x Hx. + split. + unfold CRle. + setoid_replace (x - 'l)%CR with ('(-l) + x)%CR by ring. + rewrite CRplus_translate. + intros e. + simpl. + rewrite Qle_minus_iff. + replace RHS with (e + - (l - approximate x e))%Q by ring. + rewrite <- Qle_minus_iff. + apply Qle_closed. + intros e2. + assert (L:=Hx e e2). + simpl in L. + set (a:=(max 1 (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) + (CompactIntervalQ_nat e2)))) in *. + assert (L0:=UniformPartition_inside a). + induction (UniformPartition a). + contradiction. + destruct L as [ G | L | L] using orC_ind. + auto with *. + rewrite -> Qball_Qabs in L. + eapply Qle_trans;[|apply L]. + rewrite <- Qabs_opp. + eapply Qle_trans;[|apply Qle_Qabs]. + rewrite Qle_minus_iff. + replace RHS with (a0 + - l)%Q by ring. + rewrite <- Qle_minus_iff. + destruct (L0 a0); auto with *. + apply IHl0; auto with *. unfold CRle. - setoid_replace (x - 'l)%CR with ('(-l) + x)%CR by ring. rewrite CRplus_translate. intros e. simpl. rewrite Qle_minus_iff. - replace RHS with (e + - (l - approximate x e))%Q by ring. + replace RHS with (e + - (approximate x e - r))%Q by ring. rewrite <- Qle_minus_iff. apply Qle_closed. intros e2. assert (L:=Hx e e2). simpl in L. - set (a:=(max 1 - (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) - (CompactIntervalQ_nat e2)))) in *. + set (a:=(max 1 (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) + (CompactIntervalQ_nat e2)))) in *. assert (L0:=UniformPartition_inside a). induction (UniformPartition a). contradiction. @@ -397,145 +388,114 @@ split. auto with *. rewrite -> Qball_Qabs in L. eapply Qle_trans;[|apply L]. - rewrite <- Qabs_opp. eapply Qle_trans;[|apply Qle_Qabs]. rewrite Qle_minus_iff. - replace RHS with (a0 + - l)%Q by ring. + replace RHS with (r + - a0)%Q by ring. rewrite <- Qle_minus_iff. destruct (L0 a0); auto with *. apply IHl0; auto with *. -unfold CRle. -rewrite CRplus_translate. -intros e. -simpl. -rewrite Qle_minus_iff. -replace RHS with (e + - (approximate x e - r))%Q by ring. -rewrite <- Qle_minus_iff. -apply Qle_closed. -intros e2. -assert (L:=Hx e e2). -simpl in L. -set (a:=(max 1 - (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) - (CompactIntervalQ_nat e2)))) in *. -assert (L0:=UniformPartition_inside a). -induction (UniformPartition a). - contradiction. -destruct L as [ G | L | L] using orC_ind. - auto with *. - rewrite -> Qball_Qabs in L. - eapply Qle_trans;[|apply L]. - eapply Qle_trans;[|apply Qle_Qabs]. - rewrite Qle_minus_iff. - replace RHS with (r + - a0)%Q by ring. - rewrite <- Qle_minus_iff. - destruct (L0 a0); auto with *. -apply IHl0; auto with *. Qed. Lemma CompactIntervalQ_correct2 : forall (x:CR), ('l <= x /\ x <= 'r) -> inCompact x CompactIntervalQ. Proof. -intros x [Hlx Hxr] e1 e2. -simpl. -set (y:= (Qmax (Qmin (approximate x e1) r) l)). -apply (@almostIn_triangle_l _ stableQ e1 e2 (approximate x e1) y). - unfold y. - apply Qmin_case. - apply Qmax_case. - auto with *. - intros H _. + intros x [Hlx Hxr] e1 e2. + simpl. + set (y:= (Qmax (Qmin (approximate x e1) r) l)). + apply (@almostIn_triangle_l _ stableQ e1 e2 (approximate x e1) y). + unfold y. + apply Qmin_case. + apply Qmax_case. + auto with *. + intros H _. + split; simpl. + unfold CRle in Hlx. + setoid_replace (x - 'l) with ('(-l) + x) in Hlx by ring. + rewrite -> CRplus_translate in Hlx. + assert (H0:=Hlx e1). + simpl in H0. + clear - H0. + rewrite -> Qle_minus_iff in *. + replace RHS with (-l + approximate x e1 + - - e1)%Q by ring. + auto. + apply Qle_trans with 0; auto with *. + clear - H. + rewrite -> Qle_minus_iff in *. + replace RHS with (l + - approximate x e1)%Q by ring. + auto. + intros H. + rewrite -> Qle_max_l in Hlr. + simpl. + rewrite Hlr. split; simpl. - unfold CRle in Hlx. - setoid_replace (x - 'l) with ('(-l) + x) in Hlx by ring. - rewrite -> CRplus_translate in Hlx. - assert (H0:=Hlx e1). - simpl in H0. - clear - H0. - rewrite -> Qle_minus_iff in *. - replace RHS with (-l + approximate x e1 + - - e1)%Q by ring. + clear - H. + apply Qle_trans with 0; auto with *. + rewrite -> Qle_minus_iff in *. + replace RHS with (approximate x e1 + - r)%Q by ring. auto. - apply Qle_trans with 0; auto with *. - clear - H. + unfold CRle in Hxr. + rewrite -> CRplus_translate in Hxr. + assert (H0:=Hxr e1). + simpl in H0. + clear - H0. rewrite -> Qle_minus_iff in *. - replace RHS with (l + - approximate x e1)%Q by ring. + replace RHS with ( r + - approximate x e1 + - - e1)%Q by ring. auto. - intros H. - rewrite -> Qle_max_l in Hlr. - simpl. - rewrite Hlr. - split; simpl. - clear - H. - apply Qle_trans with 0; auto with *. - rewrite -> Qle_minus_iff in *. - replace RHS with (approximate x e1 + - r)%Q by ring. - auto. - unfold CRle in Hxr. - rewrite -> CRplus_translate in Hxr. - assert (H0:=Hxr e1). - simpl in H0. - clear - H0. - rewrite -> Qle_minus_iff in *. - replace RHS with ( r + - approximate x e1 + - - e1)%Q by ring. - auto. -assert (L: l <= y <= r). - unfold y. - auto with *. -set (n:=(max 1 - (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) - (CompactIntervalQ_nat e2)))). -destruct (UniformPartition_fine (pred n) L) as [z Hz]. -assert (L0:(0 < 2*n)%Q). - Transparent max. - simpl. - destruct ( Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) - (CompactIntervalQ_nat e2)); auto with *. -rewrite S_predn in Hz. - clear - Hz L0. - destruct Hz as [Hz0 Hz1]. - induction (UniformPartition n). - contradiction. - destruct Hz0 as [Hz0 | Hz0]; - apply orWeaken. - left. - rewrite Hz0. - simpl. - rewrite Qball_Qabs. - eapply Qle_trans;[apply Hz1|]. - apply Qle_shift_div_r;auto. - replace RHS with (n*(2%positive*e2))%Q by ring. - rewrite <- (Qinv_involutive (2%positive*e2)). - apply Qle_shift_div_l; auto with *. - unfold n. - fold ((r - l) / (2%positive * e2)). - generalize (CompactIntervalQ_nat e2). - generalize ((r - l) / (2%positive * e2)). - intros q He. - apply Qle_trans with (Qceiling q); auto with *. - rewrite inj_max. - unfold Qle. - simpl. - ring_simplify. - eapply Zle_trans;[|apply Zle_max_r]. - rewrite <- Z_to_nat_correct. + assert (L: l <= y <= r). + unfold y. auto with *. - right. - apply IHl0. - auto. -clear - L0. -intros H. -rewrite H in L0. -discriminate L0. + set (n:=(max 1 (Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) (CompactIntervalQ_nat e2)))). + destruct (UniformPartition_fine (pred n) L) as [z Hz]. + assert (L0:(0 < 2*n)%Q). + Transparent max. + simpl. + destruct ( Z_to_nat (z:=Qceiling ((r - l) / (2%positive * e2))) + (CompactIntervalQ_nat e2)); auto with *. + rewrite S_predn in Hz. + clear - Hz L0. + destruct Hz as [Hz0 Hz1]. + induction (UniformPartition n). + contradiction. + destruct Hz0 as [Hz0 | Hz0]; apply orWeaken. + left. + rewrite Hz0. + simpl. + rewrite Qball_Qabs. + eapply Qle_trans;[apply Hz1|]. + apply Qle_shift_div_r;auto. + replace RHS with (n*(2%positive*e2))%Q by ring. + rewrite <- (Qinv_involutive (2%positive*e2)). + apply Qle_shift_div_l; auto with *. + unfold n. + fold ((r - l) / (2%positive * e2)). + generalize (CompactIntervalQ_nat e2). + generalize ((r - l) / (2%positive * e2)). + intros q He. + apply Qle_trans with (Qceiling q); auto with *. + rewrite inj_max. + unfold Qle. + simpl. + ring_simplify. + eapply Zle_trans;[|apply Zle_max_r]. + rewrite <- Z_to_nat_correct. + auto with *. + right. + apply IHl0. + auto. + clear - L0. + intros H. + rewrite H in L0. + discriminate L0. Qed. Lemma CompactIntervalQ_bonus_correct : forall e x, In x (approximate CompactIntervalQ e) -> (l <= x <= r). Proof. -intros [e|] x H. - simpl in H. - apply: UniformPartition_inside. - apply H. -elim H. + intros [e|] x H. + simpl in H. + apply: UniformPartition_inside. + apply H. + elim H. Qed. End Interval. diff --git a/reals/fast/LazyNat.v b/reals/fast/LazyNat.v index c072ce156..d22ff1677 100644 --- a/reals/fast/LazyNat.v +++ b/reals/fast/LazyNat.v @@ -24,7 +24,7 @@ Require Export BinPos. (** * Lazy Nat This s a lazified version of the natural number that allow one to delay -computation until demanded. This is useful for large natural numbers +computation until demanded. This is useful for large natural numbers (often upper bounds) where only a small number of terms are actually need for compuation. *) @@ -55,7 +55,7 @@ end. Lemma LazifyPred : forall n, LazifyNat (pred n) = LazyPred (LazifyNat n). Proof. -induction n; reflexivity. + induction n; reflexivity. Qed. (** @@ -69,12 +69,12 @@ Fixpoint LazyPlus (n m : LazyNat) {struct n} : LazyNat := Lemma LazifyPlus : forall n m, (LazifyNat (n + m) = LazyPlus (LazifyNat n) (LazifyNat m))%nat. Proof. -induction n. -reflexivity. -simpl. -intros m. -rewrite IHn. -reflexivity. + induction n. + reflexivity. + simpl. + intros m. + rewrite IHn. + reflexivity. Qed. (** @@ -89,9 +89,7 @@ Fixpoint Pmult_LazyNat (x:positive) (pow2:LazyNat) {struct x} : LazyNat := Lemma LazifyPmult_LazyNat : forall x pow2, LazifyNat (Pmult_nat x pow2) = Pmult_LazyNat x (LazifyNat pow2). Proof. -induction x; simpl; intros pow2; -repeat (rewrite LazifyPlus||rewrite IHx); -reflexivity. + induction x; simpl; intros pow2; repeat (rewrite LazifyPlus||rewrite IHx); reflexivity. Qed. (** Convert a positive to a lazy nat. This is the most common way of @@ -100,8 +98,8 @@ Definition LazyNat_of_P (x:positive) := Pmult_LazyNat x (LazyS (fun _ => LazyO)) Lemma LazifyNat_of_P : forall x, LazifyNat (nat_of_P x) = LazyNat_of_P x. Proof. -intros x. -refine (LazifyPmult_LazyNat _ _). + intros x. + refine (LazifyPmult_LazyNat _ _). Qed. (* begin hide *) Hint Rewrite <- LazifyNat_of_P LazifyPmult_LazyNat LazifyPlus LazifyPred : UnLazyNat. diff --git a/reals/fast/ModulusDerivative.v b/reals/fast/ModulusDerivative.v index 71a151764..d95c19e21 100644 --- a/reals/fast/ModulusDerivative.v +++ b/reals/fast/ModulusDerivative.v @@ -38,14 +38,14 @@ CR is uniformly continuous with modulus [fun e => e/M] where M is some upper bound on the absolute value of the derivative. *) Variable l r : option Q. -Hypothesis Hlr : +Hypothesis Hlr : match l,r with | None, _ => True | _, None => True | Some l', Some r' => (l' realline | Some l', None => closel (inj_Q _ l') @@ -55,13 +55,13 @@ end. Let properI : proper I. Proof. -destruct l as [|l];destruct r as [|r]; try constructor. -simpl. -apply inj_Q_less. -assumption. + destruct l as [|l];destruct r as [|r]; try constructor. + simpl. + apply inj_Q_less. + assumption. Qed. -Let clamp (q:Q) := +Let clamp (q:Q) := match l,r with | None, None => q | Some l', None => QboundBelow_uc l' q @@ -71,8 +71,7 @@ end. Lemma ball_clamp : forall e a b, ball e a b -> ball e (clamp a) (clamp b). Proof. -destruct l as [|l]; destruct r as [|r]; unfold clamp; -intros e a b Hab; try apply uc_prf; apply Hab. + destruct l as [|l]; destruct r as [|r]; unfold clamp; intros e a b Hab; try apply uc_prf; apply Hab. Qed. Variable f f' : PartFunct IR. @@ -88,65 +87,61 @@ Hypothesis Hc : forall x Hx, I x -> (AbsIR (f' x Hx)[<=](inj_Q _ (c:Q))). Lemma is_UniformlyContinuousD : is_UniformlyContinuousFunction (fun x => g (clamp x)) (Qscale_modulus c). Proof. -intros e a b Hab. -assert (X:forall x, I (inj_Q _ (clamp x))). -clear -I Hlr. -intros x. -destruct l as [|l];destruct r as [|r]; try split; - unfold clamp; - apply: inj_Q_leEq; simpl; - auto with *. -assert (Y:=(fun a=> (Hg _ (Derivative_imp_inc _ _ _ _ Hf _ (X a)) (X a)))). -do 2 rewrite Y. -rewrite <- CRAbsSmall_ball. -unfold cg_minus. -simpl. -stepl (IRasCR (inj_Q IR (e:Q))) by simpl; apply IR_inj_Q_as_CR. -stepr (IRasCR - ((f (inj_Q IR (clamp a)) - (Derivative_imp_inc I properI f f' Hf (inj_Q IR (clamp a)) (X a)))[-] - (f (inj_Q IR (clamp b)) - (Derivative_imp_inc I properI f f' Hf (inj_Q IR (clamp b)) (X b))))) - by simpl; apply IR_minus_as_CR. -rewrite <- IR_AbsSmall_as_CR. -apply AbsIR_imp_AbsSmall. -eapply leEq_transitive;[eapply Law_of_the_Mean_Abs_ineq;try apply Hf;try apply X|]. - intros x H Hx. - apply Hc. - eapply included_interval;[| |apply H];apply X. -revert Hab. -apply Qscale_modulus_elim. - intros Hc0 _. - stepl (inj_Q IR (nring 0)). - apply inj_Q_leEq. - simpl; auto with *. - setoid_replace (inj_Q IR c) with (inj_Q IR (nring 0)). - rewrite inj_Q_nring. - rational. - apply inj_Q_wd. - auto. -intros y Hyc Hab. -stepr ((inj_Q IR (e/y)%Q[*](inj_Q _ (y:Q)))). -apply mult_resp_leEq_both. - eapply leEq_transitive. - apply AbsIR_nonneg. - apply (Hc _ (Derivative_imp_inc' I properI f f' Hf (inj_Q IR (clamp a)) (X a))). - apply X. - apply AbsIR_nonneg. - apply inj_Q_leEq. - destruct Hyc; auto. - apply AbsSmall_imp_AbsIR. - stepr (inj_Q IR (clamp a - clamp b)%Q) by apply inj_Q_minus. - apply inj_Q_AbsSmall. - change (ball y (clamp a) (clamp b)). - apply ball_clamp. - auto. -assert (Z:Zero[<]inj_Q IR (y:Q)). - (stepl (inj_Q IR (Zero:Q)) by apply (inj_Q_nring IR 0)); apply inj_Q_less; apply Qpos_prf. -apply: eq_transitive. - apply mult_wdl. - apply (inj_Q_div IR e _ (pos_ap_zero _ _ Z)). -apply div_1. + intros e a b Hab. + assert (X:forall x, I (inj_Q _ (clamp x))). + clear -I Hlr. + intros x. + destruct l as [|l];destruct r as [|r]; try split; unfold clamp; apply: inj_Q_leEq; simpl; + auto with *. + assert (Y:=(fun a=> (Hg _ (Derivative_imp_inc _ _ _ _ Hf _ (X a)) (X a)))). + do 2 rewrite Y. + rewrite <- CRAbsSmall_ball. + unfold cg_minus. + simpl. + stepl (IRasCR (inj_Q IR (e:Q))) by simpl; apply IR_inj_Q_as_CR. + stepr (IRasCR ((f (inj_Q IR (clamp a)) + (Derivative_imp_inc I properI f f' Hf (inj_Q IR (clamp a)) (X a)))[-] (f (inj_Q IR (clamp b)) + (Derivative_imp_inc I properI f f' Hf (inj_Q IR (clamp b)) (X b))))) + by simpl; apply IR_minus_as_CR. + rewrite <- IR_AbsSmall_as_CR. + apply AbsIR_imp_AbsSmall. + eapply leEq_transitive;[eapply Law_of_the_Mean_Abs_ineq;try apply Hf;try apply X|]. + intros x H Hx. + apply Hc. + eapply included_interval;[| |apply H];apply X. + revert Hab. + apply Qscale_modulus_elim. + intros Hc0 _. + stepl (inj_Q IR (nring 0)). + apply inj_Q_leEq. + simpl; auto with *. + setoid_replace (inj_Q IR c) with (inj_Q IR (nring 0)). + rewrite inj_Q_nring. + rational. + apply inj_Q_wd. + auto. + intros y Hyc Hab. + stepr ((inj_Q IR (e/y)%Q[*](inj_Q _ (y:Q)))). + apply mult_resp_leEq_both. + eapply leEq_transitive. + apply AbsIR_nonneg. + apply (Hc _ (Derivative_imp_inc' I properI f f' Hf (inj_Q IR (clamp a)) (X a))). + apply X. + apply AbsIR_nonneg. + apply inj_Q_leEq. + destruct Hyc; auto. + apply AbsSmall_imp_AbsIR. + stepr (inj_Q IR (clamp a - clamp b)%Q) by apply inj_Q_minus. + apply inj_Q_AbsSmall. + change (ball y (clamp a) (clamp b)). + apply ball_clamp. + auto. + assert (Z:Zero[<]inj_Q IR (y:Q)). + (stepl (inj_Q IR (Zero:Q)) by apply (inj_Q_nring IR 0)); apply inj_Q_less; apply Qpos_prf. + apply: eq_transitive. + apply mult_wdl. + apply (inj_Q_div IR e _ (pos_ap_zero _ _ Z)). + apply div_1. Qed. End GeneralCase. @@ -159,132 +154,129 @@ Lemma is_UniformlyContinuousD_Q (forall (x : Q) (Hx : Dom f' (inj_Q IR x)), I (inj_Q IR x) -> AbsIR (f' (inj_Q IR x) Hx)[<=]inj_Q IR (c:Q)) -> is_UniformlyContinuousFunction (fun x : Q_as_MetricSpace => g (clamp x)) (Qscale_modulus c). Proof. -intros g Hg c Hc. -intros e a b Hab. -rewrite <- ball_Cunit. -generalize e a b Hab; clear e a b Hab. -change (is_UniformlyContinuousFunction - (fun x : Q_as_MetricSpace => ((fun y => '(g y)) (clamp x)))%CR (Qscale_modulus c)). -apply is_UniformlyContinuousD. - intros q Hq H. - rewrite <- IR_inj_Q_as_CR. - apply IRasCR_wd. - apply Hg. - assumption. -intros x Hx HI. -rstepr (Zero[+]inj_Q IR c). -apply shift_leEq_plus. -apply approach_zero_weak. -intros e He. -assert (X:Derivative_I - (proper_compact_in_interval' I properI x HI - (compact_compact_in_interval I properI x HI)) f f'). - apply (included_imp_Derivative) with I properI; try assumption. - eapply included_trans. - apply iprop_compact_in_interval_inc1. - apply included_compact_in_interval. -set (LI' := (Lend (compact_compact_in_interval I properI x HI))). -set (RI' := (Rend (compact_compact_in_interval I properI x HI))). -set (I':=(less_leEq IR LI' RI' - (proper_compact_in_interval' I properI x HI - (compact_compact_in_interval I properI x HI)))). -assert (X':Continuous_I I' (FAbs f')). - apply Continuous_I_abs. - apply (deriv_imp_contin'_I _ _ _ _ _ (less_leEq _ _ _ (proper_compact_in_interval' I properI x HI - (compact_compact_in_interval I properI x HI))) X). -clear X. -destruct (contin_prop _ _ _ _ X' _ (pos_div_two _ _ He)) as [d Hd Hd0]. -destruct (iprop_compact_in_interval' _ properI x HI _ I') as [c0 c1]. -assert (Z:~((LI'[<]x or x[<]RI')->False)). - intro H. - fold LI' in c0. - fold RI' in c1. - apply (leEq_less_or_equal _ _ _ c0). - intros [H0|H0];[tauto|]. - apply (leEq_less_or_equal _ _ _ c1). - intros [H1|H1];[tauto|]. - generalize (proper_compact_in_interval' I properI x HI - (compact_compact_in_interval I properI x HI)). - change (Not (LI'[<]RI')). + intros g Hg c Hc. + intros e a b Hab. + rewrite <- ball_Cunit. + generalize e a b Hab; clear e a b Hab. + change (is_UniformlyContinuousFunction + (fun x : Q_as_MetricSpace => ((fun y => '(g y)) (clamp x)))%CR (Qscale_modulus c)). + apply is_UniformlyContinuousD. + intros q Hq H. + rewrite <- IR_inj_Q_as_CR. + apply IRasCR_wd. + apply Hg. + assumption. + intros x Hx HI. + rstepr (Zero[+]inj_Q IR c). + apply shift_leEq_plus. + apply approach_zero_weak. + intros e He. + assert (X:Derivative_I (proper_compact_in_interval' I properI x HI + (compact_compact_in_interval I properI x HI)) f f'). + apply (included_imp_Derivative) with I properI; try assumption. + eapply included_trans. + apply iprop_compact_in_interval_inc1. + apply included_compact_in_interval. + set (LI' := (Lend (compact_compact_in_interval I properI x HI))). + set (RI' := (Rend (compact_compact_in_interval I properI x HI))). + set (I':=(less_leEq IR LI' RI' (proper_compact_in_interval' I properI x HI + (compact_compact_in_interval I properI x HI)))). + assert (X':Continuous_I I' (FAbs f')). + apply Continuous_I_abs. + apply (deriv_imp_contin'_I _ _ _ _ _ (less_leEq _ _ _ (proper_compact_in_interval' I properI x HI + (compact_compact_in_interval I properI x HI))) X). + clear X. + destruct (contin_prop _ _ _ _ X' _ (pos_div_two _ _ He)) as [d Hd Hd0]. + destruct (iprop_compact_in_interval' _ properI x HI _ I') as [c0 c1]. + assert (Z:~((LI'[<]x or x[<]RI')->False)). + intro H. + fold LI' in c0. + fold RI' in c1. + apply (leEq_less_or_equal _ _ _ c0). + intros [H0|H0];[tauto|]. + apply (leEq_less_or_equal _ _ _ c1). + intros [H1|H1];[tauto|]. + generalize (proper_compact_in_interval' I properI x HI (compact_compact_in_interval I properI x HI)). + change (Not (LI'[<]RI')). + rewrite <- leEq_def. + rewrite -> H0, <- H1. + apply leEq_reflexive. + rewrite leEq_def. + intros Z0. + apply Z. + intros Z'. + revert Z0. + change (Not (e[<]AbsIR (f' x Hx)[-]inj_Q IR c)). rewrite <- leEq_def. - rewrite -> H0, <- H1. - apply leEq_reflexive. -rewrite leEq_def. -intros Z0. -apply Z. -intros Z'. -revert Z0. -change (Not (e[<]AbsIR (f' x Hx)[-]inj_Q IR c)). -rewrite <- leEq_def. -clear Z. -assert (J:Max LI' (x[-]d)[<]Min RI' (x[+]d)). - destruct Z' as [Z'|Z']. - apply less_leEq_trans with x. - apply Max_less; auto. + clear Z. + assert (J:Max LI' (x[-]d)[<]Min RI' (x[+]d)). + destruct Z' as [Z'|Z']. + apply less_leEq_trans with x. + apply Max_less; auto. + rstepr (x[-]Zero). + apply minus_resp_less_rht. + auto. + apply leEq_Min; auto with *. + rstepl (x[+]Zero). + apply plus_resp_leEq_lft. + apply less_leEq. + auto with *. + apply leEq_less_trans with x. + apply Max_leEq; auto. rstepr (x[-]Zero). - apply minus_resp_less_rht. + apply minus_resp_leEq_rht. + apply less_leEq. auto. - apply leEq_Min; auto with *. + apply less_Min; auto with *. rstepl (x[+]Zero). - apply plus_resp_leEq_lft. - apply less_leEq. + apply plus_resp_less_lft. auto with *. - apply leEq_less_trans with x. - apply Max_leEq; auto. - rstepr (x[-]Zero). - apply minus_resp_leEq_rht. - apply less_leEq. + destruct (Q_dense_in_CReals' _ _ _ J) as [q Hq0 Hq1]. + rstepr (e[/]TwoNZ [+] e[/]TwoNZ). + assert (HI0 : Compact I' (inj_Q IR q)). + split; apply less_leEq. + eapply leEq_less_trans;[|apply Hq0]. + apply lft_leEq_Max. + eapply less_leEq_trans;[apply Hq1|]. + apply Min_leEq_lft. + assert (Hq:Dom f' (inj_Q IR q)). + apply (Derivative_imp_inc' _ _ _ _ Hf). + apply (included_compact_in_interval _ properI x HI). + apply (iprop_compact_in_interval_inc1 _ _ _ _ _ I'). auto. - apply less_Min; auto with *. - rstepl (x[+]Zero). - apply plus_resp_less_lft. - auto with *. -destruct (Q_dense_in_CReals' _ _ _ J) as [q Hq0 Hq1]. -rstepr (e[/]TwoNZ [+] e[/]TwoNZ). -assert (HI0 : Compact I' (inj_Q IR q)). - split; apply less_leEq. - eapply leEq_less_trans;[|apply Hq0]. - apply lft_leEq_Max. - eapply less_leEq_trans;[apply Hq1|]. - apply Min_leEq_lft. -assert (Hq:Dom f' (inj_Q IR q)). - apply (Derivative_imp_inc' _ _ _ _ Hf). - apply (included_compact_in_interval _ properI x HI). - apply (iprop_compact_in_interval_inc1 _ _ _ _ _ I'). - auto. -rstepl ((AbsIR (f' x Hx)[-]AbsIR (f' _ Hq))[+](AbsIR (f' _ Hq)[-]inj_Q IR c)). -apply plus_resp_leEq_both. - eapply leEq_transitive. - apply leEq_AbsIR. - assert (Z : Dom (FAbs f') x). - split;auto. - assert (Y : Dom (FAbs f') (inj_Q IR q)). - split;auto. - rewrite <- (FAbs_char _ _ Z). - rewrite <- (FAbs_char _ _ Y). - apply Hd0; auto. - apply iprop_compact_in_interval'. - apply AbsSmall_imp_AbsIR. - split. - apply shift_leEq_minus'. - rstepl (inj_Q IR q[-]d). + rstepl ((AbsIR (f' x Hx)[-]AbsIR (f' _ Hq))[+](AbsIR (f' _ Hq)[-]inj_Q IR c)). + apply plus_resp_leEq_both. + eapply leEq_transitive. + apply leEq_AbsIR. + assert (Z : Dom (FAbs f') x). + split;auto. + assert (Y : Dom (FAbs f') (inj_Q IR q)). + split;auto. + rewrite <- (FAbs_char _ _ Z). + rewrite <- (FAbs_char _ _ Y). + apply Hd0; auto. + apply iprop_compact_in_interval'. + apply AbsSmall_imp_AbsIR. + split. + apply shift_leEq_minus'. + rstepl (inj_Q IR q[-]d). + apply shift_minus_leEq. + apply less_leEq. + eapply less_leEq_trans;[apply Hq1|]. + apply Min_leEq_rht. apply shift_minus_leEq. + apply shift_leEq_plus'. apply less_leEq. - eapply less_leEq_trans;[apply Hq1|]. - apply Min_leEq_rht. + eapply leEq_less_trans;[|apply Hq0]. + apply rht_leEq_Max. + eapply leEq_transitive;[|apply nonneg_div_two;apply less_leEq; auto]. + clear - Hc HI0. apply shift_minus_leEq. - apply shift_leEq_plus'. - apply less_leEq. - eapply leEq_less_trans;[|apply Hq0]. - apply rht_leEq_Max. -eapply leEq_transitive;[|apply nonneg_div_two;apply less_leEq; auto]. -clear - Hc HI0. -apply shift_minus_leEq. -rstepr (inj_Q IR c). -apply Hc. -apply (included_compact_in_interval _ properI x HI). -apply (iprop_compact_in_interval_inc1 _ properI x HI _ I'). -auto. + rstepr (inj_Q IR c). + apply Hc. + apply (included_compact_in_interval _ properI x HI). + apply (iprop_compact_in_interval_inc1 _ properI x HI _ I'). + auto. Qed. -End Modulus. \ No newline at end of file +End Modulus. diff --git a/reals/fast/MultivariatePolynomials.v b/reals/fast/MultivariatePolynomials.v index 3672e8437..6564a6bc7 100644 --- a/reals/fast/MultivariatePolynomials.v +++ b/reals/fast/MultivariatePolynomials.v @@ -56,13 +56,12 @@ End MultivariatePolynomial. (* begin hide *) Add Parametric Morphism F n : (@MVP_apply F n) with signature (@st_eq (MultivariatePolynomial F n)) ==> (@eq _) ==> (@st_eq _) as MVP_apply_wd. Proof. -induction n; - intros x y Hxy z. - assumption. -simpl. -apply IHn. -rewrite Hxy. -reflexivity. + induction n; intros x y Hxy z. + assumption. + simpl. + apply IHn. + rewrite Hxy. + reflexivity. Qed. (* end hide *) @@ -70,85 +69,86 @@ Qed. Lemma zero_MVP_apply : forall F n v, MVP_apply F (Zero:MultivariatePolynomial F n) v[=]Zero. Proof. -induction v. + induction v. + reflexivity. + simpl. + rewrite <- IHv. reflexivity. -simpl. -rewrite <- IHv. -reflexivity. Qed. Lemma one_MVP_apply : forall F n v, MVP_apply F (One:MultivariatePolynomial F n) v[=]One. Proof. -induction v. + induction v. + reflexivity. + simpl. + rewrite <- IHv. + rewrite one_apply. reflexivity. -simpl. -rewrite <- IHv. -rewrite one_apply. -reflexivity. Qed. Lemma C_MVP_apply : forall F n q v, MVP_apply F (MVP_C_ F n q) v[=]q. Proof. -induction v. - reflexivity. -simpl. -rewrite c_apply. -assumption. + induction v. + reflexivity. + simpl. + rewrite c_apply. + assumption. Qed. Lemma MVP_plus_apply: forall F n (p q : MultivariatePolynomial F n) v, MVP_apply F (p[+]q) v [=] MVP_apply F p v[+]MVP_apply F q v. Proof. -induction v. - reflexivity. -simpl. -rewrite plus_apply. -apply IHv. + induction v. + reflexivity. + simpl. + rewrite plus_apply. + apply IHv. Qed. Lemma MVP_mult_apply: forall F n (p q : MultivariatePolynomial F n) v, MVP_apply F (p[*]q) v [=] MVP_apply F p v[*]MVP_apply F q v. Proof. -induction v. - reflexivity. -simpl. -rewrite mult_apply. -apply IHv. + induction v. + reflexivity. + simpl. + rewrite mult_apply. + apply IHv. Qed. Lemma MVP_c_mult_apply: forall F n (p : MultivariatePolynomial F n) c v, MVP_apply F (MVP_C_ _ _ c[*]p) v[=]c[*]MVP_apply F p v. Proof. -induction v. + induction v. + reflexivity. + simpl. + rewrite <- IHv. + rewrite c_mult_apply. reflexivity. -simpl. -rewrite <- IHv. -rewrite c_mult_apply. -reflexivity. Qed. Lemma MVP_apply_hom_strext : forall (F:CRing) n (v:vector F n), fun_strext (fun (p:MultivariatePolynomial F n) => MVP_apply _ p v). Proof. -induction n. - intros v x y. - simpl. - auto with *. -intros v x y H. -simpl in H. -destruct (csbf_strext _ _ _ _ _ _ _ _ (IHn _ _ _ H)) as [H0 | H0]. - assumption. -elim (ap_irreflexive _ _ H0). + induction n. + intros v x y. + simpl. + auto with *. + intros v x y H. + simpl in H. + destruct (csbf_strext _ _ _ _ _ _ _ _ (IHn _ _ _ H)) as [H0 | H0]. + assumption. + elim (ap_irreflexive _ _ H0). Defined. -Definition MVP_apply_hom_csf (F:CRing) n (v:vector F n) := +Definition MVP_apply_hom_csf (F:CRing) n (v:vector F n) := Build_CSetoid_fun _ _ _ (MVP_apply_hom_strext F v). Definition MVP_apply_hom (F:CRing) n (v:vector F n) : RingHom (MultivariatePolynomial F n) F. -intros F n v. -exists (MVP_apply_hom_csf F v). - intros x y; apply: MVP_plus_apply. - intros x y; apply: MVP_mult_apply. -apply: one_MVP_apply. +Proof. + intros F n v. + exists (MVP_apply_hom_csf F v). + intros x y; apply: MVP_plus_apply. + intros x y; apply: MVP_mult_apply. + apply: one_MVP_apply. Defined. (** [MVP_map] applies a ring homomorphism to the coefficents of a multivariable polynomial *) @@ -161,14 +161,14 @@ end. Lemma MVP_map_C_ : forall R S (f:RingHom R S) n c, MVP_map f n (MVP_C_ _ _ c)[=]MVP_C_ _ _ (f c). Proof. -induction n. - intros c; reflexivity. -intros c. -simpl. -change (cpoly_map (MVP_map f n) (_C_ (MVP_C_ R n c))[=]_C_ (MVP_C_ S n (f c))). -rewrite cpoly_map_C. -rewrite IHn. -reflexivity. + induction n. + intros c; reflexivity. + intros c. + simpl. + change (cpoly_map (MVP_map f n) (_C_ (MVP_C_ R n c))[=]_C_ (MVP_C_ S n (f c))). + rewrite cpoly_map_C. + rewrite IHn. + reflexivity. Qed. (* In practice we use the Bernstein coeffecients to bound the polynomials *) @@ -177,7 +177,7 @@ Fixpoint MVP_upperBound (n:nat) : MultivariatePolynomial Q_as_CRing n -> Q := match n return MultivariatePolynomial Q_as_CRing n -> Q with | O => fun x => x | (S n') => fun p => let (m,b) := BernsteinCoefficents (MVP_C_ Q_as_CRing n') p - in vector_rec _ (fun _ _ => Q) 0%Q + in vector_rec _ (fun _ _ => Q) 0%Q (fun c _ _ rec => Qmax (MVP_upperBound n' c) rec) m b end. @@ -186,7 +186,7 @@ Fixpoint MVP_lowerBound (n:nat) : MultivariatePolynomial Q_as_CRing n -> Q := match n return MultivariatePolynomial Q_as_CRing n -> Q with | O => fun x => x | (S n') => fun p => let (m,b) := BernsteinCoefficents (MVP_C_ Q_as_CRing n') p - in vector_rec _ (fun _ _ => Q) 0%Q + in vector_rec _ (fun _ _ => Q) 0%Q (fun c _ _ rec => Qmin (MVP_lowerBound n' c) rec) m b end. @@ -203,30 +203,27 @@ end. Lemma BernsteinApplyRingHom : forall R F (eta: RingHom R F) n i (H:(i <= n)%nat) a, (Bernstein F H) ! (eta a)[=](eta (Bernstein R H) ! a). Proof. -induction n. - simpl. - intros _ _ a. - do 2 rewrite one_apply. - auto with *. -intros [|i] H a; simpl;[|destruct (le_lt_eq_dec (S i) (S n) H)]; - autorewrite with apply ringHomPush; - repeat rewrite IHn; - reflexivity. -Qed. + induction n. + simpl. + intros _ _ a. + do 2 rewrite one_apply. + auto with *. + intros [|i] H a; simpl;[|destruct (le_lt_eq_dec (S i) (S n) H)]; autorewrite with apply ringHomPush; + repeat rewrite IHn; reflexivity. +Qed. Lemma MVP_BernsteinNonNeg : forall m n i (H:(i <= n)%nat) v (a:Q), 0 <= a -> a <= 1 -> 0 <= @MVP_apply Q_as_CRing m ((Bernstein _ H)!(MVP_C_ _ _ a)) v. Proof. -intros m n i H v a Ha0 Ha1. -induction v. - apply: BernsteinNonNeg; auto. -simpl. -replace RHS with (MVP_apply Q_as_CRing - (Bernstein _ H) ! (MVP_C_ Q_as_CRing n0 a) v). - apply IHv. -apply MVP_apply_wd;try reflexivity. -rewrite BernsteinApplyRingHom. -auto with *. + intros m n i H v a Ha0 Ha1. + induction v. + apply: BernsteinNonNeg; auto. + simpl. + replace RHS with (MVP_apply Q_as_CRing (Bernstein _ H) ! (MVP_C_ Q_as_CRing n0 a) v). + apply IHv. + apply MVP_apply_wd;try reflexivity. + rewrite BernsteinApplyRingHom. + auto with *. Qed. (* end hide *) @@ -243,25 +240,150 @@ end H. (** The upper and lower bounds are correct. *) Lemma MVP_upperBound_correct : forall n p v, UnitHyperInterval v -> MVP_apply _ p v[<=]MVP_upperBound n p. Proof. -induction n; - intros p v H. - apply Qle_refl. -revert p H. -dependent inversion v. -clear H0. -intros p [[Ha0 Ha1] Hv]. -stepl (@MVP_apply Q_as_CRing (S n) (let (n0, b) := BernsteinCoefficents (MVP_C_ Q_as_CRing n) p in - evalBernsteinBasis (MultivariatePolynomial Q_as_CRing n) b) (Vcons Q a n v0)); - [|apply MVP_apply_wd;[apply evalBernsteinCoefficents|reflexivity]]. -simpl (MVP_upperBound (S n) p). -destruct (BernsteinCoefficents (MVP_C_ Q_as_CRing n) p) as [m b]. -apply Qle_trans with - (vector_rec (MultivariatePolynomial Q_as_CRing n) - (fun (n1 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n1) => Q) - 0 - (fun (c : MultivariatePolynomial Q_as_CRing n) (n1 : nat) - (_ : vector (MultivariatePolynomial Q_as_CRing n) n1) (rec : Q) => - Qmax (MVP_apply _ c v0) rec) m b). + induction n; intros p v H. + apply Qle_refl. + revert p H. + dependent inversion v. + clear H0. + intros p [[Ha0 Ha1] Hv]. + stepl (@MVP_apply Q_as_CRing (S n) (let (n0, b) := BernsteinCoefficents (MVP_C_ Q_as_CRing n) p in + evalBernsteinBasis (MultivariatePolynomial Q_as_CRing n) b) (Vcons Q a n v0)); + [|apply MVP_apply_wd;[apply evalBernsteinCoefficents|reflexivity]]. + simpl (MVP_upperBound (S n) p). + destruct (BernsteinCoefficents (MVP_C_ Q_as_CRing n) p) as [m b]. + apply Qle_trans with (vector_rec (MultivariatePolynomial Q_as_CRing n) + (fun (n1 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n1) => Q) 0 + (fun (c : MultivariatePolynomial Q_as_CRing n) (n1 : nat) + (_ : vector (MultivariatePolynomial Q_as_CRing n) n1) (rec : Q) => + Qmax (MVP_apply _ c v0) rec) m b). + clear IHn Hv. + destruct m as [|m]. + rewrite (V0_eq _ b). + unfold evalBernsteinBasis. + simpl. + rewrite zero_MVP_apply. + apply Qle_refl. + unfold evalBernsteinBasis. + match goal with |- (?A <= ?B) => set (L:=A); set (R:=B) end. + change (L[<=]R). + rstepr (R[*]One). + rewrite <- (@one_MVP_apply Q_as_CRing _ (Vcons _ a _ v0)). + stepr (R[*](@MVP_apply Q_as_CRing (S n) (@Sumx (cpoly_cring _) _ (fun i H => Bernstein _ (lt_n_Sm_le i m (lt_le_trans _ _ _ H (le_refl _))))) (Vcons _ a _ v0))). + fold (MultivariatePolynomial Q_as_CRing n). + unfold L, R; clear L R. + generalize (le_refl (S m)). + revert b. + generalize (S m) at 1 2 5 6 7 8 9. + induction b; intros l. + simpl. + rewrite zero_MVP_apply. + apply Qle_refl. + simpl (vector_rec (MultivariatePolynomial Q_as_CRing n) + (fun (n2 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) => Q) 0 + (fun (c : MultivariatePolynomial Q_as_CRing n) (n2 : nat) + (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) (rec : Q) => + Qmax (MVP_apply Q_as_CRing c v0) rec) (S n1) + (Vcons (MultivariatePolynomial Q_as_CRing n) a0 n1 b)). + simpl (evalBernsteinBasisH (MultivariatePolynomial Q_as_CRing n) + (Vcons (MultivariatePolynomial Q_as_CRing n) a0 n1 b) l). + simpl (Sumx (fun (i : nat) (H : (i < S n1)%nat) => Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) H l)))). + do 2 rewrite MVP_plus_apply. + rewrite -> (Qplus_comm (@MVP_apply Q_as_CRing (S n) (Sumx (fun (i : nat) (l0 : (i < n1)%nat) => + Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 l0) l)))) (Vcons Q a n v0))). + rewrite -> Qmult_comm. + rewrite Qmult_plus_distr_l. + apply Qplus_le_compat; rewrite Qmult_comm; rewrite Qmax_mult_pos_distr_l. + replace LHS with (MVP_apply Q_as_CRing a0 v0 * @MVP_apply Q_as_CRing (S n) + (Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le n1 m (lt_le_trans n1 (S n1) (S m) (lt_n_Sn n1) l))) (Vcons Q a n v0)). + apply Qmax_ub_l. + simpl. + rewrite <- (MVP_mult_apply Q_as_CRing). + apply: MVP_apply_wd; try reflexivity. + replace (lt_n_Sm_le n1 m (lt_le_trans n1 (S n1) (S m) (lt_n_Sn n1) l)) + with (le_S_n n1 m l) by apply le_irrelevent. + apply c_mult_apply. + apply MVP_BernsteinNonNeg; auto. + eapply Qle_trans;[|apply Qmax_ub_r]. + set (R:=vector_rec (MultivariatePolynomial Q_as_CRing n) + (fun (n2 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) => Q) 0 + (fun (c : MultivariatePolynomial Q_as_CRing n) (n2 : nat) + (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) (rec : Q) => + Qmax (MVP_apply Q_as_CRing c v0) rec) n1 b) in *. + replace RHS with (R*@MVP_apply Q_as_CRing (S n) (Sumx (fun (i : nat) (l0 : (i < n1)%nat) => + Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i n1 (S m) l0 (le_Sn_le _ _ l))))) (Vcons Q a n v0)). + apply IHb. + apply: mult_wdr. + apply MVP_apply_wd; try reflexivity. + apply Sumx_wd. + intros i H. + replace (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 H) l)) + with (lt_n_Sm_le i m (lt_le_trans i n1 (S m) H (le_Sn_le n1 (S m) l))) by apply le_irrelevent. + reflexivity. + clear - Ha0 Ha1. + induction n1. + rewrite zero_MVP_apply. + auto with *. + simpl (Sumx (fun (i : nat) (l0 : (i < S n1)%nat) => Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i (S (S n1)) (S m) (lt_S i (S n1) l0) l)))). + rewrite MVP_plus_apply. + apply: plus_resp_nonneg. + stepr (@MVP_apply Q_as_CRing (S n) (Sumx (fun (i : nat) (l0 : (i < n1)%nat) => + Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 l0) (le_Sn_le _ _ l))))) (Vcons Q a n v0)). + apply IHn1. + apply MVP_apply_wd; try reflexivity. + apply Sumx_wd. + intros i H. + replace (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 H) (le_Sn_le (S n1) (S m) l))) + with (lt_n_Sm_le i m (lt_le_trans i (S (S n1)) (S m) (lt_S i (S n1) (lt_S i n1 H)) l)) + by apply le_irrelevent. + reflexivity. + apply MVP_BernsteinNonNeg; auto with *. + apply mult_wdr. + apply MVP_apply_wd; try reflexivity. + simpl (MultivariatePolynomial Q_as_CRing (S n)). + rewrite <- (fun X => partitionOfUnity X m). + apply Sumx_wd. + intros i H. + replace (lt_n_Sm_le i m (lt_le_trans i (S m) (S m) H (le_refl (S m)))) + with (lt_n_Sm_le i m H) by apply le_irrelevent. + reflexivity. + clear - IHn Hv. + induction b. + auto with *. + apply Qmax_le_compat. + apply IHn; apply Hv. + auto. +Qed. + +Lemma MVP_lowerBound_correct : forall n p v, UnitHyperInterval v -> MVP_lowerBound n p[<=]MVP_apply _ p v. +Proof. + induction n; intros p v H. + apply Qle_refl. + revert p H. + dependent inversion v. + clear H0. + intros p [[Ha0 Ha1] Hv]. + stepr (@MVP_apply Q_as_CRing (S n) (let (n0, b) := BernsteinCoefficents (MVP_C_ Q_as_CRing n) p in + evalBernsteinBasis (MultivariatePolynomial Q_as_CRing n) b) (Vcons Q a n v0)); + [|apply MVP_apply_wd;[apply evalBernsteinCoefficents|reflexivity]]. + simpl (MVP_lowerBound (S n) p). + destruct (BernsteinCoefficents (MVP_C_ Q_as_CRing n) p) as [m b]. + apply Qle_trans with (vector_rec (MultivariatePolynomial Q_as_CRing n) + (fun (n1 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n1) => Q) 0 + (fun (c : MultivariatePolynomial Q_as_CRing n) (n1 : nat) + (_ : vector (MultivariatePolynomial Q_as_CRing n) n1) (rec : Q) => + Qmin (MVP_apply _ c v0) rec) m b). + clear - IHn Hv. + induction b. + auto with *. + apply Qmin_le_compat. + apply IHn; apply Hv. + auto. clear IHn Hv. destruct m as [|m]. rewrite (V0_eq _ b). @@ -270,103 +392,83 @@ apply Qle_trans with rewrite zero_MVP_apply. apply Qle_refl. unfold evalBernsteinBasis. - match goal with - |- (?A <= ?B) => set (L:=A); set (R:=B) - end. - change (L[<=]R). - rstepr (R[*]One). + match goal with |- (?A <= ?B) => set (R:=A); set (L:=B) end. + change (R[<=]L). + rstepl (R[*]One). rewrite <- (@one_MVP_apply Q_as_CRing _ (Vcons _ a _ v0)). - stepr (R[*](@MVP_apply Q_as_CRing (S n) (@Sumx (cpoly_cring _) _ (fun i H => Bernstein _ (lt_n_Sm_le i m (lt_le_trans _ _ _ H (le_refl _))))) (Vcons _ a _ v0))). + stepl (R[*](@MVP_apply Q_as_CRing (S n) (@Sumx (cpoly_cring _) _ (fun i H => Bernstein _ (lt_n_Sm_le i m (lt_le_trans _ _ _ H (le_refl _))))) (Vcons _ a _ v0))). fold (MultivariatePolynomial Q_as_CRing n). unfold L, R; clear L R. generalize (le_refl (S m)). revert b. - generalize (S m) at 1 2 5 6 7 8 9. + generalize (S m) at 1 2 4 5 6 7 10. induction b; intros l. simpl. rewrite zero_MVP_apply. apply Qle_refl. simpl (vector_rec (MultivariatePolynomial Q_as_CRing n) - (fun (n2 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) => Q) - 0 - (fun (c : MultivariatePolynomial Q_as_CRing n) (n2 : nat) - (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) (rec : Q) => - Qmax (MVP_apply Q_as_CRing c v0) rec) (S n1) - (Vcons (MultivariatePolynomial Q_as_CRing n) a0 n1 b)). + (fun (n2 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) => Q) 0 + (fun (c : MultivariatePolynomial Q_as_CRing n) (n2 : nat) + (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) (rec : Q) => + Qmin (MVP_apply Q_as_CRing c v0) rec) (S n1) + (Vcons (MultivariatePolynomial Q_as_CRing n) a0 n1 b)). simpl (evalBernsteinBasisH (MultivariatePolynomial Q_as_CRing n) (Vcons (MultivariatePolynomial Q_as_CRing n) a0 n1 b) l). - simpl (Sumx - (fun (i : nat) (H : (i < S n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) H l)))). + simpl (Sumx (fun (i : nat) (H : (i < S n1)%nat) => Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) H l)))). do 2 rewrite MVP_plus_apply. - rewrite -> (Qplus_comm (@MVP_apply Q_as_CRing (S n) - (Sumx - (fun (i : nat) (l0 : (i < n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 l0) l)))) - (Vcons Q a n v0))). - rewrite -> Qmult_comm. + rewrite -> (Qplus_comm (@MVP_apply Q_as_CRing (S n) (Sumx (fun (i : nat) (l0 : (i < n1)%nat) => + Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 l0) l)))) (Vcons Q a n v0))). + rewrite -> Qmult_comm. rewrite Qmult_plus_distr_l. - apply Qplus_le_compat; rewrite Qmult_comm; rewrite Qmax_mult_pos_distr_l. - replace LHS with (MVP_apply Q_as_CRing a0 v0 * - @MVP_apply Q_as_CRing (S n) - (Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le n1 m (lt_le_trans n1 (S n1) (S m) (lt_n_Sn n1) l))) - (Vcons Q a n v0)). - apply Qmax_ub_l. + apply Qplus_le_compat; rewrite Qmult_comm; rewrite Qmin_mult_pos_distr_l. + replace RHS with (MVP_apply Q_as_CRing a0 v0 * @MVP_apply Q_as_CRing (S n) + (Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le n1 m (lt_le_trans n1 (S n1) (S m) (lt_n_Sn n1) l))) (Vcons Q a n v0)). + apply Qmin_lb_l. simpl. rewrite <- (MVP_mult_apply Q_as_CRing). apply: MVP_apply_wd; try reflexivity. replace (lt_n_Sm_le n1 m (lt_le_trans n1 (S n1) (S m) (lt_n_Sn n1) l)) - with (le_S_n n1 m l) by apply le_irrelevent. + with (le_S_n n1 m l) by apply le_irrelevent. apply c_mult_apply. apply MVP_BernsteinNonNeg; auto. - eapply Qle_trans;[|apply Qmax_ub_r]. + eapply Qle_trans;[apply Qmin_lb_r|]. set (R:=vector_rec (MultivariatePolynomial Q_as_CRing n) - (fun (n2 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) => Q) - 0 - (fun (c : MultivariatePolynomial Q_as_CRing n) (n2 : nat) - (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) (rec : Q) => - Qmax (MVP_apply Q_as_CRing c v0) rec) n1 b) in *. - replace RHS with (R*@MVP_apply Q_as_CRing (S n) - (Sumx - (fun (i : nat) (l0 : (i < n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i n1 (S m) l0 (le_Sn_le _ _ l))))) - (Vcons Q a n v0)). + (fun (n2 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) => Q) 0 + (fun (c : MultivariatePolynomial Q_as_CRing n) (n2 : nat) + (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) (rec : Q) => + Qmin (MVP_apply Q_as_CRing c v0) rec) n1 b) in *. + replace LHS with (R*@MVP_apply Q_as_CRing (S n) (Sumx (fun (i : nat) (l0 : (i < n1)%nat) => + Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i n1 (S m) l0 (le_Sn_le _ _ l))))) (Vcons Q a n v0)). apply IHb. apply: mult_wdr. apply MVP_apply_wd; try reflexivity. apply Sumx_wd. intros i H. replace (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 H) l)) - with (lt_n_Sm_le i m (lt_le_trans i n1 (S m) H (le_Sn_le n1 (S m) l))) by apply le_irrelevent. + with (lt_n_Sm_le i m (lt_le_trans i n1 (S m) H (le_Sn_le n1 (S m) l))) by apply le_irrelevent. reflexivity. clear - Ha0 Ha1. induction n1. rewrite zero_MVP_apply. auto with *. - simpl (Sumx - (fun (i : nat) (l0 : (i < S n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i (S (S n1)) (S m) (lt_S i (S n1) l0) l)))). + simpl (Sumx (fun (i : nat) (l0 : (i < S n1)%nat) => Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i (S (S n1)) (S m) (lt_S i (S n1) l0) l)))). rewrite MVP_plus_apply. apply: plus_resp_nonneg. - stepr (@MVP_apply Q_as_CRing (S n) - (Sumx - (fun (i : nat) (l0 : (i < n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 l0) (le_Sn_le _ _ l))))) (Vcons Q a n v0)). + stepr (@MVP_apply Q_as_CRing (S n) (Sumx (fun (i : nat) (l0 : (i < n1)%nat) => + Bernstein (MultivariatePolynomial Q_as_CRing n) + (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 l0) (le_Sn_le _ _ l))))) (Vcons Q a n v0)). apply IHn1. apply MVP_apply_wd; try reflexivity. apply Sumx_wd. intros i H. - replace (lt_n_Sm_le i m - (lt_le_trans i (S n1) (S m) (lt_S i n1 H) (le_Sn_le (S n1) (S m) l))) - with (lt_n_Sm_le i m - (lt_le_trans i (S (S n1)) (S m) (lt_S i (S n1) (lt_S i n1 H)) l)) - by apply le_irrelevent. + replace (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 H) (le_Sn_le (S n1) (S m) l))) + with (lt_n_Sm_le i m (lt_le_trans i (S (S n1)) (S m) (lt_S i (S n1) (lt_S i n1 H)) l)) + by apply le_irrelevent. reflexivity. apply MVP_BernsteinNonNeg; auto with *. apply mult_wdr. @@ -376,159 +478,8 @@ apply Qle_trans with apply Sumx_wd. intros i H. replace (lt_n_Sm_le i m (lt_le_trans i (S m) (S m) H (le_refl (S m)))) - with (lt_n_Sm_le i m H) by apply le_irrelevent. + with (lt_n_Sm_le i m H) by apply le_irrelevent. reflexivity. -clear - IHn Hv. -induction b. - auto with *. -apply Qmax_le_compat. - apply IHn; apply Hv. -auto. -Qed. - -Lemma MVP_lowerBound_correct : forall n p v, UnitHyperInterval v -> MVP_lowerBound n p[<=]MVP_apply _ p v. -Proof. -induction n; - intros p v H. - apply Qle_refl. -revert p H. -dependent inversion v. -clear H0. -intros p [[Ha0 Ha1] Hv]. -stepr (@MVP_apply Q_as_CRing (S n) (let (n0, b) := BernsteinCoefficents (MVP_C_ Q_as_CRing n) p in - evalBernsteinBasis (MultivariatePolynomial Q_as_CRing n) b) (Vcons Q a n v0)); - [|apply MVP_apply_wd;[apply evalBernsteinCoefficents|reflexivity]]. -simpl (MVP_lowerBound (S n) p). -destruct (BernsteinCoefficents (MVP_C_ Q_as_CRing n) p) as [m b]. -apply Qle_trans with - (vector_rec (MultivariatePolynomial Q_as_CRing n) - (fun (n1 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n1) => Q) - 0 - (fun (c : MultivariatePolynomial Q_as_CRing n) (n1 : nat) - (_ : vector (MultivariatePolynomial Q_as_CRing n) n1) (rec : Q) => - Qmin (MVP_apply _ c v0) rec) m b). - clear - IHn Hv. - induction b. - auto with *. - apply Qmin_le_compat. - apply IHn; apply Hv. - auto. -clear IHn Hv. -destruct m as [|m]. - rewrite (V0_eq _ b). - unfold evalBernsteinBasis. - simpl. - rewrite zero_MVP_apply. - apply Qle_refl. -unfold evalBernsteinBasis. -match goal with - |- (?A <= ?B) => set (R:=A); set (L:=B) -end. -change (R[<=]L). -rstepl (R[*]One). -rewrite <- (@one_MVP_apply Q_as_CRing _ (Vcons _ a _ v0)). -stepl (R[*](@MVP_apply Q_as_CRing (S n) (@Sumx (cpoly_cring _) _ (fun i H => Bernstein _ (lt_n_Sm_le i m (lt_le_trans _ _ _ H (le_refl _))))) (Vcons _ a _ v0))). - fold (MultivariatePolynomial Q_as_CRing n). - unfold L, R; clear L R. - generalize (le_refl (S m)). - revert b. - generalize (S m) at 1 2 4 5 6 7 10. - induction b; intros l. - simpl. - rewrite zero_MVP_apply. - apply Qle_refl. - simpl (vector_rec (MultivariatePolynomial Q_as_CRing n) - (fun (n2 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) => Q) - 0 - (fun (c : MultivariatePolynomial Q_as_CRing n) (n2 : nat) - (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) (rec : Q) => - Qmin (MVP_apply Q_as_CRing c v0) rec) (S n1) - (Vcons (MultivariatePolynomial Q_as_CRing n) a0 n1 b)). - simpl (evalBernsteinBasisH (MultivariatePolynomial Q_as_CRing n) - (Vcons (MultivariatePolynomial Q_as_CRing n) a0 n1 b) l). - simpl (Sumx - (fun (i : nat) (H : (i < S n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) H l)))). - do 2 rewrite MVP_plus_apply. - rewrite -> (Qplus_comm (@MVP_apply Q_as_CRing (S n) - (Sumx - (fun (i : nat) (l0 : (i < n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 l0) l)))) - (Vcons Q a n v0))). - rewrite -> Qmult_comm. - rewrite Qmult_plus_distr_l. - apply Qplus_le_compat; rewrite Qmult_comm; rewrite Qmin_mult_pos_distr_l. - replace RHS with (MVP_apply Q_as_CRing a0 v0 * - @MVP_apply Q_as_CRing (S n) - (Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le n1 m (lt_le_trans n1 (S n1) (S m) (lt_n_Sn n1) l))) - (Vcons Q a n v0)). - apply Qmin_lb_l. - simpl. - rewrite <- (MVP_mult_apply Q_as_CRing). - apply: MVP_apply_wd; try reflexivity. - replace (lt_n_Sm_le n1 m (lt_le_trans n1 (S n1) (S m) (lt_n_Sn n1) l)) - with (le_S_n n1 m l) by apply le_irrelevent. - apply c_mult_apply. - apply MVP_BernsteinNonNeg; auto. - eapply Qle_trans;[apply Qmin_lb_r|]. - set (R:=vector_rec (MultivariatePolynomial Q_as_CRing n) - (fun (n2 : nat) (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) => Q) - 0 - (fun (c : MultivariatePolynomial Q_as_CRing n) (n2 : nat) - (_ : vector (MultivariatePolynomial Q_as_CRing n) n2) (rec : Q) => - Qmin (MVP_apply Q_as_CRing c v0) rec) n1 b) in *. - replace LHS with (R*@MVP_apply Q_as_CRing (S n) - (Sumx - (fun (i : nat) (l0 : (i < n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i n1 (S m) l0 (le_Sn_le _ _ l))))) - (Vcons Q a n v0)). - apply IHb. - apply: mult_wdr. - apply MVP_apply_wd; try reflexivity. - apply Sumx_wd. - intros i H. - replace (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 H) l)) - with (lt_n_Sm_le i m (lt_le_trans i n1 (S m) H (le_Sn_le n1 (S m) l))) by apply le_irrelevent. - reflexivity. - clear - Ha0 Ha1. - induction n1. - rewrite zero_MVP_apply. - auto with *. - simpl (Sumx - (fun (i : nat) (l0 : (i < S n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i (S (S n1)) (S m) (lt_S i (S n1) l0) l)))). - rewrite MVP_plus_apply. - apply: plus_resp_nonneg. - stepr (@MVP_apply Q_as_CRing (S n) - (Sumx - (fun (i : nat) (l0 : (i < n1)%nat) => - Bernstein (MultivariatePolynomial Q_as_CRing n) - (lt_n_Sm_le i m (lt_le_trans i (S n1) (S m) (lt_S i n1 l0) (le_Sn_le _ _ l))))) (Vcons Q a n v0)). - apply IHn1. - apply MVP_apply_wd; try reflexivity. - apply Sumx_wd. - intros i H. - replace (lt_n_Sm_le i m - (lt_le_trans i (S n1) (S m) (lt_S i n1 H) (le_Sn_le (S n1) (S m) l))) - with (lt_n_Sm_le i m - (lt_le_trans i (S (S n1)) (S m) (lt_S i (S n1) (lt_S i n1 H)) l)) - by apply le_irrelevent. - reflexivity. - apply MVP_BernsteinNonNeg; auto with *. -apply mult_wdr. -apply MVP_apply_wd; try reflexivity. -simpl (MultivariatePolynomial Q_as_CRing (S n)). -rewrite <- (fun X => partitionOfUnity X m). -apply Sumx_wd. -intros i H. -replace (lt_n_Sm_le i m (lt_le_trans i (S m) (S m) H (le_refl (S m)))) - with (lt_n_Sm_le i m H) by apply le_irrelevent. -reflexivity. Qed. Open Local Scope Q_scope. @@ -539,87 +490,81 @@ Definition MVP_apply_modulus n (p:MultivariatePolynomial Q_as_CRing (S n)) := let p' := (_D_ p) in Qscale_modulus (Qmax (MVP_upperBound (S n) p') (-(MVP_lowerBound (S n) p'))). -Lemma MVP_apply_modulus_correct : forall n (p:MultivariatePolynomial Q_as_CRing (S n)) x y e, +Lemma MVP_apply_modulus_correct : forall n (p:MultivariatePolynomial Q_as_CRing (S n)) x y e, (0 <= x) -> (x <= 1) -> (0 <= y) -> (y <= 1) -> - ball_ex (MVP_apply_modulus p e) x y -> + ball_ex (MVP_apply_modulus p e) x y -> forall (v:vector Q n), UnitHyperInterval v -> ball e (MVP_apply _ p (Vcons _ x _ v):Q) (MVP_apply _ p (Vcons _ y _ v)). -intros n p x y e Hx0 Hx1 Hy0 Hy1 Hxy v Hv. -assert (Hx : (Qmax 0 (Qmin 1 x))==x). - rewrite -> Qle_min_r in Hx1. - rewrite Hx1. - rewrite -> Qle_max_r in Hx0. - rewrite Hx0. - reflexivity. -assert (Hy : (Qmax 0 (Qmin 1 y))==y). - rewrite -> Qle_min_r in Hy1. - rewrite Hy1. - rewrite -> Qle_max_r in Hy0. - rewrite Hy0. - reflexivity. -simpl. -rewrite <- Hx. -rewrite <- Hy. -unfold MVP_apply_modulus in Hxy. -set (c:=(Qmax (MVP_upperBound (S n) (_D_ p)) - (- MVP_lowerBound (S n) (_D_ p)))) in *. -set (fp:=cpoly_map (RHcompose _ _ _ (inj_Q_hom IR) (MVP_apply_hom _ v)) p). -apply (fun A B e => is_UniformlyContinuousD_Q (Some 0) (Some 1) (refl_equal _) (FPoly _ fp) (FPoly _ (_D_ fp)) (Derivative_poly _ _ _) - (fun x => (MVP_apply _ p (Vcons _ x _ v))) A c B e x y); - try assumption. - unfold fp. +Proof. + intros n p x y e Hx0 Hx1 Hy0 Hy1 Hxy v Hv. + assert (Hx : (Qmax 0 (Qmin 1 x))==x). + rewrite -> Qle_min_r in Hx1. + rewrite Hx1. + rewrite -> Qle_max_r in Hx0. + rewrite Hx0. + reflexivity. + assert (Hy : (Qmax 0 (Qmin 1 y))==y). + rewrite -> Qle_min_r in Hy1. + rewrite Hy1. + rewrite -> Qle_max_r in Hy0. + rewrite Hy0. + reflexivity. simpl. - intros q _ _. - clear - p. - change (inj_Q_hom IR (MVP_apply_hom Q_as_CRing v p ! (MVP_C_ Q_as_CRing n q))[=] - (cpoly_map (RHcompose (MultivariatePolynomial Q_as_CRing n) Q_as_CRing IR + rewrite <- Hx. + rewrite <- Hy. + unfold MVP_apply_modulus in Hxy. + set (c:=(Qmax (MVP_upperBound (S n) (_D_ p)) (- MVP_lowerBound (S n) (_D_ p)))) in *. + set (fp:=cpoly_map (RHcompose _ _ _ (inj_Q_hom IR) (MVP_apply_hom _ v)) p). + apply (fun A B e => is_UniformlyContinuousD_Q (Some 0) (Some 1) (refl_equal _) (FPoly _ fp) (FPoly _ (_D_ fp)) (Derivative_poly _ _ _) + (fun x => (MVP_apply _ p (Vcons _ x _ v))) A c B e x y); try assumption. + unfold fp. + simpl. + intros q _ _. + clear - p. + change (inj_Q_hom IR (MVP_apply_hom Q_as_CRing v p ! (MVP_C_ Q_as_CRing n q))[=] + (cpoly_map (RHcompose (MultivariatePolynomial Q_as_CRing n) Q_as_CRing IR (inj_Q_hom IR) (MVP_apply_hom Q_as_CRing v)) p) ! (inj_Q_hom IR q)). + rewrite cpoly_map_compose. + rewrite <- cpoly_map_apply. + apply inj_Q_wd. + rewrite cpoly_map_apply. + apply csbf_wd; try reflexivity. + apply: C_MVP_apply. + simpl. + clear - c Hv. + intros x _ [H0x Hx1]. + change (AbsIR (_D_ (cpoly_map (RHcompose (MultivariatePolynomial Q_as_CRing n) Q_as_CRing IR + (inj_Q_hom IR) (MVP_apply_hom Q_as_CRing v)) p)) ! (inj_Q_hom IR x)[<=] inj_Q IR c). + rewrite <- cpoly_map_diff. rewrite cpoly_map_compose. rewrite <- cpoly_map_apply. - apply inj_Q_wd. - rewrite cpoly_map_apply. - apply csbf_wd; try reflexivity. - apply: C_MVP_apply. -simpl. -clear - c Hv. -intros x _ [H0x Hx1]. -change (AbsIR - (_D_ - (cpoly_map - (RHcompose (MultivariatePolynomial Q_as_CRing n) Q_as_CRing IR - (inj_Q_hom IR) (MVP_apply_hom Q_as_CRing v)) p)) ! (inj_Q_hom IR x)[<=] - inj_Q IR c). -rewrite <- cpoly_map_diff. -rewrite cpoly_map_compose. -rewrite <- cpoly_map_apply. -change (AbsIR (inj_Q IR (cpoly_map (MVP_apply_hom Q_as_CRing v) (_D_ p)) ! x)[<=]inj_Q IR c). -rewrite AbsIR_Qabs. -apply inj_Q_leEq. -assert (Hx: 0 <= x <= 1). - split; - apply (leEq_inj_Q IR). - rewrite inj_Q_Zero. - rstepl (Zero[/]Zero[+]One[//]den_is_nonzero IR 0); auto. - rewrite inj_Q_One. - rstepr (One[/]Zero[+]One[//]den_is_nonzero IR 1); auto. -setoid_replace ((cpoly_map (MVP_apply_hom Q_as_CRing v) (_D_ p)) ! x) - with (@MVP_apply Q_as_CRing (S n) (_D_ p) (Vcons _ x _ v)). - apply Qabs_case; intros H. - eapply Qle_trans;[|apply Qmax_ub_l]. - apply MVP_upperBound_correct. + change (AbsIR (inj_Q IR (cpoly_map (MVP_apply_hom Q_as_CRing v) (_D_ p)) ! x)[<=]inj_Q IR c). + rewrite AbsIR_Qabs. + apply inj_Q_leEq. + assert (Hx: 0 <= x <= 1). + split; apply (leEq_inj_Q IR). + rewrite inj_Q_Zero. + rstepl (Zero[/]Zero[+]One[//]den_is_nonzero IR 0); auto. + rewrite inj_Q_One. + rstepr (One[/]Zero[+]One[//]den_is_nonzero IR 1); auto. + setoid_replace ((cpoly_map (MVP_apply_hom Q_as_CRing v) (_D_ p)) ! x) + with (@MVP_apply Q_as_CRing (S n) (_D_ p) (Vcons _ x _ v)). + apply Qabs_case; intros H. + eapply Qle_trans;[|apply Qmax_ub_l]. + apply MVP_upperBound_correct. + split; auto. + eapply Qle_trans;[|apply Qmax_ub_r]. + apply Qopp_le_compat. + apply MVP_lowerBound_correct. split; auto. - eapply Qle_trans;[|apply Qmax_ub_r]. - apply Qopp_le_compat. - apply MVP_lowerBound_correct. - split; auto. -generalize (_D_ p). -intros s; clear -s. -simpl. -change ((cpoly_map_fun (MultivariatePolynomial Q_as_CRing n) Q_as_CRing + generalize (_D_ p). + intros s; clear -s. + simpl. + change ((cpoly_map_fun (MultivariatePolynomial Q_as_CRing n) Q_as_CRing (MVP_apply_hom Q_as_CRing v) s) ! x == MVP_apply_hom Q_as_CRing v (s ! (MVP_C_ Q_as_CRing n x))). -rewrite cpoly_map_apply. -simpl. -rewrite C_MVP_apply. -reflexivity. + rewrite cpoly_map_apply. + simpl. + rewrite C_MVP_apply. + reflexivity. Qed. Open Local Scope uc_scope. @@ -629,78 +574,78 @@ Definition Qclamp01 := QboundBelow_uc (0) ∘ QboundAbove_uc 1. Lemma Qclamp01_clamped : forall x, 0 <= Qclamp01 x <= 1. Proof. -intros x. -unfold Qclamp01. -split; simpl. - apply Qmax_ub_l. -rewrite Qmax_min_distr_r. -apply Qmin_lb_l. -Qed. + intros x. + unfold Qclamp01. + split; simpl. + apply Qmax_ub_l. + rewrite Qmax_min_distr_r. + apply Qmin_lb_l. +Qed. Lemma Qclamp01_le : forall x y, x <= y -> Qclamp01 x <= Qclamp01 y. Proof. -intros x y H. -simpl. -apply Qmax_le_compat; auto with *. -apply Qmin_le_compat; auto with *. + intros x y H. + simpl. + apply Qmax_le_compat; auto with *. + apply Qmin_le_compat; auto with *. Qed. Lemma Qclamp01_close : forall e x y, Qabs (x-y) <= e -> Qabs (Qclamp01 x - Qclamp01 y) <= e. Proof. -intros e. -cut (forall x y : Q, y <= x -> x - y <= e -> Qclamp01 x - Qclamp01 y <= e). - intros H x y. - destruct (Qle_total x y). - rewrite Qabs_neg. - intros He. + intros e. + cut (forall x y : Q, y <= x -> x - y <= e -> Qclamp01 x - Qclamp01 y <= e). + intros H x y. + destruct (Qle_total x y). rewrite Qabs_neg. - replace LHS with (Qclamp01 y - Qclamp01 x) by ring. - apply H; auto. - replace LHS with (- (x-y)) by ring. + intros He. + rewrite Qabs_neg. + replace LHS with (Qclamp01 y - Qclamp01 x) by ring. + apply H; auto. + replace LHS with (- (x-y)) by ring. + auto. + apply (shift_minus_leEq Q_as_COrdField). + stepr (Qclamp01 y) by (simpl; ring). + apply Qclamp01_le. auto. apply (shift_minus_leEq Q_as_COrdField). - stepr (Qclamp01 y) by (simpl; ring). - apply Qclamp01_le. + stepr y by (simpl; ring). auto. - apply (shift_minus_leEq Q_as_COrdField). - stepr y by (simpl; ring). - auto. - rewrite Qabs_pos. - intros He. rewrite Qabs_pos. - apply H; auto. + intros He. + rewrite Qabs_pos. + apply H; auto. + apply: shift_zero_leEq_minus. + apply Qclamp01_le. + auto. apply: shift_zero_leEq_minus. - apply Qclamp01_le. auto. - apply: shift_zero_leEq_minus. + intros x y Hxy He. + simpl. + apply (Qmin_case 1 y). + intros Hy. + assert (Hx:=Qle_trans _ _ _ Hy Hxy). + rewrite -> Qle_min_l in Hx. + rewrite Hx. + replace LHS with 0 by ring. + eapply Qle_trans;[|apply He]. + apply: shift_zero_leEq_minus; auto. + apply (Qmin_case 1 x). + intros Hx Hy. + eapply Qle_trans;[|apply He]. + apply Qplus_le_compat; auto. + apply Qopp_le_compat. + apply Qmax_ub_r. + intros _ _. + apply (Qmax_case 0 x); intros Hx. + assert (Hy:=Qle_trans _ _ _ Hxy Hx). + rewrite -> Qle_max_l in Hy. + rewrite Hy. + eapply Qle_trans;[|apply He]. + apply: shift_zero_leEq_minus; auto. + apply (Qmax_case 0 y); intros Hy. + eapply Qle_trans;[|apply He]. + apply Qplus_le_compat; auto with *. auto. -intros x y Hxy He. -simpl. -apply (Qmin_case 1 y). - intros Hy. - assert (Hx:=Qle_trans _ _ _ Hy Hxy). - rewrite -> Qle_min_l in Hx. - rewrite Hx. - replace LHS with 0 by ring. - eapply Qle_trans;[|apply He]. - apply: shift_zero_leEq_minus; auto. -apply (Qmin_case 1 x). - intros Hx Hy. - eapply Qle_trans;[|apply He]. - apply Qplus_le_compat; auto. - apply Qopp_le_compat. - apply Qmax_ub_r. -intros _ _. -apply (Qmax_case 0 x); intros Hx. - assert (Hy:=Qle_trans _ _ _ Hxy Hx). - rewrite -> Qle_max_l in Hy. - rewrite Hy. - eapply Qle_trans;[|apply He]. - apply: shift_zero_leEq_minus; auto. -apply (Qmax_case 0 y); intros Hy. - eapply Qle_trans;[|apply He]. - apply Qplus_le_compat; auto with *. -auto. Qed. Require Import RSetoid. @@ -731,70 +676,50 @@ end. Definition MVP_uc : forall n (p:MultivariatePolynomial Q_as_CRing n), {f:n_UniformlyContinuousFunction Q_as_MetricSpace Q_as_MetricSpace n |MVP_uc_sig _ p f}. -induction n. - intros x. - exists x. +Proof. + induction n. + intros x. + exists x. + simpl. + reflexivity. + intros p. + assert (is_UniformlyContinuousFunction (fun (x:Q_as_CRing) => ProjT1 (IHn (p ! (MVP_C_ Q_as_CRing _ (Qclamp01 x))))) (MVP_apply_modulus p)) by abstract + (intros e x y Hxy; assert (Hxy' : ball_ex (MVP_apply_modulus p e) (Qclamp01 x) (Qclamp01 y)) by + (destruct (MVP_apply_modulus p e); auto; simpl; rewrite Qball_Qabs; apply: Qclamp01_close; + rewrite <- Qball_Qabs; auto); destruct (Qclamp01_clamped x) as [Hx0 Hx1]; + destruct (Qclamp01_clamped y) as [Hy0 Hy1]; + assert (X:=@MVP_apply_modulus_correct _ p (Qclamp01 x) (Qclamp01 y) e Hx0 Hx1 Hy0 Hy1 Hxy'); + clear Hxy Hxy'; generalize (proj2_sigT _ _ (IHn p ! (MVP_C_ Q_as_CRing n (Qclamp01 x)))) + (proj2_sigT _ _ (IHn p ! (MVP_C_ Q_as_CRing n (Qclamp01 y)))); + set (x':=Qclamp01 x) in *; set (y':=Qclamp01 y) in *; simpl in X; revert X; + generalize (ProjT1 (IHn p ! (MVP_C_ Q_as_CRing n x'))) + (ProjT1 (IHn p ! (MVP_C_ Q_as_CRing n y'))); + change (Q_as_CSetoid) with (csg_crr Q_as_CRing); + generalize (p ! (MVP_C_ Q_as_CRing n x')) (p ! (MVP_C_ Q_as_CRing n y')); + clear - e; induction n;[ simpl; intros p q s t H Hs Ht; + rewrite <- Hs, <- Ht; apply (H (Vnil _)); constructor|]; simpl; + intros p q s t H Hs Ht v; apply (fun H => IHn _ _ _ _ H (Hs v) (Ht v)); + intros v0 Hv0; apply (H (Vcons _ (Qclamp01 v) _ v0)); split; auto; + apply Qclamp01_clamped). + exists (Build_UniformlyContinuousFunction H). simpl. - reflexivity. -intros p. -assert (is_UniformlyContinuousFunction (fun (x:Q_as_CRing) => ProjT1 (IHn (p ! (MVP_C_ Q_as_CRing _ (Qclamp01 x))))) (MVP_apply_modulus p)) by abstract - (intros e x y Hxy; - assert (Hxy' : ball_ex (MVP_apply_modulus p e) (Qclamp01 x) (Qclamp01 y)) by - (destruct (MVP_apply_modulus p e); auto; - simpl; - rewrite Qball_Qabs; - apply: Qclamp01_close; - rewrite <- Qball_Qabs; - auto); - destruct (Qclamp01_clamped x) as [Hx0 Hx1]; - destruct (Qclamp01_clamped y) as [Hy0 Hy1]; - assert (X:=@MVP_apply_modulus_correct _ p (Qclamp01 x) (Qclamp01 y) e Hx0 Hx1 Hy0 Hy1 Hxy'); - clear Hxy Hxy'; - generalize - (proj2_sigT _ _ (IHn p ! (MVP_C_ Q_as_CRing n (Qclamp01 x)))) - (proj2_sigT _ _ (IHn p ! (MVP_C_ Q_as_CRing n (Qclamp01 y)))); - set (x':=Qclamp01 x) in *; - set (y':=Qclamp01 y) in *; - simpl in X; - revert X; - generalize (ProjT1 (IHn p ! (MVP_C_ Q_as_CRing n x'))) - (ProjT1 (IHn p ! (MVP_C_ Q_as_CRing n y'))); - change (Q_as_CSetoid) with (csg_crr Q_as_CRing); - generalize (p ! (MVP_C_ Q_as_CRing n x')) - (p ! (MVP_C_ Q_as_CRing n y')); - clear - e; - induction n;[ - simpl; - intros p q s t H Hs Ht; - rewrite <- Hs, <- Ht; - apply (H (Vnil _)); - constructor|]; - simpl; - intros p q s t H Hs Ht v; - apply (fun H => IHn _ _ _ _ H (Hs v) (Ht v)); - intros v0 Hv0; - apply (H (Vcons _ (Qclamp01 v) _ v0)); - split; auto; - apply Qclamp01_clamped). -exists (Build_UniformlyContinuousFunction H). -simpl. -intros v. -exact (ProjT2 (IHn p ! (MVP_C_ Q_as_CRing n (Qclamp01 v)))). + intros v. + exact (ProjT2 (IHn p ! (MVP_C_ Q_as_CRing n (Qclamp01 v)))). Defined. Definition MVP_uc_Q := (fun n p => ProjT1 (MVP_uc n p)). Add Parametric Morphism n : (@MVP_uc_Q n) with signature (@st_eq _) ==> (@st_eq _) as MVP_uc_Q_wd. Proof. -induction n. - simpl. - unfold MVP_uc_Q. - simpl. - auto. -intros x y Hxy a. -apply: IHn. -rewrite Hxy. -reflexivity. + induction n. + simpl. + unfold MVP_uc_Q. + simpl. + auto. + intros x y Hxy a. + apply: IHn. + rewrite Hxy. + reflexivity. Qed. Fixpoint n_Cap X Y (plX : PrelengthSpace X) n : Complete (n_UniformlyContinuousFunction X Y n) --> @@ -813,35 +738,37 @@ Definition n_Cmap X Y (plX : PrelengthSpace X) n : n_UniformlyContinuousFunction Add Parametric Morphism X Y plX n : (@n_Cap X Y plX n) with signature (@st_eq _) ==> (@st_eq _) as n_Cap_wd. Proof. -induction n. - simpl. - auto. -intros x y Hxy z. -apply: IHn. -apply: Cap_wd; auto. -reflexivity. + induction n. + simpl. + auto. + intros x y Hxy z. + apply: IHn. + apply: Cap_wd; auto. + reflexivity. Qed. Add Parametric Morphism X Y plX n : (@n_Cmap X Y plX n) with signature (@st_eq _) ==> (@st_eq _) as n_Cmap_wd. -intros x y Hxy. -unfold n_Cmap. -simpl. -rewrite Hxy. -reflexivity. +Proof. + intros x y Hxy. + unfold n_Cmap. + simpl. + rewrite Hxy. + reflexivity. Qed. (** Multivariable polynomials on the unit hyper interval can be applied to real numbers *) Definition MVP_uc_fun n (p:MultivariatePolynomial _ n) : - n_UniformlyContinuousFunction CR CR n := + n_UniformlyContinuousFunction CR CR n := n_Cmap _ QPrelengthSpace n (MVP_uc_Q n p). Add Parametric Morphism n : (@MVP_uc_fun n) with signature (@st_eq _) ==> (@st_eq _) as MVP_uc_fun_wd. -intros x y Hxy. -unfold MVP_uc_fun. -rewrite Hxy. -reflexivity. +Proof. + intros x y Hxy. + unfold MVP_uc_fun. + rewrite Hxy. + reflexivity. Qed. Section MVP_correct. @@ -851,34 +778,33 @@ Lemma MVP_uc_fun_sub_Q : forall n (p:MultivariatePolynomial _ (S n)) x, 0 <= x -> x <= 1 -> (MVP_uc_fun (S n) p ('x)%CR)[=](MVP_uc_fun n (p!(MVP_C_ _ _ x))). Proof. -intros n p x Hx0 Hx1. -unfold MVP_uc_fun. -apply: n_Cap_wd. -intros e1 e2. -simpl. -unfold Cap_raw. -simpl. -change (ball (e1 + e2) - (MVP_uc_Q n p ! (MVP_C_ Q_as_CRing n (Qmax 0 (Qmin 1 x)))) - (MVP_uc_Q n p ! (MVP_C_ Q_as_CRing n x))). -rewrite -> Qle_min_r in Hx1. -rewrite Hx1. -rewrite -> Qle_max_r in Hx0. -rewrite Hx0. -apply ball_refl. + intros n p x Hx0 Hx1. + unfold MVP_uc_fun. + apply: n_Cap_wd. + intros e1 e2. + simpl. + unfold Cap_raw. + simpl. + change (ball (e1 + e2) (MVP_uc_Q n p ! (MVP_C_ Q_as_CRing n (Qmax 0 (Qmin 1 x)))) + (MVP_uc_Q n p ! (MVP_C_ Q_as_CRing n x))). + rewrite -> Qle_min_r in Hx1. + rewrite Hx1. + rewrite -> Qle_max_r in Hx0. + rewrite Hx0. + apply ball_refl. Qed. Fixpoint MVP_CR_apply n : extSetoid (MultivariatePolynomial CRasCRing n) (n_Function CR CR n) := match n return extSetoid (MultivariatePolynomial CRasCRing n) (n_Function CR CR n) with | O => id -| S n' => Build_Morphism _ (n_Function CR CR (S n')) (fun p => Build_Morphism _ _ (fun x => MVP_CR_apply n' (p!(MVP_C_ _ n' x))) +| S n' => Build_Morphism _ (n_Function CR CR (S n')) (fun p => Build_Morphism _ _ (fun x => MVP_CR_apply n' (p!(MVP_C_ _ n' x))) (fun (x y : RegularFunction Q_as_MetricSpace) (Hxy : regFunEq x y) => Morphism_prf (MVP_CR_apply n') p ! (MVP_C_ CRasCRing n' x) p ! (MVP_C_ CRasCRing n' y) (cpoly_apply_wd (MultivariatePolynomial CRasCRing n') p p (MVP_C_ CRasCRing n' x) (MVP_C_ CRasCRing n' y) (reflexivity p) (csf_wd CRasCSetoid (MultivariatePolynomial CRasCRing n') - (MVP_C_ CRasCRing n') x y Hxy)))) + (MVP_C_ CRasCRing n') x y Hxy)))) (fun (x1 x2 : cpoly_cring (MultivariatePolynomial CRasCRing n')) (H : x1[=]x2) (x : RegularFunction Q_as_MetricSpace) => Morphism_prf (MVP_CR_apply n') x1 ! (MVP_C_ CRasCRing n' x) @@ -894,45 +820,43 @@ match n return n_UniformlyContinuousFunction CR CR n -> n_Function CR CR n -> Pr | S n' => fun f g => forall x, (0 <= x)%Q -> (x <= 1)%Q -> MVP_uc_fun_correct_sig_Q n' (f ('x)%CR) (g ('x)%CR) end. -Add Parametric Morphism n : +Add Parametric Morphism n : (@MVP_uc_fun_correct_sig_Q n) with signature (@st_eq _) ==> (@st_eq _) ==> iff as MVP_uc_fun_correct_sig_Q_wd. -induction n; - intros x y Hxy a b Hab. - change (x==a <-> y==b)%CR. - rewrite Hxy Hab. - reflexivity. -simpl. -split; - intros H c. - rewrite <- (IHn _ _ (Hxy (' c)%CR) _ _ (Hab ('c)%CR)). + induction n; intros x y Hxy a b Hab. +Proof. + change (x==a <-> y==b)%CR. + rewrite Hxy Hab. + reflexivity. + simpl. + split; intros H c. + rewrite <- (IHn _ _ (Hxy (' c)%CR) _ _ (Hab ('c)%CR)). + auto. + rewrite (IHn _ _ (Hxy ('c)%CR) _ _ (Hab ('c)%CR)). auto. -rewrite (IHn _ _ (Hxy ('c)%CR) _ _ (Hab ('c)%CR)). -auto. Qed. Lemma MVP_uc_fun_correct_Q : forall n (p:MultivariatePolynomial Q_as_CRing n), MVP_uc_fun_correct_sig_Q n (MVP_uc_fun n p) (MVP_CR_apply n (MVP_map inject_Q_hom n p)). Proof. -induction n; intros p. - change ('p=='p)%CR. - reflexivity. -intros x Hx0 Hx1. -change (MVP_uc_fun_correct_sig_Q n (MVP_uc_fun (S n) p ('x)%CR) - (MVP_CR_apply n ((MVP_map inject_Q_hom (S n) p)!(MVP_C_ _ _ ('x)%CR)))). -eapply MVP_uc_fun_correct_sig_Q_wd;[apply MVP_uc_fun_sub_Q; auto| |apply IHn]. -apply Morphism_prf. -simpl. -setoid_replace (MVP_C_ CRasCRing n (' x)%CR) - with ((MVP_map inject_Q_hom n) (MVP_C_ Q_as_CRing n x)). - symmetry. - apply cpoly_map_apply. -clear - n. -induction n. - change ('x[=]'x)%CR. - reflexivity. -simpl. -apply: csf_wd. -apply IHn. + induction n; intros p. + change ('p=='p)%CR. + reflexivity. + intros x Hx0 Hx1. + change (MVP_uc_fun_correct_sig_Q n (MVP_uc_fun (S n) p ('x)%CR) + (MVP_CR_apply n ((MVP_map inject_Q_hom (S n) p)!(MVP_C_ _ _ ('x)%CR)))). + eapply MVP_uc_fun_correct_sig_Q_wd;[apply MVP_uc_fun_sub_Q; auto| |apply IHn]. + apply Morphism_prf. + simpl. + setoid_replace (MVP_C_ CRasCRing n (' x)%CR) with ((MVP_map inject_Q_hom n) (MVP_C_ Q_as_CRing n x)). + symmetry. + apply cpoly_map_apply. + clear - n. + induction n. + change ('x[=]'x)%CR. + reflexivity. + simpl. + apply: csf_wd. + apply IHn. Qed. Fixpoint MVP_uc_fun_close_sig n e : n_UniformlyContinuousFunction CR CR n -> n_Function CR CR n -> Prop := @@ -941,35 +865,33 @@ match n return n_UniformlyContinuousFunction CR CR n -> n_Function CR CR n -> Pr | S n' => fun f g => forall x, ('0 <= x)%CR -> (x <= '1)%CR -> MVP_uc_fun_close_sig n' e (f x) (g x) end. -Add Parametric Morphism n : +Add Parametric Morphism n : (@MVP_uc_fun_close_sig n) with signature QposEq ==> (@st_eq _) ==> (@st_eq _) ==> iff as MVP_uc_fun_close_sig_wd. -induction n; - intros e1 e2 He x y Hxy a b Hab. - change (ball e1 x a <-> ball e2 y b). - rewrite He Hxy Hab. - reflexivity. -simpl. -split; - intros H c. - rewrite <- (IHn _ _ He _ _ (Hxy c) _ _ (Hab c)). + induction n; intros e1 e2 He x y Hxy a b Hab. +Proof. + change (ball e1 x a <-> ball e2 y b). + rewrite He Hxy Hab. + reflexivity. + simpl. + split; intros H c. + rewrite <- (IHn _ _ He _ _ (Hxy c) _ _ (Hab c)). + auto. + rewrite (IHn _ _ He _ _ (Hxy c) _ _ (Hab c)). auto. -rewrite (IHn _ _ He _ _ (Hxy c) _ _ (Hab c)). -auto. Qed. Lemma MVP_uc_fun_close_weaken : forall n (e1 e2:Qpos) f g, (e1 <= e2) -> MVP_uc_fun_close_sig n e1 f g -> MVP_uc_fun_close_sig n e2 f g. Proof. -induction n; - intros e1 e2 f g He H. - apply: ball_weak_le. + induction n; intros e1 e2 f g He H. + apply: ball_weak_le. + apply He. + apply H. + intros x Hx0 Hx1. + apply: IHn. apply He. - apply H. -intros x Hx0 Hx1. -apply: IHn. - apply He. -apply H; auto. + apply H; auto. Qed. Fixpoint n_Function_ball01 n e : n_Function CR CR n -> n_Function CR CR n -> Prop := @@ -978,20 +900,19 @@ match n return n_Function CR CR n -> n_Function CR CR n -> Prop with | S n' => fun f g => forall x, ('0 <= x)%CR -> (x <= '1)%CR -> n_Function_ball01 n' e (f x) (g x) end. -Add Parametric Morphism n : +Add Parametric Morphism n : (@n_Function_ball01 n) with signature QposEq ==> (@st_eq _) ==> (@st_eq _) ==> iff as n_Function_ball01_wd. -induction n; - intros e1 e2 He x y Hxy a b Hab. - change (ball e1 x a <-> ball e2 y b). - rewrite He Hxy Hab. - reflexivity. -simpl. -split; - intros H c. - rewrite <- (IHn _ _ He _ _ (Hxy c) _ _ (Hab c)). + induction n; intros e1 e2 He x y Hxy a b Hab. +Proof. + change (ball e1 x a <-> ball e2 y b). + rewrite He Hxy Hab. + reflexivity. + simpl. + split; intros H c. + rewrite <- (IHn _ _ He _ _ (Hxy c) _ _ (Hab c)). + auto. + rewrite (IHn _ _ He _ _ (Hxy c) _ _ (Hab c)). auto. -rewrite (IHn _ _ He _ _ (Hxy c) _ _ (Hab c)). -auto. Qed. @@ -1000,15 +921,14 @@ Lemma MVP_uc_fun_close_left : forall n (e1 e2:Qpos) f1 f2 g, MVP_uc_fun_close_sig n e2 f2 g -> MVP_uc_fun_close_sig n (e1+e2) f1 g. Proof. -induction n; - intros e1 e2 f g1 g2 H0 H1. - eapply ball_triangle. - apply H0. - apply H1. -intros x Hx0 Hx1. -apply: IHn. - apply H0; auto. -apply H1; auto. + induction n; intros e1 e2 f g1 g2 H0 H1. + eapply ball_triangle. + apply H0. + apply H1. + intros x Hx0 Hx1. + apply: IHn. + apply H0; auto. + apply H1; auto. Qed. Lemma MVP_uc_fun_close_right : forall n (e1 e2:Qpos) f g1 g2, @@ -1016,26 +936,25 @@ Lemma MVP_uc_fun_close_right : forall n (e1 e2:Qpos) f g1 g2, n_Function_ball01 n e2 g1 g2 -> MVP_uc_fun_close_sig n (e1+e2) f g2. Proof. -induction n; - intros e1 e2 f g1 g2 H0 H1. - eapply ball_triangle. - apply H0. - apply H1. -intros x Hx0 Hx1. -apply: IHn. - apply H0; auto. -apply H1; auto. + induction n; intros e1 e2 f g1 g2 H0 H1. + eapply ball_triangle. + apply H0. + apply H1. + intros x Hx0 Hx1. + apply: IHn. + apply H0; auto. + apply H1; auto. Qed. Lemma n_Function_ball01_sym : forall n e f g, (n_Function_ball01 n e f g) -> (n_Function_ball01 n e g f). Proof. -induction n. - apply ball_sym. -intros e f g H x Hx0 Hx1. -apply IHn. -apply H; auto. + induction n. + apply ball_sym. + intros e f g H x Hx0 Hx1. + apply IHn. + apply H; auto. Qed. Lemma n_Function_ball01_triangle : forall n e1 e2 f g h, @@ -1043,45 +962,44 @@ Lemma n_Function_ball01_triangle : forall n e1 e2 f g h, (n_Function_ball01 n e2 g h) -> (n_Function_ball01 n (e1+e2)%Qpos f h). Proof. -induction n. - apply ball_triangle. -intros e1 e2 f g h H0 H1 x Hx0 Hx1. -apply: IHn. - apply H0; auto. -apply H1; auto. + induction n. + apply ball_triangle. + intros e1 e2 f g h H0 H1 x Hx0 Hx1. + apply: IHn. + apply H0; auto. + apply H1; auto. Qed. Lemma n_Function_ball01_plus : forall n e p1 p2 p3, (n_Function_ball01 n e (MVP_CR_apply n p2) (MVP_CR_apply n p3)) -> (n_Function_ball01 n e (MVP_CR_apply n (p1[+]p2)) (MVP_CR_apply n (p1[+]p3))). Proof. -induction n; - intros e p1 p2 p3 H. - intros d1 d2. - simpl. - unfold Qball. - unfold Cap_raw. - simpl. - replace RHS with ((approximate p1 ((1 # 2) * d1)%Qpos - approximate p1 ((1 # 2) * d2)%Qpos) - +(approximate p2 ((1 # 2) * d1)%Qpos - approximate p3 ((1 # 2) * d2)%Qpos)) by ring. - replace LHS with (((1 # 2) * d1 + (1 # 2) * d2)%Qpos+((1 # 2) * d1 + e + (1 # 2) * d2)%Qpos) by QposRing. - apply AbsSmall_plus. - change (ball ((1 # 2) * d1 + (1 # 2) * d2) (approximate p1 ((1 # 2) * d1)%Qpos) (approximate p1 ((1 # 2) * d2)%Qpos)). - generalize ((1#2)*d1)%Qpos ((1#2)*d2)%Qpos. - change (p1[=]p1). - reflexivity. - generalize ((1#2)*d1)%Qpos ((1#2)*d2)%Qpos. - apply H. -intros x Hx0 Hx1. -change (n_Function_ball01 n e (MVP_CR_apply _ (p1[+]p2) ! (MVP_C_ _ _ x)) - (MVP_CR_apply _ (p1[+]p3) ! (MVP_C_ _ _ x))). -eapply n_Function_ball01_wd;[| | |apply IHn]. + induction n; intros e p1 p2 p3 H. + intros d1 d2. + simpl. + unfold Qball. + unfold Cap_raw. + simpl. + replace RHS with ((approximate p1 ((1 # 2) * d1)%Qpos - approximate p1 ((1 # 2) * d2)%Qpos) + +(approximate p2 ((1 # 2) * d1)%Qpos - approximate p3 ((1 # 2) * d2)%Qpos)) by ring. + replace LHS with (((1 # 2) * d1 + (1 # 2) * d2)%Qpos+((1 # 2) * d1 + e + (1 # 2) * d2)%Qpos) by QposRing. + apply AbsSmall_plus. + change (ball ((1 # 2) * d1 + (1 # 2) * d2) (approximate p1 ((1 # 2) * d1)%Qpos) (approximate p1 ((1 # 2) * d2)%Qpos)). + generalize ((1#2)*d1)%Qpos ((1#2)*d2)%Qpos. + change (p1[=]p1). reflexivity. + generalize ((1#2)*d1)%Qpos ((1#2)*d2)%Qpos. + apply H. + intros x Hx0 Hx1. + change (n_Function_ball01 n e (MVP_CR_apply _ (p1[+]p2) ! (MVP_C_ _ _ x)) + (MVP_CR_apply _ (p1[+]p3) ! (MVP_C_ _ _ x))). + eapply n_Function_ball01_wd;[| | |apply IHn]. + reflexivity. + apply Morphism_prf. + apply plus_apply. apply Morphism_prf. apply plus_apply. - apply Morphism_prf. - apply plus_apply. -apply: H; auto. + apply: H; auto. Qed. Lemma n_Function_ball01_mult_C : forall n e c q1 q2, @@ -1090,111 +1008,107 @@ Lemma n_Function_ball01_mult_C : forall n e c q1 q2, (n_Function_ball01 n e (MVP_CR_apply n ((MVP_C_ _ _ c)[*]q1)) (MVP_CR_apply n ((MVP_C_ _ _ c)[*]q2))). Proof. -induction n; - intros e c q1 q2 Hc0 Hc1 H. - change (ball e (c * q1)%CR (c * q2)%CR). - rewrite <- CRAbsSmall_ball. - change (AbsSmall (' e)%CR (c[*]q1[-]c[*]q2)). - rstepr (c[*](q1[-]q2)). - apply AbsSmall_leEq_trans with (c[*]'e)%CR. - rstepr (One[*]('e))%CR. - apply mult_resp_leEq_rht; auto. - change ('0<='e)%CR. - rewrite CRle_Qle. - auto with *. - apply mult_resp_AbsSmall; auto. - rewrite CRAbsSmall_ball. - auto. -intros x Hx0 Hx1. -change (n_Function_ball01 n e (MVP_CR_apply _ (MVP_C_ _ _ c[*]q1) ! (MVP_C_ _ _ x)) - (MVP_CR_apply _ (MVP_C_ _ _ c[*]q2) ! (MVP_C_ _ _ x))). -eapply n_Function_ball01_wd. - reflexivity. + induction n; intros e c q1 q2 Hc0 Hc1 H. + change (ball e (c * q1)%CR (c * q2)%CR). + rewrite <- CRAbsSmall_ball. + change (AbsSmall (' e)%CR (c[*]q1[-]c[*]q2)). + rstepr (c[*](q1[-]q2)). + apply AbsSmall_leEq_trans with (c[*]'e)%CR. + rstepr (One[*]('e))%CR. + apply mult_resp_leEq_rht; auto. + change ('0<='e)%CR. + rewrite CRle_Qle. + auto with *. + apply mult_resp_AbsSmall; auto. + rewrite CRAbsSmall_ball. + auto. + intros x Hx0 Hx1. + change (n_Function_ball01 n e (MVP_CR_apply _ (MVP_C_ _ _ c[*]q1) ! (MVP_C_ _ _ x)) + (MVP_CR_apply _ (MVP_C_ _ _ c[*]q2) ! (MVP_C_ _ _ x))). + eapply n_Function_ball01_wd. + reflexivity. + apply Morphism_prf. + eapply eq_transitive. + apply mult_apply. + apply mult_wdl. + simpl. + apply c_apply. apply Morphism_prf. eapply eq_transitive. apply mult_apply. apply mult_wdl. simpl. apply c_apply. - apply Morphism_prf. - eapply eq_transitive. - apply mult_apply. - apply mult_wdl. - simpl. - apply c_apply. -apply IHn; auto. -apply: H; auto. + apply IHn; auto. + apply: H; auto. Qed. Fixpoint MVP_is_Bound01 n (M:CR) : MultivariatePolynomial CRasCRing n -> Prop := match n return MultivariatePolynomial CRasCRing n -> Prop with | O => fun a => AbsSmall M a -| S n' => fun p => forall x, ('0 <= x)%CR -> (x <= '1)%CR -> +| S n' => fun p => forall x, ('0 <= x)%CR -> (x <= '1)%CR -> MVP_is_Bound01 n' M (p ! (MVP_C_ _ _ x)) end. -Add Parametric Morphism n : +Add Parametric Morphism n : (@MVP_is_Bound01 n) with signature (@st_eq _) ==> (@st_eq _) ==> iff as MVP_is_Bound01_wd. Proof. -induction n; - intros x y Hxy a b Hab. - simpl. - rewrite Hxy. + induction n; intros x y Hxy a b Hab. + simpl. + rewrite Hxy. + rewrite Hab. + reflexivity. + split; intros H c Hc0 Hc1. + change (MVP_is_Bound01 n y b ! (MVP_C_ CRasCRing n c)). + rewrite <- (IHn _ _ Hxy (a!(MVP_C_ CRasCRing n c)) (b!(MVP_C_ CRasCRing n c))). + apply H; auto. + rewrite Hab. + reflexivity. + change (MVP_is_Bound01 n x a ! (MVP_C_ CRasCRing n c)). + rewrite <- (fun A => IHn y x A (b!(MVP_C_ CRasCRing n c)) (a!(MVP_C_ CRasCRing n c))). + apply H; auto. + symmetry; auto. rewrite Hab. reflexivity. -split; - intros H c Hc0 Hc1. - change (MVP_is_Bound01 n y b ! (MVP_C_ CRasCRing n c)). - rewrite <- (IHn _ _ Hxy (a!(MVP_C_ CRasCRing n c)) (b!(MVP_C_ CRasCRing n c))). - apply H; auto. - rewrite Hab. - reflexivity. -change (MVP_is_Bound01 n x a ! (MVP_C_ CRasCRing n c)). -rewrite <- (fun A => IHn y x A (b!(MVP_C_ CRasCRing n c)) (a!(MVP_C_ CRasCRing n c))). - apply H; auto. - symmetry; auto. -rewrite Hab. -reflexivity. -Qed. +Qed. Lemma MVP_is_Bound01_plus : forall n M N p q, MVP_is_Bound01 n M p -> MVP_is_Bound01 n N q -> MVP_is_Bound01 n (M+N)%CR (p[+]q). Proof. -induction n; intros M N p q Hp Hq. - apply: AbsSmall_plus; auto. -simpl. -intros x Hx0 Hx1. -rewrite plus_apply. -auto. + induction n; intros M N p q Hp Hq. + apply: AbsSmall_plus; auto. + simpl. + intros x Hx0 Hx1. + rewrite plus_apply. + auto. Qed. Lemma MVP_is_Bound01_mult01 : forall n M p x, ('0 <= x)%CR -> (x <= '1)%CR -> - MVP_is_Bound01 n M p -> + MVP_is_Bound01 n M p -> MVP_is_Bound01 n M (MVP_C_ _ n x[*]p). Proof. -induction n; - intros M p x Hx0 Hx1 H. - simpl. - change (st_car CR) in p. - eapply AbsSmall_leEq_trans;[|apply mult_resp_AbsSmall;[|apply H]]; auto. - rstepr ((One:CR)[*]M). - apply mult_resp_leEq_rht; auto. - simpl in H. - rewrite <- CRabs_AbsSmall in H. - eapply leEq_transitive;[|apply H]. - rewrite <- (CRasIRasCR_id p). - rewrite <- CRabs_correct. + induction n; intros M p x Hx0 Hx1 H. + simpl. + change (st_car CR) in p. + eapply AbsSmall_leEq_trans;[|apply mult_resp_AbsSmall;[|apply H]]; auto. + rstepr ((One:CR)[*]M). + apply mult_resp_leEq_rht; auto. + simpl in H. + rewrite <- CRabs_AbsSmall in H. + eapply leEq_transitive;[|apply H]. + rewrite <- (CRasIRasCR_id p). + rewrite <- CRabs_correct. + simpl. + rewrite <- IR_Zero_as_CR. + rewrite <- IR_leEq_as_CR. + apply AbsIR_nonneg. simpl. - rewrite <- IR_Zero_as_CR. - rewrite <- IR_leEq_as_CR. - apply AbsIR_nonneg. -simpl. -intros y Hy0 Hy1. -rewrite mult_apply. -rewrite c_apply. -apply IHn; auto. + intros y Hy0 Hy1. + rewrite mult_apply. + rewrite c_apply. + apply IHn; auto. Qed. Lemma n_Function_ball01_mult : forall n e x y p M, @@ -1204,86 +1118,92 @@ n_Function_ball01 n e (MVP_CR_apply n (MVP_C_ CRasCRing n x[*]p)) (MVP_CR_apply n (MVP_C_ CRasCRing n y[*]p)). Proof. -induction n; intros e x y p b Hb Hxy. - change (ball e (x*p) (y*p))%CR. - rewrite <- CRAbsSmall_ball. - change (AbsSmall (' e)%CR (x[*]p[-]y[*]p)). - rstepr (p[*](x[-]y)). - simpl in Hb. - case_eq (Qscale_modulus b e). - intros q Hq. - apply AbsSmall_leEq_trans with (CRabs p[*]'q)%CR. - destruct b as [[|nb|nb] db]. - discriminate Hq. - simpl in Hq. - injection Hq; clear Hq; intros Hq; rewrite <- Hq. - assert (Z: (' ((db # nb) * e)%Qpos)%CR[#]Zero). - apply: Qap_CRap. + induction n; intros e x y p b Hb Hxy. + change (ball e (x*p) (y*p))%CR. + rewrite <- CRAbsSmall_ball. + change (AbsSmall (' e)%CR (x[*]p[-]y[*]p)). + rstepr (p[*](x[-]y)). + simpl in Hb. + case_eq (Qscale_modulus b e). + intros q Hq. + apply AbsSmall_leEq_trans with (CRabs p[*]'q)%CR. + destruct b as [[|nb|nb] db]. + discriminate Hq. + simpl in Hq. + injection Hq; clear Hq; intros Hq; rewrite <- Hq. + assert (Z: (' ((db # nb) * e)%Qpos)%CR[#]Zero). + apply: Qap_CRap. + apply Qpos_nonzero. + apply shift_mult_leEq with Z. + apply: CRlt_Qlt; auto with *. + rewrite <- CRabs_AbsSmall in Hb. + stepr ('(nb#db))%CR; auto. + change ((' (nb # db))%CR[=](' e)%CR[*]CRinv (' ((db # nb) * e)%Qpos)%CR Z). + rewrite CRinv_Qinv. + rewrite -> CRmult_Qmult. + rewrite CReq_Qeq. + autorewrite with QposElim. + rewrite Qinv_mult_distr. + replace RHS with ((/(db#nb) * e) * /e) by ring. + change (nb#db == ((nb#db)*e/e)). + rewrite Qdiv_mult_l. + reflexivity. apply Qpos_nonzero. - apply shift_mult_leEq with Z. - apply: CRlt_Qlt; auto with *. - rewrite <- CRabs_AbsSmall in Hb. - stepr ('(nb#db))%CR; auto. - change ((' (nb # db))%CR[=](' e)%CR[*]CRinv (' ((db # nb) * e)%Qpos)%CR Z). - rewrite CRinv_Qinv. - rewrite -> CRmult_Qmult. - rewrite CReq_Qeq. - autorewrite with QposElim. - rewrite Qinv_mult_distr. - replace RHS with ((/(db#nb) * e) * /e) by ring. - change (nb#db == ((nb#db)*e/e)). - rewrite Qdiv_mult_l. - reflexivity. - apply Qpos_nonzero. - elim (Qle_not_lt 0 (Zneg nb # db)); auto with *. - rewrite <- CRle_Qle. - apply: AbsSmall_nonneg. - apply Hb. - cut (Not (Not (AbsSmall (CRabs p[*](' q)%CR) (p[*](x[-]y))))). - unfold Not, AbsSmall. - repeat rewrite leEq_def. - unfold Not; tauto. - generalize (leEq_or_leEq CRasCOrdField Zero p). - cut (((Zero:CR)[<=]p or (p:CR)[<=]Zero) -> AbsSmall (CRabs p[*](' q)%CR) (p[*](x[-]y))). - unfold Not; tauto. - intros [Hp|Hp]. - rewrite CRabs_pos; auto. - apply mult_resp_AbsSmall;auto. + elim (Qle_not_lt 0 (Zneg nb # db)); auto with *. + rewrite <- CRle_Qle. + apply: AbsSmall_nonneg. + apply Hb. + cut (Not (Not (AbsSmall (CRabs p[*](' q)%CR) (p[*](x[-]y))))). + unfold Not, AbsSmall. + repeat rewrite leEq_def. + unfold Not; tauto. + generalize (leEq_or_leEq CRasCOrdField Zero p). + cut (((Zero:CR)[<=]p or (p:CR)[<=]Zero) -> AbsSmall (CRabs p[*](' q)%CR) (p[*](x[-]y))). + unfold Not; tauto. + intros [Hp|Hp]. + rewrite CRabs_pos; auto. + apply mult_resp_AbsSmall;auto. + rewrite Hq in Hxy. + rewrite CRAbsSmall_ball. + auto. + rewrite CRabs_neg; auto. + rstepr (([--]p)[*](y[-]x)). + apply mult_resp_AbsSmall. + rstepl ([--]Zero:CR). + apply inv_resp_leEq. + auto. rewrite Hq in Hxy. rewrite CRAbsSmall_ball. - auto. - rewrite CRabs_neg; auto. - rstepr (([--]p)[*](y[-]x)). - apply mult_resp_AbsSmall. - rstepl ([--]Zero:CR). - apply inv_resp_leEq. - auto. - rewrite Hq in Hxy. - rewrite CRAbsSmall_ball. - apply ball_sym. - apply Hxy. - intros Hq. - destruct b as [[|nb|nb] db]; try discriminate Hq. - stepr (Zero:CR). - apply zero_AbsSmall. - simpl. - rewrite CRle_Qle; auto with *. - rstepl (Zero[*](x[-]y))%CR. - apply mult_wdl. - destruct Hb as [Hb0 Hb1]. - apply: leEq_imp_eq. - stepl (-(' (0 # db)))%CR; auto. - rewrite CRopp_Qopp. + apply ball_sym. + apply Hxy. + intros Hq. + destruct b as [[|nb|nb] db]; try discriminate Hq. + stepr (Zero:CR). + apply zero_AbsSmall. + simpl. + rewrite CRle_Qle; auto with *. + rstepl (Zero[*](x[-]y))%CR. + apply mult_wdl. + destruct Hb as [Hb0 Hb1]. + apply: leEq_imp_eq. + stepl (-(' (0 # db)))%CR; auto. + rewrite CRopp_Qopp. + change ('(0#db)=='0)%CR. + rewrite CReq_Qeq. + unfold Qeq; reflexivity. + stepr ((' (0 # db)))%CR; auto. change ('(0#db)=='0)%CR. rewrite CReq_Qeq. unfold Qeq; reflexivity. - stepr ((' (0 # db)))%CR; auto. - change ('(0#db)=='0)%CR. - rewrite CReq_Qeq. - unfold Qeq; reflexivity. -simpl. -intros a Ha0 Ha1. -eapply n_Function_ball01_wd. + simpl. + intros a Ha0 Ha1. + eapply n_Function_ball01_wd. + reflexivity. + apply Morphism_prf. + eapply eq_transitive. + apply mult_apply. + apply csbf_wd. + apply c_apply. reflexivity. apply Morphism_prf. eapply eq_transitive. @@ -1291,13 +1211,7 @@ eapply n_Function_ball01_wd. apply csbf_wd. apply c_apply. reflexivity. - apply Morphism_prf. - eapply eq_transitive. - apply mult_apply. - apply csbf_wd. - apply c_apply. - reflexivity. -apply: IHn; auto. + apply: IHn; auto. Qed. Fixpoint MVP_poor_Bound01 n : MultivariatePolynomial Q_as_CRing n -> Q := @@ -1312,90 +1226,84 @@ end. Lemma MVP_poor_Bound01_zero : forall n, MVP_poor_Bound01 n (Zero)==0. Proof. -induction n. + induction n. + reflexivity. reflexivity. -reflexivity. Qed. -Add Parametric Morphism n : +Add Parametric Morphism n : (@MVP_poor_Bound01 n) with signature (@st_eq _) ==> Qeq as MVP_poor_Bound01_wd. -induction n. - intros x y Hxy. - simpl in *. - rewrite Hxy. - reflexivity. -induction x. - induction y. +Proof. + induction n. + intros x y Hxy. + simpl in *. + rewrite Hxy. reflexivity. - intros [H0 H1]. - simpl in *. - change 0 with (0+0). - apply Qplus_comp. - rewrite <- (MVP_poor_Bound01_zero n). - apply IHn. - symmetry; auto. - apply IHy. - apply H1. -intros [|t y] [H0 H1]. - simpl. - change 0 with (0+0). + induction x. + induction y. + reflexivity. + intros [H0 H1]. + simpl in *. + change 0 with (0+0). + apply Qplus_comp. + rewrite <- (MVP_poor_Bound01_zero n). + apply IHn. + symmetry; auto. + apply IHy. + apply H1. + intros [|t y] [H0 H1]. + simpl. + change 0 with (0+0). apply Qplus_comp. - rewrite <- (MVP_poor_Bound01_zero n). + rewrite <- (MVP_poor_Bound01_zero n). + apply IHn. + auto. + change (MVP_poor_Bound01 (S n) x==0). + rewrite <- (MVP_poor_Bound01_zero (S n)). + apply IHx. + apply eq_symmetric. + apply H1. + simpl. + apply Qplus_comp. apply IHn. auto. - change (MVP_poor_Bound01 (S n) x==0). - rewrite <- (MVP_poor_Bound01_zero (S n)). apply IHx. - apply eq_symmetric. - apply H1. -simpl. -apply Qplus_comp. - apply IHn. auto. -apply IHx. -auto. Qed. Lemma MVP_poor_is_Bound01 : forall n p, MVP_is_Bound01 n ('(MVP_poor_Bound01 n p))%CR (MVP_map inject_Q_hom n p). Proof. -induction n. - split. - change (-('Qabs p)<='p)%CR. - rewrite CRopp_Qopp. + induction n. + split. + change (-('Qabs p)<='p)%CR. + rewrite CRopp_Qopp. + rewrite CRle_Qle. + simpl in p. + replace RHS with (- (- p)) by ring. + apply Qopp_le_compat. + rewrite <- Qabs_opp. + apply Qle_Qabs. + change ('p<=('Qabs p))%CR. rewrite CRle_Qle. - simpl in p. - replace RHS with (- (- p)) by ring. - apply Qopp_le_compat. - rewrite <- Qabs_opp. apply Qle_Qabs. - change ('p<=('Qabs p))%CR. - rewrite CRle_Qle. - apply Qle_Qabs. -simpl. -induction p; intros x Hx0 Hx1. - change (MVP_is_Bound01 n ('0)%CR (Zero)). - clear - n. - induction n. - apply AbsSmall_reflexive. - apply leEq_reflexive. - intros y _ _. - apply IHn. -change (MVP_is_Bound01 n - (' (MVP_poor_Bound01 n s + - (fix MVP_poor_Bound01_H (p0 : cpoly - (MultivariatePolynomial Q_as_CRing n)) : - Q := - match p0 with - | cpoly_zero => 0 - | cpoly_linear s0 p' => - (MVP_poor_Bound01 n s0 + MVP_poor_Bound01_H p')%Q - end) p))%CR - (MVP_map inject_Q_hom n s[+]MVP_C_ CRasCRing n x[*](cpoly_map (MVP_map inject_Q_hom n) p) ! (MVP_C_ CRasCRing n x))). -rewrite <- CRplus_Qplus. -apply MVP_is_Bound01_plus. - apply IHn. -apply MVP_is_Bound01_mult01; auto. + simpl. + induction p; intros x Hx0 Hx1. + change (MVP_is_Bound01 n ('0)%CR (Zero)). + clear - n. + induction n. + apply AbsSmall_reflexive. + apply leEq_reflexive. + intros y _ _. + apply IHn. + change (MVP_is_Bound01 n (' (MVP_poor_Bound01 n s + (fix MVP_poor_Bound01_H (p0 : cpoly + (MultivariatePolynomial Q_as_CRing n)) : Q := match p0 with | cpoly_zero => 0 + | cpoly_linear s0 p' => (MVP_poor_Bound01 n s0 + MVP_poor_Bound01_H p')%Q end) p))%CR + (MVP_map inject_Q_hom n s[+]MVP_C_ CRasCRing n x[*](cpoly_map (MVP_map inject_Q_hom n) p) ! (MVP_C_ CRasCRing n x))). + rewrite <- CRplus_Qplus. + apply MVP_is_Bound01_plus. + apply IHn. + apply MVP_is_Bound01_mult01; auto. Qed. Lemma MVP_CR_apply_cont : forall n e (p:MultivariatePolynomial Q_as_CRing (S n)), @@ -1406,170 +1314,162 @@ Lemma MVP_CR_apply_cont : forall n e (p:MultivariatePolynomial Q_as_CRing (S n)) n_Function_ball01 n e (MVP_CR_apply _ (MVP_map inject_Q_hom _ p) x) (MVP_CR_apply _ (MVP_map inject_Q_hom _ p) ('y)%CR)}. Proof. -intros n e p. -revert e. -induction p; intros e. - exists QposInfinity. - intros x y _ _ _ _ _. - change (n_Function_ball01 n e - (MVP_CR_apply n Zero) - (MVP_CR_apply n Zero)). - generalize (MVP_CR_apply n Zero). - induction n. - apply ball_refl. - intros s a _ _. - apply IHn. -simpl. -destruct (IHp ((1#2)*e)%Qpos) as [d0 Hd0]. -set (b:=MVP_poor_Bound01 (S n) p). -set (d1:=(Qscale_modulus b ((1 # 2) * e))). -exists (QposInf_min d0 d1). -intros x y Hx0 Hx1 Hy0 Hy1 Hxy. -change (n_Function_ball01 n e - (MVP_CR_apply n - ((MVP_map inject_Q_hom n s)[+](MVP_C_ CRasCRing n x)[*]((cpoly_map (MVP_map inject_Q_hom n) p)) - ! (MVP_C_ CRasCRing n x))) - (MVP_CR_apply n - ((MVP_map inject_Q_hom n s)[+](MVP_C_ CRasCRing n ('y)%CR)[*]((cpoly_map (MVP_map inject_Q_hom n) p)) + intros n e p. + revert e. + induction p; intros e. + exists QposInfinity. + intros x y _ _ _ _ _. + change (n_Function_ball01 n e (MVP_CR_apply n Zero) (MVP_CR_apply n Zero)). + generalize (MVP_CR_apply n Zero). + induction n. + apply ball_refl. + intros s a _ _. + apply IHn. + simpl. + destruct (IHp ((1#2)*e)%Qpos) as [d0 Hd0]. + set (b:=MVP_poor_Bound01 (S n) p). + set (d1:=(Qscale_modulus b ((1 # 2) * e))). + exists (QposInf_min d0 d1). + intros x y Hx0 Hx1 Hy0 Hy1 Hxy. + change (n_Function_ball01 n e (MVP_CR_apply n + ((MVP_map inject_Q_hom n s)[+](MVP_C_ CRasCRing n x)[*]((cpoly_map (MVP_map inject_Q_hom n) p)) + ! (MVP_C_ CRasCRing n x))) (MVP_CR_apply n + ((MVP_map inject_Q_hom n s)[+](MVP_C_ CRasCRing n ('y)%CR)[*]((cpoly_map (MVP_map inject_Q_hom n) p)) ! (MVP_C_ CRasCRing n (inject_Q_hom y)%CR)))). -apply n_Function_ball01_plus. -setoid_replace e with ((1#2)*e + (1#2)*e)%Qpos by QposRing. -apply n_Function_ball01_triangle with (MVP_CR_apply n - (MVP_C_ CRasCRing n x[*] - (cpoly_map (MVP_map inject_Q_hom n) p) ! (MVP_C_ CRasCRing n (inject_Q_hom y)%CR))). - apply n_Function_ball01_mult_C; auto. - change (n_Function_ball01 n ((1 # 2) * e) - (MVP_CR_apply (S n) (MVP_map inject_Q_hom (S n) p) x) - (MVP_CR_apply (S n) (MVP_map inject_Q_hom (S n) p) ('y)%CR)). - apply Hd0; auto with *. - eapply ball_ex_weak_le;[|apply Hxy]. - apply QposInf_min_lb_l. -eapply n_Function_ball01_wd. - reflexivity. + apply n_Function_ball01_plus. + setoid_replace e with ((1#2)*e + (1#2)*e)%Qpos by QposRing. + apply n_Function_ball01_triangle with (MVP_CR_apply n (MVP_C_ CRasCRing n x[*] + (cpoly_map (MVP_map inject_Q_hom n) p) ! (MVP_C_ CRasCRing n (inject_Q_hom y)%CR))). + apply n_Function_ball01_mult_C; auto. + change (n_Function_ball01 n ((1 # 2) * e) (MVP_CR_apply (S n) (MVP_map inject_Q_hom (S n) p) x) + (MVP_CR_apply (S n) (MVP_map inject_Q_hom (S n) p) ('y)%CR)). + apply Hd0; auto with *. + eapply ball_ex_weak_le;[|apply Hxy]. + apply QposInf_min_lb_l. + eapply n_Function_ball01_wd. + reflexivity. + apply Morphism_prf. + apply mult_wdr. + eapply eq_transitive. + apply csbf_wd;[apply eq_reflexive|]. + symmetry. + apply MVP_map_C_. + symmetry. + apply cpoly_map_apply. apply Morphism_prf. apply mult_wdr. eapply eq_transitive. apply csbf_wd;[apply eq_reflexive|]. - symmetry. + symmetry. apply MVP_map_C_. symmetry. apply cpoly_map_apply. - apply Morphism_prf. - apply mult_wdr. - eapply eq_transitive. - apply csbf_wd;[apply eq_reflexive|]. - symmetry. - apply MVP_map_C_. - symmetry. - apply cpoly_map_apply. -apply n_Function_ball01_mult with b. - assert (Z:=MVP_poor_is_Bound01 (S n) p _ Hy0 Hy1). - unfold b. - change (MVP_is_Bound01 n (' MVP_poor_Bound01 (S n) p)%CR - (MVP_map inject_Q_hom (S n) p) ! (MVP_C_ CRasCRing n (' y)%CR)) in Z. - eapply MVP_is_Bound01_wd;[| |apply Z]. - reflexivity. - simpl. - change (MVP_map inject_Q_hom n p ! (MVP_C_ Q_as_CRing n y)[=] -(cpoly_map (MVP_map inject_Q_hom n) p) -! (MVP_C_ CRasCRing n (inject_Q_hom y)%CR)). - rewrite <- MVP_map_C_. - apply cpoly_map_apply. -eapply ball_ex_weak_le;[|apply Hxy]. -apply QposInf_min_lb_r. + apply n_Function_ball01_mult with b. + assert (Z:=MVP_poor_is_Bound01 (S n) p _ Hy0 Hy1). + unfold b. + change (MVP_is_Bound01 n (' MVP_poor_Bound01 (S n) p)%CR + (MVP_map inject_Q_hom (S n) p) ! (MVP_C_ CRasCRing n (' y)%CR)) in Z. + eapply MVP_is_Bound01_wd;[| |apply Z]. + reflexivity. + simpl. + change (MVP_map inject_Q_hom n p ! (MVP_C_ Q_as_CRing n y)[=] (cpoly_map (MVP_map inject_Q_hom n) p) + ! (MVP_C_ CRasCRing n (inject_Q_hom y)%CR)). + rewrite <- MVP_map_C_. + apply cpoly_map_apply. + eapply ball_ex_weak_le;[|apply Hxy]. + apply QposInf_min_lb_r. Qed. Lemma MVP_uc_fun_close : forall n e (p:MultivariatePolynomial Q_as_CRing n), MVP_uc_fun_close_sig n e (MVP_uc_fun n p) (MVP_CR_apply n (MVP_map inject_Q_hom n p)). Proof. -induction n; intros e p. - change (ball e ('p) ('p))%CR. - apply ball_refl. -intros x Hx0 Hx1. -change (MVP_uc_fun_close_sig n e (MVP_uc_fun (S n) p x) - (MVP_CR_apply (S n) (MVP_map inject_Q_hom (S n) p) x)). -setoid_replace e with ((((1#3)*e)+(1#3)*e)+(1#3)*e)%Qpos by QposRing. -set (e3:=((1#3)*e)%Qpos). -destruct (MVP_CR_apply_cont e3 p) as [d0 Hd]. -set (d1:=mu (MVP_uc_fun (S n) p) e3). -set (d:=QposInf_min d0 d1). -set (y:=Qclamp01 (approximate x d)). -destruct (Qclamp01_clamped (approximate x d)) as [Hy0 Hy1]. -rewrite <- CRle_Qle in Hy0. -rewrite <- CRle_Qle in Hy1. -assert (Hd0:=Hd _ _ Hx0 Hx1 Hy0 Hy1). -assert (Z:ball_ex d x (' Qclamp01 (approximate x d))%CR). - clear - Hx0 Hx1. - destruct d as [d|];[|constructor]. - change (ball d x (' Qclamp01 (approximate x d))%CR). - rewrite <- CRAbsSmall_ball. - assert (Z:=ball_approx_r x d). - rewrite <- CRAbsSmall_ball in Z. - change (AbsSmall (' d)%CR (x[-]'(approximate x d)))%CR in Z. - revert Z. - generalize (approximate x d). - clear - Hx0 Hx1. - intros s [Z0 Z1]. - simpl. - split. - apply Qmax_case. + induction n; intros e p. + change (ball e ('p) ('p))%CR. + apply ball_refl. + intros x Hx0 Hx1. + change (MVP_uc_fun_close_sig n e (MVP_uc_fun (S n) p x) + (MVP_CR_apply (S n) (MVP_map inject_Q_hom (S n) p) x)). + setoid_replace e with ((((1#3)*e)+(1#3)*e)+(1#3)*e)%Qpos by QposRing. + set (e3:=((1#3)*e)%Qpos). + destruct (MVP_CR_apply_cont e3 p) as [d0 Hd]. + set (d1:=mu (MVP_uc_fun (S n) p) e3). + set (d:=QposInf_min d0 d1). + set (y:=Qclamp01 (approximate x d)). + destruct (Qclamp01_clamped (approximate x d)) as [Hy0 Hy1]. + rewrite <- CRle_Qle in Hy0. + rewrite <- CRle_Qle in Hy1. + assert (Hd0:=Hd _ _ Hx0 Hx1 Hy0 Hy1). + assert (Z:ball_ex d x (' Qclamp01 (approximate x d))%CR). + clear - Hx0 Hx1. + destruct d as [d|];[|constructor]. + change (ball d x (' Qclamp01 (approximate x d))%CR). + rewrite <- CRAbsSmall_ball. + assert (Z:=ball_approx_r x d). + rewrite <- CRAbsSmall_ball in Z. + change (AbsSmall (' d)%CR (x[-]'(approximate x d)))%CR in Z. + revert Z. + generalize (approximate x d). + clear - Hx0 Hx1. + intros s [Z0 Z1]. + simpl. + split. + apply Qmax_case. + intros _. + apply leEq_transitive with (Zero:CR). + rstepr ([--](Zero:CR)). + apply inv_resp_leEq. + change ('0<='d)%CR. + rewrite CRle_Qle. + auto with *. + change (Zero[<=]x[-]Zero)%CR. + rstepr x. + auto. + intros H. + eapply leEq_transitive;[apply Z0|]. + apply minus_resp_leEq_rht. + rewrite -> CRle_Qle. + apply Qmin_lb_r. + rewrite Qmax_min_distr_r. + apply Qmin_case. intros _. - apply leEq_transitive with (Zero:CR). - rstepr ([--](Zero:CR)). - apply inv_resp_leEq. - change ('0<='d)%CR. - rewrite CRle_Qle. - auto with *. - change (Zero[<=]x[-]Zero)%CR. - rstepr x. - auto. + eapply leEq_transitive with ('1[-]'1)%CR. + apply minus_resp_leEq. + auto. + rstepl (Zero:CR). + change ('0<='d)%CR. + rewrite CRle_Qle. + auto with *. intros H. - eapply leEq_transitive;[apply Z0|]. + eapply leEq_transitive;[|apply Z1]. apply minus_resp_leEq_rht. rewrite -> CRle_Qle. - apply Qmin_lb_r. - rewrite Qmax_min_distr_r. - apply Qmin_case. - intros _. - eapply leEq_transitive with ('1[-]'1)%CR. - apply minus_resp_leEq. - auto. - rstepl (Zero:CR). - change ('0<='d)%CR. - rewrite CRle_Qle. - auto with *. - intros H. - eapply leEq_transitive;[|apply Z1]. - apply minus_resp_leEq_rht. - rewrite -> CRle_Qle. - apply Qmax_ub_r. -eapply MVP_uc_fun_close_right; - [|apply n_Function_ball01_sym;apply Hd0]. - eapply MVP_uc_fun_close_left. - apply uc_prf. - eapply ball_ex_weak_le;[|apply Z]. - apply QposInf_min_lb_r. - rewrite -> CRle_Qle in Hy0. - rewrite -> CRle_Qle in Hy1. - rewrite MVP_uc_fun_sub_Q;auto. - eapply MVP_uc_fun_close_sig_wd. - reflexivity. - reflexivity. - simpl. - apply Morphism_prf. - eapply eq_transitive. - apply csbf_wd. + apply Qmax_ub_r. + eapply MVP_uc_fun_close_right; [|apply n_Function_ball01_sym;apply Hd0]. + eapply MVP_uc_fun_close_left. + apply uc_prf. + eapply ball_ex_weak_le;[|apply Z]. + apply QposInf_min_lb_r. + rewrite -> CRle_Qle in Hy0. + rewrite -> CRle_Qle in Hy1. + rewrite MVP_uc_fun_sub_Q;auto. + eapply MVP_uc_fun_close_sig_wd. + reflexivity. reflexivity. + simpl. + apply Morphism_prf. + eapply eq_transitive. + apply csbf_wd. + reflexivity. + symmetry. + apply (MVP_map_C_ inject_Q_hom). symmetry. - apply (MVP_map_C_ inject_Q_hom). - symmetry. - change (cpoly_map_fun (MultivariatePolynomial Q_as_CRing n) - (MultivariatePolynomial CRasCRing n) (MVP_map inject_Q_hom n) p) - with (cpoly_map (MVP_map inject_Q_hom n) p). - apply cpoly_map_apply. - apply IHn. -eapply ball_ex_weak_le;[|apply Z]. -apply QposInf_min_lb_l. + change (cpoly_map_fun (MultivariatePolynomial Q_as_CRing n) + (MultivariatePolynomial CRasCRing n) (MVP_map inject_Q_hom n) p) + with (cpoly_map (MVP_map inject_Q_hom n) p). + apply cpoly_map_apply. + apply IHn. + eapply ball_ex_weak_le;[|apply Z]. + apply QposInf_min_lb_l. Qed. Fixpoint MVP_uc_fun_correct_sig n : n_UniformlyContinuousFunction CR CR n -> n_Function CR CR n -> Prop := @@ -1582,17 +1482,17 @@ end. Lemma MVP_uc_fun_correct : forall n (p:MultivariatePolynomial Q_as_CRing n), MVP_uc_fun_correct_sig n (MVP_uc_fun n p) (MVP_CR_apply n (MVP_map inject_Q_hom n p)). Proof. -intros n p. -generalize (fun e => MVP_uc_fun_close n e p). -generalize (MVP_uc_fun n p) (MVP_CR_apply n (MVP_map inject_Q_hom n p)). -clear p. -induction n; intros a b H. - apply ball_eq. - auto. -intros x Hx0 Hx1. -apply IHn. -intros e. -apply H; auto. + intros n p. + generalize (fun e => MVP_uc_fun_close n e p). + generalize (MVP_uc_fun n p) (MVP_CR_apply n (MVP_map inject_Q_hom n p)). + clear p. + induction n; intros a b H. + apply ball_eq. + auto. + intros x Hx0 Hx1. + apply IHn. + intros e. + apply H; auto. Qed. End MVP_correct. diff --git a/reals/fast/Plot.v b/reals/fast/Plot.v index bfac450d0..4e4dafd28 100644 --- a/reals/fast/Plot.v +++ b/reals/fast/Plot.v @@ -50,35 +50,35 @@ Variable f : Q_as_MetricSpace --> CR. Lemma plFEQ : PrelengthSpace (FinEnum stableQ). Proof. -apply FinEnum_prelength. - apply locatedQ. -apply QPrelengthSpace. + apply FinEnum_prelength. + apply locatedQ. + apply QPrelengthSpace. Qed. Definition graphQ f := CompactGraph_b f stableQ2 plFEQ (CompactIntervalQ (Qlt_le_weak _ _ Hlr)). -Lemma graphQ_bonus : forall e x y, +Lemma graphQ_bonus : forall e x y, In (x, y) (approximate (graphQ (uc_compose clip f)) e) -> l <= x <= r /\ b <= y <= t. Proof. -intros [e|] x y;[|intros; contradiction]. -simpl. -unfold Cjoin_raw. -Opaque CompactIntervalQ. -simpl. -unfold FinCompact_raw. -rewrite map_map. -rewrite in_map_iff. -unfold graphPoint_b_raw. -simpl. -unfold Couple_raw. -simpl. -intros [z [Hz0 Hz1]]. -inversion Hz0. -rewrite <- H0. -clear Hz0 x y H0 H1. -split; auto with *. -eapply CompactIntervalQ_bonus_correct. -apply Hz1. + intros [e|] x y;[|intros; contradiction]. + simpl. + unfold Cjoin_raw. + Opaque CompactIntervalQ. + simpl. + unfold FinCompact_raw. + rewrite map_map. + rewrite in_map_iff. + unfold graphPoint_b_raw. + simpl. + unfold Couple_raw. + simpl. + intros [z [Hz0 Hz1]]. + inversion Hz0. + rewrite <- H0. + clear Hz0 x y H0 H1. + split; auto with *. + eapply CompactIntervalQ_bonus_correct. + apply Hz1. Qed. Variable n m : nat. @@ -91,58 +91,58 @@ Let h := proj1_sigT _ _ (Qpos_lt_plus Hbt). (* Variable err : Qpos. *) -Let err := Qpos_max ((1 # 4 * P_of_succ_nat (pred n)) * w) +Let err := Qpos_max ((1 # 4 * P_of_succ_nat (pred n)) * w) ((1 # 4 * P_of_succ_nat (pred m)) * h). (** [PlotQ] is the function that does all the work. *) -Definition PlotQ := RasterizeQ2 (approximate (graphQ (uc_compose clip f)) err) n m t l b r. +Definition PlotQ := RasterizeQ2 (approximate (graphQ (uc_compose clip f)) err) n m t l b r. Open Local Scope raster. (** The resulting plot is close to the graph of [f] *) -Theorem Plot_correct : +Theorem Plot_correct : ball (err + Qpos_max ((1 # 2 * P_of_succ_nat (pred n)) * w) ((1 # 2 * P_of_succ_nat (pred m)) * h)) (graphQ (uc_compose clip f)) (Cunit (InterpRaster PlotQ (l,t) (r,b))). Proof. -assert (Hw:=(ProjT2 (Qpos_lt_plus Hlr))). -assert (Hh:=(ProjT2 (Qpos_lt_plus Hbt))). -fold w in Hw. -fold h in Hh. -simpl in Hw, Hh. -apply ball_triangle with (Cunit (approximate (graphQ (uc_compose clip f)) err)). - apply ball_approx_r. -unfold Compact. -rewrite ball_Cunit. -apply ball_sym. -assert (L:st_eq ((l,t):Q2) (l,b + h)). - split; simpl. - reflexivity. - auto. -set (Z0:=(l, t):Q2) in *. -set (Z1:=(r, b):Q2) in *. -set (Z:=(l, (b + h)):Q2) in *. -rewrite L. -setoid_replace Z1 with (l+w,b). - unfold Z, PlotQ. - rewrite Hw Hh. - destruct n; try discriminate. - destruct m; try discriminate. - apply (RasterizeQ2_correct). - intros. - rewrite <- Hw. - rewrite <- Hh. - destruct (InStrengthen _ _ H) as [[zx xy] [Hz0 [Hz1 Hz2]]]. - simpl in Hz1, Hz2. - rewrite Hz1 Hz2. - eapply graphQ_bonus. - apply Hz0. -split; simpl; auto with *. + assert (Hw:=(ProjT2 (Qpos_lt_plus Hlr))). + assert (Hh:=(ProjT2 (Qpos_lt_plus Hbt))). + fold w in Hw. + fold h in Hh. + simpl in Hw, Hh. + apply ball_triangle with (Cunit (approximate (graphQ (uc_compose clip f)) err)). + apply ball_approx_r. + unfold Compact. + rewrite ball_Cunit. + apply ball_sym. + assert (L:st_eq ((l,t):Q2) (l,b + h)). + split; simpl. + reflexivity. + auto. + set (Z0:=(l, t):Q2) in *. + set (Z1:=(r, b):Q2) in *. + set (Z:=(l, (b + h)):Q2) in *. + rewrite L. + setoid_replace Z1 with (l+w,b). + unfold Z, PlotQ. + rewrite Hw Hh. + destruct n; try discriminate. + destruct m; try discriminate. + apply (RasterizeQ2_correct). + intros. + rewrite <- Hw. + rewrite <- Hh. + destruct (InStrengthen _ _ H) as [[zx xy] [Hz0 [Hz1 Hz2]]]. + simpl in Hz1, Hz2. + rewrite Hz1 Hz2. + eapply graphQ_bonus. + apply Hz0. + split; simpl; auto with *. Qed. End Plot. (** Some nice notation for the graph of f. *) -Notation "'graphCR' f [ l '..' r ]" := +Notation "'graphCR' f [ l '..' r ]" := (graphQ l r (refl_equal _) f) (f at level 0) : raster. diff --git a/reals/fast/PowerBound.v b/reals/fast/PowerBound.v index 52522a2a7..751cece2f 100644 --- a/reals/fast/PowerBound.v +++ b/reals/fast/PowerBound.v @@ -33,93 +33,89 @@ Open Local Scope Q_scope. form 3^z or 4^z. *) Lemma power3bound : forall (q:Q), (q <= (3^(Z_of_nat (let (n,_):= q in match n with Zpos p => Psize p | _ => O end)))%Z). -intros [[|n|n] d]; try discriminate. -unfold Qle. -simpl. -Open Scope Z_scope. -rewrite Zpos_mult_morphism. -apply Zmult_le_compat; auto with *. -clear - n. -apply Zle_trans with (two_p (Zsucc (log_inf n))-1)%Z. - rewrite <- Zle_plus_swap. - apply Zlt_succ_le. - change (' n+1) with (Zsucc ('n)). - apply Zsucc_lt_compat. - destruct (log_inf_correct2 n). - assumption. -replace (Zsucc (log_inf n)) with (Z_of_nat (Psize n)). - apply Zle_trans with (two_p (Z_of_nat (Psize n))). - auto with *. - induction (Psize n); auto with *. - rewrite inj_S. +Proof. + intros [[|n|n] d]; try discriminate. + unfold Qle. simpl. - unfold Zsucc. - rewrite two_p_is_exp; auto with *. - change (two_p 1) with 2. - rewrite Zpower_exp; auto with *. - change (3^1) with 3. + Open Scope Z_scope. + rewrite Zpos_mult_morphism. apply Zmult_le_compat; auto with *. - induction (Z_of_nat n0); auto with *. -induction n; auto with *; simpl; rewrite <- IHn; - rewrite <- POS_anti_convert; rewrite inj_S; reflexivity. + clear - n. + apply Zle_trans with (two_p (Zsucc (log_inf n))-1)%Z. + rewrite <- Zle_plus_swap. + apply Zlt_succ_le. + change (' n+1) with (Zsucc ('n)). + apply Zsucc_lt_compat. + destruct (log_inf_correct2 n). + assumption. + replace (Zsucc (log_inf n)) with (Z_of_nat (Psize n)). + apply Zle_trans with (two_p (Z_of_nat (Psize n))). + auto with *. + induction (Psize n); auto with *. + rewrite inj_S. + simpl. + unfold Zsucc. + rewrite two_p_is_exp; auto with *. + change (two_p 1) with 2. + rewrite Zpower_exp; auto with *. + change (3^1) with 3. + apply Zmult_le_compat; auto with *. + induction (Z_of_nat n0); auto with *. + induction n; auto with *; simpl; rewrite <- IHn; + rewrite <- POS_anti_convert; rewrite inj_S; reflexivity. Close Scope Z_scope. Qed. Lemma power4bound : forall (q:Q), (q <= (4^(Z_of_nat (let (n,_):= q in match n with Zpos p => Psize p | _ => O end)))%Z). Proof. -intros q. -eapply Qle_trans. - apply power3bound. -generalize (let (n, _) := q in - match n with - | 0 => 0%nat - | ' p => Psize p - | Zneg _ => 0%nat - end)%Z. -intros n. -unfold Qle. -simpl. -ring_simplify. -induction n. - apply Zle_refl. -rewrite inj_S. -unfold Zsucc. -do 2 (rewrite Zpower_exp;try auto with *). -ring_simplify. -apply Zmult_le_compat; try discriminate. - assumption. -clear -n. -induction n. - discriminate. -rewrite inj_S. -unfold Zsucc. -rewrite Zpower_exp;try auto with *. + intros q. + eapply Qle_trans. + apply power3bound. + generalize (let (n, _) := q in match n with | 0 => 0%nat | ' p => Psize p | Zneg _ => 0%nat end)%Z. + intros n. + unfold Qle. + simpl. + ring_simplify. + induction n. + apply Zle_refl. + rewrite inj_S. + unfold Zsucc. + do 2 (rewrite Zpower_exp;try auto with *). + ring_simplify. + apply Zmult_le_compat; try discriminate. + assumption. + clear -n. + induction n. + discriminate. + rewrite inj_S. + unfold Zsucc. + rewrite Zpower_exp;try auto with *. Qed. Lemma power4bound' : forall (q:Q), (0 < q) -> ((/(4^(Z_of_nat (let (_,d):= q in Psize d)))%Z) <= q). Proof. -intros [[|n|n] d] H. - elim (Qlt_not_eq _ _ H). - constructor. - assert (X:=power4bound (d#n)). - simpl in X. - rewrite Zpower_Qpower; try auto with *. - apply Qle_shift_inv_r. - clear - d. - induction (Psize d). + intros [[|n|n] d] H. + elim (Qlt_not_eq _ _ H). constructor. - rewrite inj_S. - unfold Zsucc. - rewrite Qpower_plus;[|discriminate]. - apply: mult_resp_pos;[assumption|constructor]. - rewrite <- Zpower_Qpower; try auto with *. - destruct (inject_Z (4%positive ^ Psize d)%Z). - change ((1 * (d * Qden)%positive <= n * Qnum * 1)%Z). - ring_simplify. - unfold Qle in *. - simpl in X. - rewrite Zmult_comm. - assumption. -elim (Qlt_not_le _ _ H). -discriminate. + assert (X:=power4bound (d#n)). + simpl in X. + rewrite Zpower_Qpower; try auto with *. + apply Qle_shift_inv_r. + clear - d. + induction (Psize d). + constructor. + rewrite inj_S. + unfold Zsucc. + rewrite Qpower_plus;[|discriminate]. + apply: mult_resp_pos;[assumption|constructor]. + rewrite <- Zpower_Qpower; try auto with *. + destruct (inject_Z (4%positive ^ Psize d)%Z). + change ((1 * (d * Qden)%positive <= n * Qnum * 1)%Z). + ring_simplify. + unfold Qle in *. + simpl in X. + rewrite Zmult_comm. + assumption. + elim (Qlt_not_le _ _ H). + discriminate. Qed. diff --git a/reals/fast/RasterQ.v b/reals/fast/RasterQ.v index d5d2bd7c2..25647c7a1 100644 --- a/reals/fast/RasterQ.v +++ b/reals/fast/RasterQ.v @@ -34,7 +34,7 @@ Definition Q2 := (ProductMS Q_as_MetricSpace Q_as_MetricSpace). Lemma stableQ2 : stableMetric Q2. Proof. -apply ProductMS_stable; apply stableQ. + apply ProductMS_stable; apply stableQ. Qed. (** For [Q2], classical membership in a finite enumeration is the @@ -42,26 +42,26 @@ same as a constructive membership. *) Lemma InStrengthen : forall x (l:FinEnum stableQ2), InFinEnumC x l -> exists y : ProductMS _ _, In y l /\ st_eq x y. Proof. -induction l. - contradiction. -intros H. -assert (L:st_eq x a \/ ~st_eq x a). - destruct (Qeq_dec (fst x) (fst a)). - destruct (Qeq_dec (snd x) (snd a)). - left. - split; auto. - right; intros [_ B]; auto. - right; intros [B _]; auto. -destruct L. - exists a. + induction l. + contradiction. + intros H. + assert (L:st_eq x a \/ ~st_eq x a). + destruct (Qeq_dec (fst x) (fst a)). + destruct (Qeq_dec (snd x) (snd a)). + left. + split; auto. + right; intros [_ B]; auto. + right; intros [B _]; auto. + destruct L. + exists a. + split; auto with *. + destruct (IHl) as [y [Hy0 Hy1]]. + destruct H as [G | H | H] using orC_ind. + auto using InFinEnumC_stable. + elim H0; auto. + auto. + exists y. split; auto with *. -destruct (IHl) as [y [Hy0 Hy1]]. - destruct H as [G | H | H] using orC_ind. - auto using InFinEnumC_stable. - elim H0; auto. - auto. -exists y. -split; auto with *. Qed. Definition InterpRow (up : list Q) n (v:Bvector n) : FinEnum stableQ:= @@ -81,7 +81,7 @@ Notation "a ⇱ b ⇲ c" := (InterpRaster b a c) (at level 1, Open Local Scope raster. Open Local Scope raster_parsing. -Example ex5 := +Example ex5 := (0, 1)⇱ ⎥█░█⎢ ⎥░█░⎢ @@ -99,165 +99,156 @@ Let f := fun l r (n:nat) (i:Z) => l + (r - l) * (2 * i + 1 # 1) / (2 * n # 1). Lemma InterpRaster_correct1 : forall n m (t l b r:Q) (bitmap: raster n m) i j, Is_true (RasterIndex bitmap i j) -> In (f l r n j,f t b m i) (InterpRaster bitmap (l,t) (r,b)). Proof. -intros n m t l b r bitmap. -unfold InterpRaster, InterpRow, UniformPartition. -fold (f l r n). -fold (f t b m). -generalize (f l r n) (f t b m). -induction bitmap; - intros f0 f1 i j H. - unfold RasterIndex in H. - destruct (nth_in_or_default i (map (@vectorAsList _ _) (Vnil (vector bool n))) nil) as [A | A]. - contradiction. - rewrite A in H; clear A. - destruct (nth_in_or_default j nil false) as [A | A]. - contradiction. - rewrite A in H; clear A. - contradiction. -destruct i as [|i]. - simpl. - apply in_or_app. - left. - unfold RasterIndex in H. - simpl in H. - clear bitmap IHbitmap. - revert f0 j H. - induction a; intros f0 j H. - destruct (nth_in_or_default j (Vnil bool) false) as [A | A]. + intros n m t l b r bitmap. + unfold InterpRaster, InterpRow, UniformPartition. + fold (f l r n). + fold (f t b m). + generalize (f l r n) (f t b m). + induction bitmap; intros f0 f1 i j H. + unfold RasterIndex in H. + destruct (nth_in_or_default i (map (@vectorAsList _ _) (Vnil (vector bool n))) nil) as [A | A]. + contradiction. + rewrite A in H; clear A. + destruct (nth_in_or_default j nil false) as [A | A]. contradiction. rewrite A in H; clear A. contradiction. - destruct j as [|j]. - simpl in H. - destruct a; try contradiction. + destruct i as [|i]. simpl. - left; reflexivity. + apply in_or_app. + left. + unfold RasterIndex in H. + simpl in H. + clear bitmap IHbitmap. + revert f0 j H. + induction a; intros f0 j H. + destruct (nth_in_or_default j (Vnil bool) false) as [A | A]. + contradiction. + rewrite A in H; clear A. + contradiction. + destruct j as [|j]. + simpl in H. + destruct a; try contradiction. + simpl. + left; reflexivity. + rewrite inj_S. + cut (In ((f0 (Zsucc j)), (f1 0%Z)) (map (fun x : Q => (x, (f1 0%Z))) + (map (@fst _ _) (filter (@snd _ _) (combine (map f0 (iterateN Zsucc 1%Z n)) a0))))). + intros L. + destruct a; try right; auto. + change (1%Z) with (Zsucc 0). + rewrite iterateN_f. + rewrite (map_map Zsucc f0). + apply (IHa (fun x:Z => f0 (Zsucc x))). + apply H. rewrite inj_S. - cut (In ((f0 (Zsucc j)), (f1 0%Z)) - (map (fun x : Q => (x, (f1 0%Z))) - (map (@fst _ _) (filter (@snd _ _) (combine (map f0 (iterateN Zsucc 1%Z n)) a0))))). - intros L. - destruct a; try right; auto. + set (f1':= fun (x:Z) =>(f1 (Zsucc x))). + fold (f1' i). + simpl. + apply in_or_app. + right. change (1%Z) with (Zsucc 0). rewrite iterateN_f. - rewrite (map_map Zsucc f0). - apply (IHa (fun x:Z => f0 (Zsucc x))). + rewrite map_map. + fold f1'. + apply IHbitmap. apply H. -rewrite inj_S. -set (f1':= fun (x:Z) =>(f1 (Zsucc x))). -fold (f1' i). -simpl. -apply in_or_app. -right. -change (1%Z) with (Zsucc 0). -rewrite iterateN_f. -rewrite map_map. -fold f1'. -apply IHbitmap. -apply H. Qed. Lemma InterpRaster_correct2 : forall n m (t l b r:Q) x y (bitmap: raster n m), -In (x,y) (InterpRaster bitmap (l,t) (r,b)) -> +In (x,y) (InterpRaster bitmap (l,t) (r,b)) -> exists p, Is_true (RasterIndex bitmap (fst p) (snd p)) /\ x=f l r n (snd p) /\ y=f t b m (fst p). Proof. -intros n m t l b r x y bitmap. -unfold InterpRaster, InterpRow, UniformPartition. -fold (f l r n). -fold (f t b m). -generalize (f l r n) (f t b m). -induction bitmap; - intros f0 f1 H. - contradiction. -simpl in H. -destruct (in_app_or _ _ _ H) as [H0 | H0]; clear H. - cut (exists p : nat, - Is_true (nth p a false) /\ - x = f0 p /\ y = f1 0%Z). - intros [z Z]. - clear -Z. - exists (0%nat,z). - auto. - clear bitmap IHbitmap. - revert f0 H0. - induction a; intros f0 H0. + intros n m t l b r x y bitmap. + unfold InterpRaster, InterpRow, UniformPartition. + fold (f l r n). + fold (f t b m). + generalize (f l r n) (f t b m). + induction bitmap; intros f0 f1 H. contradiction. - destruct a. - simpl in H0. - destruct H0 as [H0 | H0]. - exists 0%nat. - split. - constructor. - simpl in H0. - inversion_clear H0. + simpl in H. + destruct (in_app_or _ _ _ H) as [H0 | H0]; clear H. + cut (exists p : nat, Is_true (nth p a false) /\ x = f0 p /\ y = f1 0%Z). + intros [z Z]. + clear -Z. + exists (0%nat,z). auto. + clear bitmap IHbitmap. + revert f0 H0. + induction a; intros f0 H0. + contradiction. + destruct a. + simpl in H0. + destruct H0 as [H0 | H0]. + exists 0%nat. + split. + constructor. + simpl in H0. + inversion_clear H0. + auto. + edestruct IHa as [z Hz]. + change 1%Z with (Zsucc 0) in H0. + rewrite iterateN_f in H0. + rewrite (map_map Zsucc f0) in H0. + apply H0. + exists (S z). + rewrite inj_S; auto. edestruct IHa as [z Hz]. + simpl in H0. change 1%Z with (Zsucc 0) in H0. rewrite iterateN_f in H0. rewrite (map_map Zsucc f0) in H0. apply H0. exists (S z). rewrite inj_S; auto. - edestruct IHa as [z Hz]. - simpl in H0. - change 1%Z with (Zsucc 0) in H0. - rewrite iterateN_f in H0. - rewrite (map_map Zsucc f0) in H0. + change 1%Z with (Zsucc 0) in H0. + rewrite iterateN_f in H0. + rewrite (map_map) in H0. + edestruct IHbitmap as [z Hz]. apply H0. - exists (S z). - rewrite inj_S; auto. -change 1%Z with (Zsucc 0) in H0. -rewrite iterateN_f in H0. -rewrite (map_map) in H0. -edestruct IHbitmap as [z Hz]. - apply H0. -exists (S (fst z),snd z). -simpl (fst ((S (fst z)), (snd z))). -rewrite inj_S. -auto. + exists (S (fst z),snd z). + simpl (fst ((S (fst z)), (snd z))). + rewrite inj_S. + auto. Qed. End InterpRasterCorrect. (* begin hide *) Add Parametric Morphism n m bm : (@InterpRaster n m bm) with signature (@st_eq _) ==> (@st_eq _) ==> (@st_eq _) as InterpRaster_wd. -cut (forall (x1 x2 : Q2), - prod_st_eq Q_as_MetricSpace Q_as_MetricSpace x1 x2 -> - forall x3 x4 : Q2, - prod_st_eq Q_as_MetricSpace Q_as_MetricSpace x3 x4 -> forall y, - InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) y - (InterpRaster bm x1 x3) -> - InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) y - (InterpRaster bm x2 x4)). - intros L. - split. - apply L; auto. - apply L. +Proof. + cut (forall (x1 x2 : Q2), prod_st_eq Q_as_MetricSpace Q_as_MetricSpace x1 x2 -> forall x3 x4 : Q2, + prod_st_eq Q_as_MetricSpace Q_as_MetricSpace x3 x4 -> forall y, + InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) y (InterpRaster bm x1 x3) -> + InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) y (InterpRaster bm x2 x4)). + intros L. + split. + apply L; auto. + apply L. + symmetry; auto. symmetry; auto. - symmetry; auto. -intros [x1l x1r] x2 Hx [y1l y1r] y2 Hy z Hz. -destruct (InStrengthen _ _ Hz) as [[ax ay] [Ha0 Ha1]]. -destruct (InterpRaster_correct2 _ _ _ _ _ _ _ Ha0) as [[bx by] [Hb0 [Hb1 Hb2]]]. -rewrite Hb1 in Ha1. -rewrite Hb2 in Ha1. -unfold snd, fst in Ha1. -destruct x2 as [x2l x2r]. -destruct y2 as [y2l y2r]. -assert (L0:st_eq z ((x2l + (y2l - x2l) * (2 * by + 1 # 1) / (2 * n # 1)), - (x2r + (y2r - x2r) * (2 * bx + 1 # 1) / (2 * m # 1)))). - transitivity ((x1l + (y1l - x1l) * (2 * by + 1 # 1) / (2 * n # 1)), - (x1r + (y1r - x1r) * (2 * bx + 1 # 1) / (2 * m # 1))). - auto. - clear - Hx Hy. - destruct Hx as [Hx1 Hx2]. - destruct Hy as [Hy1 Hy2]. - split; - unfold fst,snd in *. - rewrite Hx1 Hy1. + intros [x1l x1r] x2 Hx [y1l y1r] y2 Hy z Hz. + destruct (InStrengthen _ _ Hz) as [[ax ay] [Ha0 Ha1]]. + destruct (InterpRaster_correct2 _ _ _ _ _ _ _ Ha0) as [[bx by] [Hb0 [Hb1 Hb2]]]. + rewrite Hb1 in Ha1. + rewrite Hb2 in Ha1. + unfold snd, fst in Ha1. + destruct x2 as [x2l x2r]. + destruct y2 as [y2l y2r]. + assert (L0:st_eq z ((x2l + (y2l - x2l) * (2 * by + 1 # 1) / (2 * n # 1)), + (x2r + (y2r - x2r) * (2 * bx + 1 # 1) / (2 * m # 1)))). + transitivity ((x1l + (y1l - x1l) * (2 * by + 1 # 1) / (2 * n # 1)), + (x1r + (y1r - x1r) * (2 * bx + 1 # 1) / (2 * m # 1))). + auto. + clear - Hx Hy. + destruct Hx as [Hx1 Hx2]. + destruct Hy as [Hy1 Hy2]. + split; unfold fst,snd in *. + rewrite Hx1 Hy1. + reflexivity. + rewrite Hx2 Hy2. reflexivity. - rewrite Hx2 Hy2. - reflexivity. -rewrite (InFinEnumC_wd1 _ _ _ (InterpRaster bm (x2l, x2r) (y2l, y2r)) L0). -apply InFinEnumC_weaken. -auto using InterpRaster_correct1. + rewrite (InFinEnumC_wd1 _ _ _ (InterpRaster bm (x2l, x2r) (y2l, y2r)) L0). + apply InFinEnumC_weaken. + auto using InterpRaster_correct1. Qed. (* end hide *) diff --git a/reals/fast/RasterizeQ.v b/reals/fast/RasterizeQ.v index 80197c3ec..f5c21e7f1 100644 --- a/reals/fast/RasterizeQ.v +++ b/reals/fast/RasterizeQ.v @@ -51,44 +51,41 @@ let j := min (pred m) (Z_to_nat (Zle_max_l 0 (rasterize1 b t m (snd p)))) in setRaster bm true (pred m - j) i. (* begin hide *) Add Parametric Morphism n m bm : (@RasterizePoint n m bm) with signature Qeq ==> Qeq ==> Qeq ==> Qeq ==> (@eq _) ==> (@eq _) as RasterizePoint_wd. -intros x0 x1 H x2 x3 H0 x4 x5 H1 x6 x7 H2 x. -unfold RasterizePoint. -replace (rasterize1 x4 x0 m (snd x)) - with (rasterize1 x5 x1 m (snd x)). - replace (rasterize1 x2 x6 n (fst x)) - with (rasterize1 x3 x7 n (fst x)). +Proof. + intros x0 x1 H x2 x3 H0 x4 x5 H1 x6 x7 H2 x. + unfold RasterizePoint. + replace (rasterize1 x4 x0 m (snd x)) with (rasterize1 x5 x1 m (snd x)). + replace (rasterize1 x2 x6 n (fst x)) with (rasterize1 x3 x7 n (fst x)). + reflexivity. + unfold rasterize1. + rewrite H0. + rewrite H2. reflexivity. unfold rasterize1. - rewrite H0. - rewrite H2. + rewrite H. + rewrite H1. reflexivity. -unfold rasterize1. -rewrite H. -rewrite H1. -reflexivity. Qed. (* end hide *) Lemma RasterizePoint_carry : forall t l b r n m (bm:raster n m) p i j, Is_true (RasterIndex bm i j) -> Is_true (RasterIndex (RasterizePoint bm t l b r p) i j). Proof. -intros t l b r m n bm p i j H. -unfold RasterizePoint. -set (j0:=(min (pred m) - (Z_to_nat (z:=Zmax 0 (rasterize1 l r m (fst p))) - (Zle_max_l 0 (rasterize1 l r m (fst p)))))). -set (i0:=(pred n - - min (pred n) - (Z_to_nat (z:=Zmax 0 (rasterize1 b t n (snd p))) (Zle_max_l 0 (rasterize1 b t n (snd p)))))%nat). -destruct (le_lt_dec n i0). - rewrite setRaster_overflow; auto. -destruct (le_lt_dec m j0). - rewrite setRaster_overflow; auto. -destruct (eq_nat_dec i i0). - destruct (eq_nat_dec j j0). - rewrite e e0. - rewrite setRaster_correct1; try constructor; congruence. + intros t l b r m n bm p i j H. + unfold RasterizePoint. + set (j0:=(min (pred m) (Z_to_nat (z:=Zmax 0 (rasterize1 l r m (fst p))) + (Zle_max_l 0 (rasterize1 l r m (fst p)))))). + set (i0:=(pred n - min (pred n) + (Z_to_nat (z:=Zmax 0 (rasterize1 b t n (snd p))) (Zle_max_l 0 (rasterize1 b t n (snd p)))))%nat). + destruct (le_lt_dec n i0). + rewrite setRaster_overflow; auto. + destruct (le_lt_dec m j0). + rewrite setRaster_overflow; auto. + destruct (eq_nat_dec i i0). + destruct (eq_nat_dec j j0). + rewrite e e0. + rewrite setRaster_correct1; try constructor; congruence. + rewrite setRaster_correct2; auto. rewrite setRaster_correct2; auto. -rewrite setRaster_correct2; auto. Qed. (** Rasterization is done by rasterizing each point, and composing @@ -99,14 +96,15 @@ Definition RasterizeQ2 (f:FinEnum stableQ2) n m (t l b r:Q) : raster n m := fold_left (fun x y => @RasterizePoint n m x t l b r y) f (emptyRaster _ _). (* begin hide *) Add Parametric Morphism f n m : (@RasterizeQ2 f n m) with signature Qeq ==> Qeq ==> Qeq ==> Qeq ==> (@eq _) as RasterizeQ2_wd. -intros. -unfold RasterizeQ2. -do 2 rewrite <- fold_left_rev_right. -induction (@rev (prod Q Q) f). - reflexivity. -simpl. -rewrite IHl. -apply RasterizePoint_wd; auto. +Proof. + intros. + unfold RasterizeQ2. + do 2 rewrite <- fold_left_rev_right. + induction (@rev (prod Q Q) f). + reflexivity. + simpl. + rewrite IHl. + apply RasterizePoint_wd; auto. Qed. (* end hide *) Section RasterizeCorrect. @@ -116,121 +114,111 @@ Let C := fun l r (n:nat) (i:Z) => l + (r - l) * (2 * i + 1 # 1) / (2 * n # 1). Lemma rasterization_error : forall l (w:Qpos) n x, (l <= x <= l + w) -> ball (m:=Q_as_MetricSpace) ((1 #2*P_of_succ_nat n) * w) (C l (l + w) (S n) (min n - (Z_to_nat + (Z_to_nat (Zle_max_l 0 (rasterize1 l (l+w) (S n) x))))) x. Proof. -clear - C. -intros l w n x H0. -destruct (Qlt_le_dec x (l+w)). - replace (Z_of_nat (min n - (Z_to_nat (z:=Zmax 0 (rasterize1 l (l + w) (S n) x)) - (Zle_max_l 0 (rasterize1 l (l + w) (S n) x))))) - with (rasterize1 l (l + w) (S n) x). - apply ball_sym. - simpl. - rewrite Qball_Qabs. - assert (l < l + w). - rewrite Qlt_minus_iff. - ring_simplify. - auto with *. - eapply Qle_trans. + clear - C. + intros l w n x H0. + destruct (Qlt_le_dec x (l+w)). + replace (Z_of_nat (min n (Z_to_nat (z:=Zmax 0 (rasterize1 l (l + w) (S n) x)) + (Zle_max_l 0 (rasterize1 l (l + w) (S n) x))))) with (rasterize1 l (l + w) (S n) x). + apply ball_sym. + simpl. + rewrite Qball_Qabs. + assert (l < l + w). + rewrite Qlt_minus_iff. + ring_simplify. + auto with *. + eapply Qle_trans. + unfold C. + apply (rasterize1_close H). + change ((l + w - l) / (2 * S n) <=(/ 2%positive) * (/ P_of_succ_nat n) * w). + unfold Qdiv. + rewrite Qinv_mult_distr. + replace LHS with (((/ 2) * (/ S n) * w)) by ring. + apply Qle_refl. + rewrite inj_min. + rewrite <- Z_to_nat_correct. + rewrite Zmax_right. + apply Zmin_case_strong. + intros H. + apply Zle_antisym; auto. + apply Zlt_succ_le. + rewrite <- inj_S. + apply rasterize1_boundR; auto. + rewrite Qle_minus_iff. + ring_simplify. + auto with *. + reflexivity. + destruct H0. + apply rasterize1_boundL; auto. + apply Qle_trans with x; auto. + simpl. + replace (min n (Z_to_nat (z:=Zmax 0 (rasterize1 l (l + w) (S n) x)) + (Zle_max_l 0 (rasterize1 l (l + w) (S n) x)))) with n. + setoid_replace x with (l + w). + apply: ball_sym. + rewrite -> Qball_Qabs. unfold C. - apply (rasterize1_close H). - change ((l + w - l) / (2 * S n) <=(/ 2%positive) * (/ P_of_succ_nat n) * w). - unfold Qdiv. - rewrite Qinv_mult_distr. - replace LHS with (((/ 2) * (/ S n) * w)) by ring. - apply Qle_refl. - rewrite inj_min. - rewrite <- Z_to_nat_correct. - rewrite Zmax_right. - apply Zmin_case_strong. - intros H. - apply Zle_antisym; auto. - apply Zlt_succ_le. - rewrite <- inj_S. - apply rasterize1_boundR; auto. - rewrite Qle_minus_iff. - ring_simplify. + autorewrite with QposElim. + replace RHS with (w*(1#xO (P_of_succ_nat n))) by ring. + change (1 # xO (P_of_succ_nat n)) with (/(2*(S n))). + change (2*S n #1) with (2*S n). + change (2*n + 1#1) with ((2*n + 1)%Z:Q). + rewrite (inj_S n). + unfold Zsucc. + do 2 rewrite injz_plus. + setoid_replace ((2%positive * n)%Z:Q) with (2*n) by (unfold Qeq; simpl; auto with *). + setoid_replace (l + w - (l + (l + w - l) * (2 * n + 1%positive) / (2 * (n + 1%positive)))) + with ((w / (2 * (n + 1%positive)))) by (field; unfold Qeq; simpl; auto with *). + rewrite Qabs_pos;[apply Qle_refl|]. + apply Qle_shift_div_l; [apply: mult_resp_pos; simpl; auto with *; unfold Qlt; simpl; auto with *|]. + replace LHS with 0 by ring. auto with *. - reflexivity. - destruct H0. - apply rasterize1_boundL; auto. - apply Qle_trans with x; auto. -simpl. -replace (min n - (Z_to_nat (z:=Zmax 0 (rasterize1 l (l + w) (S n) x)) - (Zle_max_l 0 (rasterize1 l (l + w) (S n) x)))) - with n. - setoid_replace x with (l + w). - apply: ball_sym. - rewrite -> Qball_Qabs. - unfold C. - autorewrite with QposElim. - replace RHS with (w*(1#xO (P_of_succ_nat n))) by ring. - change (1 # xO (P_of_succ_nat n)) with (/(2*(S n))). - change (2*S n #1) with (2*S n). - change (2*n + 1#1) with ((2*n + 1)%Z:Q). - rewrite (inj_S n). - unfold Zsucc. - do 2 rewrite injz_plus. - setoid_replace ((2%positive * n)%Z:Q) with (2*n) - by (unfold Qeq; simpl; auto with *). - setoid_replace (l + w - (l + (l + w - l) * (2 * n + 1%positive) / (2 * (n + 1%positive)))) - with ((w / (2 * (n + 1%positive)))) - by (field; unfold Qeq; simpl; auto with *). - rewrite Qabs_pos;[apply Qle_refl|]. - apply Qle_shift_div_l; - [apply: mult_resp_pos; simpl; auto with *; - unfold Qlt; simpl; auto with *|]. - replace LHS with 0 by ring. + destruct H0. + apply Qle_antisym; auto. + symmetry. + apply min_l. + apply surj_le. + rewrite <- Z_to_nat_correct. + eapply Zle_trans;[|apply Zle_max_r]. + unfold rasterize1. + rewrite <- (Qfloor_Z n). + apply Qfloor_resp_le. + setoid_replace x with (l+w). + setoid_replace (l + w - l) with (w:Q) by ring. + field_simplify;[|apply Qpos_nonzero]. + unfold Qle. + simpl. + change (n * 1* 1 <= (S n)*1*1)%Z. + ring_simplify. + apply inj_le. auto with *. - destruct H0. - apply Qle_antisym; auto. -symmetry. -apply min_l. -apply surj_le. -rewrite <- Z_to_nat_correct. -eapply Zle_trans;[|apply Zle_max_r]. -unfold rasterize1. -rewrite <- (Qfloor_Z n). -apply Qfloor_resp_le. -setoid_replace x with (l+w). - setoid_replace (l + w - l) with (w:Q) by ring. - field_simplify;[|apply Qpos_nonzero]. - unfold Qle. - simpl. - change (n * 1* 1 <= (S n)*1*1)%Z. - ring_simplify. - apply inj_le. - auto with *. -destruct H0; auto with *. + destruct H0; auto with *. Qed. Lemma switch_line_interp : forall t b m j, (j <= m)%nat -> C t b (S m) (m - j)%nat == C b t (S m) j. Proof. -intros t b m j H. -unfold C. -rewrite inj_minus1;[|auto]. -change (2 * (m - j) + 1 # 1) with ((2 * (m - j) + 1)%Z:Q). -change (2*S m#1) with (2*(S m)). -change ((2*j +1)#1) with ((2*j+1)%Z:Q). -do 2 rewrite injz_plus. -change ((2%positive * (m - j))%Z:Q) - with (2 * (m - j)%Z). -change ((2%positive * j)%Z:Q) - with (2 * j). -change (1%Z:Q) with (1:Q). -unfold Zminus. -rewrite injz_plus. -rewrite (inj_S m). -unfold Zsucc. -rewrite injz_plus. -change ((-j)%Z:Q) with (-j). -field. -unfold Qeq. -simpl. -auto with *. + intros t b m j H. + unfold C. + rewrite inj_minus1;[|auto]. + change (2 * (m - j) + 1 # 1) with ((2 * (m - j) + 1)%Z:Q). + change (2*S m#1) with (2*(S m)). + change ((2*j +1)#1) with ((2*j+1)%Z:Q). + do 2 rewrite injz_plus. + change ((2%positive * (m - j))%Z:Q) with (2 * (m - j)%Z). + change ((2%positive * j)%Z:Q) with (2 * j). + change (1%Z:Q) with (1:Q). + unfold Zminus. + rewrite injz_plus. + rewrite (inj_S m). + unfold Zsucc. + rewrite injz_plus. + change ((-j)%Z:Q) with (-j). + field. + unfold Qeq. + simpl. + auto with *. Qed. Variable b l:Q. @@ -247,223 +235,212 @@ Let errX : Qpos := ((1#2*P_of_succ_nat n)*w)%Qpos. Let errY : Qpos := ((1#2*P_of_succ_nat m)*h)%Qpos. Let err : Qpos := Qpos_max errX errY. -Hypothesis Hf:forall x y, InFinEnumC ((x,y):ProductMS _ _) f -> +Hypothesis Hf:forall x y, InFinEnumC ((x,y):ProductMS _ _) f -> (l<= x <= r) /\ (b <= y <= t). (** The Rasterization is close to the original enumeration. *) Lemma RasterizeQ2_correct1 : forall x y, - InFinEnumC ((x,y):ProductMS _ _) f -> - existsC (ProductMS _ _) + InFinEnumC ((x,y):ProductMS _ _) f -> + existsC (ProductMS _ _) (fun p => InFinEnumC p (InterpRaster (RasterizeQ2 f (S n) (S m) t l b r) (l,t) (r,b)) /\ ball err p (x,y)). Proof. -intros x y. -unfold RasterizeQ2. -rewrite <- fold_left_rev_right. -intros H. -destruct (Hf _ _ H) as [Hfl Hfr]. -clear Hf. -destruct (FinEnum_eq_rev f (x,y)) as [L _]. -generalize (L H). -clear L H. -simpl (st_car (msp_is_setoid Q2)). -generalize (emptyRaster (S n) (S m)). -induction (@rev (prod Q Q) f). - contradiction. -intros bm H. -destruct H as [G | [Hl Hr] | H] using orC_ind. - auto using existsC_stable. - simpl in Hl, Hr. - simpl (fold_right - (fun (y0 : Q * Q) (x0 : raster (S n) (S m)) => - RasterizePoint x0 t l b r y0) bm (a :: l0)). - unfold RasterizePoint at 1. - simpl (pred (S n)). - simpl (pred (S m)). - set (i:=min n - (Z_to_nat (Zle_max_l 0 (rasterize1 l r (S n) (fst a))))). - set (j:=min m - (Z_to_nat (Zle_max_l 0 (rasterize1 b t (S m) (snd a))))). - cbv zeta. - apply existsWeaken. - exists (C l r (S n) i,C t b (S m) (m -j)%nat). - split. - apply InFinEnumC_weaken. - apply InterpRaster_correct1. - rewrite setRaster_correct1; unfold i, j; auto with *. - split. - change (ball err (C l r (S n) i) x). - change (st_eq x (fst a)) in Hl. - rewrite Hl. + intros x y. + unfold RasterizeQ2. + rewrite <- fold_left_rev_right. + intros H. + destruct (Hf _ _ H) as [Hfl Hfr]. + clear Hf. + destruct (FinEnum_eq_rev f (x,y)) as [L _]. + generalize (L H). + clear L H. + simpl (st_car (msp_is_setoid Q2)). + generalize (emptyRaster (S n) (S m)). + induction (@rev (prod Q Q) f). + contradiction. + intros bm H. + destruct H as [G | [Hl Hr] | H] using orC_ind. + auto using existsC_stable. + simpl in Hl, Hr. + simpl (fold_right (fun (y0 : Q * Q) (x0 : raster (S n) (S m)) => + RasterizePoint x0 t l b r y0) bm (a :: l0)). + unfold RasterizePoint at 1. + simpl (pred (S n)). + simpl (pred (S m)). + set (i:=min n (Z_to_nat (Zle_max_l 0 (rasterize1 l r (S n) (fst a))))). + set (j:=min m (Z_to_nat (Zle_max_l 0 (rasterize1 b t (S m) (snd a))))). + cbv zeta. + apply existsWeaken. + exists (C l r (S n) i,C t b (S m) (m -j)%nat). + split. + apply InFinEnumC_weaken. + apply InterpRaster_correct1. + rewrite setRaster_correct1; unfold i, j; auto with *. + split. + change (ball err (C l r (S n) i) x). + change (st_eq x (fst a)) in Hl. + rewrite Hl. + eapply ball_weak_le. + unfold err. + apply Qpos_max_ub_l. + apply rasterization_error. + simpl in Hl. + rewrite -> Hl in Hfl. + auto. + change (ball err (C t b (S m) (m-j)%nat) y). + change (st_eq y (snd a)) in Hr. + rewrite Hr. eapply ball_weak_le. unfold err. - apply Qpos_max_ub_l. + apply Qpos_max_ub_r. + simpl (ball (m:=Q_as_MetricSpace)). + rewrite switch_line_interp;[|unfold j; auto with *]. apply rasterization_error. - simpl in Hl. - rewrite -> Hl in Hfl. + simpl in Hr. + rewrite -> Hr in Hfr. auto. - change (ball err (C t b (S m) (m-j)%nat) y). - change (st_eq y (snd a)) in Hr. - rewrite Hr. - eapply ball_weak_le. - unfold err. - apply Qpos_max_ub_r. - simpl (ball (m:=Q_as_MetricSpace)). - rewrite switch_line_interp;[|unfold j; auto with *]. - apply rasterization_error. - simpl in Hr. - rewrite -> Hr in Hfr. + simpl ((fold_right (fun (y : Q * Q) (x : raster (S n) (S m)) => + RasterizePoint x t l b r y) bm) (a :: l0)). + destruct (IHl0 bm H) as [G | z [Hz0 Hz1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists z. + split; auto. + clear - Hz0. + destruct z as [zx zy]. + destruct (InStrengthen _ _ Hz0) as [[zx' zy'] [Hz'0 Hz'1]]. + rewrite (fun a => InFinEnumC_wd1 _ _ _ a Hz'1). + apply InFinEnumC_weaken. + destruct (InterpRaster_correct2 _ _ _ _ _ _ _ Hz'0) as [[ax ay] [Ha1 [Ha2 Ha3]]]. + rewrite Ha2. + rewrite Ha3. + apply InterpRaster_correct1. + apply RasterizePoint_carry. auto. -simpl ((fold_right - (fun (y : Q * Q) (x : raster (S n) (S m)) => - RasterizePoint x t l b r y) bm) (a :: l0)). -destruct (IHl0 bm H) as [G | z [Hz0 Hz1]] using existsC_ind. - auto using existsC_stable. -apply existsWeaken. -exists z. -split; auto. -clear - Hz0. -destruct z as [zx zy]. -destruct (InStrengthen _ _ Hz0) as [[zx' zy'] [Hz'0 Hz'1]]. -rewrite (fun a => InFinEnumC_wd1 _ _ _ a Hz'1). -apply InFinEnumC_weaken. -destruct (InterpRaster_correct2 _ _ _ _ _ _ _ Hz'0) as [[ax ay] [Ha1 [Ha2 Ha3]]]. -rewrite Ha2. -rewrite Ha3. -apply InterpRaster_correct1. -apply RasterizePoint_carry. -auto. Qed. Lemma RasterizeQ2_correct2 : forall x y, InFinEnumC ((x,y):ProductMS _ _) (InterpRaster (RasterizeQ2 f (S n) (S m) t l b r) (l,t) (r,b)) - -> (existsC (ProductMS _ _) + -> (existsC (ProductMS _ _) (fun p => InFinEnumC p f/\ ball err p (x,y))). Proof. -intros x y H. -destruct (InStrengthen _ _ H) as [[x' y'] [H' Hxy]]. -destruct (InterpRaster_correct2 _ _ _ _ _ _ _ H') as [[j i] [Hij [Hx' Hy']]]. -rewrite Hx' in Hxy. -rewrite Hy' in Hxy. -assert (Hf':forall x y : Q_as_MetricSpace, - InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) - ((x, y):ProductMS Q_as_MetricSpace Q_as_MetricSpace) (rev f) -> - l <= x <= r /\ b <= y <= t). - intros c d Hcd. - apply Hf. - destruct (FinEnum_eq_rev f (c,d)); auto. -clear Hf. -clear Hx' Hy' H' H. -destruct Hxy as [Hx' Hy']. -cut (existsC (ProductMS Q_as_MetricSpace Q_as_MetricSpace) - (fun p : ProductMS Q_as_MetricSpace Q_as_MetricSpace => - InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) p (rev f) /\ - ball (m:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) err p (x, y))). - intros L. - clear -L. - destruct L as [G | z [Hz0 Hz]] using existsC_ind. - auto using existsC_stable. - apply existsWeaken. - exists z. - split; auto. - destruct (FinEnum_eq_rev f z); auto. -unfold RasterizeQ2 in Hij. -rewrite <- fold_left_rev_right in Hij. -simpl (st_car (msp_is_setoid Q2)) in Hf'|-*. -induction (@rev (prod Q Q) f). - clear - Hij. - set (z:=emptyRaster (S n) (S m)) in Hij. - simpl in Hij. - unfold z in Hij. - rewrite emptyRasterEmpty in Hij. - contradiction. -simpl (fold_right (fun (y : Q * Q) (x : raster (S n) (S m)) => - RasterizePoint x t l b r y) (emptyRaster (S n) (S m)) - (a :: l0)) in Hij. -unfold RasterizePoint at 1 in Hij. -set (i0:=min (pred (S n)) - (Z_to_nat (z:=Zmax 0 (rasterize1 l r (S n) (fst a))) - (Zle_max_l 0 (rasterize1 l r (S n) (fst a))))) in *. -set (j0:=min (pred (S m)) - (Z_to_nat (z:=Zmax 0 (rasterize1 b t (S m) (snd a))) - (Zle_max_l 0 (rasterize1 b t (S m) (snd a))))) in *. -cbv zeta in Hij. -assert (L:((i=i0)/\(j=m-j0) \/ ((j<>(m-j0)) \/ (i<>i0)))%nat) - by omega. -destruct L as [[Hi Hj] | L]. - clear IHl0. - rewrite Hi Hj in Hx'. - rewrite Hi Hj in Hy'. - unfold fst, snd in *. - apply existsWeaken. - exists a. - change (st_car (msp_is_setoid Q2)) in a. - split. - apply orWeaken. - left. - reflexivity. - destruct a as [ax ay]. - destruct (Hf' ax ay) as [Hax Hay]. - apply orWeaken;left;change (ax, ay) with ((ax,ay):Q2);reflexivity. - clear Hf'. - split. - unfold fst. - rewrite Hx'. + intros x y H. + destruct (InStrengthen _ _ H) as [[x' y'] [H' Hxy]]. + destruct (InterpRaster_correct2 _ _ _ _ _ _ _ H') as [[j i] [Hij [Hx' Hy']]]. + rewrite Hx' in Hxy. + rewrite Hy' in Hxy. + assert (Hf':forall x y : Q_as_MetricSpace, + InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) + ((x, y):ProductMS Q_as_MetricSpace Q_as_MetricSpace) (rev f) -> l <= x <= r /\ b <= y <= t). + intros c d Hcd. + apply Hf. + destruct (FinEnum_eq_rev f (c,d)); auto. + clear Hf. + clear Hx' Hy' H' H. + destruct Hxy as [Hx' Hy']. + cut (existsC (ProductMS Q_as_MetricSpace Q_as_MetricSpace) + (fun p : ProductMS Q_as_MetricSpace Q_as_MetricSpace => + InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) p (rev f) /\ + ball (m:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) err p (x, y))). + intros L. + clear -L. + destruct L as [G | z [Hz0 Hz]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists z. + split; auto. + destruct (FinEnum_eq_rev f z); auto. + unfold RasterizeQ2 in Hij. + rewrite <- fold_left_rev_right in Hij. + simpl (st_car (msp_is_setoid Q2)) in Hf'|-*. + induction (@rev (prod Q Q) f). + clear - Hij. + set (z:=emptyRaster (S n) (S m)) in Hij. + simpl in Hij. + unfold z in Hij. + rewrite emptyRasterEmpty in Hij. + contradiction. + simpl (fold_right (fun (y : Q * Q) (x : raster (S n) (S m)) => + RasterizePoint x t l b r y) (emptyRaster (S n) (S m)) (a :: l0)) in Hij. + unfold RasterizePoint at 1 in Hij. + set (i0:=min (pred (S n)) (Z_to_nat (z:=Zmax 0 (rasterize1 l r (S n) (fst a))) + (Zle_max_l 0 (rasterize1 l r (S n) (fst a))))) in *. + set (j0:=min (pred (S m)) (Z_to_nat (z:=Zmax 0 (rasterize1 b t (S m) (snd a))) + (Zle_max_l 0 (rasterize1 b t (S m) (snd a))))) in *. + cbv zeta in Hij. + assert (L:((i=i0)/\(j=m-j0) \/ ((j<>(m-j0)) \/ (i<>i0)))%nat) by omega. + destruct L as [[Hi Hj] | L]. + clear IHl0. + rewrite Hi Hj in Hx'. + rewrite Hi Hj in Hy'. + unfold fst, snd in *. + apply existsWeaken. + exists a. + change (st_car (msp_is_setoid Q2)) in a. + split. + apply orWeaken. + left. + reflexivity. + destruct a as [ax ay]. + destruct (Hf' ax ay) as [Hax Hay]. + apply orWeaken;left;change (ax, ay) with ((ax,ay):Q2);reflexivity. + clear Hf'. + split. + unfold fst. + rewrite Hx'. + apply ball_sym. + eapply ball_weak_le. + unfold err. + apply Qpos_max_ub_l. + apply rasterization_error. + auto. + unfold snd. + rewrite Hy'. apply ball_sym. eapply ball_weak_le. unfold err. - apply Qpos_max_ub_l. + apply Qpos_max_ub_r. + fold (C t b (S m) (m - j0)%nat). + simpl (ball (m:=Q_as_MetricSpace)). + rewrite switch_line_interp;[|unfold j0; auto with *]. apply rasterization_error. auto. - unfold snd. - rewrite Hy'. - apply ball_sym. - eapply ball_weak_le. - unfold err. - apply Qpos_max_ub_r. - fold (C t b (S m) (m - j0)%nat). - simpl (ball (m:=Q_as_MetricSpace)). - rewrite switch_line_interp;[|unfold j0; auto with *]. - apply rasterization_error. - auto. -assert (L0:existsC (Q * Q) - (fun p : Q * Q => - InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) p l0 /\ - ball (m:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) err p - (x, y))). - apply IHl0. - simpl in Hij. - rewrite setRaster_correct2 in Hij; auto. - intros c d Hcd. - apply Hf'. - apply orWeaken; right; auto. -destruct L0 as [G | z [Hz0 Hz1]] using existsC_ind. - auto using existsC_stable. -apply existsWeaken. -exists z. -split; auto. -apply orWeaken. -right; auto. + assert (L0:existsC (Q * Q) (fun p : Q * Q => + InFinEnumC (X:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) p l0 /\ + ball (m:=ProductMS Q_as_MetricSpace Q_as_MetricSpace) err p (x, y))). + apply IHl0. + simpl in Hij. + rewrite setRaster_correct2 in Hij; auto. + intros c d Hcd. + apply Hf'. + apply orWeaken; right; auto. + destruct L0 as [G | z [Hz0 Hz1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists z. + split; auto. + apply orWeaken. + right; auto. Qed. -Lemma RasterizeQ2_correct : +Lemma RasterizeQ2_correct : ball err (InterpRaster (RasterizeQ2 f (S n) (S m) t l b r) (l,t) (r,b)) f. Proof. -split; intros [x y] Hx. - destruct (RasterizeQ2_correct2 Hx) as [ G | z [Hz0 Hz1]] using existsC_ind. + split; intros [x y] Hx. + destruct (RasterizeQ2_correct2 Hx) as [ G | z [Hz0 Hz1]] using existsC_ind. + auto using existsC_stable. + apply existsWeaken. + exists z. + split; auto. + auto using ball_sym. + destruct (RasterizeQ2_correct1 Hx) as [ G | z [Hz0 Hz1]] using existsC_ind. auto using existsC_stable. apply existsWeaken. exists z. split; auto. auto using ball_sym. -destruct (RasterizeQ2_correct1 Hx) as [ G | z [Hz0 Hz1]] using existsC_ind. - auto using existsC_stable. -apply existsWeaken. -exists z. -split; auto. -auto using ball_sym. Qed. End RasterizeCorrect. diff --git a/reals/iso_CReals.v b/reals/iso_CReals.v index 8d030936f..f236e3b04 100644 --- a/reals/iso_CReals.v +++ b/reals/iso_CReals.v @@ -18,23 +18,23 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) -(* in this file the concrete canonical isomorphism -in te sense of +(* in this file the concrete canonical isomorphism -in te sense of R_morphisms.v - between two arbitrary model of real numbers is built *) Require Export Q_dense. @@ -47,76 +47,71 @@ Proof. simpl in |- *. red in |- *. cut (SeqLimit (CS_seq IR g) (Lim g)). - intro H0. - cut (SeqLimit (CS_seq IR h) (Lim h)). - intro H1. - red in H0. - cut - {N : nat | - forall m : nat, - N <= m -> AbsSmall ((Lim h[-]Lim g) [/]ThreeNZ) (CS_seq IR g m[-]Lim g)}. - intro H2. - case H2. - intro N1. - intro H3. - red in H1. - cut - {N : nat | - forall m : nat, - N <= m -> AbsSmall ((Lim h[-]Lim g) [/]ThreeNZ) (CS_seq IR h m[-]Lim h)}. - intro H4. - case H4. - intro N2. - intro H5. - exists (N1 + N2). - exists ((Lim h[-]Lim g) [/]FourNZ). - apply pos_div_four. - apply shift_zero_less_minus. - assumption. - intros. - cut (AbsSmall ((Lim h[-]Lim g) [/]ThreeNZ) (CS_seq IR h n[-]Lim h)). - intro. - cut (AbsSmall ((Lim h[-]Lim g) [/]ThreeNZ) (CS_seq IR g n[-]Lim g)). - intro. - elim H7. - intros H9 H10. - elim H8. - intros H11 H12. - apply leEq_transitive with ((Lim h[-]Lim g) [/]ThreeNZ). - apply mult_cancel_leEq with (Twelve:IR). - astepl (nring (R:=IR) 0); apply nring_less; auto with arith. - rstepl (Zero[+]Three[*](Lim h[-]Lim g)). - rstepr (Lim h[-]Lim g[+]Three[*](Lim h[-]Lim g)). - apply plus_resp_leEq. - apply shift_zero_leEq_minus; apply less_leEq; auto. - apply plus_cancel_leEq_rht with (z := Lim g[-]Lim h). - rstepr (CS_seq IR h n[-]Lim h[+](Lim g[-]CS_seq IR g n)). - rstepl ([--]((Lim h[-]Lim g) [/]ThreeNZ)[+][--]((Lim h[-]Lim g) [/]ThreeNZ)). - apply plus_resp_leEq_both. - assumption. - rstepr ([--](CS_seq IR g n[-]Lim g)). - apply inv_resp_leEq. - assumption. - - apply H3. - apply le_trans with (m := N1 + N2). - apply le_plus_l. - assumption. - apply H5. - apply le_trans with (m := N1 + N2). - apply le_plus_r. - assumption. - apply H1. - apply div_resp_pos. - apply pos_three. - apply shift_zero_less_minus. - assumption. - apply H0. - apply div_resp_pos. - apply pos_three. - apply shift_zero_less_minus. - assumption. - apply Lim_Cauchy. + intro H0. + cut (SeqLimit (CS_seq IR h) (Lim h)). + intro H1. + red in H0. + cut {N : nat | forall m : nat, + N <= m -> AbsSmall ((Lim h[-]Lim g) [/]ThreeNZ) (CS_seq IR g m[-]Lim g)}. + intro H2. + case H2. + intro N1. + intro H3. + red in H1. + cut {N : nat | forall m : nat, + N <= m -> AbsSmall ((Lim h[-]Lim g) [/]ThreeNZ) (CS_seq IR h m[-]Lim h)}. + intro H4. + case H4. + intro N2. + intro H5. + exists (N1 + N2). + exists ((Lim h[-]Lim g) [/]FourNZ). + apply pos_div_four. + apply shift_zero_less_minus. + assumption. + intros. + cut (AbsSmall ((Lim h[-]Lim g) [/]ThreeNZ) (CS_seq IR h n[-]Lim h)). + intro. + cut (AbsSmall ((Lim h[-]Lim g) [/]ThreeNZ) (CS_seq IR g n[-]Lim g)). + intro. + elim H7. + intros H9 H10. + elim H8. + intros H11 H12. + apply leEq_transitive with ((Lim h[-]Lim g) [/]ThreeNZ). + apply mult_cancel_leEq with (Twelve:IR). + astepl (nring (R:=IR) 0); apply nring_less; auto with arith. + rstepl (Zero[+]Three[*](Lim h[-]Lim g)). + rstepr (Lim h[-]Lim g[+]Three[*](Lim h[-]Lim g)). + apply plus_resp_leEq. + apply shift_zero_leEq_minus; apply less_leEq; auto. + apply plus_cancel_leEq_rht with (z := Lim g[-]Lim h). + rstepr (CS_seq IR h n[-]Lim h[+](Lim g[-]CS_seq IR g n)). + rstepl ([--]((Lim h[-]Lim g) [/]ThreeNZ)[+][--]((Lim h[-]Lim g) [/]ThreeNZ)). + apply plus_resp_leEq_both. + assumption. + rstepr ([--](CS_seq IR g n[-]Lim g)). + apply inv_resp_leEq. + assumption. + apply H3. + apply le_trans with (m := N1 + N2). + apply le_plus_l. + assumption. + apply H5. + apply le_trans with (m := N1 + N2). + apply le_plus_r. + assumption. + apply H1. + apply div_resp_pos. + apply pos_three. + apply shift_zero_less_minus. + assumption. + apply H0. + apply div_resp_pos. + apply pos_three. + apply shift_zero_less_minus. + assumption. + apply Lim_Cauchy. apply Lim_Cauchy. Qed. @@ -136,65 +131,58 @@ Proof. intros e H1 H3. set (H2 := True) in *. (* dummy *) cut (SeqLimit (CS_seq IR g) (Lim g)). - intro H4. - cut (SeqLimit (CS_seq IR h) (Lim h)). - intro H5. - red in H4. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall (e [/]ThreeNZ) (CS_seq IR g m[-]Lim g)}. - intro H6. - red in H5. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall (e [/]ThreeNZ) (CS_seq IR h m[-]Lim h)}. - intro H7. - case H6. - intro N1. - intro H8. - case H7. - intro N2. - intro H9. - cut (AbsSmall (e [/]ThreeNZ) (CS_seq IR g (N + (N1 + N2))[-]Lim g)). - intro H10. - cut (AbsSmall (e [/]ThreeNZ) (CS_seq IR h (N + (N1 + N2))[-]Lim h)). - intro H11. - elim H10. - intros H12 H13. - elim H11. - intros H14 H15. - apply less_leEq_trans with (y := e [/]ThreeNZ). - apply pos_div_three. - assumption. - rstepr - (Lim h[-]CS_seq IR h (N + (N1 + N2))[+] - (CS_seq IR h (N + (N1 + N2))[-]CS_seq IR g (N + (N1 + N2)))[+] - (CS_seq IR g (N + (N1 + N2))[-]Lim g)). - rstepl ([--](e [/]ThreeNZ)[+]e[+][--](e [/]ThreeNZ)). - apply plus_resp_leEq_both. - apply plus_resp_leEq_both. - rstepr ([--](CS_seq IR h (N + (N1 + N2))[-]Lim h)). - apply inv_resp_leEq. - assumption. - apply H3. - apply le_plus_l. - assumption. - - apply H9. - rewrite -> plus_comm with (m := N2). - rewrite -> plus_permute with (m := N2). - apply le_plus_l. - apply H8. - rewrite -> plus_permute with (m := N1). - apply le_plus_l. - - apply H5. - apply pos_div_three. - assumption. - apply H4. - apply pos_div_three. - assumption. - apply Lim_Cauchy. + intro H4. + cut (SeqLimit (CS_seq IR h) (Lim h)). + intro H5. + red in H4. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]ThreeNZ) (CS_seq IR g m[-]Lim g)}. + intro H6. + red in H5. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]ThreeNZ) (CS_seq IR h m[-]Lim h)}. + intro H7. + case H6. + intro N1. + intro H8. + case H7. + intro N2. + intro H9. + cut (AbsSmall (e [/]ThreeNZ) (CS_seq IR g (N + (N1 + N2))[-]Lim g)). + intro H10. + cut (AbsSmall (e [/]ThreeNZ) (CS_seq IR h (N + (N1 + N2))[-]Lim h)). + intro H11. + elim H10. + intros H12 H13. + elim H11. + intros H14 H15. + apply less_leEq_trans with (y := e [/]ThreeNZ). + apply pos_div_three. + assumption. + rstepr (Lim h[-]CS_seq IR h (N + (N1 + N2))[+] + (CS_seq IR h (N + (N1 + N2))[-]CS_seq IR g (N + (N1 + N2)))[+] + (CS_seq IR g (N + (N1 + N2))[-]Lim g)). + rstepl ([--](e [/]ThreeNZ)[+]e[+][--](e [/]ThreeNZ)). + apply plus_resp_leEq_both. + apply plus_resp_leEq_both. + rstepr ([--](CS_seq IR h (N + (N1 + N2))[-]Lim h)). + apply inv_resp_leEq. + assumption. + apply H3. + apply le_plus_l. + assumption. + apply H9. + rewrite -> plus_comm with (m := N2). + rewrite -> plus_permute with (m := N2). + apply le_plus_l. + apply H8. + rewrite -> plus_permute with (m := N1). + apply le_plus_l. + apply H5. + apply pos_div_three. + assumption. + apply H4. + apply pos_div_three. + assumption. + apply Lim_Cauchy. apply Lim_Cauchy. Qed. @@ -209,9 +197,9 @@ Lemma inj_seq_less : (inj_Q_Cauchy IR h). Proof. do 3 intro. intro H. - simpl in |- *. + simpl in |- *. red in |- *. - simpl in H. + simpl in H. red in H. case H. intros N H2. @@ -220,22 +208,17 @@ Proof. set (H0 := True) in *. (* dummy *) exists N. exists (inj_Q IR e). - - apply less_wdl with (x := inj_Q IR Zero). - apply inj_Q_less. - assumption. - simpl in |- *. - rational. - + apply less_wdl with (x := inj_Q IR Zero). + apply inj_Q_less. + assumption. + simpl in |- *. + rational. intros. simpl in |- *. - apply - leEq_wdr - with - (y := inj_Q IR (CS_seq Q_as_COrdField h n[-]CS_seq Q_as_COrdField g n)). - apply inj_Q_leEq. - apply H3. - assumption. + apply leEq_wdr with (y := inj_Q IR (CS_seq Q_as_COrdField h n[-]CS_seq Q_as_COrdField g n)). + apply inj_Q_leEq. + apply H3. + assumption. apply inj_Q_minus. Qed. @@ -259,33 +242,28 @@ Proof. intros e H1 H6. set (H0 := True) in *. (* dummy *) case (Q_dense_in_CReals IR e). - assumption. + assumption. intro q. set (H3 := True) in *. (* dummy *) intros H4 H5. exists N. exists q. - - apply less_inj_Q with (R1 := IR). - simpl in |- *. - rstepl (Zero:IR). - assumption. - + apply less_inj_Q with (R1 := IR). + simpl in |- *. + rstepl (Zero:IR). + assumption. intros. apply leEq_inj_Q with (R1 := IR). apply leEq_transitive with (y := e). - apply less_leEq; assumption. - apply - leEq_wdr - with - (y := inj_Q IR (CS_seq Q_as_COrdField h n)[-] - inj_Q IR (CS_seq Q_as_COrdField g n)). - apply H6. - assumption. + apply less_leEq; assumption. + apply leEq_wdr with (y := inj_Q IR (CS_seq Q_as_COrdField h n)[-] + inj_Q IR (CS_seq Q_as_COrdField g n)). + apply H6. + assumption. apply eq_symmetric_unfolded. apply inj_Q_minus. Qed. - + Theorem SeqLimit_unique : forall (IR : CReals) (g : CauchySeq IR) (y : IR), SeqLimit g y -> y[=]Lim g. Proof. @@ -293,105 +271,87 @@ Proof. apply not_ap_imp_eq. intro H0. case (ap_imp_less IR y (Lim g) H0). - intro H1. - red in H. - cut - {N : nat | - forall m : nat, - N <= m -> AbsSmall ((Lim g[-]y) [/]ThreeNZ) (CS_seq IR g m[-]y)}. - intro H2. - case H2. - intro N1. - intro H3. - cut (SeqLimit g (Lim g)). - intro H4. - red in H4. - cut - {N : nat | - forall m : nat, - N <= m -> AbsSmall ((Lim g[-]y) [/]ThreeNZ) (CS_seq IR g m[-]Lim g)}. - intro H5. - case H5. - intro N2. - intro H6. - apply less_irreflexive_unfolded with (x := y[-]Lim g). - - rstepr (Zero[+](CS_seq _ g (N1 + N2)[-]Lim g)[+](y[-]CS_seq _ g (N1 + N2))). - rstepl - ((y[-]Lim g) [/]ThreeNZ[+](y[-]Lim g) [/]ThreeNZ[+](y[-]Lim g) [/]ThreeNZ). - apply plus_resp_less_leEq. - apply plus_resp_less_leEq. - apply shift_div_less. - apply pos_three. - apply shift_minus_less; rstepr (Lim g); auto. - elim (H6 (N1 + N2)); intros. - rstepl ([--]((Lim g[-]y) [/]ThreeNZ)); auto. - apply le_plus_r. - elim (H3 (N1 + N2)); intros. - apply inv_cancel_leEq. - rstepr ((Lim g[-]y) [/]ThreeNZ); rstepl (g (N1 + N2)[-]y); auto. - apply le_plus_l. - apply H4. - apply pos_div_three. - apply shift_zero_less_minus. - assumption. - apply Lim_Cauchy. - apply H. - apply pos_div_three. - apply shift_zero_less_minus. - assumption. - - + intro H1. + red in H. + cut {N : nat | forall m : nat, N <= m -> AbsSmall ((Lim g[-]y) [/]ThreeNZ) (CS_seq IR g m[-]y)}. + intro H2. + case H2. + intro N1. + intro H3. + cut (SeqLimit g (Lim g)). + intro H4. + red in H4. + cut {N : nat | forall m : nat, N <= m -> AbsSmall ((Lim g[-]y) [/]ThreeNZ) (CS_seq IR g m[-]Lim g)}. + intro H5. + case H5. + intro N2. + intro H6. + apply less_irreflexive_unfolded with (x := y[-]Lim g). + rstepr (Zero[+](CS_seq _ g (N1 + N2)[-]Lim g)[+](y[-]CS_seq _ g (N1 + N2))). + rstepl ((y[-]Lim g) [/]ThreeNZ[+](y[-]Lim g) [/]ThreeNZ[+](y[-]Lim g) [/]ThreeNZ). + apply plus_resp_less_leEq. + apply plus_resp_less_leEq. + apply shift_div_less. + apply pos_three. + apply shift_minus_less; rstepr (Lim g); auto. + elim (H6 (N1 + N2)); intros. + rstepl ([--]((Lim g[-]y) [/]ThreeNZ)); auto. + apply le_plus_r. + elim (H3 (N1 + N2)); intros. + apply inv_cancel_leEq. + rstepr ((Lim g[-]y) [/]ThreeNZ); rstepl (g (N1 + N2)[-]y); auto. + apply le_plus_l. + apply H4. + apply pos_div_three. + apply shift_zero_less_minus. + assumption. + apply Lim_Cauchy. + apply H. + apply pos_div_three. + apply shift_zero_less_minus. + assumption. intro. red in H. - cut - {N : nat | - forall m : nat, - N <= m -> AbsSmall ((y[-]Lim g) [/]ThreeNZ) (CS_seq IR g m[-]y)}. - intro H2. - case H2. - intro N1. - intro H3. - cut (SeqLimit g (Lim g)). - intro H4. - red in H4. - cut - {N : nat | - forall m : nat, - N <= m -> AbsSmall ((y[-]Lim g) [/]ThreeNZ) (CS_seq IR g m[-]Lim g)}. - intro H5. - case H5. - intro N2. - intros. - apply less_irreflexive_unfolded with (x := Lim g[-]y). - - rstepr (Zero[+](Lim g[-]CS_seq _ g (N1 + N2))[+](CS_seq _ g (N1 + N2)[-]y)). - rstepl - ((Lim g[-]y) [/]ThreeNZ[+](Lim g[-]y) [/]ThreeNZ[+](Lim g[-]y) [/]ThreeNZ). - apply plus_resp_less_leEq. - apply plus_resp_less_leEq. - apply shift_div_less. - apply pos_three. - apply shift_minus_less; rstepr y; auto. - elim (a (N1 + N2)); intros. - apply inv_cancel_leEq. - rstepr ((y[-]Lim g) [/]ThreeNZ); rstepl (g (N1 + N2)[-]Lim g); auto. - apply le_plus_r. - elim (H3 (N1 + N2)); intros. - rstepl ([--]((y[-]Lim g) [/]ThreeNZ)); auto. - apply le_plus_l. - apply H4. - apply pos_div_three. - apply shift_zero_less_minus. - assumption. - apply Lim_Cauchy. + cut {N : nat | forall m : nat, N <= m -> AbsSmall ((y[-]Lim g) [/]ThreeNZ) (CS_seq IR g m[-]y)}. + intro H2. + case H2. + intro N1. + intro H3. + cut (SeqLimit g (Lim g)). + intro H4. + red in H4. + cut {N : nat | forall m : nat, N <= m -> AbsSmall ((y[-]Lim g) [/]ThreeNZ) (CS_seq IR g m[-]Lim g)}. + intro H5. + case H5. + intro N2. + intros. + apply less_irreflexive_unfolded with (x := Lim g[-]y). + rstepr (Zero[+](Lim g[-]CS_seq _ g (N1 + N2))[+](CS_seq _ g (N1 + N2)[-]y)). + rstepl ((Lim g[-]y) [/]ThreeNZ[+](Lim g[-]y) [/]ThreeNZ[+](Lim g[-]y) [/]ThreeNZ). + apply plus_resp_less_leEq. + apply plus_resp_less_leEq. + apply shift_div_less. + apply pos_three. + apply shift_minus_less; rstepr y; auto. + elim (a (N1 + N2)); intros. + apply inv_cancel_leEq. + rstepr ((y[-]Lim g) [/]ThreeNZ); rstepl (g (N1 + N2)[-]Lim g); auto. + apply le_plus_r. + elim (H3 (N1 + N2)); intros. + rstepl ([--]((y[-]Lim g) [/]ThreeNZ)); auto. + apply le_plus_l. + apply H4. + apply pos_div_three. + apply shift_zero_less_minus. + assumption. + apply Lim_Cauchy. apply H. apply pos_div_three. apply shift_zero_less_minus. assumption. Qed. - + Lemma Lim_well_def : forall (IR : CReals) (g h : R_COrdField IR), g[=]h -> Lim g[=]Lim h. Proof. @@ -399,61 +359,49 @@ Proof. apply SeqLimit_unique with (y := Lim g). red in |- *. intros e H0. - cut (Not (g[#]h)). - intro. - cut - (forall e : IR, - Zero[<]e -> - {N : nat | - forall m : nat, N <= m -> AbsSmall e (CS_seq IR g m[-]CS_seq IR h m)}). - intro H2. - cut - {N : nat | - forall m : nat, - N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR g m[-]CS_seq IR h m)}. - intro H3. - cut (SeqLimit (CS_seq IR g) (Lim g)). - intro H4. - red in H4. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR g m[-]Lim g)}. - intro H5. - case H3. - intro N1. - intro H6. - case H5. - intro N2. - intro H7. - exists (N1 + N2). - intros. - rstepl (e [/]TwoNZ[+]e [/]TwoNZ). - rstepr (CS_seq IR h m[-]CS_seq IR g m[+](CS_seq IR g m[-]Lim g)). - apply AbsSmall_plus. - apply AbsSmall_minus. - - apply H6. - apply le_trans with (m := N1 + N2). - apply le_plus_l. - assumption. - - apply H7. - apply le_trans with (m := N1 + N2). - apply le_plus_r. - assumption. - apply H4. - apply pos_div_two. - assumption. - apply Lim_Cauchy. - apply H2. - apply pos_div_two. - assumption. - - intros. - apply Eq_alt_2_1. - assumption. - assumption. + intro. + cut (forall e : IR, Zero[<]e -> {N : nat | + forall m : nat, N <= m -> AbsSmall e (CS_seq IR g m[-]CS_seq IR h m)}). + intro H2. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR g m[-]CS_seq IR h m)}. + intro H3. + cut (SeqLimit (CS_seq IR g) (Lim g)). + intro H4. + red in H4. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR g m[-]Lim g)}. + intro H5. + case H3. + intro N1. + intro H6. + case H5. + intro N2. + intro H7. + exists (N1 + N2). + intros. + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + rstepr (CS_seq IR h m[-]CS_seq IR g m[+](CS_seq IR g m[-]Lim g)). + apply AbsSmall_plus. + apply AbsSmall_minus. + apply H6. + apply le_trans with (m := N1 + N2). + apply le_plus_l. + assumption. + apply H7. + apply le_trans with (m := N1 + N2). + apply le_plus_r. + assumption. + apply H4. + apply pos_div_two. + assumption. + apply Lim_Cauchy. + apply H2. + apply pos_div_two. + assumption. + intros. + apply Eq_alt_2_1. + assumption. + assumption. apply eq_imp_not_ap. assumption. Qed. @@ -466,67 +414,60 @@ Lemma Lim_one_one : Proof. intros. apply not_ap_imp_eq. - apply Eq_alt_2_2 with (x := g) (y := h). + apply Eq_alt_2_2 with (x := g) (y := h). intros. cut (SeqLimit (CS_seq IR g) (Lim g)). - intro H1. - red in H1. - cut (SeqLimit (CS_seq IR h) (Lim h)). - intro H2. - red in H2. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR g m[-]Lim g)}. - intro H3. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR h m[-]Lim h)}. - intro H4. - case H3. - intro N1. - intro H5. - case H4. - intro N2. - intro H6. - exists (N1 + N2). - intros m H7. - rstepl (e [/]TwoNZ[+]e [/]TwoNZ). - astepr (CS_seq IR g m[-]Lim g[+](Lim h[-]CS_seq IR h m)). - apply AbsSmall_plus. - apply H5. - apply le_trans with (m := N1 + N2). - apply le_plus_l. - assumption. - apply AbsSmall_minus. - apply H6. - apply le_trans with (m := N1 + N2). - apply le_plus_r. - assumption. - apply - eq_transitive_unfolded - with (y := CS_seq IR g m[-]CS_seq IR h m[+](Lim h[-]Lim g)). - rational. - astepr (CS_seq IR g m[-]CS_seq IR h m[+]Zero). - apply bin_op_wd_unfolded. - apply eq_reflexive_unfolded. - apply cg_cancel_rht with (x := Lim g). - apply eq_transitive_unfolded with (y := Lim h). - apply eq_symmetric_unfolded. - apply cg_cancel_mixed. - astepr (Lim g). - apply eq_symmetric_unfolded. - assumption. - - apply H2. - apply pos_div_two. - assumption. - apply H1. - apply pos_div_two. - assumption. - apply Lim_Cauchy. + intro H1. + red in H1. + cut (SeqLimit (CS_seq IR h) (Lim h)). + intro H2. + red in H2. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR g m[-]Lim g)}. + intro H3. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR h m[-]Lim h)}. + intro H4. + case H3. + intro N1. + intro H5. + case H4. + intro N2. + intro H6. + exists (N1 + N2). + intros m H7. + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + astepr (CS_seq IR g m[-]Lim g[+](Lim h[-]CS_seq IR h m)). + apply AbsSmall_plus. + apply H5. + apply le_trans with (m := N1 + N2). + apply le_plus_l. + assumption. + apply AbsSmall_minus. + apply H6. + apply le_trans with (m := N1 + N2). + apply le_plus_r. + assumption. + apply eq_transitive_unfolded with (y := CS_seq IR g m[-]CS_seq IR h m[+](Lim h[-]Lim g)). + rational. + astepr (CS_seq IR g m[-]CS_seq IR h m[+]Zero). + apply bin_op_wd_unfolded. + apply eq_reflexive_unfolded. + apply cg_cancel_rht with (x := Lim g). + apply eq_transitive_unfolded with (y := Lim h). + apply eq_symmetric_unfolded. + apply cg_cancel_mixed. + astepr (Lim g). + apply eq_symmetric_unfolded. + assumption. + apply H2. + apply pos_div_two. + assumption. + apply H1. + apply pos_div_two. + assumption. + apply Lim_Cauchy. apply Lim_Cauchy. Qed. - + Lemma inj_seq_well_def : forall (IR : CReals) (g h : R_COrdField Q_as_COrdField), @@ -539,53 +480,42 @@ Lemma inj_seq_well_def : Proof. intros. apply not_ap_imp_eq. - apply - Eq_alt_2_2 - with - (x := Build_CauchySeq IR (fun m : nat => inj_Q IR (CS_seq _ g m)) - (inj_Q_Cauchy IR g)) - (y := Build_CauchySeq IR - (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField h m)) - (inj_Q_Cauchy IR h)). + apply Eq_alt_2_2 with (x := Build_CauchySeq IR (fun m : nat => inj_Q IR (CS_seq _ g m)) + (inj_Q_Cauchy IR g)) (y := Build_CauchySeq IR (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField h m)) + (inj_Q_Cauchy IR h)). intros. simpl in |- *. case (Q_dense_in_CReals IR (e [/]TwoNZ)). - apply pos_div_two. - assumption. + apply pos_div_two. + assumption. intro q. set (H1 := True) in *. (* dummy *) intros H2 H3. - cut - {N : nat | - forall m : nat, - N <= m -> - AbsSmall q (CS_seq Q_as_COrdField g m[-]CS_seq Q_as_COrdField h m)}. - intro H4. - case H4. - intro N. - intro H5. - exists N. - intros. - apply - AbsSmall_wdr_unfolded - with - (y := inj_Q IR (CS_seq Q_as_COrdField g m[-]CS_seq Q_as_COrdField h m)). - apply AbsSmall_leEq_trans with (inj_Q IR q). - apply less_leEq; apply less_transitive_unfolded with (e [/]TwoNZ). - assumption. - apply pos_div_two'; auto. - apply inj_Q_AbsSmall. - - apply H5. - assumption. - apply inj_Q_minus. + cut {N : nat | forall m : nat, N <= m -> + AbsSmall q (CS_seq Q_as_COrdField g m[-]CS_seq Q_as_COrdField h m)}. + intro H4. + case H4. + intro N. + intro H5. + exists N. + intros. + apply AbsSmall_wdr_unfolded with + (y := inj_Q IR (CS_seq Q_as_COrdField g m[-]CS_seq Q_as_COrdField h m)). + apply AbsSmall_leEq_trans with (inj_Q IR q). + apply less_leEq; apply less_transitive_unfolded with (e [/]TwoNZ). + assumption. + apply pos_div_two'; auto. + apply inj_Q_AbsSmall. + apply H5. + assumption. + apply inj_Q_minus. apply Eq_alt_2_1. - change (Not (g[#]h)) in |- *. - apply eq_imp_not_ap. - assumption. + change (Not (g[#]h)) in |- *. + apply eq_imp_not_ap. + assumption. apply less_inj_Q with (R1 := IR). apply less_wdl with (Zero:IR). - assumption. + assumption. simpl in |- *. rational. Qed. @@ -601,70 +531,43 @@ Lemma inj_Q_one_one : Proof. intros. apply not_ap_imp_eq. - apply Eq_alt_2_2 with (x := g) (y := h). - intros. - cut - {N : nat | - forall m : nat, - N <= m -> - AbsSmall (inj_Q IR e) - (CS_seq IR - (Build_CauchySeq IR - (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField g m)) - (inj_Q_Cauchy IR g)) m[-] - CS_seq IR - (Build_CauchySeq IR - (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField h m)) - (inj_Q_Cauchy IR h)) m)}. - intro H1. - case H1. - intro N. - intros. - exists N. + apply Eq_alt_2_2 with (x := g) (y := h). intros. - cut - (AbsSmall (inj_Q IR e) - (CS_seq IR - (Build_CauchySeq IR - (fun m0 : nat => inj_Q IR (CS_seq Q_as_COrdField g m0)) - (inj_Q_Cauchy IR g)) m[-] - CS_seq IR - (Build_CauchySeq IR - (fun m0 : nat => inj_Q IR (CS_seq Q_as_COrdField h m0)) - (inj_Q_Cauchy IR h)) m)). - intro. - cut - (AbsSmall (inj_Q IR e) - (inj_Q IR (CS_seq Q_as_COrdField g m[-]CS_seq Q_as_COrdField h m))). - intro H5. - apply AbsSmall_inj_Q with IR. - auto. - - apply - AbsSmall_wdr_unfolded - with - (inj_Q IR (CS_seq Q_as_COrdField g m)[-] - inj_Q IR (CS_seq Q_as_COrdField h m)). - assumption. - apply eq_symmetric_unfolded. - apply inj_Q_minus. - apply a. - assumption. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (inj_Q IR e) (CS_seq IR (Build_CauchySeq IR + (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField g m)) (inj_Q_Cauchy IR g)) m[-] CS_seq IR + (Build_CauchySeq IR (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField h m)) + (inj_Q_Cauchy IR h)) m)}. + intro H1. + case H1. + intro N. + intros. + exists N. + intros. + cut (AbsSmall (inj_Q IR e) (CS_seq IR (Build_CauchySeq IR + (fun m0 : nat => inj_Q IR (CS_seq Q_as_COrdField g m0)) (inj_Q_Cauchy IR g)) m[-] CS_seq IR + (Build_CauchySeq IR (fun m0 : nat => inj_Q IR (CS_seq Q_as_COrdField h m0)) + (inj_Q_Cauchy IR h)) m)). + intro. + cut (AbsSmall (inj_Q IR e) (inj_Q IR (CS_seq Q_as_COrdField g m[-]CS_seq Q_as_COrdField h m))). + intro H5. + apply AbsSmall_inj_Q with IR. + auto. + apply AbsSmall_wdr_unfolded with (inj_Q IR (CS_seq Q_as_COrdField g m)[-] + inj_Q IR (CS_seq Q_as_COrdField h m)). + assumption. + apply eq_symmetric_unfolded. + apply inj_Q_minus. + apply a. + assumption. apply Eq_alt_2_1. - change - (Not - ((Build_CauchySeq IR - (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField g m)) - (inj_Q_Cauchy IR g) - :R_COrdField IR)[#] - Build_CauchySeq IR - (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField h m)) - (inj_Q_Cauchy IR h))) in |- *. - apply eq_imp_not_ap. - assumption. + change (Not ((Build_CauchySeq IR (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField g m)) + (inj_Q_Cauchy IR g) :R_COrdField IR)[#] Build_CauchySeq IR + (fun m : nat => inj_Q IR (CS_seq Q_as_COrdField h m)) (inj_Q_Cauchy IR h))) in |- *. + apply eq_imp_not_ap. + assumption. apply less_wdl with (inj_Q IR Zero). - apply inj_Q_less. - assumption. + apply inj_Q_less. + assumption. simpl in |- *. rational. Qed. @@ -680,37 +583,32 @@ Proof. red in |- *. simpl in |- *. intros. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR g m[-]Lim g)}. - intro H2. - case H2. - intro N1. - intro H3. - cut - {N : nat | - forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR h m[-]Lim h)}. - intro H4. - case H4. - intro N2. - intro H5. - exists (N1 + N2). - intros. - rstepr (CS_seq IR g m[-]Lim g[+](CS_seq IR h m[-]Lim h)). - rstepl (e [/]TwoNZ[+]e [/]TwoNZ). - apply AbsSmall_plus. - apply H3. - apply le_trans with (m := N1 + N2). - apply le_plus_l. - assumption. - apply H5. - apply le_trans with (m := N1 + N2). - apply le_plus_r. - assumption. - - apply (ax_Lim _ _ (crl_proof IR) h). - apply pos_div_two. - assumption. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR g m[-]Lim g)}. + intro H2. + case H2. + intro N1. + intro H3. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (e [/]TwoNZ) (CS_seq IR h m[-]Lim h)}. + intro H4. + case H4. + intro N2. + intro H5. + exists (N1 + N2). + intros. + rstepr (CS_seq IR g m[-]Lim g[+](CS_seq IR h m[-]Lim h)). + rstepl (e [/]TwoNZ[+]e [/]TwoNZ). + apply AbsSmall_plus. + apply H3. + apply le_trans with (m := N1 + N2). + apply le_plus_l. + assumption. + apply H5. + apply le_trans with (m := N1 + N2). + apply le_plus_r. + assumption. + apply (ax_Lim _ _ (crl_proof IR) h). + apply pos_div_two. + assumption. apply (ax_Lim _ _ (crl_proof IR) g). apply pos_div_two. assumption. @@ -728,163 +626,115 @@ Lemma G_pres_plus : Proof. intros. apply not_ap_imp_eq. - apply - Eq_alt_2_2 - with - (x := Build_CauchySeq Q_as_COrdField (fun m : nat => G IR (x[+]y) m) - (CS_seq_G IR (x[+]y))) - (y := Build_CauchySeq Q_as_COrdField - (fun m : nat => G IR x m[+]G IR y m) - (CS_seq_plus Q_as_COrdField (fun n : nat => G IR x n) - (fun n : nat => G IR y n) (CS_seq_G IR x) ( - CS_seq_G IR y))). + apply Eq_alt_2_2 with (x := Build_CauchySeq Q_as_COrdField (fun m : nat => G IR (x[+]y) m) + (CS_seq_G IR (x[+]y))) (y := Build_CauchySeq Q_as_COrdField (fun m : nat => G IR x m[+]G IR y m) + (CS_seq_plus Q_as_COrdField (fun n : nat => G IR x n) (fun n : nat => G IR y n) (CS_seq_G IR x) ( + CS_seq_G IR y))). intros e H. unfold CS_seq at 1 in |- *. unfold CS_seq in |- *. cut (SeqLimit (inj_Q_G_as_CauchySeq IR x) x). - intro H0. - cut (SeqLimit (inj_Q_G_as_CauchySeq IR y) y). - intro H1. - red in H0. - cut - {N : nat | - forall m : nat, - N <= m -> - AbsSmall (inj_Q IR (e [/]ThreeNZ)) - (CS_seq IR (inj_Q_G_as_CauchySeq IR x) m[-]x)}. - intro H2. - case H2. - intro N1. - intros. - red in H1. - cut - {N : nat | - forall m : nat, - N <= m -> - AbsSmall (inj_Q IR (e [/]ThreeNZ)) - (CS_seq IR (inj_Q_G_as_CauchySeq IR y) m[-]y)}. - intro H4. - case H4. - intro N2. - intro H5. - cut (SeqLimit (inj_Q_G_as_CauchySeq IR (x[+]y)) (x[+]y)). - intro H6. - red in H6. - cut - {N : nat | - forall m : nat, - N <= m -> - AbsSmall (inj_Q IR (e [/]ThreeNZ)) - (CS_seq IR (inj_Q_G_as_CauchySeq IR (x[+]y)) m[-](x[+]y))}. - intro H7. - case H7. - intro K. - intro H8. - exists (K + (N1 + N2)). - intros. - apply AbsSmall_inj_Q with (R1 := IR). - apply - AbsSmall_wdr_unfolded - with - (y := inj_Q IR (G IR (x[+]y) m)[-] - (inj_Q _ (G IR x m)[+]inj_Q _ (G IR y m))). - rstepr - (inj_Q _ (G IR (x[+]y) m)[-](x[+]y)[+](x[-]inj_Q _ (G IR x m))[+] - (y[-]inj_Q _ (G IR y m))). - apply - AbsSmall_wdl_unfolded - with - (x := inj_Q IR (e [/]ThreeNZ)[+]inj_Q IR (e [/]ThreeNZ)[+] - inj_Q IR (e [/]ThreeNZ)). - apply AbsSmall_plus. - apply AbsSmall_plus. - change - (AbsSmall (inj_Q IR (e [/]ThreeNZ)) - (CS_seq IR (inj_Q_G_as_CauchySeq IR (x[+]y)) m[-](x[+]y))) - in |- *. - apply H8. - apply le_trans with (m := K + (N1 + N2)). - apply le_plus_l. - assumption. - - apply AbsSmall_minus. - change - (AbsSmall (inj_Q IR (e [/]ThreeNZ)) - (CS_seq IR (inj_Q_G_as_CauchySeq IR x) m[-]x)) - in |- *. - apply a. - apply le_trans with (m := K + (N1 + N2)). - rewrite -> plus_permute with (m := N1). - apply le_plus_l. - assumption. - - apply AbsSmall_minus. - change - (AbsSmall (inj_Q IR (e [/]ThreeNZ)) - (CS_seq IR (inj_Q_G_as_CauchySeq IR y) m[-]y)) - in |- *. - apply H5. - apply le_trans with (m := K + (N1 + N2)). - rewrite -> plus_comm with (m := N2). - rewrite -> plus_permute with (m := N2). - apply le_plus_l. - assumption. - - apply - eq_transitive_unfolded - with (y := inj_Q IR (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ)). - apply - eq_transitive_unfolded - with - (y := inj_Q _ (e [/]ThreeNZ[+]e [/]ThreeNZ)[+]inj_Q IR (e [/]ThreeNZ)). - apply bin_op_wd_unfolded. - apply eq_symmetric_unfolded. - apply inj_Q_plus. - apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. - apply inj_Q_plus. - apply inj_Q_wd. - rational. - apply - eq_transitive_unfolded - with (y := inj_Q IR (G IR (x[+]y) m)[-]inj_Q IR (G IR x m[+]G IR y m)). - apply cg_minus_wd. - apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. - apply inj_Q_plus. - apply eq_symmetric_unfolded. - apply inj_Q_minus. - - apply H6. - apply less_wdl with (x := inj_Q IR Zero). - apply inj_Q_less. - apply div_resp_pos. - apply pos_three. - assumption. - simpl in |- *. - rational. - - apply x_is_SeqLimit_G. - - apply H1. - apply less_wdl with (x := inj_Q IR Zero). - apply inj_Q_less. - apply div_resp_pos. - apply pos_three. - assumption. - simpl in |- *. - rational. - - apply H0. - apply less_wdl with (x := inj_Q IR Zero). - apply inj_Q_less. - apply div_resp_pos. - apply pos_three. - assumption. - simpl in |- *. - rational. - - apply x_is_SeqLimit_G. + intro H0. + cut (SeqLimit (inj_Q_G_as_CauchySeq IR y) y). + intro H1. + red in H0. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (inj_Q IR (e [/]ThreeNZ)) + (CS_seq IR (inj_Q_G_as_CauchySeq IR x) m[-]x)}. + intro H2. + case H2. + intro N1. + intros. + red in H1. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (inj_Q IR (e [/]ThreeNZ)) + (CS_seq IR (inj_Q_G_as_CauchySeq IR y) m[-]y)}. + intro H4. + case H4. + intro N2. + intro H5. + cut (SeqLimit (inj_Q_G_as_CauchySeq IR (x[+]y)) (x[+]y)). + intro H6. + red in H6. + cut {N : nat | forall m : nat, N <= m -> AbsSmall (inj_Q IR (e [/]ThreeNZ)) + (CS_seq IR (inj_Q_G_as_CauchySeq IR (x[+]y)) m[-](x[+]y))}. + intro H7. + case H7. + intro K. + intro H8. + exists (K + (N1 + N2)). + intros. + apply AbsSmall_inj_Q with (R1 := IR). + apply AbsSmall_wdr_unfolded with (y := inj_Q IR (G IR (x[+]y) m)[-] + (inj_Q _ (G IR x m)[+]inj_Q _ (G IR y m))). + rstepr (inj_Q _ (G IR (x[+]y) m)[-](x[+]y)[+](x[-]inj_Q _ (G IR x m))[+] (y[-]inj_Q _ (G IR y m))). + apply AbsSmall_wdl_unfolded with (x := inj_Q IR (e [/]ThreeNZ)[+]inj_Q IR (e [/]ThreeNZ)[+] + inj_Q IR (e [/]ThreeNZ)). + apply AbsSmall_plus. + apply AbsSmall_plus. + change (AbsSmall (inj_Q IR (e [/]ThreeNZ)) (CS_seq IR (inj_Q_G_as_CauchySeq IR (x[+]y)) m[-](x[+]y))) + in |- *. + apply H8. + apply le_trans with (m := K + (N1 + N2)). + apply le_plus_l. + assumption. + apply AbsSmall_minus. + change (AbsSmall (inj_Q IR (e [/]ThreeNZ)) (CS_seq IR (inj_Q_G_as_CauchySeq IR x) m[-]x)) in |- *. + apply a. + apply le_trans with (m := K + (N1 + N2)). + rewrite -> plus_permute with (m := N1). + apply le_plus_l. + assumption. + apply AbsSmall_minus. + change (AbsSmall (inj_Q IR (e [/]ThreeNZ)) (CS_seq IR (inj_Q_G_as_CauchySeq IR y) m[-]y)) in |- *. + apply H5. + apply le_trans with (m := K + (N1 + N2)). + rewrite -> plus_comm with (m := N2). + rewrite -> plus_permute with (m := N2). + apply le_plus_l. + assumption. + apply eq_transitive_unfolded with (y := inj_Q IR (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ)). + apply eq_transitive_unfolded with + (y := inj_Q _ (e [/]ThreeNZ[+]e [/]ThreeNZ)[+]inj_Q IR (e [/]ThreeNZ)). + apply bin_op_wd_unfolded. + apply eq_symmetric_unfolded. + apply inj_Q_plus. + apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded. + apply inj_Q_plus. + apply inj_Q_wd. + rational. + apply eq_transitive_unfolded with (y := inj_Q IR (G IR (x[+]y) m)[-]inj_Q IR (G IR x m[+]G IR y m)). + apply cg_minus_wd. + apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded. + apply inj_Q_plus. + apply eq_symmetric_unfolded. + apply inj_Q_minus. + apply H6. + apply less_wdl with (x := inj_Q IR Zero). + apply inj_Q_less. + apply div_resp_pos. + apply pos_three. + assumption. + simpl in |- *. + rational. + apply x_is_SeqLimit_G. + apply H1. + apply less_wdl with (x := inj_Q IR Zero). + apply inj_Q_less. + apply div_resp_pos. + apply pos_three. + assumption. + simpl in |- *. + rational. + apply H0. + apply less_wdl with (x := inj_Q IR Zero). + apply inj_Q_less. + apply div_resp_pos. + apply pos_three. + assumption. + simpl in |- *. + rational. + apply x_is_SeqLimit_G. apply x_is_SeqLimit_G. Qed. @@ -900,33 +750,32 @@ Proof. intros H0 H1. case H1. intro M. - intro H2. + intro H2. exists (One[+]K). - apply plus_resp_pos. - apply pos_one. - apply leEq_not_eq. - apply (AbsSmall_nonneg IR K (CS_seq IR g M)). - apply H2. - constructor. - apply ap_symmetric_unfolded; apply pos_ap_zero; auto. - + apply plus_resp_pos. + apply pos_one. + apply leEq_not_eq. + apply (AbsSmall_nonneg IR K (CS_seq IR g M)). + apply H2. + constructor. + apply ap_symmetric_unfolded; apply pos_ap_zero; auto. cut (SeqLimit g (Lim g)). - intro H3. - red in H3. - case (H3 One). - apply pos_one. - intro N. - intros. - rstepr (Lim g[-]CS_seq IR g (N + M)[+]CS_seq IR g (N + M)). - apply AbsSmall_plus. - apply AbsSmall_minus. - apply a. - apply le_plus_l. - apply H2. - apply le_plus_r. + intro H3. + red in H3. + case (H3 One). + apply pos_one. + intro N. + intros. + rstepr (Lim g[-]CS_seq IR g (N + M)[+]CS_seq IR g (N + M)). + apply AbsSmall_plus. + apply AbsSmall_minus. + apply a. + apply le_plus_l. + apply H2. + apply le_plus_r. apply Lim_Cauchy. Qed. - + Lemma Lim_pres_mult : forall (IR : CReals) (g h : R_COrdField IR), Lim (g[*]h)[=]Lim g[*]Lim h. Proof. @@ -947,77 +796,64 @@ Proof. intro L. set (H6 := True) in *. (* dummy *) intros H7 H8. - cut (Six[*]K[#]Zero). - intro H9. - cut (Six[*]L[#]Zero). - intro H10. - case (ax_Lim _ _ (crl_proof IR) g (e[/] Six[*]L[//]H10)). - apply div_resp_pos. - apply mult_resp_pos. - apply pos_nring_S. - assumption. - assumption. - - intro N1. - intro H11. - - case (ax_Lim _ _ (crl_proof IR) h (e[/] Six[*]K[//]H9)). - apply div_resp_pos. - apply mult_resp_pos. - apply pos_nring_S. - apply leEq_not_eq. - apply (AbsSmall_nonneg IR K (CS_seq IR g M1)). - apply H5. - constructor. - apply less_imp_ap; auto. - assumption. - - intro N2. - intro H12. - exists (N1 + (N2 + M1)). - intros m H13. - rstepr - (CS_seq IR g m[*](CS_seq IR h m[-]Lim h)[+]Lim h[*](CS_seq IR g m[-]Lim g)). - rstepl - (Three[*](K[*](e[/] Six[*]K[//]H9))[+]Three[*](L[*](e[/] Six[*]L[//]H10))). - apply AbsSmall_plus. - apply AbsSmall_mult. - apply H5. - - apply le_trans with (m := N1 + (N2 + M1)). - rewrite -> plus_comm with (m := M1). - rewrite -> plus_permute with (m := M1). - apply le_plus_l. - assumption. - - apply H12. - - apply le_trans with (m := N1 + (N2 + M1)). - rewrite -> plus_permute with (m := N2). - apply le_plus_l. - assumption. - - apply AbsSmall_mult. - assumption. - - apply H11. - - apply le_trans with (m := N1 + (N2 + M1)). - apply le_plus_l. + cut (Six[*]K[#]Zero). + intro H9. + cut (Six[*]L[#]Zero). + intro H10. + case (ax_Lim _ _ (crl_proof IR) g (e[/] Six[*]L[//]H10)). + apply div_resp_pos. + apply mult_resp_pos. + apply pos_nring_S. + assumption. + assumption. + intro N1. + intro H11. + case (ax_Lim _ _ (crl_proof IR) h (e[/] Six[*]K[//]H9)). + apply div_resp_pos. + apply mult_resp_pos. + apply pos_nring_S. + apply leEq_not_eq. + apply (AbsSmall_nonneg IR K (CS_seq IR g M1)). + apply H5. + constructor. + apply less_imp_ap; auto. + assumption. + intro N2. + intro H12. + exists (N1 + (N2 + M1)). + intros m H13. + rstepr (CS_seq IR g m[*](CS_seq IR h m[-]Lim h)[+]Lim h[*](CS_seq IR g m[-]Lim g)). + rstepl (Three[*](K[*](e[/] Six[*]K[//]H9))[+]Three[*](L[*](e[/] Six[*]L[//]H10))). + apply AbsSmall_plus. + apply AbsSmall_mult. + apply H5. + apply le_trans with (m := N1 + (N2 + M1)). + rewrite -> plus_comm with (m := M1). + rewrite -> plus_permute with (m := M1). + apply le_plus_l. + assumption. + apply H12. + apply le_trans with (m := N1 + (N2 + M1)). + rewrite -> plus_permute with (m := N2). + apply le_plus_l. + assumption. + apply AbsSmall_mult. + assumption. + apply H11. + apply le_trans with (m := N1 + (N2 + M1)). + apply le_plus_l. + assumption. + apply Greater_imp_ap. + apply mult_resp_pos. + apply pos_nring_S. assumption. - apply Greater_imp_ap. apply mult_resp_pos. - apply pos_nring_S. - assumption. - apply Greater_imp_ap. - apply mult_resp_pos. - apply pos_nring_S. - - apply leEq_not_eq. - apply (AbsSmall_nonneg IR K (CS_seq IR g M1)). - apply H5. - constructor. + apply pos_nring_S. + apply leEq_not_eq. + apply (AbsSmall_nonneg IR K (CS_seq IR g M1)). + apply H5. + constructor. apply less_imp_ap; auto. Qed. @@ -1039,165 +875,145 @@ Proof. unfold CS_seq at 1 in |- *. unfold CS_seq in |- *. cut (SeqLimit (inj_Q_G_as_CauchySeq IR x) x). - intro H0. - cut (SeqLimit (inj_Q_G_as_CauchySeq IR y) y). - intro H1. - cut (SeqLimit (inj_Q_G_as_CauchySeq IR (x[*]y)) (x[*]y)). - intro H2. - case (CS_seq_bounded Q_as_COrdField (G IR y) (CS_seq_G IR y)). - intro K. - set (H3 := True) in *. (* dummy *) - intros H4 H5. - case H5. - intro M1. - intro H6. - case (nonarchemaedian_bound_for_Lim _ (inj_Q_G_as_CauchySeq IR x)). - intro L. - set (H7 := True) in *. (* dummy *) - intros H8 H9. - cut (Twelve[*]inj_Q IR K[#]Zero). - intro H10. - cut (Twelve[*]L[#]Zero). - intro H11. - red in H0. - case (H0 (inj_Q IR e[/] Twelve[*]inj_Q IR K[//]H10)). - apply div_resp_pos. - apply mult_resp_pos. - apply pos_nring_S. - apply less_wdl with (x := inj_Q IR Zero). - apply inj_Q_less. - apply leEq_not_eq. - apply (AbsSmall_nonneg Q_as_COrdField K (G IR y M1)). - apply H6. - constructor. - apply less_imp_ap; auto. - simpl in |- *. - rational. - apply less_wdl with (x := inj_Q IR Zero). - apply inj_Q_less. - assumption. - simpl in |- *. - rational. - - intro N1. - intro H12. - - red in H1. - case (H1 (inj_Q IR e[/] Twelve[*]L[//]H11)). - apply div_resp_pos. - apply mult_resp_pos. - apply pos_nring_S. - assumption. - - apply less_wdl with (x := inj_Q IR Zero). - apply inj_Q_less. - assumption. - simpl in |- *. - rational. - - intro N2. - intro H13. - - red in H2. - case (H2 (inj_Q IR e [/]TwoNZ)). - apply div_resp_pos. - apply pos_two. - apply less_wdl with (x := inj_Q IR Zero). - apply inj_Q_less. - assumption. - simpl in |- *. - rational. - - intro N3. - intro H14. - - exists (N1 + (N2 + (N3 + M1))). - intros. - apply (AbsSmall_inj_Q IR). - apply - AbsSmall_wdr_unfolded - with - (y := inj_Q IR (G IR (x[*]y) m)[-] - inj_Q IR (G IR x m)[*]inj_Q IR (G IR y m)). - rstepr - (inj_Q IR (G IR (x[*]y) m)[-]x[*]y[+]x[*](y[-]inj_Q IR (G IR y m))[+] - inj_Q IR (G IR y m)[*](x[-]inj_Q IR (G IR x m))). - rstepl - (inj_Q IR e [/]TwoNZ[+]Three[*](L[*](inj_Q IR e[/] Twelve[*]L[//]H11))[+] - Three[*](inj_Q IR K[*](inj_Q IR e[/] Twelve[*]inj_Q IR K[//]H10))). - apply AbsSmall_plus. - apply AbsSmall_plus. - unfold inj_Q_G_as_CauchySeq in H14. - unfold CS_seq at 1 in H14. - apply H14. - apply le_trans with (m := N1 + (N2 + (N3 + M1))). - rewrite -> plus_permute with (m := N3). - rewrite -> plus_permute with (m := N3). - apply le_plus_l. - assumption. - - apply AbsSmall_mult. - apply AbsSmall_wdr_unfolded with (y := Lim (inj_Q_G_as_CauchySeq IR x)). - assumption. - apply eq_symmetric_unfolded. - apply SeqLimit_unique. - apply x_is_SeqLimit_G. - apply AbsSmall_minus. - unfold inj_Q_G_as_CauchySeq in H13. - unfold CS_seq at 1 in H13. - apply H13. - apply le_trans with (m := N1 + (N2 + (N3 + M1))). - rewrite -> plus_permute with (m := N2). - apply le_plus_l. - assumption. - - apply AbsSmall_mult. - apply inj_Q_AbsSmall. - apply H6. - apply le_trans with (m := N1 + (N2 + (N3 + M1))). - rewrite -> plus_comm with (m := M1). - rewrite -> plus_permute with (m := M1). - rewrite -> plus_permute with (m := M1). - apply le_plus_l. - assumption. - apply AbsSmall_minus. - unfold inj_Q_G_as_CauchySeq in H12. - unfold CS_seq at 1 in H12. - apply H12. - - apply le_trans with (m := N1 + (N2 + (N3 + M1))). - apply le_plus_l. - assumption. - - apply - eq_transitive_unfolded - with (y := inj_Q IR (G IR (x[*]y) m)[-]inj_Q IR (G IR x m[*]G IR y m)). - apply cg_minus_wd. - apply eq_reflexive_unfolded. - apply eq_symmetric_unfolded. - apply inj_Q_mult. - apply eq_symmetric_unfolded. - apply inj_Q_minus. - - apply Greater_imp_ap. - apply mult_resp_pos. - apply pos_nring_S. - assumption. - apply Greater_imp_ap. - apply mult_resp_pos. - apply pos_nring_S. - apply less_wdl with (x := inj_Q IR Zero). - apply inj_Q_less. - apply leEq_not_eq. - apply (AbsSmall_nonneg Q_as_COrdField K (G IR y M1)). - apply H6. - constructor. - apply less_imp_ap; auto. - simpl in |- *. - rational. - - apply x_is_SeqLimit_G. - apply x_is_SeqLimit_G. + intro H0. + cut (SeqLimit (inj_Q_G_as_CauchySeq IR y) y). + intro H1. + cut (SeqLimit (inj_Q_G_as_CauchySeq IR (x[*]y)) (x[*]y)). + intro H2. + case (CS_seq_bounded Q_as_COrdField (G IR y) (CS_seq_G IR y)). + intro K. + set (H3 := True) in *. (* dummy *) + intros H4 H5. + case H5. + intro M1. + intro H6. + case (nonarchemaedian_bound_for_Lim _ (inj_Q_G_as_CauchySeq IR x)). + intro L. + set (H7 := True) in *. (* dummy *) + intros H8 H9. + cut (Twelve[*]inj_Q IR K[#]Zero). + intro H10. + cut (Twelve[*]L[#]Zero). + intro H11. + red in H0. + case (H0 (inj_Q IR e[/] Twelve[*]inj_Q IR K[//]H10)). + apply div_resp_pos. + apply mult_resp_pos. + apply pos_nring_S. + apply less_wdl with (x := inj_Q IR Zero). + apply inj_Q_less. + apply leEq_not_eq. + apply (AbsSmall_nonneg Q_as_COrdField K (G IR y M1)). + apply H6. + constructor. + apply less_imp_ap; auto. + simpl in |- *. + rational. + apply less_wdl with (x := inj_Q IR Zero). + apply inj_Q_less. + assumption. + simpl in |- *. + rational. + intro N1. + intro H12. + red in H1. + case (H1 (inj_Q IR e[/] Twelve[*]L[//]H11)). + apply div_resp_pos. + apply mult_resp_pos. + apply pos_nring_S. + assumption. + apply less_wdl with (x := inj_Q IR Zero). + apply inj_Q_less. + assumption. + simpl in |- *. + rational. + intro N2. + intro H13. + red in H2. + case (H2 (inj_Q IR e [/]TwoNZ)). + apply div_resp_pos. + apply pos_two. + apply less_wdl with (x := inj_Q IR Zero). + apply inj_Q_less. + assumption. + simpl in |- *. + rational. + intro N3. + intro H14. + exists (N1 + (N2 + (N3 + M1))). + intros. + apply (AbsSmall_inj_Q IR). + apply AbsSmall_wdr_unfolded with (y := inj_Q IR (G IR (x[*]y) m)[-] + inj_Q IR (G IR x m)[*]inj_Q IR (G IR y m)). + rstepr (inj_Q IR (G IR (x[*]y) m)[-]x[*]y[+]x[*](y[-]inj_Q IR (G IR y m))[+] + inj_Q IR (G IR y m)[*](x[-]inj_Q IR (G IR x m))). + rstepl (inj_Q IR e [/]TwoNZ[+]Three[*](L[*](inj_Q IR e[/] Twelve[*]L[//]H11))[+] + Three[*](inj_Q IR K[*](inj_Q IR e[/] Twelve[*]inj_Q IR K[//]H10))). + apply AbsSmall_plus. + apply AbsSmall_plus. + unfold inj_Q_G_as_CauchySeq in H14. + unfold CS_seq at 1 in H14. + apply H14. + apply le_trans with (m := N1 + (N2 + (N3 + M1))). + rewrite -> plus_permute with (m := N3). + rewrite -> plus_permute with (m := N3). + apply le_plus_l. + assumption. + apply AbsSmall_mult. + apply AbsSmall_wdr_unfolded with (y := Lim (inj_Q_G_as_CauchySeq IR x)). + assumption. + apply eq_symmetric_unfolded. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. + apply AbsSmall_minus. + unfold inj_Q_G_as_CauchySeq in H13. + unfold CS_seq at 1 in H13. + apply H13. + apply le_trans with (m := N1 + (N2 + (N3 + M1))). + rewrite -> plus_permute with (m := N2). + apply le_plus_l. + assumption. + apply AbsSmall_mult. + apply inj_Q_AbsSmall. + apply H6. + apply le_trans with (m := N1 + (N2 + (N3 + M1))). + rewrite -> plus_comm with (m := M1). + rewrite -> plus_permute with (m := M1). + rewrite -> plus_permute with (m := M1). + apply le_plus_l. + assumption. + apply AbsSmall_minus. + unfold inj_Q_G_as_CauchySeq in H12. + unfold CS_seq at 1 in H12. + apply H12. + apply le_trans with (m := N1 + (N2 + (N3 + M1))). + apply le_plus_l. + assumption. + apply eq_transitive_unfolded with (y := inj_Q IR (G IR (x[*]y) m)[-]inj_Q IR (G IR x m[*]G IR y m)). + apply cg_minus_wd. + apply eq_reflexive_unfolded. + apply eq_symmetric_unfolded. + apply inj_Q_mult. + apply eq_symmetric_unfolded. + apply inj_Q_minus. + apply Greater_imp_ap. + apply mult_resp_pos. + apply pos_nring_S. + assumption. + apply Greater_imp_ap. + apply mult_resp_pos. + apply pos_nring_S. + apply less_wdl with (x := inj_Q IR Zero). + apply inj_Q_less. + apply leEq_not_eq. + apply (AbsSmall_nonneg Q_as_COrdField K (G IR y M1)). + apply H6. + constructor. + apply less_imp_ap; auto. + simpl in |- *. + rational. + apply x_is_SeqLimit_G. + apply x_is_SeqLimit_G. apply x_is_SeqLimit_G. Qed. @@ -1213,11 +1029,8 @@ Lemma image_Cauchy12 : forall x : R1, Cauchy_prop (fun n : nat => inj_Q R2 (G R1 x n)). Proof. intros. - change - (Cauchy_prop - (fun n : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 x) n))) - in |- *. + change (Cauchy_prop (fun n : nat => inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 x) n))) + in |- *. apply inj_Q_Cauchy. Qed. @@ -1225,11 +1038,8 @@ Lemma image_Cauchy21 : forall y : R2, Cauchy_prop (fun n : nat => inj_Q R1 (G R2 y n)). Proof. intros. - change - (Cauchy_prop - (fun n : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) n))) - in |- *. + change (Cauchy_prop (fun n : nat => inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) n))) + in |- *. apply inj_Q_Cauchy. Qed. @@ -1250,54 +1060,31 @@ Proof. intro. unfold f12 in |- *. cut (y[=]Lim (inj_Q_G_as_CauchySeq R2 y)). - intro. - apply eq_transitive_unfolded with (y := Lim (inj_Q_G_as_CauchySeq R2 y)). - assumption. - apply Lim_well_def. - unfold inj_Q_G_as_CauchySeq in |- *. - unfold image_G_as_CauchySeq12 in |- *. - change - ((Build_CauchySeq R2 - (fun m : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) m)) - (CS_seq_inj_Q_G R2 y) - :R_COrdField R2)[=] - Build_CauchySeq R2 - (fun n : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 (g21 y)) n)) - (image_Cauchy12 (g21 y))) in |- *. - - change - ((Build_CauchySeq R2 - (fun m : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) m)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R2 y)) - :R_COrdField R2)[=] - Build_CauchySeq R2 - (fun n : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 (g21 y)) n)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R1 (g21 y)))) - in |- *. - apply - inj_seq_well_def - with (g := G_as_CauchySeq R2 y) (h := G_as_CauchySeq R1 (g21 y)). - - apply inj_Q_one_one with (IR := R1). - change - ((Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 y m)) - (image_Cauchy21 y) - :R_COrdField R1)[=] - Build_CauchySeq R1 (fun n : nat => inj_Q R1 (G R1 (g21 y) n)) + intro. + apply eq_transitive_unfolded with (y := Lim (inj_Q_G_as_CauchySeq R2 y)). + assumption. + apply Lim_well_def. + unfold inj_Q_G_as_CauchySeq in |- *. + unfold image_G_as_CauchySeq12 in |- *. + change ((Build_CauchySeq R2 (fun m : nat => inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) m)) + (CS_seq_inj_Q_G R2 y) :R_COrdField R2)[=] Build_CauchySeq R2 (fun n : nat => + inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 (g21 y)) n)) + (image_Cauchy12 (g21 y))) in |- *. + change ((Build_CauchySeq R2 (fun m : nat => inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) m)) + (inj_Q_Cauchy R2 (G_as_CauchySeq R2 y)) :R_COrdField R2)[=] Build_CauchySeq R2 (fun n : nat => + inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 (g21 y)) n)) + (inj_Q_Cauchy R2 (G_as_CauchySeq R1 (g21 y)))) in |- *. + apply inj_seq_well_def with (g := G_as_CauchySeq R2 y) (h := G_as_CauchySeq R1 (g21 y)). + apply inj_Q_one_one with (IR := R1). + change ((Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 y m)) (image_Cauchy21 y) + :R_COrdField R1)[=] Build_CauchySeq R1 (fun n : nat => inj_Q R1 (G R1 (g21 y) n)) (CS_seq_inj_Q_G R1 (g21 y))) in |- *. - change - ((image_G_as_CauchySeq21 y:R_COrdField R1)[=] - inj_Q_G_as_CauchySeq R1 (g21 y)) in |- *. - apply Lim_one_one with (IR := R1). - apply eq_transitive_unfolded with (y := g21 y). - apply eq_reflexive_unfolded. - - apply SeqLimit_unique. - apply x_is_SeqLimit_G. + change ((image_G_as_CauchySeq21 y:R_COrdField R1)[=] inj_Q_G_as_CauchySeq R1 (g21 y)) in |- *. + apply Lim_one_one with (IR := R1). + apply eq_transitive_unfolded with (y := g21 y). + apply eq_reflexive_unfolded. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. apply SeqLimit_unique. apply x_is_SeqLimit_G. Qed. @@ -1318,65 +1105,48 @@ Proof. red in |- *. unfold f12 in |- *. intros x y H. - case - (ap_imp_less R2 (Lim (image_G_as_CauchySeq12 x)) - (Lim (image_G_as_CauchySeq12 y)) H). - intro. - apply less_imp_ap. - apply less_wdl with (x := Lim (inj_Q_G_as_CauchySeq R1 x)). - apply less_wdr with (y := Lim (inj_Q_G_as_CauchySeq R1 y)). - apply Lim_pres_less. - unfold inj_Q_G_as_CauchySeq in |- *. - change - ((Build_CauchySeq R1 - (fun m : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 x) m)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R1 x)) - :R_COrdField R1)[<] - Build_CauchySeq R1 - (fun n : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) n)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R1 y))) in |- *. - apply inj_seq_less. - apply less_inj_seq with (IR := R2). - change - ((image_G_as_CauchySeq12 x:R_COrdField R2)[<] - (image_G_as_CauchySeq12 y:R_COrdField R2)) in |- *. - apply less_pres_Lim. - assumption. - apply eq_symmetric_unfolded. - apply SeqLimit_unique. - apply x_is_SeqLimit_G. - apply eq_symmetric_unfolded. - apply SeqLimit_unique. - apply x_is_SeqLimit_G. - + case (ap_imp_less R2 (Lim (image_G_as_CauchySeq12 x)) (Lim (image_G_as_CauchySeq12 y)) H). + intro. + apply less_imp_ap. + apply less_wdl with (x := Lim (inj_Q_G_as_CauchySeq R1 x)). + apply less_wdr with (y := Lim (inj_Q_G_as_CauchySeq R1 y)). + apply Lim_pres_less. + unfold inj_Q_G_as_CauchySeq in |- *. + change ((Build_CauchySeq R1 (fun m : nat => inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 x) m)) + (inj_Q_Cauchy R1 (G_as_CauchySeq R1 x)) :R_COrdField R1)[<] Build_CauchySeq R1 (fun n : nat => + inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) n)) + (inj_Q_Cauchy R1 (G_as_CauchySeq R1 y))) in |- *. + apply inj_seq_less. + apply less_inj_seq with (IR := R2). + change ((image_G_as_CauchySeq12 x:R_COrdField R2)[<] + (image_G_as_CauchySeq12 y:R_COrdField R2)) in |- *. + apply less_pres_Lim. + assumption. + apply eq_symmetric_unfolded. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. + apply eq_symmetric_unfolded. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. intro. apply Greater_imp_ap. apply less_wdl with (x := Lim (inj_Q_G_as_CauchySeq R1 y)). - apply less_wdr with (y := Lim (inj_Q_G_as_CauchySeq R1 x)). - apply Lim_pres_less. - unfold inj_Q_G_as_CauchySeq in |- *. - change - ((Build_CauchySeq R1 - (fun m : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) m)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R1 y)) - :R_COrdField R1)[<] - Build_CauchySeq R1 - (fun n : nat => + apply less_wdr with (y := Lim (inj_Q_G_as_CauchySeq R1 x)). + apply Lim_pres_less. + unfold inj_Q_G_as_CauchySeq in |- *. + change ((Build_CauchySeq R1 (fun m : nat => inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) m)) + (inj_Q_Cauchy R1 (G_as_CauchySeq R1 y)) :R_COrdField R1)[<] Build_CauchySeq R1 (fun n : nat => inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 x) n)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R1 x))) in |- *. - apply inj_seq_less. - apply less_inj_seq with (IR := R2). - change - ((image_G_as_CauchySeq12 y:R_COrdField R2)[<] - (image_G_as_CauchySeq12 x:R_COrdField R2)) in |- *. - apply less_pres_Lim. - assumption. - apply eq_symmetric_unfolded. - apply SeqLimit_unique. - apply x_is_SeqLimit_G. + (inj_Q_Cauchy R1 (G_as_CauchySeq R1 x))) in |- *. + apply inj_seq_less. + apply less_inj_seq with (IR := R2). + change ((image_G_as_CauchySeq12 y:R_COrdField R2)[<] + (image_G_as_CauchySeq12 x:R_COrdField R2)) in |- *. + apply less_pres_Lim. + assumption. + apply eq_symmetric_unfolded. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. apply eq_symmetric_unfolded. apply SeqLimit_unique. apply x_is_SeqLimit_G. @@ -1390,27 +1160,20 @@ Proof. unfold f12 in |- *. apply Lim_pres_less. unfold image_G_as_CauchySeq12 in |- *. - change - ((Build_CauchySeq R2 - (fun m : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 x) m)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R1 x)) - :R_COrdField R2)[<] - Build_CauchySeq R2 - (fun n : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) n)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R1 y))) in |- *. + change ((Build_CauchySeq R2 (fun m : nat => inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 x) m)) + (inj_Q_Cauchy R2 (G_as_CauchySeq R1 x)) :R_COrdField R2)[<] Build_CauchySeq R2 (fun n : nat => + inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) n)) + (inj_Q_Cauchy R2 (G_as_CauchySeq R1 y))) in |- *. apply inj_seq_less. - apply less_inj_seq with (IR := R1). - change - ((inj_Q_G_as_CauchySeq R1 x:R_COrdField R1)[<] - (inj_Q_G_as_CauchySeq R1 y:R_COrdField R1)) in |- *. + apply less_inj_seq with (IR := R1). + change ((inj_Q_G_as_CauchySeq R1 x:R_COrdField R1)[<] + (inj_Q_G_as_CauchySeq R1 y:R_COrdField R1)) in |- *. apply less_pres_Lim. apply less_wdl with (x := x). - apply less_wdr with (y := y). - assumption. - apply SeqLimit_unique. - apply x_is_SeqLimit_G. + apply less_wdr with (y := y). + assumption. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. apply SeqLimit_unique. apply x_is_SeqLimit_G. Qed. @@ -1421,90 +1184,57 @@ Theorem f12_pres_plus : Proof. red in |- *. intros. - unfold f12 in |- *. - apply - eq_transitive_unfolded - with - (y := Lim - ((image_G_as_CauchySeq12 x:R_COrdField R2)[+] - image_G_as_CauchySeq12 y)). - apply Lim_well_def. - unfold image_G_as_CauchySeq12 in |- *. - apply - eq_transitive_unfolded - with - (S := R_COrdField R2:CSetoid) - (y := Build_CauchySeq R2 (fun m : nat => inj_Q R2 (G R1 x m[+]G R1 y m)) - (inj_Q_Cauchy R2 - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R1 x m[+]G R1 y m) - (CS_seq_plus Q_as_COrdField (fun n : nat => G R1 x n) - (fun n : nat => G R1 y n) (CS_seq_G R1 x) - (CS_seq_G R1 y)))) - :R_COrdField R2). - change - ((Build_CauchySeq R2 - (fun n : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 (x[+]y)) n)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R1 (x[+]y))) - :R_COrdField R2)[=] - Build_CauchySeq R2 - (fun m : nat => - inj_Q R2 - (CS_seq Q_as_COrdField - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R1 x m[+]G R1 y m) - (CS_seq_plus Q_as_COrdField (fun n : nat => G R1 x n) - (fun n : nat => G R1 y n) (CS_seq_G R1 x) ( - CS_seq_G R1 y))) m)) - (inj_Q_Cauchy R2 - (Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[+]G R1 y m) - (CS_seq_plus Q_as_COrdField (fun n : nat => G R1 x n) - (fun n : nat => G R1 y n) (CS_seq_G R1 x) ( - CS_seq_G R1 y))))) in |- *. - apply inj_seq_well_def. - unfold G_as_CauchySeq in |- *. - apply G_pres_plus. - (* Cauchy inj_Q plus *) - apply not_ap_imp_eq. - apply - Eq_alt_2_2 - with - (x := Build_CauchySeq R2 (fun m : nat => inj_Q R2 (G R1 x m[+]G R1 y m)) - (inj_Q_Cauchy R2 - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R1 x m[+]G R1 y m) - (CS_seq_plus Q_as_COrdField (fun n : nat => G R1 x n) - (fun n : nat => G R1 y n) (CS_seq_G R1 x) - (CS_seq_G R1 y)))) - :R_COrdField R2) - (y := Build_CauchySeq R2 - (fun m : nat => inj_Q R2 (G R1 x m)[+]inj_Q R2 (G R1 y m)) - (CS_seq_plus R2 (fun n : nat => inj_Q R2 (G R1 x n)) - (fun n : nat => inj_Q R2 (G R1 y n)) ( - image_Cauchy12 x) (image_Cauchy12 y)) - :R_COrdField R2). - intros. - exists 0. - intros. - unfold CS_seq in |- *. - apply AbsSmall_wdr_unfolded with (y := Zero:R2). - split. - rstepr ([--](Zero:R2)). - apply inv_resp_leEq. - apply less_leEq. - assumption. - apply less_leEq. - assumption. - apply cg_cancel_rht with (x := inj_Q R2 (G R1 x m)[+]inj_Q R2 (G R1 y m)). - astepl (inj_Q R2 (G R1 x m)[+]inj_Q R2 (G R1 y m)). - apply eq_transitive_unfolded with (y := inj_Q R2 (G R1 x m[+]G R1 y m)). - apply eq_symmetric_unfolded. - apply inj_Q_plus. - apply cg_cancel_mixed. + unfold f12 in |- *. + apply eq_transitive_unfolded with (y := Lim ((image_G_as_CauchySeq12 x:R_COrdField R2)[+] + image_G_as_CauchySeq12 y)). + apply Lim_well_def. + unfold image_G_as_CauchySeq12 in |- *. + apply eq_transitive_unfolded with (S := R_COrdField R2:CSetoid) + (y := Build_CauchySeq R2 (fun m : nat => inj_Q R2 (G R1 x m[+]G R1 y m)) (inj_Q_Cauchy R2 + (Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[+]G R1 y m) + (CS_seq_plus Q_as_COrdField (fun n : nat => G R1 x n) (fun n : nat => G R1 y n) (CS_seq_G R1 x) + (CS_seq_G R1 y)))) :R_COrdField R2). + change ((Build_CauchySeq R2 (fun n : nat => + inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 (x[+]y)) n)) + (inj_Q_Cauchy R2 (G_as_CauchySeq R1 (x[+]y))) :R_COrdField R2)[=] Build_CauchySeq R2 + (fun m : nat => inj_Q R2 (CS_seq Q_as_COrdField (Build_CauchySeq Q_as_COrdField + (fun m : nat => G R1 x m[+]G R1 y m) (CS_seq_plus Q_as_COrdField (fun n : nat => G R1 x n) + (fun n : nat => G R1 y n) (CS_seq_G R1 x) ( CS_seq_G R1 y))) m)) (inj_Q_Cauchy R2 + (Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[+]G R1 y m) + (CS_seq_plus Q_as_COrdField (fun n : nat => G R1 x n) + (fun n : nat => G R1 y n) (CS_seq_G R1 x) ( CS_seq_G R1 y))))) in |- *. + apply inj_seq_well_def. + unfold G_as_CauchySeq in |- *. + apply G_pres_plus. + (* Cauchy inj_Q plus *) + apply not_ap_imp_eq. + apply Eq_alt_2_2 with (x := Build_CauchySeq R2 (fun m : nat => inj_Q R2 (G R1 x m[+]G R1 y m)) + (inj_Q_Cauchy R2 (Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[+]G R1 y m) + (CS_seq_plus Q_as_COrdField (fun n : nat => G R1 x n) (fun n : nat => G R1 y n) (CS_seq_G R1 x) + (CS_seq_G R1 y)))) :R_COrdField R2) (y := Build_CauchySeq R2 + (fun m : nat => inj_Q R2 (G R1 x m)[+]inj_Q R2 (G R1 y m)) + (CS_seq_plus R2 (fun n : nat => inj_Q R2 (G R1 x n)) (fun n : nat => inj_Q R2 (G R1 y n)) ( + image_Cauchy12 x) (image_Cauchy12 y)) :R_COrdField R2). + intros. + exists 0. + intros. + unfold CS_seq in |- *. + apply AbsSmall_wdr_unfolded with (y := Zero:R2). + split. + rstepr ([--](Zero:R2)). + apply inv_resp_leEq. + apply less_leEq. + assumption. + apply less_leEq. + assumption. + apply cg_cancel_rht with (x := inj_Q R2 (G R1 x m)[+]inj_Q R2 (G R1 y m)). + astepl (inj_Q R2 (G R1 x m)[+]inj_Q R2 (G R1 y m)). + apply eq_transitive_unfolded with (y := inj_Q R2 (G R1 x m[+]G R1 y m)). + apply eq_symmetric_unfolded. + apply inj_Q_plus. + apply cg_cancel_mixed. (* End of Cauchy inj_Q plus *) - - apply Lim_pres_plus. + apply Lim_pres_plus. Qed. @@ -1514,96 +1244,61 @@ Theorem f12_pres_mult : Proof. red in |- *. intros. - unfold f12 in |- *. - apply - eq_transitive_unfolded - with - (y := Lim - ((image_G_as_CauchySeq12 x:R_COrdField R2)[*] - image_G_as_CauchySeq12 y)). - apply Lim_well_def. - unfold image_G_as_CauchySeq12 in |- *. - apply - eq_transitive_unfolded - with - (S := R_COrdField R2:CSetoid) - (y := Build_CauchySeq R2 (fun m : nat => inj_Q R2 (G R1 x m[*]G R1 y m)) - (inj_Q_Cauchy R2 - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R1 x m[*]G R1 y m) - (CS_seq_mult Q_as_COrdField _ _ - (CS_proof _ (G_as_CauchySeq R1 x)) - (CS_proof _ (G_as_CauchySeq R1 y))))) - :R_COrdField R2). - change - ((Build_CauchySeq R2 - (fun n : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 (x[*]y)) n)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R1 (x[*]y))) - :R_COrdField R2)[=] - Build_CauchySeq R2 - (fun m : nat => - inj_Q R2 - (CS_seq Q_as_COrdField - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R1 x m[*]G R1 y m) - (CS_seq_mult Q_as_COrdField _ _ - (CS_proof _ (G_as_CauchySeq R1 x)) - (CS_proof _ (G_as_CauchySeq R1 y)))) m)) - (inj_Q_Cauchy R2 - (Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[*]G R1 y m) - (CS_seq_mult Q_as_COrdField _ _ - (CS_proof _ (G_as_CauchySeq R1 x)) - (CS_proof _ (G_as_CauchySeq R1 y)))))) - in |- *. - apply inj_seq_well_def. - unfold G_as_CauchySeq in |- *. - change - ((Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 (x[*]y) m) - (CS_seq_G R1 (x[*]y)) - :R_COrdField Q_as_COrdField)[=] - Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[*]G R1 y m) - (CS_seq_mult Q_as_COrdField _ _ (CS_proof _ (G_as_CauchySeq R1 x)) + unfold f12 in |- *. + apply eq_transitive_unfolded with (y := Lim ((image_G_as_CauchySeq12 x:R_COrdField R2)[*] + image_G_as_CauchySeq12 y)). + apply Lim_well_def. + unfold image_G_as_CauchySeq12 in |- *. + apply eq_transitive_unfolded with (S := R_COrdField R2:CSetoid) + (y := Build_CauchySeq R2 (fun m : nat => inj_Q R2 (G R1 x m[*]G R1 y m)) (inj_Q_Cauchy R2 + (Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[*]G R1 y m) + (CS_seq_mult Q_as_COrdField _ _ (CS_proof _ (G_as_CauchySeq R1 x)) + (CS_proof _ (G_as_CauchySeq R1 y))))) :R_COrdField R2). + change ((Build_CauchySeq R2 (fun n : nat => + inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 (x[*]y)) n)) + (inj_Q_Cauchy R2 (G_as_CauchySeq R1 (x[*]y))) :R_COrdField R2)[=] Build_CauchySeq R2 + (fun m : nat => inj_Q R2 (CS_seq Q_as_COrdField (Build_CauchySeq Q_as_COrdField + (fun m : nat => G R1 x m[*]G R1 y m) (CS_seq_mult Q_as_COrdField _ _ + (CS_proof _ (G_as_CauchySeq R1 x)) (CS_proof _ (G_as_CauchySeq R1 y)))) m)) + (inj_Q_Cauchy R2 (Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[*]G R1 y m) + (CS_seq_mult Q_as_COrdField _ _ (CS_proof _ (G_as_CauchySeq R1 x)) + (CS_proof _ (G_as_CauchySeq R1 y)))))) in |- *. + apply inj_seq_well_def. + unfold G_as_CauchySeq in |- *. + change ((Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 (x[*]y) m) (CS_seq_G R1 (x[*]y)) + :R_COrdField Q_as_COrdField)[=] Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[*]G R1 y m) + (CS_seq_mult Q_as_COrdField _ _ (CS_proof _ (G_as_CauchySeq R1 x)) (CS_proof _ (G_as_CauchySeq R1 y)))) in |- *. - apply G_pres_mult. - - (* Cauchy inj_Q mult *) - apply not_ap_imp_eq. - apply - Eq_alt_2_2 - with - (x := Build_CauchySeq R2 (fun m : nat => inj_Q R2 (G R1 x m[*]G R1 y m)) - (inj_Q_Cauchy R2 - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R1 x m[*]G R1 y m) - (CS_seq_mult Q_as_COrdField _ _ - (CS_proof Q_as_COrdField (G_as_CauchySeq R1 x)) - (CS_proof Q_as_COrdField (G_as_CauchySeq R1 y)))))) - (y := Build_CauchySeq R2 - (fun m : nat => inj_Q R2 (G R1 x m)[*]inj_Q R2 (G R1 y m)) - (CS_seq_mult R2 _ _ (CS_proof R2 (image_G_as_CauchySeq12 x)) - (CS_proof R2 (image_G_as_CauchySeq12 y)))). - intros. - exists 0. - intros. - unfold CS_seq in |- *. - apply AbsSmall_wdr_unfolded with (y := Zero:R2). - split. - rstepr ([--](Zero:R2)). - apply inv_resp_leEq. - apply less_leEq. - assumption. - apply less_leEq. - assumption. - apply cg_cancel_rht with (x := inj_Q R2 (G R1 x m)[*]inj_Q R2 (G R1 y m)). - astepl (inj_Q R2 (G R1 x m)[*]inj_Q R2 (G R1 y m)). - apply eq_transitive_unfolded with (y := inj_Q R2 (G R1 x m[*]G R1 y m)). - apply eq_symmetric_unfolded. - apply inj_Q_mult. - apply cg_cancel_mixed. + apply G_pres_mult. + (* Cauchy inj_Q mult *) + apply not_ap_imp_eq. + apply Eq_alt_2_2 with (x := Build_CauchySeq R2 (fun m : nat => inj_Q R2 (G R1 x m[*]G R1 y m)) + (inj_Q_Cauchy R2 (Build_CauchySeq Q_as_COrdField (fun m : nat => G R1 x m[*]G R1 y m) + (CS_seq_mult Q_as_COrdField _ _ (CS_proof Q_as_COrdField (G_as_CauchySeq R1 x)) + (CS_proof Q_as_COrdField (G_as_CauchySeq R1 y)))))) (y := Build_CauchySeq R2 + (fun m : nat => inj_Q R2 (G R1 x m)[*]inj_Q R2 (G R1 y m)) + (CS_seq_mult R2 _ _ (CS_proof R2 (image_G_as_CauchySeq12 x)) + (CS_proof R2 (image_G_as_CauchySeq12 y)))). + intros. + exists 0. + intros. + unfold CS_seq in |- *. + apply AbsSmall_wdr_unfolded with (y := Zero:R2). + split. + rstepr ([--](Zero:R2)). + apply inv_resp_leEq. + apply less_leEq. + assumption. + apply less_leEq. + assumption. + apply cg_cancel_rht with (x := inj_Q R2 (G R1 x m)[*]inj_Q R2 (G R1 y m)). + astepl (inj_Q R2 (G R1 x m)[*]inj_Q R2 (G R1 y m)). + apply eq_transitive_unfolded with (y := inj_Q R2 (G R1 x m[*]G R1 y m)). + apply eq_symmetric_unfolded. + apply inj_Q_mult. + apply cg_cancel_mixed. (* End of Cauchy inj_Q mult *) - - apply Lim_pres_mult. + apply Lim_pres_mult. Qed. @@ -1613,49 +1308,29 @@ Proof. intro. unfold g21 in |- *. cut (y[=]Lim (inj_Q_G_as_CauchySeq R1 y)). - intro. - apply eq_transitive_unfolded with (y := Lim (inj_Q_G_as_CauchySeq R1 y)). - assumption. - apply Lim_well_def. - unfold inj_Q_G_as_CauchySeq in |- *. - unfold image_G_as_CauchySeq21 in |- *. - change - ((Build_CauchySeq R1 - (fun m : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) m)) - (CS_seq_inj_Q_G R1 y) - :R_COrdField R1)[=] - Build_CauchySeq R1 - (fun n : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 (f12 y)) n)) - (image_Cauchy21 (f12 y))) in |- *. - - change - ((Build_CauchySeq R1 - (fun m : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) m)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R1 y)) - :R_COrdField R1)[=] - Build_CauchySeq R1 - (fun n : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 (f12 y)) n)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R2 (f12 y)))) - in |- *. - apply - inj_seq_well_def - with (g := G_as_CauchySeq R1 y) (h := G_as_CauchySeq R2 (f12 y)). - - apply inj_Q_one_one with (IR := R2). - change - ((image_G_as_CauchySeq12 y:R_COrdField R2)[=] - inj_Q_G_as_CauchySeq R2 (f12 y)) in |- *. - apply Lim_one_one with (IR := R2). - apply eq_transitive_unfolded with (y := f12 y). - change (f12 y[=]f12 y) in |- *. - apply eq_reflexive_unfolded. - - apply SeqLimit_unique. - apply x_is_SeqLimit_G. + intro. + apply eq_transitive_unfolded with (y := Lim (inj_Q_G_as_CauchySeq R1 y)). + assumption. + apply Lim_well_def. + unfold inj_Q_G_as_CauchySeq in |- *. + unfold image_G_as_CauchySeq21 in |- *. + change ((Build_CauchySeq R1 (fun m : nat => inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) m)) + (CS_seq_inj_Q_G R1 y) :R_COrdField R1)[=] Build_CauchySeq R1 (fun n : nat => + inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 (f12 y)) n)) + (image_Cauchy21 (f12 y))) in |- *. + change ((Build_CauchySeq R1 (fun m : nat => inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R1 y) m)) + (inj_Q_Cauchy R1 (G_as_CauchySeq R1 y)) :R_COrdField R1)[=] Build_CauchySeq R1 (fun n : nat => + inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 (f12 y)) n)) + (inj_Q_Cauchy R1 (G_as_CauchySeq R2 (f12 y)))) in |- *. + apply inj_seq_well_def with (g := G_as_CauchySeq R1 y) (h := G_as_CauchySeq R2 (f12 y)). + apply inj_Q_one_one with (IR := R2). + change ((image_G_as_CauchySeq12 y:R_COrdField R2)[=] inj_Q_G_as_CauchySeq R2 (f12 y)) in |- *. + apply Lim_one_one with (IR := R2). + apply eq_transitive_unfolded with (y := f12 y). + change (f12 y[=]f12 y) in |- *. + apply eq_reflexive_unfolded. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. apply SeqLimit_unique. apply x_is_SeqLimit_G. Qed. @@ -1676,65 +1351,48 @@ Proof. red in |- *. unfold g21 in |- *. intros x y H. - case - (ap_imp_less R1 (Lim (image_G_as_CauchySeq21 x)) - (Lim (image_G_as_CauchySeq21 y)) H). - intro. - apply less_imp_ap. - apply less_wdl with (x := Lim (inj_Q_G_as_CauchySeq R2 x)). - apply less_wdr with (y := Lim (inj_Q_G_as_CauchySeq R2 y)). - apply Lim_pres_less. - unfold inj_Q_G_as_CauchySeq in |- *. - change - ((Build_CauchySeq R2 - (fun m : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 x) m)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R2 x)) - :R_COrdField R2)[<] - Build_CauchySeq R2 - (fun n : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) n)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R2 y))) in |- *. - apply inj_seq_less. - apply less_inj_seq with (IR := R1). - change - ((image_G_as_CauchySeq21 x:R_COrdField R1)[<] - (image_G_as_CauchySeq21 y:R_COrdField R1)) in |- *. - apply less_pres_Lim. - assumption. - apply eq_symmetric_unfolded. - apply SeqLimit_unique. - apply x_is_SeqLimit_G. - apply eq_symmetric_unfolded. - apply SeqLimit_unique. - apply x_is_SeqLimit_G. - + case (ap_imp_less R1 (Lim (image_G_as_CauchySeq21 x)) (Lim (image_G_as_CauchySeq21 y)) H). + intro. + apply less_imp_ap. + apply less_wdl with (x := Lim (inj_Q_G_as_CauchySeq R2 x)). + apply less_wdr with (y := Lim (inj_Q_G_as_CauchySeq R2 y)). + apply Lim_pres_less. + unfold inj_Q_G_as_CauchySeq in |- *. + change ((Build_CauchySeq R2 (fun m : nat => inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 x) m)) + (inj_Q_Cauchy R2 (G_as_CauchySeq R2 x)) :R_COrdField R2)[<] Build_CauchySeq R2 (fun n : nat => + inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) n)) + (inj_Q_Cauchy R2 (G_as_CauchySeq R2 y))) in |- *. + apply inj_seq_less. + apply less_inj_seq with (IR := R1). + change ((image_G_as_CauchySeq21 x:R_COrdField R1)[<] + (image_G_as_CauchySeq21 y:R_COrdField R1)) in |- *. + apply less_pres_Lim. + assumption. + apply eq_symmetric_unfolded. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. + apply eq_symmetric_unfolded. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. intro. apply Greater_imp_ap. apply less_wdl with (x := Lim (inj_Q_G_as_CauchySeq R2 y)). - apply less_wdr with (y := Lim (inj_Q_G_as_CauchySeq R2 x)). - apply Lim_pres_less. - unfold inj_Q_G_as_CauchySeq in |- *. - change - ((Build_CauchySeq R2 - (fun m : nat => - inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) m)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R2 y)) - :R_COrdField R2)[<] - Build_CauchySeq R2 - (fun n : nat => + apply less_wdr with (y := Lim (inj_Q_G_as_CauchySeq R2 x)). + apply Lim_pres_less. + unfold inj_Q_G_as_CauchySeq in |- *. + change ((Build_CauchySeq R2 (fun m : nat => inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) m)) + (inj_Q_Cauchy R2 (G_as_CauchySeq R2 y)) :R_COrdField R2)[<] Build_CauchySeq R2 (fun n : nat => inj_Q R2 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 x) n)) - (inj_Q_Cauchy R2 (G_as_CauchySeq R2 x))) in |- *. - apply inj_seq_less. - apply less_inj_seq with (IR := R1). - change - ((image_G_as_CauchySeq21 y:R_COrdField R1)[<] - (image_G_as_CauchySeq21 x:R_COrdField R1)) in |- *. - apply less_pres_Lim. - assumption. - apply eq_symmetric_unfolded. - apply SeqLimit_unique. - apply x_is_SeqLimit_G. + (inj_Q_Cauchy R2 (G_as_CauchySeq R2 x))) in |- *. + apply inj_seq_less. + apply less_inj_seq with (IR := R1). + change ((image_G_as_CauchySeq21 y:R_COrdField R1)[<] + (image_G_as_CauchySeq21 x:R_COrdField R1)) in |- *. + apply less_pres_Lim. + assumption. + apply eq_symmetric_unfolded. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. apply eq_symmetric_unfolded. apply SeqLimit_unique. apply x_is_SeqLimit_G. @@ -1748,27 +1406,20 @@ Proof. unfold g21 in |- *. apply Lim_pres_less. unfold image_G_as_CauchySeq21 in |- *. - change - ((Build_CauchySeq R1 - (fun m : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 x) m)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R2 x)) - :R_COrdField R1)[<] - Build_CauchySeq R1 - (fun n : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) n)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R2 y))) in |- *. + change ((Build_CauchySeq R1 (fun m : nat => inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 x) m)) + (inj_Q_Cauchy R1 (G_as_CauchySeq R2 x)) :R_COrdField R1)[<] Build_CauchySeq R1 (fun n : nat => + inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 y) n)) + (inj_Q_Cauchy R1 (G_as_CauchySeq R2 y))) in |- *. apply inj_seq_less. - apply less_inj_seq with (IR := R2). - change - ((inj_Q_G_as_CauchySeq R2 x:R_COrdField R2)[<] - (inj_Q_G_as_CauchySeq R2 y:R_COrdField R2)) in |- *. + apply less_inj_seq with (IR := R2). + change ((inj_Q_G_as_CauchySeq R2 x:R_COrdField R2)[<] + (inj_Q_G_as_CauchySeq R2 y:R_COrdField R2)) in |- *. apply less_pres_Lim. apply less_wdl with (x := x). - apply less_wdr with (y := y). - assumption. - apply SeqLimit_unique. - apply x_is_SeqLimit_G. + apply less_wdr with (y := y). + assumption. + apply SeqLimit_unique. + apply x_is_SeqLimit_G. apply SeqLimit_unique. apply x_is_SeqLimit_G. Qed. @@ -1779,90 +1430,57 @@ Theorem g21_pres_plus : Proof. red in |- *. intros. - unfold g21 in |- *. - apply - eq_transitive_unfolded - with - (y := Lim - ((image_G_as_CauchySeq21 x:R_COrdField R1)[+] - image_G_as_CauchySeq21 y)). - apply Lim_well_def. - unfold image_G_as_CauchySeq21 in |- *. - apply - eq_transitive_unfolded - with - (S := R_COrdField R1:CSetoid) - (y := Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 x m[+]G R2 y m)) - (inj_Q_Cauchy R1 - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R2 x m[+]G R2 y m) - (CS_seq_plus Q_as_COrdField (fun n : nat => G R2 x n) - (fun n : nat => G R2 y n) (CS_seq_G R2 x) - (CS_seq_G R2 y)))) - :R_COrdField R1). - change - ((Build_CauchySeq R1 - (fun n : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 (x[+]y)) n)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R2 (x[+]y))) - :R_COrdField R1)[=] - Build_CauchySeq R1 - (fun m : nat => - inj_Q R1 - (CS_seq Q_as_COrdField - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R2 x m[+]G R2 y m) - (CS_seq_plus Q_as_COrdField (fun n : nat => G R2 x n) - (fun n : nat => G R2 y n) (CS_seq_G R2 x) ( - CS_seq_G R2 y))) m)) - (inj_Q_Cauchy R1 - (Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[+]G R2 y m) - (CS_seq_plus Q_as_COrdField (fun n : nat => G R2 x n) - (fun n : nat => G R2 y n) (CS_seq_G R2 x) ( - CS_seq_G R2 y))))) in |- *. - apply inj_seq_well_def. - unfold G_as_CauchySeq in |- *. - apply G_pres_plus. - (* Cauchy inj_Q plus *) - apply not_ap_imp_eq. - apply - Eq_alt_2_2 - with - (x := Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 x m[+]G R2 y m)) - (inj_Q_Cauchy R1 - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R2 x m[+]G R2 y m) - (CS_seq_plus Q_as_COrdField (fun n : nat => G R2 x n) - (fun n : nat => G R2 y n) (CS_seq_G R2 x) - (CS_seq_G R2 y)))) - :R_COrdField R1) - (y := Build_CauchySeq R1 - (fun m : nat => inj_Q R1 (G R2 x m)[+]inj_Q R1 (G R2 y m)) - (CS_seq_plus R1 (fun n : nat => inj_Q R1 (G R2 x n)) - (fun n : nat => inj_Q R1 (G R2 y n)) ( - image_Cauchy21 x) (image_Cauchy21 y)) - :R_COrdField R1). - intros. - exists 0. - intros. - unfold CS_seq in |- *. - apply AbsSmall_wdr_unfolded with (y := Zero:R1). - split. - rstepr ([--](Zero:R1)). - apply inv_resp_leEq. - apply less_leEq. - assumption. - apply less_leEq. - assumption. - apply cg_cancel_rht with (x := inj_Q R1 (G R2 x m)[+]inj_Q R1 (G R2 y m)). - astepl (inj_Q R1 (G R2 x m)[+]inj_Q R1 (G R2 y m)). - apply eq_transitive_unfolded with (y := inj_Q R1 (G R2 x m[+]G R2 y m)). - apply eq_symmetric_unfolded. - apply inj_Q_plus. - apply cg_cancel_mixed. + unfold g21 in |- *. + apply eq_transitive_unfolded with (y := Lim ((image_G_as_CauchySeq21 x:R_COrdField R1)[+] + image_G_as_CauchySeq21 y)). + apply Lim_well_def. + unfold image_G_as_CauchySeq21 in |- *. + apply eq_transitive_unfolded with (S := R_COrdField R1:CSetoid) + (y := Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 x m[+]G R2 y m)) (inj_Q_Cauchy R1 + (Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[+]G R2 y m) + (CS_seq_plus Q_as_COrdField (fun n : nat => G R2 x n) (fun n : nat => G R2 y n) (CS_seq_G R2 x) + (CS_seq_G R2 y)))) :R_COrdField R1). + change ((Build_CauchySeq R1 (fun n : nat => + inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 (x[+]y)) n)) + (inj_Q_Cauchy R1 (G_as_CauchySeq R2 (x[+]y))) :R_COrdField R1)[=] Build_CauchySeq R1 + (fun m : nat => inj_Q R1 (CS_seq Q_as_COrdField (Build_CauchySeq Q_as_COrdField + (fun m : nat => G R2 x m[+]G R2 y m) (CS_seq_plus Q_as_COrdField (fun n : nat => G R2 x n) + (fun n : nat => G R2 y n) (CS_seq_G R2 x) ( CS_seq_G R2 y))) m)) (inj_Q_Cauchy R1 + (Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[+]G R2 y m) + (CS_seq_plus Q_as_COrdField (fun n : nat => G R2 x n) + (fun n : nat => G R2 y n) (CS_seq_G R2 x) ( CS_seq_G R2 y))))) in |- *. + apply inj_seq_well_def. + unfold G_as_CauchySeq in |- *. + apply G_pres_plus. + (* Cauchy inj_Q plus *) + apply not_ap_imp_eq. + apply Eq_alt_2_2 with (x := Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 x m[+]G R2 y m)) + (inj_Q_Cauchy R1 (Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[+]G R2 y m) + (CS_seq_plus Q_as_COrdField (fun n : nat => G R2 x n) (fun n : nat => G R2 y n) (CS_seq_G R2 x) + (CS_seq_G R2 y)))) :R_COrdField R1) (y := Build_CauchySeq R1 + (fun m : nat => inj_Q R1 (G R2 x m)[+]inj_Q R1 (G R2 y m)) + (CS_seq_plus R1 (fun n : nat => inj_Q R1 (G R2 x n)) (fun n : nat => inj_Q R1 (G R2 y n)) ( + image_Cauchy21 x) (image_Cauchy21 y)) :R_COrdField R1). + intros. + exists 0. + intros. + unfold CS_seq in |- *. + apply AbsSmall_wdr_unfolded with (y := Zero:R1). + split. + rstepr ([--](Zero:R1)). + apply inv_resp_leEq. + apply less_leEq. + assumption. + apply less_leEq. + assumption. + apply cg_cancel_rht with (x := inj_Q R1 (G R2 x m)[+]inj_Q R1 (G R2 y m)). + astepl (inj_Q R1 (G R2 x m)[+]inj_Q R1 (G R2 y m)). + apply eq_transitive_unfolded with (y := inj_Q R1 (G R2 x m[+]G R2 y m)). + apply eq_symmetric_unfolded. + apply inj_Q_plus. + apply cg_cancel_mixed. (* End of Cauchy inj_Q plus *) - - apply Lim_pres_plus. + apply Lim_pres_plus. Qed. @@ -1872,99 +1490,62 @@ Theorem g21_pres_mult : Proof. red in |- *. intros. - unfold g21 in |- *. - apply - eq_transitive_unfolded - with - (y := Lim - ((image_G_as_CauchySeq21 x:R_COrdField R1)[*] - image_G_as_CauchySeq21 y)). - apply Lim_well_def. - unfold image_G_as_CauchySeq21 in |- *. - apply - eq_transitive_unfolded - with - (S := R_COrdField R1:CSetoid) - (y := Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 x m[*]G R2 y m)) - (inj_Q_Cauchy R1 - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R2 x m[*]G R2 y m) - (CS_seq_mult Q_as_COrdField _ _ - (CS_proof _ (G_as_CauchySeq R2 x)) - (CS_proof _ (G_as_CauchySeq R2 y))))) - :R_COrdField R1). - change - ((Build_CauchySeq R1 - (fun n : nat => - inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 (x[*]y)) n)) - (inj_Q_Cauchy R1 (G_as_CauchySeq R2 (x[*]y))) - :R_COrdField R1)[=] - Build_CauchySeq R1 - (fun m : nat => - inj_Q R1 - (CS_seq Q_as_COrdField - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R2 x m[*]G R2 y m) - (CS_seq_mult Q_as_COrdField _ _ - (CS_proof _ (G_as_CauchySeq R2 x)) - (CS_proof _ (G_as_CauchySeq R2 y)))) m)) - (inj_Q_Cauchy R1 - (Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[*]G R2 y m) - (CS_seq_mult Q_as_COrdField _ _ - (CS_proof _ (G_as_CauchySeq R2 x)) - (CS_proof _ (G_as_CauchySeq R2 y)))))) - in |- *. - apply inj_seq_well_def. - unfold G_as_CauchySeq in |- *. - change - ((Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 (x[*]y) m) - (CS_seq_G R2 (x[*]y)) - :R_COrdField Q_as_COrdField)[=] - Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[*]G R2 y m) - (CS_seq_mult Q_as_COrdField _ _ (CS_proof _ (G_as_CauchySeq R2 x)) + unfold g21 in |- *. + apply eq_transitive_unfolded with (y := Lim ((image_G_as_CauchySeq21 x:R_COrdField R1)[*] + image_G_as_CauchySeq21 y)). + apply Lim_well_def. + unfold image_G_as_CauchySeq21 in |- *. + apply eq_transitive_unfolded with (S := R_COrdField R1:CSetoid) + (y := Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 x m[*]G R2 y m)) (inj_Q_Cauchy R1 + (Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[*]G R2 y m) + (CS_seq_mult Q_as_COrdField _ _ (CS_proof _ (G_as_CauchySeq R2 x)) + (CS_proof _ (G_as_CauchySeq R2 y))))) :R_COrdField R1). + change ((Build_CauchySeq R1 (fun n : nat => + inj_Q R1 (CS_seq Q_as_COrdField (G_as_CauchySeq R2 (x[*]y)) n)) + (inj_Q_Cauchy R1 (G_as_CauchySeq R2 (x[*]y))) :R_COrdField R1)[=] Build_CauchySeq R1 + (fun m : nat => inj_Q R1 (CS_seq Q_as_COrdField (Build_CauchySeq Q_as_COrdField + (fun m : nat => G R2 x m[*]G R2 y m) (CS_seq_mult Q_as_COrdField _ _ + (CS_proof _ (G_as_CauchySeq R2 x)) (CS_proof _ (G_as_CauchySeq R2 y)))) m)) + (inj_Q_Cauchy R1 (Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[*]G R2 y m) + (CS_seq_mult Q_as_COrdField _ _ (CS_proof _ (G_as_CauchySeq R2 x)) + (CS_proof _ (G_as_CauchySeq R2 y)))))) in |- *. + apply inj_seq_well_def. + unfold G_as_CauchySeq in |- *. + change ((Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 (x[*]y) m) (CS_seq_G R2 (x[*]y)) + :R_COrdField Q_as_COrdField)[=] Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[*]G R2 y m) + (CS_seq_mult Q_as_COrdField _ _ (CS_proof _ (G_as_CauchySeq R2 x)) (CS_proof _ (G_as_CauchySeq R2 y)))) in |- *. - apply G_pres_mult. - - (* Cauchy inj_Q mult *) - apply not_ap_imp_eq. - apply - Eq_alt_2_2 - with - (x := Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 x m[*]G R2 y m)) - (inj_Q_Cauchy R1 - (Build_CauchySeq Q_as_COrdField - (fun m : nat => G R2 x m[*]G R2 y m) - (CS_seq_mult Q_as_COrdField (G_as_CauchySeq R2 x) - (G_as_CauchySeq R2 y) - (CS_proof Q_as_COrdField (G_as_CauchySeq R2 x)) - (CS_proof Q_as_COrdField (G_as_CauchySeq R2 y)))))) - (y := Build_CauchySeq R1 - (fun m : nat => inj_Q R1 (G R2 x m)[*]inj_Q R1 (G R2 y m)) - (CS_seq_mult R1 (image_G_as_CauchySeq21 x) - (image_G_as_CauchySeq21 y) - (CS_proof R1 (image_G_as_CauchySeq21 x)) - (CS_proof R1 (image_G_as_CauchySeq21 y)))). - intros. - exists 0. - intros. - unfold CS_seq in |- *. - apply AbsSmall_wdr_unfolded with (y := Zero:R1). - split. - rstepr ([--](Zero:R1)). - apply inv_resp_leEq. - apply less_leEq. - assumption. - apply less_leEq. - assumption. - apply cg_cancel_rht with (x := inj_Q R1 (G R2 x m)[*]inj_Q R1 (G R2 y m)). - astepl (inj_Q R1 (G R2 x m)[*]inj_Q R1 (G R2 y m)). - apply eq_transitive_unfolded with (y := inj_Q R1 (G R2 x m[*]G R2 y m)). - apply eq_symmetric_unfolded. - apply inj_Q_mult. - apply cg_cancel_mixed. + apply G_pres_mult. + (* Cauchy inj_Q mult *) + apply not_ap_imp_eq. + apply Eq_alt_2_2 with (x := Build_CauchySeq R1 (fun m : nat => inj_Q R1 (G R2 x m[*]G R2 y m)) + (inj_Q_Cauchy R1 (Build_CauchySeq Q_as_COrdField (fun m : nat => G R2 x m[*]G R2 y m) + (CS_seq_mult Q_as_COrdField (G_as_CauchySeq R2 x) (G_as_CauchySeq R2 y) + (CS_proof Q_as_COrdField (G_as_CauchySeq R2 x)) + (CS_proof Q_as_COrdField (G_as_CauchySeq R2 y)))))) (y := Build_CauchySeq R1 + (fun m : nat => inj_Q R1 (G R2 x m)[*]inj_Q R1 (G R2 y m)) + (CS_seq_mult R1 (image_G_as_CauchySeq21 x) (image_G_as_CauchySeq21 y) + (CS_proof R1 (image_G_as_CauchySeq21 x)) (CS_proof R1 (image_G_as_CauchySeq21 y)))). + intros. + exists 0. + intros. + unfold CS_seq in |- *. + apply AbsSmall_wdr_unfolded with (y := Zero:R1). + split. + rstepr ([--](Zero:R1)). + apply inv_resp_leEq. + apply less_leEq. + assumption. + apply less_leEq. + assumption. + apply cg_cancel_rht with (x := inj_Q R1 (G R2 x m)[*]inj_Q R1 (G R2 y m)). + astepl (inj_Q R1 (G R2 x m)[*]inj_Q R1 (G R2 y m)). + apply eq_transitive_unfolded with (y := inj_Q R1 (G R2 x m[*]G R2 y m)). + apply eq_symmetric_unfolded. + apply inj_Q_mult. + apply cg_cancel_mixed. (* End of Cauchy inj_Q mult *) - - apply Lim_pres_mult. + apply Lim_pres_mult. Qed. (* Building Homomorphisms out of f12 and g21 *) @@ -2003,7 +1584,7 @@ Qed. Definition Canonic_Isomorphism_between_CReals := Build_Isomorphism R1 R2 f12_as_Homomorphism g21_as_Homomorphism - f12_inverse_lft g21_inverse_rht. + f12_inverse_lft g21_inverse_rht. End Concrete_iso_between_Creals. (* end hide *) diff --git a/tactics/AlgReflection.v b/tactics/AlgReflection.v index a16ed43e5..481860871 100644 --- a/tactics/AlgReflection.v +++ b/tactics/AlgReflection.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) Require Export CLogic. @@ -400,76 +400,78 @@ End Normalization_Function. Section Correctness_Results. Lemma eq_nat_corr : forall n m:nat, eq_nat n m = true -> n = m. -simple induction n; simple induction m; simpl in |- *; intros. -trivial. -inversion H0. -inversion H0. -rewrite (H n1 H1). trivial. +Proof. + simple induction n; simple induction m; simpl in |- *; intros. + trivial. + inversion H0. + inversion H0. + rewrite (H n1 H1). trivial. Qed. Lemma eq_int_corr : forall n m:Z, eq_int n m = true -> n = m. -simple induction n; simple induction m; simpl in |- *; intros. -trivial. -inversion H. -inversion H. -inversion H. -rewrite <- (convert_is_POS p). rewrite <- (convert_is_POS p0). -cut (nat_of_P p = nat_of_P p0). auto. apply eq_nat_corr. assumption. -inversion H. -inversion H. -inversion H. -cut (p = p0); intros. -rewrite H0; auto. -rewrite (anti_convert_pred_convert p). rewrite (anti_convert_pred_convert p0). -cut (nat_of_P p = nat_of_P p0). intro. auto. apply eq_nat_corr. assumption. +Proof. + simple induction n; simple induction m; simpl in |- *; intros. + trivial. + inversion H. + inversion H. + inversion H. + rewrite <- (convert_is_POS p). rewrite <- (convert_is_POS p0). + cut (nat_of_P p = nat_of_P p0). auto. apply eq_nat_corr. assumption. + inversion H. + inversion H. + inversion H. + cut (p = p0); intros. + rewrite H0; auto. + rewrite (anti_convert_pred_convert p). rewrite (anti_convert_pred_convert p0). + cut (nat_of_P p = nat_of_P p0). intro. auto. apply eq_nat_corr. assumption. Qed. Lemma eq_expr_corr : forall e e':expr, eq_expr e e' = true -> e = e'. -simple induction e; simple induction e'; simpl in |- *; intros; - try inversion H3; try inversion H2; try inversion H1; - try inversion H0; try inversion H. -cut (v = v0). intro. rewrite H0; auto. apply eq_nat_corr; assumption. -cut (z = z0). intro. rewrite H0; auto. apply eq_int_corr; assumption. -clear H1 H2. elim (andb_prop _ _ H3); intros. -cut (e0 = e2). cut (e1 = e3). intros. rewrite H4; rewrite H6. auto. -apply H0. assumption. apply H. assumption. -clear H1 H2. elim (andb_prop _ _ H3); intros. -cut (e0 = e2). cut (e1 = e3). intros. rewrite H4; rewrite H6. auto. -apply H0. assumption. apply H. assumption. -clear H1 H2. elim (andb_prop _ _ H3); intros. -cut (e0 = e2). cut (e1 = e3). intros. rewrite H4; rewrite H6. auto. -apply H0. assumption. apply H. assumption. -clear H0. elim (andb_prop _ _ H1); intros. -cut (u = u0). cut (e0 = e1). intros. rewrite H4. rewrite H5. auto. -apply H. assumption. apply eq_nat_corr. assumption. -clear H1 H2. elim (andb_prop _ _ H3). intros. elim (andb_prop _ _ H2); intros. -cut (b = b0). cut (e0 = e2). cut (e1 = e3). -intros. rewrite H7. rewrite H8. rewrite H9. auto. -auto. auto. apply eq_nat_corr. assumption. -clear H0. elim (andb_prop _ _ H1); intros. -cut (p = p0). cut (e0 = e1). intros. rewrite H4. rewrite H5. auto. -auto. apply eq_nat_corr. assumption. +Proof. + simple induction e; simple induction e'; simpl in |- *; intros; + try inversion H3; try inversion H2; try inversion H1; try inversion H0; try inversion H. + cut (v = v0). intro. rewrite H0; auto. apply eq_nat_corr; assumption. + cut (z = z0). intro. rewrite H0; auto. apply eq_int_corr; assumption. + clear H1 H2. elim (andb_prop _ _ H3); intros. + cut (e0 = e2). cut (e1 = e3). intros. rewrite H4; rewrite H6. auto. + apply H0. assumption. apply H. assumption. + clear H1 H2. elim (andb_prop _ _ H3); intros. + cut (e0 = e2). cut (e1 = e3). intros. rewrite H4; rewrite H6. auto. + apply H0. assumption. apply H. assumption. + clear H1 H2. elim (andb_prop _ _ H3); intros. + cut (e0 = e2). cut (e1 = e3). intros. rewrite H4; rewrite H6. auto. + apply H0. assumption. apply H. assumption. + clear H0. elim (andb_prop _ _ H1); intros. + cut (u = u0). cut (e0 = e1). intros. rewrite H4. rewrite H5. auto. + apply H. assumption. apply eq_nat_corr. assumption. + clear H1 H2. elim (andb_prop _ _ H3). intros. elim (andb_prop _ _ H2); intros. + cut (b = b0). cut (e0 = e2). cut (e1 = e3). + intros. rewrite H7. rewrite H8. rewrite H9. auto. + auto. auto. apply eq_nat_corr. assumption. + clear H0. elim (andb_prop _ _ H1); intros. + cut (p = p0). cut (e0 = e1). intros. rewrite H4. rewrite H5. auto. + auto. apply eq_nat_corr. assumption. Qed. End Correctness_Results. Ltac ClosedNat t := -match t with +match t with | O => constr:true | (S ?n) => ClosedNat n | _ => constr:false end. -Ltac ClosedPositive t := -match t with +Ltac ClosedPositive t := +match t with | xH => constr:true | (xI ?n) => ClosedPositive n | (xO ?n) => ClosedPositive n | _ => constr:false end. -Ltac ClosedZ t := -match t with +Ltac ClosedZ t := +match t with | Z0 => constr:true | (Zpos ?n) => ClosedPositive n | (Zneg ?n) => ClosedPositive n @@ -500,7 +502,7 @@ Implicit Arguments Mcons [A]. Implicit Arguments Mnth [A]. Ltac FindIndex t l := -match l with +match l with | (Mcons ?x ?xs) => match x with | t => constr:O @@ -514,7 +516,7 @@ rather than using the ProdT multiple times *) Section Quadruple. Variable A B C D: Type. -Inductive quadruple : Type := +Inductive quadruple : Type := Quad : A -> B -> C -> D -> quadruple. End Quadruple. Implicit Arguments Quad [A B C D]. diff --git a/tactics/CornTac.v b/tactics/CornTac.v index 9ff669c33..c70d4222c 100644 --- a/tactics/CornTac.v +++ b/tactics/CornTac.v @@ -1,29 +1,29 @@ (* Copyright © 2006 * Russell O’Connor - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** Generic Tacticals used by the CoRN project *) (* begin hide *) Require Import SetoidTactics. -(* Implements an apply-like tactic that uses refine's strong unifcation algorithm -REPLACED by ssr apply -Ltac rapply T := +(* Implements an apply-like tactic that uses refine's strong unifcation algorithm +REPLACED by ssr apply +Ltac rapply T := (refine T || refine (T _) || refine (T _ _) || @@ -45,7 +45,7 @@ Ltac rsapply T := rapply T; simpl. Tactic Notation "replace" "LHS" "with" constr (a) "by" tactic (t) := match goal with | |-(?r ?b ?c) => - let Z := fresh "Z" in + let Z := fresh "Z" in (change (let Z:=b in r Z c);intro Z;setoid_replace Z with a; [unfold Z; clear Z|unfold Z; clear Z; solve [ t ]]) end. @@ -53,7 +53,7 @@ end. Tactic Notation "replace" "LHS" "with" constr (a) := match goal with | |-(?r ?b ?c) => - let Z := fresh "Z" in + let Z := fresh "Z" in (change (let Z:=b in r Z c);intro Z;setoid_replace Z with a; unfold Z; clear Z) end. @@ -61,7 +61,7 @@ end. Tactic Notation "replace" "RHS" "with" constr (a) "by" tactic (t) := match goal with | |-(?r ?b ?c) => - let Z := fresh "Z" in + let Z := fresh "Z" in (change (let Z:=c in r b Z);intro Z;setoid_replace Z with a; [unfold Z; clear Z|unfold Z; clear Z; solve [ t ]]) end. @@ -69,7 +69,7 @@ end. Tactic Notation "replace" "RHS" "with" constr (a) := match goal with | |-(?r ?b ?c) => - let Z := fresh "Z" in + let Z := fresh "Z" in (change (let Z:=c in r b Z);intro Z;setoid_replace Z with a; unfold Z; clear Z) end. diff --git a/tactics/DiffTactics1.v b/tactics/DiffTactics1.v index 0f733df10..ccff349e0 100644 --- a/tactics/DiffTactics1.v +++ b/tactics/DiffTactics1.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) Ltac Contin := auto with continuous included. Ltac Deriv := eauto with derivate continuous included. diff --git a/tactics/DiffTactics2.v b/tactics/DiffTactics2.v index df44bc468..b37a864c4 100644 --- a/tactics/DiffTactics2.v +++ b/tactics/DiffTactics2.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) Require Export Differentiability. @@ -80,60 +80,23 @@ Fixpoint cont_to_pfunct (r : cont_function) : PartIR := Lemma continuous_cont : forall Hab (f : cont_function), Continuous_I (a:=a) (b:=b) Hab (cont_to_pfunct f). -intros. -induction f - as - [Hab0 - F - c| - Hab' - F - F' - d| - Hab' - F - F' - d| - Hab' - F - d| - c| - | - f1 - Hrecf1 - f0 - Hrecf0| - f - Hrecf| - f1 - Hrecf1 - f0 - Hrecf0| - f1 - Hrecf1 - f0 - Hrecf0| - c - f - Hrecf| - f - Hrecf - n| - f - Hrecf]; simpl in |- *; intros. -assumption. -exact (deriv_imp_contin_I _ _ _ _ _ _ d). -exact (deriv_imp_contin'_I _ _ _ _ _ _ d). -exact (diffble_imp_contin_I _ _ _ _ _ d). -exact (Continuous_I_const _ _ _ c). -exact (Continuous_I_id _ _ _). -exact (Continuous_I_plus _ _ _ _ _ Hrecf1 Hrecf0). -exact (Continuous_I_inv _ _ _ _ Hrecf). -exact (Continuous_I_minus _ _ _ _ _ Hrecf1 Hrecf0). -exact (Continuous_I_mult _ _ _ _ _ Hrecf1 Hrecf0). -exact (Continuous_I_scal _ _ _ _ Hrecf _). -exact (Continuous_I_nth _ _ _ _ Hrecf _). -exact (Continuous_I_abs _ _ _ _ Hrecf). +Proof. + intros. + induction f as [Hab0 F c| Hab' F F' d| Hab' F F' d| Hab' F d| c| | f1 Hrecf1 f0 Hrecf0| f Hrecf| f1 + Hrecf1 f0 Hrecf0| f1 Hrecf1 f0 Hrecf0| c f Hrecf| f Hrecf n| f Hrecf]; simpl in |- *; intros. + assumption. + exact (deriv_imp_contin_I _ _ _ _ _ _ d). + exact (deriv_imp_contin'_I _ _ _ _ _ _ d). + exact (diffble_imp_contin_I _ _ _ _ _ d). + exact (Continuous_I_const _ _ _ c). + exact (Continuous_I_id _ _ _). + exact (Continuous_I_plus _ _ _ _ _ Hrecf1 Hrecf0). + exact (Continuous_I_inv _ _ _ _ Hrecf). + exact (Continuous_I_minus _ _ _ _ _ Hrecf1 Hrecf0). + exact (Continuous_I_mult _ _ _ _ _ Hrecf1 Hrecf0). + exact (Continuous_I_scal _ _ _ _ Hrecf _). + exact (Continuous_I_nth _ _ _ _ Hrecf _). + exact (Continuous_I_abs _ _ _ _ Hrecf). Qed. End Automatizing_Continuity. @@ -243,101 +206,45 @@ Fixpoint deriv_deriv (r : deriv_function) : PartIR := Lemma deriv_restr : forall Hab' (f : deriv_function), Derivative_I (a:=a) (b:=b) Hab' (deriv_to_pfunct f) (deriv_deriv f). -intros. -induction f - as - [Hab'0 - f - f' - d| - Hab'0 - f - d| - c| - | - f1 - Hrecf1 - f0 - Hrecf0| - f - Hrecf| - f1 - Hrecf1 - f0 - Hrecf0| - f1 - Hrecf1 - f0 - Hrecf0| - c - f - Hrecf| - f - Hrecf - n]; simpl in |- *. -assumption. -apply projT2. -exact (Derivative_I_const _ _ Hab' c). -exact (Derivative_I_id _ _ Hab'). -exact (Derivative_I_plus _ _ _ _ _ _ _ Hrecf1 Hrecf0). -exact (Derivative_I_inv _ _ _ _ _ Hrecf). -exact (Derivative_I_minus _ _ _ _ _ _ _ Hrecf1 Hrecf0). -exact (Derivative_I_mult _ _ _ _ _ _ _ Hrecf1 Hrecf0). -exact (Derivative_I_scal _ _ _ _ _ Hrecf _). -case n. -apply Derivative_I_wdl with (Fconst (S:=IR) One). -apply FNth_zero'. -exact (derivative_imp_inc _ _ _ _ _ Hrecf). -exact (Derivative_I_const _ _ Hab' _). -clear n; intro. -exact (Derivative_I_nth _ _ _ _ _ Hrecf n). +Proof. + intros. + induction f as [Hab'0 f f' d| Hab'0 f d| c| | f1 Hrecf1 f0 Hrecf0| f Hrecf| f1 Hrecf1 f0 Hrecf0| f1 + Hrecf1 f0 Hrecf0| c f Hrecf| f Hrecf n]; simpl in |- *. + assumption. + apply projT2. + exact (Derivative_I_const _ _ Hab' c). + exact (Derivative_I_id _ _ Hab'). + exact (Derivative_I_plus _ _ _ _ _ _ _ Hrecf1 Hrecf0). + exact (Derivative_I_inv _ _ _ _ _ Hrecf). + exact (Derivative_I_minus _ _ _ _ _ _ _ Hrecf1 Hrecf0). + exact (Derivative_I_mult _ _ _ _ _ _ _ Hrecf1 Hrecf0). + exact (Derivative_I_scal _ _ _ _ _ Hrecf _). + case n. + apply Derivative_I_wdl with (Fconst (S:=IR) One). + apply FNth_zero'. + exact (derivative_imp_inc _ _ _ _ _ Hrecf). + exact (Derivative_I_const _ _ Hab' _). + clear n; intro. + exact (Derivative_I_nth _ _ _ _ _ Hrecf n). Qed. Lemma diffble_restr : forall Hab' (f : deriv_function), Diffble_I (a:=a) (b:=b) Hab' (deriv_to_pfunct f). -intros. -induction f - as - [Hab'0 - f - f' - d| - Hab'0 - f - d| - c| - | - f1 - Hrecf1 - f0 - Hrecf0| - f - Hrecf| - f1 - Hrecf1 - f0 - Hrecf0| - f1 - Hrecf1 - f0 - Hrecf0| - c - f - Hrecf| - f - Hrecf - n]; simpl in |- *. -apply deriv_imp_Diffble_I with f'; assumption. -assumption. -exact (Diffble_I_const _ _ Hab' c). -exact (Diffble_I_id _ _ Hab'). -exact (Diffble_I_plus _ _ _ _ _ Hrecf1 Hrecf0). -exact (Diffble_I_inv _ _ _ _ Hrecf). -exact (Diffble_I_minus _ _ _ _ _ Hrecf1 Hrecf0). -exact (Diffble_I_mult _ _ _ _ _ Hrecf1 Hrecf0). -exact (Diffble_I_scal _ _ _ _ Hrecf _). -exact (Diffble_I_nth _ _ _ _ Hrecf n). +Proof. + intros. + induction f as [Hab'0 f f' d| Hab'0 f d| c| | f1 Hrecf1 f0 Hrecf0| f Hrecf| f1 Hrecf1 f0 Hrecf0| f1 + Hrecf1 f0 Hrecf0| c f Hrecf| f Hrecf n]; simpl in |- *. + apply deriv_imp_Diffble_I with f'; assumption. + assumption. + exact (Diffble_I_const _ _ Hab' c). + exact (Diffble_I_id _ _ Hab'). + exact (Diffble_I_plus _ _ _ _ _ Hrecf1 Hrecf0). + exact (Diffble_I_inv _ _ _ _ Hrecf). + exact (Diffble_I_minus _ _ _ _ _ Hrecf1 Hrecf0). + exact (Diffble_I_mult _ _ _ _ _ Hrecf1 Hrecf0). + exact (Diffble_I_scal _ _ _ _ Hrecf _). + exact (Diffble_I_nth _ _ _ _ Hrecf n). Qed. End Automatizing_Derivatives. diff --git a/tactics/DiffTactics3.v b/tactics/DiffTactics3.v index a8883725e..4efea1c6e 100644 --- a/tactics/DiffTactics3.v +++ b/tactics/DiffTactics3.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) Require Export MoreFunSeries. diff --git a/tactics/FieldReflection.v b/tactics/FieldReflection.v index b4c8a29c7..968943e03 100644 --- a/tactics/FieldReflection.v +++ b/tactics/FieldReflection.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) Require Export CFields. @@ -120,53 +120,32 @@ Fixpoint xforgetF (x:F) (e:xexprF x) {struct e} : expr := Definition xinterpF (x:F) (e:xexprF x) := x. Lemma xexprF2interpF : forall (x:F) (e:xexprF x), interpF (xforgetF _ e) x. -intros x e. -induction e. - -apply (interpF_var i); algebra. - -apply (interpF_int k); algebra. - -apply (interpF_plus (xforgetF _ e1) (xforgetF _ e2) x y (x[+]y)); algebra. - -apply (interpF_mult (xforgetF _ e1) (xforgetF _ e2) x y (x[*]y)); algebra. - -apply (interpF_unop (xforgetF _ e) f x (unop f x)); algebra. - -apply (interpF_binop (xforgetF _ e1) (xforgetF _ e2) f x y (binop f x y)); - algebra. - -eapply (interpF_part (xforgetF _ e) f x (pfun f x Hx)). - apply eq_reflexive_unfolded. -algebra. - -apply (interpF_div (xforgetF _ e1) (xforgetF _ e2) x y (x[/]y[//]nzy) nzy); - algebra. - -apply (interpF_int 0); algebra. - -apply (interpF_int 1); Step_final (One:F). - -apply (interpF_int (Z_of_nat n)); algebra. - -apply (interpF_mult (xforgetF _ e) (expr_int (-1)) x (zring (-1)) [--]x); - auto. -Step_final (zring (-1)[*]x). -apply (interpF_int (-1)); algebra. - -apply - (interpF_plus (xforgetF _ e1) (xforgetF _ (xexprF_inv _ e2)) x [--]y (x[-]y)); - algebra. -apply (interpF_mult (xforgetF _ e2) (expr_int (-1)) y (zring (-1)) [--]y); - auto. -Step_final (zring (-1)[*]y). -apply (interpF_int (-1)); algebra. - -induction n. - apply (interpF_int 1); Step_final (One:F). -apply - (interpF_mult (xforgetF _ e) (expr_power n (xforgetF _ e)) x ( - x[^]n) (x[^]S n)); algebra. +Proof. + intros x e. + induction e. + apply (interpF_var i); algebra. + apply (interpF_int k); algebra. + apply (interpF_plus (xforgetF _ e1) (xforgetF _ e2) x y (x[+]y)); algebra. + apply (interpF_mult (xforgetF _ e1) (xforgetF _ e2) x y (x[*]y)); algebra. + apply (interpF_unop (xforgetF _ e) f x (unop f x)); algebra. + apply (interpF_binop (xforgetF _ e1) (xforgetF _ e2) f x y (binop f x y)); algebra. + eapply (interpF_part (xforgetF _ e) f x (pfun f x Hx)). + apply eq_reflexive_unfolded. + algebra. + apply (interpF_div (xforgetF _ e1) (xforgetF _ e2) x y (x[/]y[//]nzy) nzy); algebra. + apply (interpF_int 0); algebra. + apply (interpF_int 1); Step_final (One:F). + apply (interpF_int (Z_of_nat n)); algebra. + apply (interpF_mult (xforgetF _ e) (expr_int (-1)) x (zring (-1)) [--]x); auto. + Step_final (zring (-1)[*]x). + apply (interpF_int (-1)); algebra. + apply (interpF_plus (xforgetF _ e1) (xforgetF _ (xexprF_inv _ e2)) x [--]y (x[-]y)); algebra. + apply (interpF_mult (xforgetF _ e2) (expr_int (-1)) y (zring (-1)) [--]y); auto. + Step_final (zring (-1)[*]y). + apply (interpF_int (-1)); algebra. + induction n. + apply (interpF_int 1); Step_final (One:F). + apply (interpF_mult (xforgetF _ e) (expr_power n (xforgetF _ e)) x ( x[^]n) (x[^]S n)); algebra. Qed. Definition xexprF_diagram_commutes : @@ -174,9 +153,10 @@ Definition xexprF_diagram_commutes : xexprF2interpF. Lemma xexprF2wfF : forall (x:F) (e:xexprF x), wfF (xforgetF _ e). -intros x e. -exists x. -apply xexprF2interpF. +Proof. + intros x e. + exists x. + apply xexprF2interpF. Qed. Record fexprF : Type := {finterpF : F; fexprF2xexprF : xexprF finterpF}. @@ -195,80 +175,76 @@ Definition fexprF_mult (e e':fexprF) := Definition fforgetF (e:fexprF) := xforgetF (finterpF e) (fexprF2xexprF e). Lemma fexprF2interpF : forall e:fexprF, interpF (fforgetF e) (finterpF e). -intros e. -elim e. intros x e'. -unfold fforgetF in |- *. simpl in |- *. -apply xexprF2interpF. +Proof. + intros e. + elim e. intros x e'. + unfold fforgetF in |- *. simpl in |- *. + apply xexprF2interpF. Qed. Lemma fexprF2wfF : forall e:fexprF, wfF (fforgetF e). -intro e. -unfold fforgetF in |- *. -apply xexprF2wfF. +Proof. + intro e. + unfold fforgetF in |- *. + apply xexprF2wfF. Qed. Load "Opaque_algebra". Lemma refl_interpF : forall (e:expr) (x y:F), interpF e x -> interpF e y -> x[=]y. -intro e. -induction e. - -intros x y Hx Hy. -inversion Hx. -inversion Hy. -Step_final (val v). - -intros x y Hx Hy. -inversion Hx. -inversion Hy. -Step_final (zring z:F). - -intros x y H1 H2. -inversion H1. -inversion H2. -astepl (x0[+]y0). -Step_final (x1[+]y1). - -intros x y H1 H2. -inversion H1. -inversion H2. -astepl (x0[*]y0). -Step_final (x1[*]y1). - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (x0[/]y0[//]nzy). Step_final (x1[/]y1[//]nzy0). - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (unop u x0); Step_final (unop u x1). - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (binop b x0 y0); Step_final (binop b x1 y1). - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (pfun p x0 Hx); Step_final (pfun p x1 Hx0). +Proof. + intro e. + induction e. + intros x y Hx Hy. + inversion Hx. + inversion Hy. + Step_final (val v). + intros x y Hx Hy. + inversion Hx. + inversion Hy. + Step_final (zring z:F). + intros x y H1 H2. + inversion H1. + inversion H2. + astepl (x0[+]y0). + Step_final (x1[+]y1). + intros x y H1 H2. + inversion H1. + inversion H2. + astepl (x0[*]y0). + Step_final (x1[*]y1). + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (x0[/]y0[//]nzy). Step_final (x1[/]y1[//]nzy0). + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (unop u x0); Step_final (unop u x1). + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (binop b x0 y0); Step_final (binop b x1 y1). + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (pfun p x0 Hx); Step_final (pfun p x1 Hx0). Qed. Lemma interpF_wd : forall (e:expr) (x y:F), interpF e x -> (x[=]y) -> interpF e y. -intros e x y H H0. -inversion H; try (rewrite <- H2; rewrite H3 in H1). (* Compat 8.0 *) -apply interpF_var. Step_final x. -apply interpF_int. Step_final x. -apply interpF_plus with x0 y0; auto. Step_final x. -apply interpF_mult with x0 y0; auto. Step_final x. -apply interpF_unop with x0; auto. Step_final x. -apply interpF_binop with x0 y0; auto. Step_final x. -apply interpF_part with x0 Hx; auto. Step_final x. -apply interpF_div with x0 y0 nzy; auto. Step_final x. +Proof. + intros e x y H H0. + inversion H; try (rewrite <- H2; rewrite H3 in H1). (* Compat 8.0 *) + apply interpF_var. Step_final x. + apply interpF_int. Step_final x. + apply interpF_plus with x0 y0; auto. Step_final x. + apply interpF_mult with x0 y0; auto. Step_final x. + apply interpF_unop with x0; auto. Step_final x. + apply interpF_binop with x0 y0; auto. Step_final x. + apply interpF_part with x0 Hx; auto. Step_final x. + apply interpF_div with x0 y0 nzy; auto. Step_final x. Qed. End Field_Interpretation_Function. @@ -300,613 +276,538 @@ P: sorted on M, all M's not an I Opaque Zmult. Lemma MI_mult_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (MI_mult e f) (x[*]y). -cut (forall x y:F, II (expr_int 0) y -> II (expr_int 0) (x[*]y)). -cut - (forall (e1 e2 f:expr) (x y:F), +Proof. + cut (forall x y:F, II (expr_int 0) y -> II (expr_int 0) (x[*]y)). + cut (forall (e1 e2 f:expr) (x y:F), (forall (f:expr) (x y:F), II e2 x -> II f y -> II (MI_mult e2 f) (x[*]y)) -> - II (expr_mult e1 e2) x -> - II f y -> II (expr_mult e1 (MI_mult e2 f)) (x[*]y)). -cut - (forall (i j:Z) (x y:F), - II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i * j)) (x[*]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -simple induction e; simple induction f; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z0; induction z; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -induction f; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z0; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -intros; apply interpF_mult with x y; algebra. -intros; apply interpF_wd with (zring (i * j):F). -apply interpF_int; algebra. -inversion X. inversion X0. -Step_final (zring i[*]zring j:F). -intros. inversion X0. -try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpF_wd with (x0[*](y0[*]y)); algebra. -apply interpF_mult with x0 (y0[*]y); algebra. -Step_final (x0[*]y0[*]y). -intros. inversion X. try (rewrite H in H0; rewrite H1 in H0). (* compat 8.0 *) -apply interpF_wd with (zring 0:F). -apply interpF_int; algebra. -astepl (Zero:F). -astepl (x[*]Zero). -Step_final (x[*]zring 0). + II (expr_mult e1 e2) x -> II f y -> II (expr_mult e1 (MI_mult e2 f)) (x[*]y)). + cut (forall (i j:Z) (x y:F), + II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i * j)) (x[*]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + simple induction e; simple induction f; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z0; induction z; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + induction f; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z0; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + intros; apply interpF_mult with x y; algebra. + intros; apply interpF_wd with (zring (i * j):F). + apply interpF_int; algebra. + inversion X. inversion X0. + Step_final (zring i[*]zring j:F). + intros. inversion X0. + try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (x0[*](y0[*]y)); algebra. + apply interpF_mult with x0 (y0[*]y); algebra. + Step_final (x0[*]y0[*]y). + intros. inversion X. try (rewrite H in H0; rewrite H1 in H0). (* compat 8.0 *) + apply interpF_wd with (zring 0:F). + apply interpF_int; algebra. + astepl (Zero:F). + astepl (x[*]Zero). + Step_final (x[*]zring 0). Qed. Transparent Zmult. Opaque MI_mult. Lemma MV_mult_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (MV_mult e f) (x[*]y). -cut - (forall (e1 e2 f:expr) (x y:F), - (forall (f:expr) (x y:F), II e2 x -> II f y -> II (MV_mult e2 f) (x[*]y)) -> - II (expr_mult e1 e2) x -> - II f y -> II (expr_mult e1 (MV_mult e2 f)) (x[*]y)). -cut - (forall (e f:expr) (x y:F), - II e x -> II f y -> II (MI_mult (expr_mult f expr_one) e) (x[*]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult f e) (x[*]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -intros H H0 H1 H2 e. elim e. -simpl in |- *; auto. -simpl in |- *; auto. -intros e1 H3 e2 H4. -elim e1; simpl in |- *; auto. -intros e1 H3 e2 H4. -elim e1; simpl in |- *; auto. -intros n f. -elim f; simpl in |- *; auto. -intro m. -elim (lt_nat n m); simpl in |- *; auto. -intros u e0 H5 f. -elim f; simpl in |- *; auto. -intros u0 e3 H6. -elim lt_nat; simpl in |- *; auto. -elim andb; simpl in |- *; auto. -intros b e0 H6 e3 H7 f. -elim f; simpl in |- *; auto. -intros b0 e4 H8 e5 H9. -elim lt_nat; simpl in |- *; auto. -elim andb; simpl in |- *; auto. -elim andb; simpl in |- *; auto. -intros n f H5 f0. -elim f0; simpl in |- *; auto. -intros f1 e0 H6. -elim lt_nat; simpl in |- *; auto. -elim andb; simpl in |- *; auto. -intros. simpl in |- *. auto. -intros n e0 H3 f. -elim f; simpl in |- *; auto. -intros n e0 H3 e1 H4 f. -elim f; simpl in |- *; auto. -intros n e0 H3 f. -elim f; simpl in |- *; auto. -intros; apply interpF_mult with x y; algebra. -intros; apply interpF_wd with (y[*]x); algebra. -apply interpF_mult with y x; algebra. -intros; apply interpF_wd with (y[*]One[*]x). -apply MI_mult_corr_F; auto. -apply interpF_mult with y (One:F); algebra. -apply (interpF_int F val unop binop pfun 1); algebra. -Step_final (x[*](y[*]One)). -intros. inversion X0. try (rewrite H0 in H2; rewrite H in X2; rewrite H1 in X3). (* compat 8.0 *) -apply interpF_wd with (x0[*](y0[*]y)). -apply interpF_mult with x0 (y0[*]y); algebra. -Step_final (x0[*]y0[*]y). +Proof. + cut (forall (e1 e2 f:expr) (x y:F), + (forall (f:expr) (x y:F), II e2 x -> II f y -> II (MV_mult e2 f) (x[*]y)) -> + II (expr_mult e1 e2) x -> II f y -> II (expr_mult e1 (MV_mult e2 f)) (x[*]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (MI_mult (expr_mult f expr_one) e) (x[*]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult f e) (x[*]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + intros H H0 H1 H2 e. elim e. + simpl in |- *; auto. + simpl in |- *; auto. + intros e1 H3 e2 H4. + elim e1; simpl in |- *; auto. + intros e1 H3 e2 H4. + elim e1; simpl in |- *; auto. + intros n f. + elim f; simpl in |- *; auto. + intro m. + elim (lt_nat n m); simpl in |- *; auto. + intros u e0 H5 f. + elim f; simpl in |- *; auto. + intros u0 e3 H6. + elim lt_nat; simpl in |- *; auto. + elim andb; simpl in |- *; auto. + intros b e0 H6 e3 H7 f. + elim f; simpl in |- *; auto. + intros b0 e4 H8 e5 H9. + elim lt_nat; simpl in |- *; auto. + elim andb; simpl in |- *; auto. + elim andb; simpl in |- *; auto. + intros n f H5 f0. + elim f0; simpl in |- *; auto. + intros f1 e0 H6. + elim lt_nat; simpl in |- *; auto. + elim andb; simpl in |- *; auto. + intros. simpl in |- *. auto. + intros n e0 H3 f. + elim f; simpl in |- *; auto. + intros n e0 H3 e1 H4 f. + elim f; simpl in |- *; auto. + intros n e0 H3 f. + elim f; simpl in |- *; auto. + intros; apply interpF_mult with x y; algebra. + intros; apply interpF_wd with (y[*]x); algebra. + apply interpF_mult with y x; algebra. + intros; apply interpF_wd with (y[*]One[*]x). + apply MI_mult_corr_F; auto. + apply interpF_mult with y (One:F); algebra. + apply (interpF_int F val unop binop pfun 1); algebra. + Step_final (x[*](y[*]One)). + intros. inversion X0. try (rewrite H0 in H2; rewrite H in X2; rewrite H1 in X3). (* compat 8.0 *) + apply interpF_wd with (x0[*](y0[*]y)). + apply interpF_mult with x0 (y0[*]y); algebra. + Step_final (x0[*]y0[*]y). Qed. Transparent MI_mult. Opaque MV_mult MI_mult. Lemma MM_mult_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (MM_mult e f) (x[*]y). -cut - (forall (e1 e2 f:expr) (x y:F), - (forall (f:expr) (x y:F), II e2 x -> II f y -> II (MM_mult e2 f) (x[*]y)) -> - II (expr_mult e1 e2) x -> - II f y -> II (MV_mult (MM_mult e2 f) e1) (x[*]y)). -cut - (forall (i:Z) (f:expr) (x y:F), +Proof. + cut (forall (e1 e2 f:expr) (x y:F), + (forall (f:expr) (x y:F), II e2 x -> II f y -> II (MM_mult e2 f) (x[*]y)) -> + II (expr_mult e1 e2) x -> II f y -> II (MV_mult (MM_mult e2 f) e1) (x[*]y)). + cut (forall (i:Z) (f:expr) (x y:F), II (expr_int i) x -> II f y -> II (MI_mult f (expr_int i)) (x[*]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -intros H H0 H1 e. -elim e; intros; simpl in |- *; auto. -intros; apply interpF_mult with x y; algebra. -intros; apply interpF_wd with (y[*]x); algebra. -apply MI_mult_corr_F; auto. -intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpF_wd with (y0[*]y[*]x0). -apply MV_mult_corr_F; auto. -astepl (x0[*](y0[*]y)). -Step_final (x0[*]y0[*]y). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + intros H H0 H1 e. + elim e; intros; simpl in |- *; auto. + intros; apply interpF_mult with x y; algebra. + intros; apply interpF_wd with (y[*]x); algebra. + apply MI_mult_corr_F; auto. + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (y0[*]y[*]x0). + apply MV_mult_corr_F; auto. + astepl (x0[*](y0[*]y)). + Step_final (x0[*]y0[*]y). Qed. Transparent MV_mult MI_mult. Opaque MV_mult. Lemma MM_plus_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (MM_plus e f) (x[+]y). -cut - (forall (i j:Z) (x y:F), - II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i + j)) (x[+]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus e f) (x[+]y)). -intros H H0 e; elim e. -simpl in |- *; auto. -intros z f; elim f; simpl in |- *; auto. -simpl in |- *; auto. -intros e1 H1 e2 H2. -elim e1; simpl in |- *; auto. -intros n f. -elim f; simpl in |- *; auto. -intros f1 H3 f2 H4. -elim f1; simpl in |- *; auto. -intro m. -cut (eq_nat n m = true -> n = m). -elim (eq_nat n m); simpl in |- *; auto. -intros. inversion X. try (rewrite H6 in X1; rewrite H8 in X2; rewrite H7 in H9). (* compat 8.0 *) -inversion X0. try (rewrite H10 in X3; rewrite H12 in X4; rewrite H11 in H13). (* compat 8.0 *) -apply interpF_wd with ((y0[+]y1)[*]x0). -apply MV_mult_corr_F; auto. -astepl (x0[*](y0[+]y1)). -astepl (x0[*]y0[+]x0[*]y1). -cut (x0[=]x1). intro. -Step_final (x0[*]y0[+]x1[*]y1). -apply refl_interpF with val unop binop pfun (expr_var n). -assumption. -rewrite (H5 (refl_equal true)). assumption. -intros; apply eq_nat_corr; auto. - -intros u e0 H3 f. -elim f; simpl in |- *; auto. -intros e3 H4 e4 H5. -elim e3; simpl in |- *; auto. -intros u0 e5 H6. -cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> u = u0). -cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> e0 = e5). -elim andb; simpl in |- *; auto. -intros H' H''. intros. -inversion X. try (rewrite H7 in X1; rewrite H9 in X2; rewrite H8 in H10). (* compat 8.0 *) -inversion X0. try (rewrite H11 in X3; rewrite H13 in X4; rewrite H12 in H14). (* compat 8.0 *) -apply interpF_wd with ((y0[+]y1)[*]x0). -apply MV_mult_corr_F; auto. -astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). -apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. -apply refl_interpF with val unop binop pfun (expr_unop u e0). -auto. rewrite H'. rewrite H''. auto. auto. auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. - -intros u e0 H3 e3 H4 f. -elim f; simpl in |- *; auto. -intros e4 H5 e5 H6. -elim e4; simpl in |- *; auto. -intros u0 e6 H7 e7 H8. -cut - (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> u = u0). -cut - (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e0 = e6). -cut - (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e3 = e7). -elim andb; simpl in |- *; auto. -intros H' H'' H'''. intros. -inversion X. try (rewrite H9 in X1; rewrite H11 in X2; rewrite H10 in H12). (* compat 8.0 *) -inversion X0. try (rewrite H13 in X3; rewrite H15 in X4; rewrite H14 in H16). (* compat 8.0 *) -apply interpF_wd with ((y0[+]y1)[*]x0). -apply MV_mult_corr_F; auto. -astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). -apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. -apply refl_interpF with val unop binop pfun (expr_binop u e0 e3). -auto. rewrite H'. rewrite H''. rewrite H'''. auto. auto. auto. -auto. -intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. - apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. - apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H9); intros. apply eq_nat_corr; auto. - -intros f e0 H3. -intro f0. -elim f0; simpl in |- *; auto. -intros e3 H4 e4 H5. -elim e3; simpl in |- *; auto. -intros f1 e5 H6. -cut (andb (eq_nat f f1) (eq_expr e0 e5) = true -> f = f1). -cut (andb (eq_nat f f1) (eq_expr e0 e5) = true -> e0 = e5). -elim (andb (eq_nat f f1) (eq_expr e0 e5)); simpl in |- *; auto. -intros. -inversion X. try (rewrite H9 in X1; rewrite H11 in X2; rewrite H10 in H12). (* compat 8.0 *) -inversion X0. try (rewrite H13 in X3; rewrite H15 in X4; rewrite H14 in H16). (* compat 8.0 *) -apply interpF_wd with ((y0[+]y1)[*]x0). -apply MV_mult_corr_F; auto. -astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). -apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. -apply refl_interpF with val unop binop pfun (expr_part f e0). -auto. rewrite H7. rewrite H8; auto. auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. -simpl in |- *; auto. - -intros u e0 H1 f. -elim f; simpl in |- *; auto. -intros u e0 H1 e1 H2 f. -elim f; simpl in |- *; auto. -intros u e0 H1 f. -elim f; simpl in |- *; auto. - -intros; apply interpF_plus with x y; algebra. -intros. inversion X. try (rewrite H1 in H0; rewrite H in H0). (* compat 8.0 *) -inversion X0. try (rewrite H2 in H3; rewrite H4 in H3). (* compat 8.0 *) -apply interpF_wd with (zring (i + j):F). -apply interpF_int; algebra. -Step_final (zring i[+]zring j:F). +Proof. + cut (forall (i j:Z) (x y:F), + II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i + j)) (x[+]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + intros H H0 e; elim e. + simpl in |- *; auto. + intros z f; elim f; simpl in |- *; auto. + simpl in |- *; auto. + intros e1 H1 e2 H2. + elim e1; simpl in |- *; auto. + intros n f. + elim f; simpl in |- *; auto. + intros f1 H3 f2 H4. + elim f1; simpl in |- *; auto. + intro m. + cut (eq_nat n m = true -> n = m). + elim (eq_nat n m); simpl in |- *; auto. + intros. inversion X. try (rewrite H6 in X1; rewrite H8 in X2; rewrite H7 in H9). (* compat 8.0 *) + inversion X0. try (rewrite H10 in X3; rewrite H12 in X4; rewrite H11 in H13). (* compat 8.0 *) + apply interpF_wd with ((y0[+]y1)[*]x0). + apply MV_mult_corr_F; auto. + astepl (x0[*](y0[+]y1)). + astepl (x0[*]y0[+]x0[*]y1). + cut (x0[=]x1). intro. + Step_final (x0[*]y0[+]x1[*]y1). + apply refl_interpF with val unop binop pfun (expr_var n). + assumption. + rewrite (H5 (refl_equal true)). assumption. + intros; apply eq_nat_corr; auto. + intros u e0 H3 f. + elim f; simpl in |- *; auto. + intros e3 H4 e4 H5. + elim e3; simpl in |- *; auto. + intros u0 e5 H6. + cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> u = u0). + cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> e0 = e5). + elim andb; simpl in |- *; auto. + intros H' H''. intros. + inversion X. try (rewrite H7 in X1; rewrite H9 in X2; rewrite H8 in H10). (* compat 8.0 *) + inversion X0. try (rewrite H11 in X3; rewrite H13 in X4; rewrite H12 in H14). (* compat 8.0 *) + apply interpF_wd with ((y0[+]y1)[*]x0). + apply MV_mult_corr_F; auto. + astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). + apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. + apply refl_interpF with val unop binop pfun (expr_unop u e0). + auto. rewrite H'. rewrite H''. auto. auto. auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. + intros u e0 H3 e3 H4 f. + elim f; simpl in |- *; auto. + intros e4 H5 e5 H6. + elim e4; simpl in |- *; auto. + intros u0 e6 H7 e7 H8. + cut (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> u = u0). + cut (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e0 = e6). + cut (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e3 = e7). + elim andb; simpl in |- *; auto. + intros H' H'' H'''. intros. + inversion X. try (rewrite H9 in X1; rewrite H11 in X2; rewrite H10 in H12). (* compat 8.0 *) + inversion X0. try (rewrite H13 in X3; rewrite H15 in X4; rewrite H14 in H16). (* compat 8.0 *) + apply interpF_wd with ((y0[+]y1)[*]x0). + apply MV_mult_corr_F; auto. + astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). + apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. + apply refl_interpF with val unop binop pfun (expr_binop u e0 e3). + auto. rewrite H'. rewrite H''. rewrite H'''. auto. auto. auto. + auto. + intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. + apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. + apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H9); intros. apply eq_nat_corr; auto. + intros f e0 H3. + intro f0. + elim f0; simpl in |- *; auto. + intros e3 H4 e4 H5. + elim e3; simpl in |- *; auto. + intros f1 e5 H6. + cut (andb (eq_nat f f1) (eq_expr e0 e5) = true -> f = f1). + cut (andb (eq_nat f f1) (eq_expr e0 e5) = true -> e0 = e5). + elim (andb (eq_nat f f1) (eq_expr e0 e5)); simpl in |- *; auto. + intros. + inversion X. try (rewrite H9 in X1; rewrite H11 in X2; rewrite H10 in H12). (* compat 8.0 *) + inversion X0. try (rewrite H13 in X3; rewrite H15 in X4; rewrite H14 in H16). (* compat 8.0 *) + apply interpF_wd with ((y0[+]y1)[*]x0). + apply MV_mult_corr_F; auto. + astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). + apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. + apply refl_interpF with val unop binop pfun (expr_part f e0). + auto. rewrite H7. rewrite H8; auto. auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. + simpl in |- *; auto. + intros u e0 H1 f. + elim f; simpl in |- *; auto. + intros u e0 H1 e1 H2 f. + elim f; simpl in |- *; auto. + intros u e0 H1 f. + elim f; simpl in |- *; auto. + intros; apply interpF_plus with x y; algebra. + intros. inversion X. try (rewrite H1 in H0; rewrite H in H0). (* compat 8.0 *) + inversion X0. try (rewrite H2 in H3; rewrite H4 in H3). (* compat 8.0 *) + apply interpF_wd with (zring (i + j):F). + apply interpF_int; algebra. + Step_final (zring i[+]zring j:F). Qed. Transparent MV_mult. Opaque MM_plus. Lemma PM_plus_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (PM_plus e f) (x[+]y). -cut - (forall (e1 e2 f:expr) (x y:F), +Proof. + cut (forall (e1 e2 f:expr) (x y:F), + (forall (f:expr) (x y:F), II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> + II (expr_plus e1 e2) x -> II f y -> II (expr_plus e1 (PM_plus e2 f)) (x[+]y)). + cut (forall (e1 e2 f:expr) (x y:F), (forall (f:expr) (x y:F), II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (expr_plus e1 (PM_plus e2 f)) (x[+]y)). -cut - (forall (e1 e2 f:expr) (x y:F), - (forall (f:expr) (x y:F), II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (PM_plus e2 (MM_plus e1 f)) (x[+]y)). -cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (MM_plus e f) (x[+]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus e f) (x[+]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus f e) (x[+]y)). -intros H H0 H1 H2 H3 e. elim e. -simpl in |- *; auto. -intros z f; elim f; intros; simpl in |- *; auto. -intros e1 H4 e2 H5 f. simpl in |- *. -elim (lt_monom e1 f); elim (eq_monom e1 f); elim f; intros; simpl in |- *; - auto. -simpl in |- *; auto. -simpl in |- *; auto. -simpl in |- *; auto. -simpl in |- *; auto. -simpl in |- *; auto. -intros; apply interpF_wd with (y[+]x); algebra. -apply interpF_plus with y x; algebra. -intros; apply interpF_plus with x y; algebra. -intros; apply MM_plus_corr_F; auto. -intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpF_wd with (y0[+](x0[+]y)). -apply X; auto. -apply MM_plus_corr_F; auto. -astepl (y0[+]x0[+]y). -Step_final (x0[+]y0[+]y). -intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpF_wd with (x0[+](y0[+]y)). -apply interpF_plus with x0 (y0[+]y); algebra. -Step_final (x0[+]y0[+]y). + II (expr_plus e1 e2) x -> II f y -> II (PM_plus e2 (MM_plus e1 f)) (x[+]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (MM_plus e f) (x[+]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus f e) (x[+]y)). + intros H H0 H1 H2 H3 e. elim e. + simpl in |- *; auto. + intros z f; elim f; intros; simpl in |- *; auto. + intros e1 H4 e2 H5 f. simpl in |- *. + elim (lt_monom e1 f); elim (eq_monom e1 f); elim f; intros; simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + intros; apply interpF_wd with (y[+]x); algebra. + apply interpF_plus with y x; algebra. + intros; apply interpF_plus with x y; algebra. + intros; apply MM_plus_corr_F; auto. + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (y0[+](x0[+]y)). + apply X; auto. + apply MM_plus_corr_F; auto. + astepl (y0[+]x0[+]y). + Step_final (x0[+]y0[+]y). + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (x0[+](y0[+]y)). + apply interpF_plus with x0 (y0[+]y); algebra. + Step_final (x0[+]y0[+]y). Qed. Transparent MM_plus. Opaque PM_plus. Lemma PP_plus_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (PP_plus e f) (x[+]y). -cut - (forall (e1 e2 f:expr) (x y:F), - (forall (f:expr) (x y:F), II e2 x -> II f y -> II (PP_plus e2 f) (x[+]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (PM_plus (PP_plus e2 f) e1) (x[+]y)). -cut - (forall (i:Z) (f:expr) (x y:F), +Proof. + cut (forall (e1 e2 f:expr) (x y:F), + (forall (f:expr) (x y:F), II e2 x -> II f y -> II (PP_plus e2 f) (x[+]y)) -> + II (expr_plus e1 e2) x -> II f y -> II (PM_plus (PP_plus e2 f) e1) (x[+]y)). + cut (forall (i:Z) (f:expr) (x y:F), II (expr_int i) x -> II f y -> II (PM_plus f (expr_int i)) (x[+]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus e f) (x[+]y)). -intros H H0 H1 e. -elim e; intros; simpl in |- *; auto. -intros. apply interpF_plus with x y; algebra. -intros. apply interpF_wd with (y[+]x); algebra. -apply PM_plus_corr_F; auto. -intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpF_wd with (y0[+]y[+]x0). -apply PM_plus_corr_F; auto. -astepl (x0[+](y0[+]y)). -Step_final (x0[+]y0[+]y). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + intros H H0 H1 e. + elim e; intros; simpl in |- *; auto. + intros. apply interpF_plus with x y; algebra. + intros. apply interpF_wd with (y[+]x); algebra. + apply PM_plus_corr_F; auto. + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (y0[+]y[+]x0). + apply PM_plus_corr_F; auto. + astepl (x0[+](y0[+]y)). + Step_final (x0[+]y0[+]y). Qed. Transparent PM_plus. Opaque PM_plus MM_mult MI_mult. Lemma PM_mult_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (PM_mult e f) (x[*]y). -cut - (forall (e1 e2 f:expr) (x y:F), - (forall (f:expr) (x y:F), II e2 x -> II f y -> II (PM_mult e2 f) (x[*]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (PM_plus (PM_mult e2 f) (MM_mult e1 f)) (x[*]y)). -cut - (forall (i:Z) (f:expr) (x y:F), - II (expr_int i) x -> +Proof. + cut (forall (e1 e2 f:expr) (x y:F), + (forall (f:expr) (x y:F), II e2 x -> II f y -> II (PM_mult e2 f) (x[*]y)) -> + II (expr_plus e1 e2) x -> II f y -> II (PM_plus (PM_mult e2 f) (MM_mult e1 f)) (x[*]y)). + cut (forall (i:Z) (f:expr) (x y:F), II (expr_int i) x -> II f y -> II (PM_plus (expr_int 0) (MI_mult f (expr_int i))) (x[*]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -intros H H0 H1 e. -elim e; intros; simpl in |- *; auto. -intros. apply interpF_mult with x y; algebra. -intros. apply interpF_wd with (zring 0[+]y[*]x). -apply PM_plus_corr_F. -apply interpF_int; algebra. -apply MI_mult_corr_F; auto. -astepl (Zero[+]y[*]x). -Step_final (y[*]x). -intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpF_wd with (y0[*]y[+]x0[*]y). -apply PM_plus_corr_F; auto. -apply MM_mult_corr_F; auto. -astepl ((y0[+]x0)[*]y). -Step_final ((x0[+]y0)[*]y). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + intros H H0 H1 e. + elim e; intros; simpl in |- *; auto. + intros. apply interpF_mult with x y; algebra. + intros. apply interpF_wd with (zring 0[+]y[*]x). + apply PM_plus_corr_F. + apply interpF_int; algebra. + apply MI_mult_corr_F; auto. + astepl (Zero[+]y[*]x). + Step_final (y[*]x). + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (y0[*]y[+]x0[*]y). + apply PM_plus_corr_F; auto. + apply MM_mult_corr_F; auto. + astepl ((y0[+]x0)[*]y). + Step_final ((x0[+]y0)[*]y). Qed. Opaque PM_mult. Lemma PP_mult_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (PP_mult e f) (x[*]y). -cut - (forall (e1 e2 f:expr) (x y:F), - (forall (f:expr) (x y:F), II e2 x -> II f y -> II (PP_mult e2 f) (x[*]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (PP_plus (PM_mult f e1) (PP_mult e2 f)) (x[*]y)). -cut - (forall (i:Z) (f:expr) (x y:F), +Proof. + cut (forall (e1 e2 f:expr) (x y:F), + (forall (f:expr) (x y:F), II e2 x -> II f y -> II (PP_mult e2 f) (x[*]y)) -> + II (expr_plus e1 e2) x -> II f y -> II (PP_plus (PM_mult f e1) (PP_mult e2 f)) (x[*]y)). + cut (forall (i:Z) (f:expr) (x y:F), II (expr_int i) x -> II f y -> II (PM_mult f (expr_int i)) (x[*]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -intros H H0 H1 e. -elim e; intros; simpl in |- *; auto. -intros. apply interpF_mult with x y; algebra. -intros. apply interpF_wd with (y[*]x); algebra. -apply PM_mult_corr_F; auto. -intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpF_wd with (y[*]x0[+]y0[*]y). -apply PP_plus_corr_F; auto. -apply PM_mult_corr_F; auto. -astepl (x0[*]y[+]y0[*]y). -Step_final ((x0[+]y0)[*]y). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + intros H H0 H1 e. + elim e; intros; simpl in |- *; auto. + intros. apply interpF_mult with x y; algebra. + intros. apply interpF_wd with (y[*]x); algebra. + apply PM_mult_corr_F; auto. + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (y[*]x0[+]y0[*]y). + apply PP_plus_corr_F; auto. + apply PM_mult_corr_F; auto. + astepl (x0[*]y[+]y0[*]y). + Step_final ((x0[+]y0)[*]y). Qed. Transparent PP_plus PM_mult PP_mult PM_plus MI_mult. Lemma FF_plus_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (FF_plus e f) (x[+]y). -cut - (forall (e1 e2 f1 f2:expr) (x y:F), - II (expr_div e1 e2) x -> - II (expr_div f1 f2) y -> - II (expr_div (PP_plus (PP_mult e1 f2) (PP_mult e2 f1)) (PP_mult e2 f2)) - (x[+]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus e f) (x[+]y)). -intros H H0 e f. -elim e; elim f; intros; simpl in |- *; auto. -intros. apply interpF_plus with x y; algebra. -intros. inversion X. -try (rewrite H in X1; rewrite H1 in X2; rewrite H0 in H2). (* compat 8.0 *) -inversion X0. -try (rewrite H3 in X3; rewrite H5 in X4; rewrite H4 in H6). (* compat 8.0 *) -cut (y0[*]y1[#]Zero). intro H13. -apply interpF_div with (x0[*]y1[+]y0[*]x1) (y0[*]y1) H13; auto. -astepl ((x0[*]y1[/] y0[*]y1[//]H13)[+](y0[*]x1[/] y0[*]y1[//]H13)). -astepl - ((x0[/] y0[//]nzy)[*](y1[/] y1[//]nzy0)[+] - (y0[/] y0[//]nzy)[*](x1[/] y1[//]nzy0)). -astepl ((x0[/] y0[//]nzy)[*]One[+]One[*](x1[/] y1[//]nzy0)). -Step_final ((x0[/] y0[//]nzy)[+](x1[/] y1[//]nzy0)). -apply PP_plus_corr_F; auto. -apply PP_mult_corr_F; auto. -apply PP_mult_corr_F; auto. -apply PP_mult_corr_F; auto. -apply mult_resp_ap_zero; auto. +Proof. + cut (forall (e1 e2 f1 f2:expr) (x y:F), II (expr_div e1 e2) x -> II (expr_div f1 f2) y -> + II (expr_div (PP_plus (PP_mult e1 f2) (PP_mult e2 f1)) (PP_mult e2 f2)) (x[+]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + intros H H0 e f. + elim e; elim f; intros; simpl in |- *; auto. + intros. apply interpF_plus with x y; algebra. + intros. inversion X. + try (rewrite H in X1; rewrite H1 in X2; rewrite H0 in H2). (* compat 8.0 *) + inversion X0. + try (rewrite H3 in X3; rewrite H5 in X4; rewrite H4 in H6). (* compat 8.0 *) + cut (y0[*]y1[#]Zero). intro H13. + apply interpF_div with (x0[*]y1[+]y0[*]x1) (y0[*]y1) H13; auto. + astepl ((x0[*]y1[/] y0[*]y1[//]H13)[+](y0[*]x1[/] y0[*]y1[//]H13)). + astepl ((x0[/] y0[//]nzy)[*](y1[/] y1[//]nzy0)[+] (y0[/] y0[//]nzy)[*](x1[/] y1[//]nzy0)). + astepl ((x0[/] y0[//]nzy)[*]One[+]One[*](x1[/] y1[//]nzy0)). + Step_final ((x0[/] y0[//]nzy)[+](x1[/] y1[//]nzy0)). + apply PP_plus_corr_F; auto. + apply PP_mult_corr_F; auto. + apply PP_mult_corr_F; auto. + apply PP_mult_corr_F; auto. + apply mult_resp_ap_zero; auto. Qed. Lemma FF_mult_corr_F : forall (e f:expr) (x y:F), II e x -> II f y -> II (FF_mult e f) (x[*]y). -cut - (forall (e1 e2 f1 f2:expr) (x y:F), - II (expr_div e1 e2) x -> - II (expr_div f1 f2) y -> - II (expr_div (PP_mult e1 f1) (PP_mult e2 f2)) (x[*]y)). -cut - (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -intros H H0 e f. -elim e; elim f; intros; simpl in |- *; auto. -intros. apply interpF_mult with x y; algebra. -intros. inversion X. -try (rewrite H in X1; rewrite H1 in X2; rewrite H0 in H2). (* compat 8.0 *) -inversion X0. -try (rewrite H3 in X3; rewrite H5 in X4; rewrite H4 in H6). (* compat 8.0 *) -cut (y0[*]y1[#]Zero). intro H13. -apply interpF_div with (x0[*]x1) (y0[*]y1) H13. -Step_final ((x0[/] y0[//]nzy)[*](x1[/] y1[//]nzy0)). -apply PP_mult_corr_F; auto. -apply PP_mult_corr_F; auto. -apply mult_resp_ap_zero; auto. +Proof. + cut (forall (e1 e2 f1 f2:expr) (x y:F), II (expr_div e1 e2) x -> II (expr_div f1 f2) y -> + II (expr_div (PP_mult e1 f1) (PP_mult e2 f2)) (x[*]y)). + cut (forall (e f:expr) (x y:F), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + intros H H0 e f. + elim e; elim f; intros; simpl in |- *; auto. + intros. apply interpF_mult with x y; algebra. + intros. inversion X. + try (rewrite H in X1; rewrite H1 in X2; rewrite H0 in H2). (* compat 8.0 *) + inversion X0. + try (rewrite H3 in X3; rewrite H5 in X4; rewrite H4 in H6). (* compat 8.0 *) + cut (y0[*]y1[#]Zero). intro H13. + apply interpF_div with (x0[*]x1) (y0[*]y1) H13. + Step_final ((x0[/] y0[//]nzy)[*](x1[/] y1[//]nzy0)). + apply PP_mult_corr_F; auto. + apply PP_mult_corr_F; auto. + apply mult_resp_ap_zero; auto. Qed. Transparent FF_div. Lemma FF_div_corr_F : forall (e f:expr) (x y:F) (nzy:y[#]Zero), II e x -> II f y -> II (FF_div e f) (x[/]y[//]nzy). -cut - (forall (e1 e2 f1 f2:expr) (x y:F) (nzy:y[#]Zero), - II (expr_div e1 e2) x -> - II (expr_div f1 f2) y -> - II (expr_div (PP_mult e1 f2) (PP_mult e2 f1)) (x[/]y[//]nzy)). -cut - (forall (e f:expr) (x y:F) (nzy:y[#]Zero), - II e x -> II f y -> II (expr_div e f) (x[/]y[//]nzy)). -intros H H0 e f. -elim e; elim f; intros; simpl in |- *; auto. -intros. apply interpF_div with x y nzy; algebra. -intros. inversion X. -try (rewrite H in X1; rewrite H1 in X2; rewrite H0 in H2). (* compat 8.0 *) -inversion X0. -try (rewrite H3 in X3; rewrite H5 in X4; rewrite H4 in H6). (* compat 8.0 *) -cut (x1[#]Zero). intro nzx1. -cut (y0[*]x1[#]Zero). intro H13. -cut ((x1[/]y1[//]nzy1)[#]Zero). intro H14. -apply interpF_div with (x0[*]y1) (y0[*]x1) H13. -astepl ((y1[*]x0)[/]y0[*]x1[//]H13). -astepl (((y1[*]x0)[/]y0[//]nzy0)[/]x1[//]nzx1). -astepl ((y1[*](x0[/]y0[//]nzy0))[/]x1[//]nzx1). -astepl (((x0[/]y0[//]nzy0)[*]y1)[/]x1[//]nzx1). -Step_final ((x0[/]y0[//]nzy0)[/]x1[/]y1[//]nzy1[//]H14). -apply PP_mult_corr_F; auto. -apply PP_mult_corr_F; auto. -apply div_resp_ap_zero_rev; auto. -apply mult_resp_ap_zero; auto. -apply div_resp_ap_zero with y1 nzy1. -astepl y. auto. +Proof. + cut (forall (e1 e2 f1 f2:expr) (x y:F) (nzy:y[#]Zero), II (expr_div e1 e2) x -> + II (expr_div f1 f2) y -> II (expr_div (PP_mult e1 f2) (PP_mult e2 f1)) (x[/]y[//]nzy)). + cut (forall (e f:expr) (x y:F) (nzy:y[#]Zero), II e x -> II f y -> II (expr_div e f) (x[/]y[//]nzy)). + intros H H0 e f. + elim e; elim f; intros; simpl in |- *; auto. + intros. apply interpF_div with x y nzy; algebra. + intros. inversion X. + try (rewrite H in X1; rewrite H1 in X2; rewrite H0 in H2). (* compat 8.0 *) + inversion X0. + try (rewrite H3 in X3; rewrite H5 in X4; rewrite H4 in H6). (* compat 8.0 *) + cut (x1[#]Zero). intro nzx1. + cut (y0[*]x1[#]Zero). intro H13. + cut ((x1[/]y1[//]nzy1)[#]Zero). intro H14. + apply interpF_div with (x0[*]y1) (y0[*]x1) H13. + astepl ((y1[*]x0)[/]y0[*]x1[//]H13). + astepl (((y1[*]x0)[/]y0[//]nzy0)[/]x1[//]nzx1). + astepl ((y1[*](x0[/]y0[//]nzy0))[/]x1[//]nzx1). + astepl (((x0[/]y0[//]nzy0)[*]y1)[/]x1[//]nzx1). + Step_final ((x0[/]y0[//]nzy0)[/]x1[/]y1[//]nzy1[//]H14). + apply PP_mult_corr_F; auto. + apply PP_mult_corr_F; auto. + apply div_resp_ap_zero_rev; auto. + apply mult_resp_ap_zero; auto. + apply div_resp_ap_zero with y1 nzy1. + astepl y. auto. Qed. Lemma NormF_corr : forall (e:expr) (x:F), II e x -> II (NormF e) x. -intro; elim e; intros; simpl in |- *. -apply - (interpF_div F val unop binop pfun - (expr_plus (expr_mult (expr_var v) expr_one) expr_zero) expr_one x - (One:F) x (ring_non_triv F)). -algebra. -apply - (interpF_plus F val unop binop pfun (expr_mult (expr_var v) expr_one) - expr_zero x (Zero:F) x). -algebra. -apply (interpF_mult F val unop binop pfun (expr_var v) expr_one x (One:F) x); - algebra. -apply (interpF_int F val unop binop pfun 1); algebra. -apply (interpF_int F val unop binop pfun 0); algebra. -apply (interpF_int F val unop binop pfun 1); algebra. -apply - (interpF_div F val unop binop pfun (expr_int z) expr_one x ( - One:F) x (ring_non_triv F)). -algebra. algebra. apply (interpF_int F val unop binop pfun 1); algebra. - -inversion X1. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) - apply interpF_wd with (x0[+]y). apply FF_plus_corr_F; auto. auto. - -inversion X1. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) - apply interpF_wd with (x0[*]y). apply FF_mult_corr_F; auto. auto. - -inversion X1. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) - apply interpF_wd with (x0[/]y[//]nzy). -apply FF_div_corr_F; auto. auto. - -inversion X0. try (rewrite H in H2; rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) -apply - (interpF_div F val unop binop pfun - (expr_plus (expr_mult (expr_unop u (NormF e0)) expr_one) expr_zero) - expr_one x (One:F) x (ring_non_triv F)). -algebra. -apply - (interpF_plus F val unop binop pfun - (expr_mult (expr_unop u (NormF e0)) expr_one) expr_zero x ( - Zero:F) x). -algebra. -apply - (interpF_mult F val unop binop pfun (expr_unop u (NormF e0)) expr_one x - (One:F) x); algebra. -apply (interpF_unop F val unop binop pfun (NormF e0) u x0); algebra. -apply (interpF_int F val unop binop pfun 1); algebra. -apply (interpF_int F val unop binop pfun 0); algebra. -apply (interpF_int F val unop binop pfun 1); algebra. - -inversion X1. try (rewrite H in H3; rewrite H1 in X2; rewrite H2 in X3; rewrite H0 in H3). (* compat 8.0 *) -apply - (interpF_div F val unop binop pfun +Proof. + intro; elim e; intros; simpl in |- *. + apply (interpF_div F val unop binop pfun + (expr_plus (expr_mult (expr_var v) expr_one) expr_zero) expr_one x (One:F) x (ring_non_triv F)). + algebra. + apply (interpF_plus F val unop binop pfun (expr_mult (expr_var v) expr_one) expr_zero x (Zero:F) x). + algebra. + apply (interpF_mult F val unop binop pfun (expr_var v) expr_one x (One:F) x); algebra. + apply (interpF_int F val unop binop pfun 1); algebra. + apply (interpF_int F val unop binop pfun 0); algebra. + apply (interpF_int F val unop binop pfun 1); algebra. + apply (interpF_div F val unop binop pfun (expr_int z) expr_one x ( One:F) x (ring_non_triv F)). + algebra. algebra. apply (interpF_int F val unop binop pfun 1); algebra. + inversion X1. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (x0[+]y). apply FF_plus_corr_F; auto. auto. + inversion X1. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (x0[*]y). apply FF_mult_corr_F; auto. auto. + inversion X1. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpF_wd with (x0[/]y[//]nzy). + apply FF_div_corr_F; auto. auto. + inversion X0. try (rewrite H in H2; rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) + apply (interpF_div F val unop binop pfun + (expr_plus (expr_mult (expr_unop u (NormF e0)) expr_one) expr_zero) + expr_one x (One:F) x (ring_non_triv F)). + algebra. + apply (interpF_plus F val unop binop pfun (expr_mult (expr_unop u (NormF e0)) expr_one) expr_zero x ( + Zero:F) x). + algebra. + apply (interpF_mult F val unop binop pfun (expr_unop u (NormF e0)) expr_one x (One:F) x); algebra. + apply (interpF_unop F val unop binop pfun (NormF e0) u x0); algebra. + apply (interpF_int F val unop binop pfun 1); algebra. + apply (interpF_int F val unop binop pfun 0); algebra. + apply (interpF_int F val unop binop pfun 1); algebra. + inversion X1. try (rewrite H in H3; rewrite H1 in X2; rewrite H2 in X3; rewrite H0 in H3). (* compat 8.0 *) + apply (interpF_div F val unop binop pfun (expr_plus (expr_mult (expr_binop b (NormF e0) (NormF e1)) expr_one) - expr_zero) expr_one x (One:F) x (ring_non_triv F)). -algebra. -apply - (interpF_plus F val unop binop pfun - (expr_mult (expr_binop b (NormF e0) (NormF e1)) expr_one) expr_zero x - (Zero:F) x). -algebra. -apply - (interpF_mult F val unop binop pfun (expr_binop b (NormF e0) (NormF e1)) - expr_one x (One:F) x); algebra. -apply (interpF_binop F val unop binop pfun (NormF e0) (NormF e1) b x0 y); - algebra. -apply (interpF_int F val unop binop pfun 1); algebra. -apply (interpF_int F val unop binop pfun 0); algebra. -apply (interpF_int F val unop binop pfun 1); algebra. - -inversion X0. - try ((generalize Hx H2; clear Hx H2; rewrite H; intros Hx H2); - rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) -apply - (interpF_div F val unop binop pfun - (expr_plus (expr_mult (expr_part p (NormF e0)) expr_one) expr_zero) - expr_one x (One:F) x (ring_non_triv F)). -algebra. -apply - (interpF_plus F val unop binop pfun - (expr_mult (expr_part p (NormF e0)) expr_one) expr_zero x ( + expr_zero) expr_one x (One:F) x (ring_non_triv F)). + algebra. + apply (interpF_plus F val unop binop pfun + (expr_mult (expr_binop b (NormF e0) (NormF e1)) expr_one) expr_zero x (Zero:F) x). + algebra. + apply (interpF_mult F val unop binop pfun (expr_binop b (NormF e0) (NormF e1)) + expr_one x (One:F) x); algebra. + apply (interpF_binop F val unop binop pfun (NormF e0) (NormF e1) b x0 y); algebra. + apply (interpF_int F val unop binop pfun 1); algebra. + apply (interpF_int F val unop binop pfun 0); algebra. + apply (interpF_int F val unop binop pfun 1); algebra. + inversion X0. + try ((generalize Hx H2; clear Hx H2; rewrite H; intros Hx H2); + rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) + apply (interpF_div F val unop binop pfun + (expr_plus (expr_mult (expr_part p (NormF e0)) expr_one) expr_zero) + expr_one x (One:F) x (ring_non_triv F)). + algebra. + apply (interpF_plus F val unop binop pfun (expr_mult (expr_part p (NormF e0)) expr_one) expr_zero x ( Zero:F) x). -algebra. -apply - (interpF_mult F val unop binop pfun (expr_part p (NormF e0)) expr_one x - (One:F) x); algebra. -apply (interpF_part F val unop binop pfun (NormF e0) p x0) with (Hx := Hx); - algebra. -apply (interpF_int F val unop binop pfun 1); algebra. -apply (interpF_int F val unop binop pfun 0); algebra. -apply (interpF_int F val unop binop pfun 1); algebra. + algebra. + apply (interpF_mult F val unop binop pfun (expr_part p (NormF e0)) expr_one x (One:F) x); algebra. + apply (interpF_part F val unop binop pfun (NormF e0) p x0) with (Hx := Hx); algebra. + apply (interpF_int F val unop binop pfun 1); algebra. + apply (interpF_int F val unop binop pfun 0); algebra. + apply (interpF_int F val unop binop pfun 1); algebra. Qed. Lemma Norm_wfF : forall e:expr, wfF F val unop binop pfun e -> wfF F val unop binop pfun (NormF e). -unfold wfF in |- *. -intros. -elim X. -intros. -exists x. -apply NormF_corr. -assumption. +Proof. + unfold wfF in |- *. + intros. + elim X. + intros. + exists x. + apply NormF_corr. + assumption. Qed. Lemma expr_is_zero_corr_F : forall e:expr, wfF F val unop binop pfun e -> expr_is_zero e = true -> II e Zero. -unfold wfF in |- *. -intros e H. -elim H. intro. -elim e; simpl in |- *; try (intros; elimtype False; inversion H0; fail). -intros e0 H0 e1 H1. -elim e0; simpl in |- *; try (intros; elimtype False; inversion H2; fail). -intro. -elim z; simpl in |- *; try (intros; elimtype False; inversion H2; fail); - intros H2 H3. -inversion H2. try (rewrite H4 in X; rewrite H6 in X0; rewrite H5 in H7). (* compat 8.0 *) -apply interpF_div with (Zero:F) y nzy; auto. -algebra. -apply (interpF_int F val unop binop pfun 0); algebra. +Proof. + unfold wfF in |- *. + intros e H. + elim H. intro. + elim e; simpl in |- *; try (intros; elimtype False; inversion H0; fail). + intros e0 H0 e1 H1. + elim e0; simpl in |- *; try (intros; elimtype False; inversion H2; fail). + intro. + elim z; simpl in |- *; try (intros; elimtype False; inversion H2; fail); intros H2 H3. + inversion H2. try (rewrite H4 in X; rewrite H6 in X0; rewrite H5 in H7). (* compat 8.0 *) + apply interpF_div with (Zero:F) y nzy; auto. + algebra. + apply (interpF_int F val unop binop pfun 0); algebra. Qed. Lemma Tactic_lemma_zero_F : forall (x:F) (e:xexprF F val unop binop pfun x), expr_is_zero (NormF (xforgetF _ _ _ _ _ _ e)) = true -> x[=]Zero. -intros. -apply refl_interpF with val unop binop pfun (NormF (xforgetF _ _ _ _ _ _ e)). -apply NormF_corr. -apply xexprF2interpF. -apply expr_is_zero_corr_F. -apply Norm_wfF. -apply xexprF2wfF. -assumption. +Proof. + intros. + apply refl_interpF with val unop binop pfun (NormF (xforgetF _ _ _ _ _ _ e)). + apply NormF_corr. + apply xexprF2interpF. + apply expr_is_zero_corr_F. + apply Norm_wfF. + apply xexprF2wfF. + assumption. Qed. Lemma Tactic_lemmaF : @@ -915,10 +816,11 @@ Lemma Tactic_lemmaF : expr_is_zero (NormF (xforgetF _ _ _ _ _ _ (xexprF_minus _ _ _ _ _ _ _ e f))) = true -> x[=]y. -intros. -apply cg_inv_unique_2. -apply Tactic_lemma_zero_F with (xexprF_minus _ _ _ _ _ _ _ e f). -assumption. +Proof. + intros. + apply cg_inv_unique_2. + apply Tactic_lemma_zero_F with (xexprF_minus _ _ _ _ _ _ _ e f). + assumption. Qed. End Field_NormCorrect. @@ -935,15 +837,15 @@ match l with match (ClosedZ k) with | true => constr:(xexprF_int R a b c d k) end - | (csbf_fun _ _ _ csg_op ?x ?y) => + | (csbf_fun _ _ _ csg_op ?x ?y) => let x' := QuoteF R l x in let y' := QuoteF R l y in constr:(xexprF_plus R a b c d _ _ x' y') - | (csbf_fun _ _ _ cr_mult ?x ?y) => + | (csbf_fun _ _ _ cr_mult ?x ?y) => let x' := QuoteF R l x in let y' := QuoteF R l y in constr:(xexprF_mult R a b c d _ _ x' y') - | (cf_div ?x ?y ?H) => + | (cf_div ?x ?y ?H) => let x' := QuoteF R l x in let y' := QuoteF R l y in constr:(xexprF_div R a b c d _ _ x' y' H) @@ -953,90 +855,90 @@ match l with match (ClosedNat n) with | true => constr:(xexprF_nat R a b c d n) end - | (csf_fun _ _ cg_inv ?x) => + | (csf_fun _ _ cg_inv ?x) => let x' := QuoteF R l x in constr:(xexprF_inv R a b c d _ x') - | (cg_minus ?x ?y) => + | (cg_minus ?x ?y) => let x' := QuoteF R l x in let y' := QuoteF R l y in constr:(xexprF_minus R a b c d _ _ x' y') - | (csf_fun _ _ (@nexp_op _ ?n) ?x) => + | (csf_fun _ _ (@nexp_op _ ?n) ?x) => match (ClosedNat n) with | true => let x' := QuoteF R l x in constr:(xexprF_power R a b c d _ x' n) end - | (pfpfun ?f ?x ?h) => + | (pfpfun ?f ?x ?h) => let x' := QuoteF R l x in let i := FindIndex f pl in - constr:(xexprF_part R a b c d _ i x' h) - | (csf_fun _ _ ?f ?x) => + constr:(xexprF_part R a b c d _ i x' h) + | (csf_fun _ _ ?f ?x) => let x' := QuoteF R l x in let i := FindIndex f ul in - constr:(xexprF_unop R a b c d _ i x') - | (csbf_fun _ _ _ ?f ?x ?y) => + constr:(xexprF_unop R a b c d _ i x') + | (csbf_fun _ _ _ ?f ?x ?y) => let x' := QuoteF R l x in let y' := QuoteF R l y in let i := FindIndex f bl in - constr:(xexprF_binop R a b c d _ _ i x' y') - | ?t => - let i := FindIndex t vl in + constr:(xexprF_binop R a b c d _ _ i x' y') + | ?t => + let i := FindIndex t vl in constr:(xexprF_var R a b c d i) end) end. -Ltac FindTermVariablesF t l := +Ltac FindTermVariablesF t l := match t with -| (zring ?k) => +| (zring ?k) => match (ClosedZ k) with | true => constr:l end -| (csbf_fun _ _ _ csg_op ?x ?y) => +| (csbf_fun _ _ _ csg_op ?x ?y) => let l1 := FindTermVariablesF x l in let l2 := FindTermVariablesF y l1 in constr:l2 -| (csbf_fun _ _ _ cr_mult ?x ?y) => +| (csbf_fun _ _ _ cr_mult ?x ?y) => let l1 := FindTermVariablesF x l in let l2 := FindTermVariablesF y l1 in constr:l2 -| (cf_div ?x ?y ?H) => +| (cf_div ?x ?y ?H) => let l1 := FindTermVariablesF x l in let l2 := FindTermVariablesF y l1 in constr:l2 | (Zero) => constr:l | (One) => constr:l -| (nring ?n) => +| (nring ?n) => match (ClosedNat n) with | true => constr:l end -| (csf_fun _ _ cg_inv ?x) => +| (csf_fun _ _ cg_inv ?x) => let l1 := FindTermVariablesF x l in constr:l1 -| (cg_minus ?x ?y) => +| (cg_minus ?x ?y) => let l1 := FindTermVariablesF x l in let l2 := FindTermVariablesF y l1 in constr:l2 -| (csf_fun _ _ (@nexp_op _ ?n) ?x) => +| (csf_fun _ _ (@nexp_op _ ?n) ?x) => match (ClosedNat n) with | true => let l1 := FindTermVariablesF x l in constr:l1 end -| (pfpfun ?f ?x ?h) => +| (pfpfun ?f ?x ?h) => let l1 := FindTermVariablesF x l in match l1 with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad vl ul bl (Mcons f pl)) end -| (csf_fun _ _ ?f ?x) => +| (csf_fun _ _ ?f ?x) => let l1 := FindTermVariablesF x l in match l1 with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad vl (Mcons f ul) bl pl) end -| (csbf_fun _ _ _ ?f ?x ?y) => +| (csbf_fun _ _ _ ?f ?x ?y) => let l1 := FindTermVariablesF x l in let l2 := FindTermVariablesF y l1 in match l2 with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad vl ul (Mcons f bl) pl) end -| ?t => match l with +| ?t => match l with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad (Mcons t vl) ul bl pl) end end. @@ -1046,10 +948,10 @@ Ltac FindTermsVariablesF fn t1 t2 := let l2 := FindTermVariablesF t2 l1 in constr:l2. -Ltac rationalF F x y := +Ltac rationalF F x y := let l:=FindTermsVariablesF F x y in - let t1:=(QuoteF F l x) in - let t2:=(QuoteF F l y) in + let t1:=(QuoteF F l x) in + let t2:=(QuoteF F l y) in eapply Tactic_lemmaF with (e:=t1) (f:=t2) ; reflexivity. diff --git a/tactics/GroupReflection.v b/tactics/GroupReflection.v index d037fb286..e11b81433 100644 --- a/tactics/GroupReflection.v +++ b/tactics/GroupReflection.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) Require Export CAbGroups. @@ -106,70 +106,22 @@ Definition xinterpG (x : G) (e : xexprG x) := x. Lemma xexprG2interpG : forall (x : G) (e : xexprG x), interpG (xforgetG _ e) x. -intros x e. -induction e - as - [i| - | - x - y - e1 - Hrece1 - e0 - Hrece0| - x - k - e - Hrece| - x - f - e - Hrece| - x - y - f - e1 - Hrece1 - e0 - Hrece0| - x - f - e - Hrece - Hx| - x - e - Hrece| - x - y - e1 - Hrece1 - e0 - Hrece0]. - -apply (interpG_var i); algebra. - -apply interpG_zero; algebra. - -apply (interpG_plus (xforgetG _ e1) (xforgetG _ e0) x y (x[+]y)); algebra. - -apply (interpG_mult_int (xforgetG _ e) k x (zmult x k)); algebra. - -apply (interpG_unop (xforgetG _ e) f x (unop f x)); algebra. - -apply (interpG_binop (xforgetG _ e1) (xforgetG _ e0) f x y (binop f x y)); - algebra. - -eapply (interpG_part (xforgetG _ e) f x (pfun f x Hx)). - apply eq_reflexive_unfolded. -algebra. - -apply (interpG_mult_int (xforgetG _ e) (-1) x); algebra. - -apply - (interpG_plus (xforgetG _ e1) (xforgetG _ (xexprG_inv _ e0)) x [--]y (x[-]y)); - algebra. -apply (interpG_mult_int (xforgetG _ e0) (-1) y); algebra. +Proof. + intros x e. + induction e as [i| | x y e1 Hrece1 e0 Hrece0| x k e Hrece| x f e Hrece| x y f e1 Hrece1 e0 Hrece0| x + f e Hrece Hx| x e Hrece| x y e1 Hrece1 e0 Hrece0]. + apply (interpG_var i); algebra. + apply interpG_zero; algebra. + apply (interpG_plus (xforgetG _ e1) (xforgetG _ e0) x y (x[+]y)); algebra. + apply (interpG_mult_int (xforgetG _ e) k x (zmult x k)); algebra. + apply (interpG_unop (xforgetG _ e) f x (unop f x)); algebra. + apply (interpG_binop (xforgetG _ e1) (xforgetG _ e0) f x y (binop f x y)); algebra. + eapply (interpG_part (xforgetG _ e) f x (pfun f x Hx)). + apply eq_reflexive_unfolded. + algebra. + apply (interpG_mult_int (xforgetG _ e) (-1) x); algebra. + apply (interpG_plus (xforgetG _ e1) (xforgetG _ (xexprG_inv _ e0)) x [--]y (x[-]y)); algebra. + apply (interpG_mult_int (xforgetG _ e0) (-1) y); algebra. Qed. Definition xexprG_diagram_commutes : @@ -177,9 +129,10 @@ Definition xexprG_diagram_commutes : xexprG2interpG. Lemma xexprG2wfG : forall (x : G) (e : xexprG x), wfG (xforgetG _ e). -intros x e. -exists x. -apply xexprG2interpG. +Proof. + intros x e. + exists x. + apply xexprG2interpG. Qed. Record fexprG : Type := {finterpG : G; fexprG2xexprG : xexprG finterpG}. @@ -196,16 +149,18 @@ Definition fexprG_mult_int (e : fexprG) (k : Z) := Definition fforgetG (e : fexprG) := xforgetG (finterpG e) (fexprG2xexprG e). Lemma fexprG2interp : forall e : fexprG, interpG (fforgetG e) (finterpG e). -intros e. -elim e. intros x e'. -unfold fforgetG in |- *. simpl in |- *. -apply xexprG2interpG. +Proof. + intros e. + elim e. intros x e'. + unfold fforgetG in |- *. simpl in |- *. + apply xexprG2interpG. Qed. Lemma fexprG2wf : forall e : fexprG, wfG (fforgetG e). -intro e. -unfold fforgetG in |- *. -apply xexprG2wfG. +Proof. + intro e. + unfold fforgetG in |- *. + apply xexprG2wfG. Qed. Opaque csg_crr. @@ -224,85 +179,54 @@ Opaque cg_minus. Lemma refl_interpG : forall (e : expr) (x y : G), interpG e x -> interpG e y -> x[=]y. -intro e. -induction e - as - [v| - z| - e1 - Hrece1 - e0 - Hrece0| - e1 - Hrece1 - e0 - Hrece0| - e1 - Hrece1 - e0 - Hrece0| - u - e - Hrece| - b - e1 - Hrece1 - e0 - Hrece0| - p - e - Hrece]. - -intros x y Hx Hy. -inversion Hx. -inversion Hy. -Step_final (val v). - -intros x y Hx Hy. -inversion Hx. -inversion Hy. -Step_final (Zero:G). - -intros x y H1 H2. -inversion H1. -inversion H2. -astepl (x0[+]y0). -Step_final (x1[+]y1). - -intros x y Hx. -inversion Hx; intro Hy; inversion Hy. -astepl (zmult x0 k). Step_final (zmult x1 k). - -intros x y H0 H1. -inversion H0. - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (unop u x0); Step_final (unop u x1). - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (binop b x0 y0); Step_final (binop b x1 y1). - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (pfun p x0 Hx); Step_final (pfun p x1 Hx0). +Proof. + intro e. + induction e as [v| z| e1 Hrece1 e0 Hrece0| e1 Hrece1 e0 Hrece0| e1 Hrece1 e0 Hrece0| u e Hrece| b e1 + Hrece1 e0 Hrece0| p e Hrece]. + intros x y Hx Hy. + inversion Hx. + inversion Hy. + Step_final (val v). + intros x y Hx Hy. + inversion Hx. + inversion Hy. + Step_final (Zero:G). + intros x y H1 H2. + inversion H1. + inversion H2. + astepl (x0[+]y0). + Step_final (x1[+]y1). + intros x y Hx. + inversion Hx; intro Hy; inversion Hy. + astepl (zmult x0 k). Step_final (zmult x1 k). + intros x y H0 H1. + inversion H0. + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (unop u x0); Step_final (unop u x1). + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (binop b x0 y0); Step_final (binop b x1 y1). + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (pfun p x0 Hx); Step_final (pfun p x1 Hx0). Qed. Lemma interpG_wd : forall (e : expr) (x y : G), interpG e x -> (x[=]y) -> interpG e y. -intros e x y H H0. -inversion H; try (rewrite <- H2; rewrite H3 in H1). (* compat 8.0 *) -apply interpG_var. Step_final x. -apply interpG_zero. Step_final x. -apply interpG_plus with x0 y0; auto. Step_final x. -apply interpG_mult_int with x0; auto. Step_final x. -apply interpG_unop with x0; auto. Step_final x. -apply interpG_binop with x0 y0; auto. Step_final x. -apply interpG_part with x0 Hx; auto. Step_final x. +Proof. + intros e x y H H0. + inversion H; try (rewrite <- H2; rewrite H3 in H1). (* compat 8.0 *) + apply interpG_var. Step_final x. + apply interpG_zero. Step_final x. + apply interpG_plus with x0 y0; auto. Step_final x. + apply interpG_mult_int with x0; auto. Step_final x. + apply interpG_unop with x0; auto. Step_final x. + apply interpG_binop with x0 y0; auto. Step_final x. + apply interpG_part with x0 Hx; auto. Step_final x. Qed. End Group_Interpretation_Function. @@ -334,312 +258,273 @@ P: sorted on M, all M's not an I Lemma MI_mult_comm_int : forall k z : Z, MI_mult (expr_int k) (expr_int z) = MI_mult (expr_int z) (expr_int k). -simple induction z; - [ induction k as [| p| p] - | induction k as [| p| p] - | induction k as [| p| p] ]; simpl in |- *; auto; - intros; rewrite Pmult_comm; auto. +Proof. + simple induction z; [ induction k as [| p| p] | induction k as [| p| p] + | induction k as [| p| p] ]; simpl in |- *; auto; intros; rewrite Pmult_comm; auto. Qed. Opaque Zmult. Lemma MI_mult_corr_G : forall (e f : expr) (x : G), II (expr_mult e f) x -> II (MI_mult e f) x. -intro e; case e; simpl in |- *; auto. - -intros n f; case f; simpl in |- *; auto. -intro z; case z; simpl in |- *; auto. -intros. apply interpG_zero. inversion X. Step_final (zmult x0 0). - -intros z f; case f; simpl in |- *; auto. -intro z0; case z0; simpl in |- *; auto. - intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) - apply interpG_zero. Step_final (zmult x0 0). - intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) - inversion X0. try (rewrite <- H3; rewrite H5 in H4). (* compat 8.0 *) - rewrite Zmult_comm. rewrite <- Zmult_0_r_reverse. apply interpG_zero. - astepr (zmult (G:=G) Zero (Zpos p)). Step_final (zmult x0 (Zpos p)). -intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) -inversion X0. try (rewrite <- H3; rewrite H5 in H4). (* compat 8.0 *) -rewrite Zmult_comm. rewrite <- Zmult_0_r_reverse. apply interpG_zero. -astepr (zmult (G:=G) Zero (Zneg p)). Step_final (zmult x0 (Zneg p)). - -intros e0 e1 f; case f; simpl in |- *; auto. -intro z; case z; simpl in |- *; auto. -intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) -apply interpG_zero. Step_final (zmult x0 0). - -intros e0 e1 f; case f; simpl in |- *; auto; try (intros; inversion X; fail). -intro z; case z; simpl in |- *; auto. - intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) +Proof. + intro e; case e; simpl in |- *; auto. + intros n f; case f; simpl in |- *; auto. + intro z; case z; simpl in |- *; auto. + intros. apply interpG_zero. inversion X. Step_final (zmult x0 0). + intros z f; case f; simpl in |- *; auto. + intro z0; case z0; simpl in |- *; auto. + intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + apply interpG_zero. Step_final (zmult x0 0). + intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + inversion X0. try (rewrite <- H3; rewrite H5 in H4). (* compat 8.0 *) + rewrite Zmult_comm. rewrite <- Zmult_0_r_reverse. apply interpG_zero. + astepr (zmult (G:=G) Zero (Zpos p)). Step_final (zmult x0 (Zpos p)). + intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + inversion X0. try (rewrite <- H3; rewrite H5 in H4). (* compat 8.0 *) + rewrite Zmult_comm. rewrite <- Zmult_0_r_reverse. apply interpG_zero. + astepr (zmult (G:=G) Zero (Zneg p)). Step_final (zmult x0 (Zneg p)). + intros e0 e1 f; case f; simpl in |- *; auto. + intro z; case z; simpl in |- *; auto. + intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + apply interpG_zero. Step_final (zmult x0 0). + intros e0 e1 f; case f; simpl in |- *; auto; try (intros; inversion X; fail). + intro z; case z; simpl in |- *; auto. + intros. inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + apply interpG_zero. Step_final (zmult x0 0). + intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + inversion X0. try (rewrite H3 in X1; rewrite H4 in H6; rewrite <- H5). (* compat 8.0 *) + simpl in |- *; apply interpG_mult_int with x1; auto. + astepr (zmult x0 (Zpos p)). Step_final (zmult (zmult x1 k0) (Zpos p)). + intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + inversion X0. try (rewrite H3 in X1; rewrite H4 in H6; rewrite <- H5). (* compat 8.0 *) + simpl in |- *; apply interpG_mult_int with x1; auto. + astepr (zmult x0 (Zneg p)). Step_final (zmult (zmult x1 k0) (Zneg p)). + intros e0 e1 f; case f; simpl in |- *; auto. + intro z; case z; simpl in |- *; auto. + intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + apply interpG_zero. Step_final (zmult x0 0). + intros n e0 f x; case f; simpl in |- *; auto. + intro z; case z; simpl in |- *; auto. + intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + apply interpG_zero. Step_final (zmult x0 0). + intros n e0 e1 f x; case f; simpl in |- *; auto. + intro z; case z; simpl in |- *; auto. + intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) apply interpG_zero. Step_final (zmult x0 0). + intros n e0 f x; case f; simpl in |- *; auto. + intro z; case z; simpl in |- *; auto. intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) - inversion X0. try (rewrite H3 in X1; rewrite H4 in H6; rewrite <- H5). (* compat 8.0 *) - simpl in |- *; apply interpG_mult_int with x1; auto. - astepr (zmult x0 (Zpos p)). Step_final (zmult (zmult x1 k0) (Zpos p)). -intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) -inversion X0. try (rewrite H3 in X1; rewrite H4 in H6; rewrite <- H5). (* compat 8.0 *) -simpl in |- *; apply interpG_mult_int with x1; auto. -astepr (zmult x0 (Zneg p)). Step_final (zmult (zmult x1 k0) (Zneg p)). - -intros e0 e1 f; case f; simpl in |- *; auto. -intro z; case z; simpl in |- *; auto. -intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) -apply interpG_zero. Step_final (zmult x0 0). - -intros n e0 f x; case f; simpl in |- *; auto. -intro z; case z; simpl in |- *; auto. -intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) -apply interpG_zero. Step_final (zmult x0 0). - -intros n e0 e1 f x; case f; simpl in |- *; auto. -intro z; case z; simpl in |- *; auto. -intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) -apply interpG_zero. Step_final (zmult x0 0). - -intros n e0 f x; case f; simpl in |- *; auto. -intro z; case z; simpl in |- *; auto. -intros; inversion X. try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) -apply interpG_zero. Step_final (zmult x0 0). + apply interpG_zero. Step_final (zmult x0 0). Qed. Transparent Zmult. Opaque MI_mult. Lemma MV_mult_corr_G : forall (e f : expr) (x : G), II (expr_mult f e) x -> II (MV_mult e f) x. -intro e; case e; simpl in |- *; intros; inversion X. -try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) -apply MI_mult_corr_G. -apply interpG_mult_int with x0; auto. -unfold expr_one in |- *. apply interpG_mult_int with x0; algebra. +Proof. + intro e; case e; simpl in |- *; intros; inversion X. + try (rewrite H in X0; rewrite H1 in H2; rewrite H0 in H2). (* compat 8.0 *) + apply MI_mult_corr_G. + apply interpG_mult_int with x0; auto. + unfold expr_one in |- *. apply interpG_mult_int with x0; algebra. Qed. Opaque MV_mult. Lemma MM_mult_corr_G : forall (e f : expr) (x : G), II (expr_mult e f) x or II (expr_mult f e) x -> II (MM_mult e f) x. -intro e; case e; simpl in |- *; intros; elim X; clear X; intro X; inversion X; - try (rewrite H in X0; rewrite H0 in H2; rewrite <- H1). (* Compat 8.0 *) - -apply interpG_mult_int with x0; auto. - -rewrite MI_mult_comm_int. -apply MI_mult_corr_G. apply interpG_mult_int with x0; auto. - -apply MI_mult_corr_G. apply interpG_mult_int with x0; auto. - -apply interpG_mult_int with x0; auto. - -apply MV_mult_corr_G. -inversion X0. try (rewrite H3 in X1; rewrite <- H5; rewrite H4 in H6). (* compat 8.0 *) -replace (MM_mult (expr_int k0) (expr_int k)) with (expr_int (k0 * k)). - apply interpG_mult_int with x1; auto. - astepr (zmult x0 k). Step_final (zmult (zmult x1 k0) k). -simpl in |- *. case k0; auto; intros; rewrite Zmult_comm; auto. -inversion X0. - -apply interpG_mult_int with x0; auto. - -apply interpG_mult_int with x0; auto. - -apply interpG_mult_int with x0; auto. +Proof. + intro e; case e; simpl in |- *; intros; elim X; clear X; intro X; inversion X; + try (rewrite H in X0; rewrite H0 in H2; rewrite <- H1). (* Compat 8.0 *) + apply interpG_mult_int with x0; auto. + rewrite MI_mult_comm_int. + apply MI_mult_corr_G. apply interpG_mult_int with x0; auto. + apply MI_mult_corr_G. apply interpG_mult_int with x0; auto. + apply interpG_mult_int with x0; auto. + apply MV_mult_corr_G. + inversion X0. try (rewrite H3 in X1; rewrite <- H5; rewrite H4 in H6). (* compat 8.0 *) + replace (MM_mult (expr_int k0) (expr_int k)) with (expr_int (k0 * k)). + apply interpG_mult_int with x1; auto. + astepr (zmult x0 k). Step_final (zmult (zmult x1 k0) k). + simpl in |- *. case k0; auto; intros; rewrite Zmult_comm; auto. + inversion X0. + apply interpG_mult_int with x0; auto. + apply interpG_mult_int with x0; auto. + apply interpG_mult_int with x0; auto. Qed. Transparent MV_mult MI_mult. Opaque MV_mult. Lemma MM_plus_corr_G : forall (e f : expr) (x y : G), II e x -> II f y -> II (MM_plus e f) (x[+]y). -cut - (forall (i j : Z) (x y : G), - II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i + j)) (x[+]y)). -cut - (forall (e f : expr) (x y : G), - II e x -> II f y -> II (expr_plus e f) (x[+]y)). -intros H H0 e; elim e. -simpl in |- *; auto. -intros z f; elim f; simpl in |- *; auto. -simpl in |- *; auto. -intros e1 H1 e2 H2. -elim e1; simpl in |- *; auto. -intros n f. -elim f; simpl in |- *; auto. -intros f1 H3 f2 H4. -elim f1; simpl in |- *; auto. -intro m. -cut (eq_nat n m = true -> n = m). -elim (eq_nat n m); simpl in |- *; auto. -intros. inversion X. try (rewrite H6 in X1; rewrite <- H8; rewrite H7 in H9). (* compat 8.0 *) -inversion X0. try (rewrite H10 in X2; rewrite <- H12; rewrite H11 in H13). (* compat 8.0 *) -apply MV_mult_corr_G. -simpl in |- *. apply interpG_mult_int with x0; auto. -astepr (zmult x0 k[+]zmult x1 k0). -cut (x0[=]x1); intros. -Step_final (zmult x0 k[+]zmult x0 k0). -apply refl_interpG with val unop binop pfun (expr_var n). -assumption. -rewrite (H5 (refl_equal true)). assumption. -intros; apply eq_nat_corr; auto. - -intros u e0 H3 f. -elim f; simpl in |- *; auto. -intros e3 H4 e4 H5. -elim e3; simpl in |- *; auto. -intros u0 e5 H6. -cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> u = u0). -cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> e0 = e5). -elim andb; simpl in |- *; auto. -intros H' H''. intros. -inversion X. try (rewrite H7 in X1; rewrite <- H9; rewrite H8 in H10). -inversion X0. try (rewrite H11 in X2; rewrite <- H13; rewrite H12 in H14). -apply MV_mult_corr_G. -simpl in |- *. apply interpG_mult_int with x0; auto. -astepr (zmult x0 k[+]zmult x1 k0). -cut (x0[=]x1); intros. -Step_final (zmult x0 k[+]zmult x0 k0). -apply refl_interpG with val unop binop pfun (expr_unop u e0). -auto. rewrite H'. rewrite H''. auto. auto. auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. - -intros u e0 H3 e3 H4 f. -elim f; simpl in |- *; auto. -intros e4 H5 e5 H6. -elim e4; simpl in |- *; auto. -intros u0 e6 H7 e7 H8. -cut - (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> u = u0). -cut - (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e0 = e6). -cut - (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e3 = e7). -elim andb; simpl in |- *; auto. -intros H' H'' H'''. intros. -inversion X. try (rewrite H9 in X1; rewrite <- H11; rewrite H10 in H12). (* compat 8.0 *) -inversion X0. try (rewrite H13 in X2; rewrite <- H15; rewrite H14 in H16). (* compat 8.0 *) -apply MV_mult_corr_G. -simpl in |- *. apply interpG_mult_int with x0; auto. -astepr (zmult x0 k[+]zmult x1 k0). -cut (x0[=]x1); intros. -Step_final (zmult x0 k[+]zmult x0 k0). -apply refl_interpG with val unop binop pfun (expr_binop u e0 e3). -auto. rewrite H'. rewrite H''. rewrite H'''. auto. auto. auto. -auto. -intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. - apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. - apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H9); intros. apply eq_nat_corr; auto. - -intros u e0 H3 f. -elim f; simpl in |- *; auto. -intros e3 H4 e4 H5. -elim e3; simpl in |- *; auto. -intros u0 e5 H6. -cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> u = u0). -cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> e0 = e5). -elim andb; simpl in |- *; auto. -intros H' H''. intros. -inversion X. try (rewrite H7 in X1; rewrite <- H9; rewrite H8 in H10). (* compat 8.0 *) -inversion X0. try (rewrite H11 in X2; rewrite <- H13; rewrite H12 in H14). (* compat 8.0 *) -apply MV_mult_corr_G. -simpl in |- *. apply interpG_mult_int with x0; auto. -astepr (zmult x0 k[+]zmult x1 k0). -cut (x0[=]x1); intros. -Step_final (zmult x0 k[+]zmult x0 k0). -apply refl_interpG with val unop binop pfun (expr_part u e0). -auto. rewrite H'. rewrite H''. auto. auto. auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. - -intros. inversion X1. -intros u e0 H1 f. -elim f; simpl in |- *; auto. -intros u e0 H1 e1 H2 f. -elim f; simpl in |- *; auto. -intros u e0 H1 f. -elim f; simpl in |- *; auto. - -intros; apply interpG_plus with x y; algebra. -intros. inversion X. try (rewrite H1 in H0; rewrite <- H). (* compat 8.0 *) -inversion X0. try (rewrite <- H2; rewrite H4 in H3). (* compat 8.0 *) -simpl in |- *. apply interpG_zero. -Step_final ((Zero:G)[+]Zero). +Proof. + cut (forall (i j : Z) (x y : G), + II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i + j)) (x[+]y)). + cut (forall (e f : expr) (x y : G), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + intros H H0 e; elim e. + simpl in |- *; auto. + intros z f; elim f; simpl in |- *; auto. + simpl in |- *; auto. + intros e1 H1 e2 H2. + elim e1; simpl in |- *; auto. + intros n f. + elim f; simpl in |- *; auto. + intros f1 H3 f2 H4. + elim f1; simpl in |- *; auto. + intro m. + cut (eq_nat n m = true -> n = m). + elim (eq_nat n m); simpl in |- *; auto. + intros. inversion X. try (rewrite H6 in X1; rewrite <- H8; rewrite H7 in H9). (* compat 8.0 *) + inversion X0. try (rewrite H10 in X2; rewrite <- H12; rewrite H11 in H13). (* compat 8.0 *) + apply MV_mult_corr_G. + simpl in |- *. apply interpG_mult_int with x0; auto. + astepr (zmult x0 k[+]zmult x1 k0). + cut (x0[=]x1); intros. + Step_final (zmult x0 k[+]zmult x0 k0). + apply refl_interpG with val unop binop pfun (expr_var n). + assumption. + rewrite (H5 (refl_equal true)). assumption. + intros; apply eq_nat_corr; auto. + intros u e0 H3 f. + elim f; simpl in |- *; auto. + intros e3 H4 e4 H5. + elim e3; simpl in |- *; auto. + intros u0 e5 H6. + cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> u = u0). + cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> e0 = e5). + elim andb; simpl in |- *; auto. + intros H' H''. intros. + inversion X. try (rewrite H7 in X1; rewrite <- H9; rewrite H8 in H10). + inversion X0. try (rewrite H11 in X2; rewrite <- H13; rewrite H12 in H14). + apply MV_mult_corr_G. + simpl in |- *. apply interpG_mult_int with x0; auto. + astepr (zmult x0 k[+]zmult x1 k0). + cut (x0[=]x1); intros. + Step_final (zmult x0 k[+]zmult x0 k0). + apply refl_interpG with val unop binop pfun (expr_unop u e0). + auto. rewrite H'. rewrite H''. auto. auto. auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. + intros u e0 H3 e3 H4 f. + elim f; simpl in |- *; auto. + intros e4 H5 e5 H6. + elim e4; simpl in |- *; auto. + intros u0 e6 H7 e7 H8. + cut (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> u = u0). + cut (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e0 = e6). + cut (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e3 = e7). + elim andb; simpl in |- *; auto. + intros H' H'' H'''. intros. + inversion X. try (rewrite H9 in X1; rewrite <- H11; rewrite H10 in H12). (* compat 8.0 *) + inversion X0. try (rewrite H13 in X2; rewrite <- H15; rewrite H14 in H16). (* compat 8.0 *) + apply MV_mult_corr_G. + simpl in |- *. apply interpG_mult_int with x0; auto. + astepr (zmult x0 k[+]zmult x1 k0). + cut (x0[=]x1); intros. + Step_final (zmult x0 k[+]zmult x0 k0). + apply refl_interpG with val unop binop pfun (expr_binop u e0 e3). + auto. rewrite H'. rewrite H''. rewrite H'''. auto. auto. auto. + auto. + intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. + apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. + apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H9); intros. apply eq_nat_corr; auto. + intros u e0 H3 f. + elim f; simpl in |- *; auto. + intros e3 H4 e4 H5. + elim e3; simpl in |- *; auto. + intros u0 e5 H6. + cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> u = u0). + cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> e0 = e5). + elim andb; simpl in |- *; auto. + intros H' H''. intros. + inversion X. try (rewrite H7 in X1; rewrite <- H9; rewrite H8 in H10). (* compat 8.0 *) + inversion X0. try (rewrite H11 in X2; rewrite <- H13; rewrite H12 in H14). (* compat 8.0 *) + apply MV_mult_corr_G. + simpl in |- *. apply interpG_mult_int with x0; auto. + astepr (zmult x0 k[+]zmult x1 k0). + cut (x0[=]x1); intros. + Step_final (zmult x0 k[+]zmult x0 k0). + apply refl_interpG with val unop binop pfun (expr_part u e0). + auto. rewrite H'. rewrite H''. auto. auto. auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. + intros. inversion X1. + intros u e0 H1 f. + elim f; simpl in |- *; auto. + intros u e0 H1 e1 H2 f. + elim f; simpl in |- *; auto. + intros u e0 H1 f. + elim f; simpl in |- *; auto. + intros; apply interpG_plus with x y; algebra. + intros. inversion X. try (rewrite H1 in H0; rewrite <- H). (* compat 8.0 *) + inversion X0. try (rewrite <- H2; rewrite H4 in H3). (* compat 8.0 *) + simpl in |- *. apply interpG_zero. + Step_final ((Zero:G)[+]Zero). Qed. Transparent MV_mult. Opaque MM_plus. Lemma PM_plus_corr_G : forall (e f : expr) (x y : G), II e x -> II f y -> II (PM_plus e f) (x[+]y). -cut - (forall (e1 e2 f : expr) (x y : G), - (forall (f : expr) (x y : G), - II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (expr_plus e1 (PM_plus e2 f)) (x[+]y)). -cut - (forall (e1 e2 f : expr) (x y : G), - (forall (f : expr) (x y : G), - II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> - II (expr_plus e1 e2) x -> II f y -> II (PM_plus e2 (MM_plus e1 f)) (x[+]y)). -cut - (forall (e f : expr) (x y : G), II e x -> II f y -> II (MM_plus e f) (x[+]y)). -cut - (forall (e f : expr) (x y : G), - II e x -> II f y -> II (expr_plus e f) (x[+]y)). -cut - (forall (e f : expr) (x y : G), - II e x -> II f y -> II (expr_plus f e) (x[+]y)). -intros H H0 H1 H2 H3 e. elim e. -simpl in |- *; auto. -intros z f; elim f; intros; simpl in |- *; auto. -intros e1 H4 e2 H5 f. simpl in |- *. -elim (lt_monom e1 f); elim (eq_monom e1 f); elim f; intros; simpl in |- *; - auto. -simpl in |- *; auto. -simpl in |- *; auto. -simpl in |- *; auto. -simpl in |- *; auto. -simpl in |- *; auto. -intros; apply interpG_wd with (y[+]x); algebra. -apply interpG_plus with y x; algebra. -intros; apply interpG_plus with x y; algebra. -intros; apply MM_plus_corr_G; auto. -intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite <- H0). (* compat 8.0 *) -apply interpG_wd with (y0[+](x0[+]y)). -apply X; auto. -apply MM_plus_corr_G; auto. -astepl (y0[+]x0[+]y). -Step_final (x0[+]y0[+]y). -intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite <- H0). (* compat 8.0 *) -apply interpG_wd with (x0[+](y0[+]y)). -apply interpG_plus with x0 (y0[+]y); algebra. -Step_final (x0[+]y0[+]y). +Proof. + cut (forall (e1 e2 f : expr) (x y : G), (forall (f : expr) (x y : G), + II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> II (expr_plus e1 e2) x -> + II f y -> II (expr_plus e1 (PM_plus e2 f)) (x[+]y)). + cut (forall (e1 e2 f : expr) (x y : G), (forall (f : expr) (x y : G), + II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> + II (expr_plus e1 e2) x -> II f y -> II (PM_plus e2 (MM_plus e1 f)) (x[+]y)). + cut (forall (e f : expr) (x y : G), II e x -> II f y -> II (MM_plus e f) (x[+]y)). + cut (forall (e f : expr) (x y : G), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + cut (forall (e f : expr) (x y : G), II e x -> II f y -> II (expr_plus f e) (x[+]y)). + intros H H0 H1 H2 H3 e. elim e. + simpl in |- *; auto. + intros z f; elim f; intros; simpl in |- *; auto. + intros e1 H4 e2 H5 f. simpl in |- *. + elim (lt_monom e1 f); elim (eq_monom e1 f); elim f; intros; simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + intros; apply interpG_wd with (y[+]x); algebra. + apply interpG_plus with y x; algebra. + intros; apply interpG_plus with x y; algebra. + intros; apply MM_plus_corr_G; auto. + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite <- H0). (* compat 8.0 *) + apply interpG_wd with (y0[+](x0[+]y)). + apply X; auto. + apply MM_plus_corr_G; auto. + astepl (y0[+]x0[+]y). + Step_final (x0[+]y0[+]y). + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite <- H0). (* compat 8.0 *) + apply interpG_wd with (x0[+](y0[+]y)). + apply interpG_plus with x0 (y0[+]y); algebra. + Step_final (x0[+]y0[+]y). Qed. Transparent MM_plus. Opaque PM_plus. Lemma PP_plus_corr_G : forall (e f : expr) (x y : G), II e x -> II f y -> II (PP_plus e f) (x[+]y). -cut - (forall (e1 e2 f : expr) (x y : G), - (forall (f : expr) (x y : G), +Proof. + cut (forall (e1 e2 f : expr) (x y : G), (forall (f : expr) (x y : G), II e2 x -> II f y -> II (PP_plus e2 f) (x[+]y)) -> - II (expr_plus e1 e2) x -> II f y -> II (PM_plus (PP_plus e2 f) e1) (x[+]y)). -cut - (forall (i : Z) (f : expr) (x y : G), - II (expr_int i) x -> II f y -> II (PM_plus f (expr_int i)) (x[+]y)). -cut - (forall (e f : expr) (x y : G), - II e x -> II f y -> II (expr_plus e f) (x[+]y)). -intros H H0 H1 e. -elim e; intros; simpl in |- *; auto. -intros. apply interpG_plus with x y; algebra. -intros. apply interpG_wd with (y[+]x); algebra. -apply PM_plus_corr_G; auto. -intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite <- H0). (* compat 8.0 *) -apply interpG_wd with (y0[+]y[+]x0). -apply PM_plus_corr_G; auto. -astepl (x0[+](y0[+]y)). -Step_final (x0[+]y0[+]y). + II (expr_plus e1 e2) x -> II f y -> II (PM_plus (PP_plus e2 f) e1) (x[+]y)). + cut (forall (i : Z) (f : expr) (x y : G), + II (expr_int i) x -> II f y -> II (PM_plus f (expr_int i)) (x[+]y)). + cut (forall (e f : expr) (x y : G), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + intros H H0 H1 e. + elim e; intros; simpl in |- *; auto. + intros. apply interpG_plus with x y; algebra. + intros. apply interpG_wd with (y[+]x); algebra. + apply PM_plus_corr_G; auto. + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite <- H0). (* compat 8.0 *) + apply interpG_wd with (y0[+]y[+]x0). + apply PM_plus_corr_G; auto. + astepl (x0[+](y0[+]y)). + Step_final (x0[+]y0[+]y). Qed. Transparent PM_plus. @@ -647,174 +532,97 @@ Opaque PM_plus MM_mult MI_mult. Lemma PM_mult_corr_G : forall (e f : expr) (x : G), II (expr_mult e f) x or II (expr_mult f e) x -> II (PM_mult e f) x. -intro e; - induction e - as - [v| - z| - e1 - Hrece1 - e0 - Hrece0| - e1 - Hrece1 - e0 - Hrece0| - e1 - Hrece1 - e0 - Hrece0| - u - e - Hrece| - b - e1 - Hrece1 - e0 - Hrece0| - p - e - Hrece]; simpl in |- *; auto. - -intros f x H; elim H; clear H; intro H; inversion H. - try (rewrite H0 in X; rewrite <- H2; rewrite H1 in H3). (* compat 8.0 *) - apply interpG_mult_int with x0; auto. - -intros f x H; elim H; clear H; intro H; inversion H. - try (rewrite H0 in X; rewrite <- H2; rewrite H1 in H3). (* compat 8.0 *) - apply interpG_wd with (Zero[+]x); algebra. - apply PM_plus_corr_G. apply interpG_zero; algebra. - rewrite MI_mult_comm_int. - apply MI_mult_corr_G. apply interpG_mult_int with x0; auto. -apply interpG_wd with (Zero[+]x); algebra. -apply PM_plus_corr_G. apply interpG_zero; algebra. -apply MI_mult_corr_G. auto. - -intros f x H; elim H; clear H; intro H; inversion H. -try (rewrite H0 in X; rewrite <- H2; rewrite H1 in H3). (* compat 8.0 *) -inversion X. try (rewrite H4 in X0; rewrite H6 in X1; rewrite H5 in H7). (* compat 8.0 *) -apply interpG_wd with (zmult y k[+]zmult x1 k). - 2: astepl (zmult (y[+]x1) k); astepl (zmult (x1[+]y) k); - Step_final (zmult x0 k). -apply PM_plus_corr_G. - apply Hrece0. left. apply interpG_mult_int with y; algebra. -apply MM_mult_corr_G; left. -apply interpG_mult_int with x1; algebra. - -intros f x H; inversion H; simpl in |- *; auto. -inversion X. - -intros f x H; inversion H; simpl in |- *; auto. -inversion X. - -intros f x H; inversion H; simpl in |- *; auto. -inversion X. - -intros f x H; inversion H; simpl in |- *; auto. -inversion X. - -intros f x H; inversion H; simpl in |- *; auto. -inversion X. +Proof. + intro e; induction e as [v| z| e1 Hrece1 e0 Hrece0| e1 Hrece1 e0 Hrece0| e1 Hrece1 e0 Hrece0| u e + Hrece| b e1 Hrece1 e0 Hrece0| p e Hrece]; simpl in |- *; auto. + intros f x H; elim H; clear H; intro H; inversion H. + try (rewrite H0 in X; rewrite <- H2; rewrite H1 in H3). (* compat 8.0 *) + apply interpG_mult_int with x0; auto. + intros f x H; elim H; clear H; intro H; inversion H. + try (rewrite H0 in X; rewrite <- H2; rewrite H1 in H3). (* compat 8.0 *) + apply interpG_wd with (Zero[+]x); algebra. + apply PM_plus_corr_G. apply interpG_zero; algebra. + rewrite MI_mult_comm_int. + apply MI_mult_corr_G. apply interpG_mult_int with x0; auto. + apply interpG_wd with (Zero[+]x); algebra. + apply PM_plus_corr_G. apply interpG_zero; algebra. + apply MI_mult_corr_G. auto. + intros f x H; elim H; clear H; intro H; inversion H. + try (rewrite H0 in X; rewrite <- H2; rewrite H1 in H3). (* compat 8.0 *) + inversion X. try (rewrite H4 in X0; rewrite H6 in X1; rewrite H5 in H7). (* compat 8.0 *) + apply interpG_wd with (zmult y k[+]zmult x1 k). + 2: astepl (zmult (y[+]x1) k); astepl (zmult (x1[+]y) k); Step_final (zmult x0 k). + apply PM_plus_corr_G. + apply Hrece0. left. apply interpG_mult_int with y; algebra. + apply MM_mult_corr_G; left. + apply interpG_mult_int with x1; algebra. + intros f x H; inversion H; simpl in |- *; auto. + inversion X. + intros f x H; inversion H; simpl in |- *; auto. + inversion X. + intros f x H; inversion H; simpl in |- *; auto. + inversion X. + intros f x H; inversion H; simpl in |- *; auto. + inversion X. + intros f x H; inversion H; simpl in |- *; auto. + inversion X. Qed. Opaque PM_mult. Lemma PP_mult_corr_G : forall (e f : expr) (x : G), II (expr_mult e f) x -> II (PP_mult e f) x. -intro e; - induction e - as - [v| - z| - e1 - Hrece1 - e0 - Hrece0| - e1 - Hrece1 - e0 - Hrece0| - e1 - Hrece1 - e0 - Hrece0| - u - e - Hrece| - b - e1 - Hrece1 - e0 - Hrece0| - p - e - Hrece]; simpl in |- *; auto. - -intros f x H. -apply PM_mult_corr_G; auto. - -intros f x H. inversion H. try (rewrite H0 in X; rewrite <- H2; rewrite <- H1). (* compat 8.0 *) -inversion X. try (rewrite H4 in X0; rewrite H6 in X1; rewrite H5 in H7). (* compat 8.0 *) -apply interpG_wd with (zmult x1 k[+]zmult y k). - 2: astepl (zmult (x1[+]y) k); Step_final (zmult x0 k). -apply PP_plus_corr_G. - apply PM_mult_corr_G; right. apply interpG_mult_int with x1; algebra. -apply Hrece0. apply interpG_mult_int with y; algebra. +Proof. + intro e; induction e as [v| z| e1 Hrece1 e0 Hrece0| e1 Hrece1 e0 Hrece0| e1 Hrece1 e0 Hrece0| u e + Hrece| b e1 Hrece1 e0 Hrece0| p e Hrece]; simpl in |- *; auto. + intros f x H. + apply PM_mult_corr_G; auto. + intros f x H. inversion H. try (rewrite H0 in X; rewrite <- H2; rewrite <- H1). (* compat 8.0 *) + inversion X. try (rewrite H4 in X0; rewrite H6 in X1; rewrite H5 in H7). (* compat 8.0 *) + apply interpG_wd with (zmult x1 k[+]zmult y k). + 2: astepl (zmult (x1[+]y) k); Step_final (zmult x0 k). + apply PP_plus_corr_G. + apply PM_mult_corr_G; right. apply interpG_mult_int with x1; algebra. + apply Hrece0. apply interpG_mult_int with y; algebra. Qed. Lemma NormG_corr_G : forall (e : expr) (x : G), II e x -> II (NormG e) x. -intro; elim e; intros; simpl in |- *. -apply - (interpG_plus G val unop binop pfun (expr_mult (expr_var v) expr_one) - expr_zero x (Zero:G) x). -algebra. -apply (interpG_mult_int G val unop binop pfun (expr_var v) 1 x); algebra. -apply interpG_zero; algebra. -auto. -inversion X1. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) - apply interpG_wd with (x0[+]y). apply PP_plus_corr_G; auto. auto. -inversion X1. try (rewrite H in X2; rewrite <- H1; rewrite H0 in H2). (* compat 8.0 *) - simpl in |- *. apply interpG_wd with (zmult x0 k). -apply PP_mult_corr_G. apply interpG_mult_int with x0; algebra. auto. -auto. - -inversion X0. try (rewrite H in H2; rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) -apply - (interpG_plus G val unop binop pfun - (expr_mult (expr_unop u (NormG e0)) expr_one) expr_zero x ( - Zero:G) x). -algebra. -apply (interpG_mult_int G val unop binop pfun (expr_unop u (NormG e0)) 1 x); - algebra. -apply (interpG_unop G val unop binop pfun (NormG e0) u x0); algebra. -apply interpG_zero; algebra. - -inversion X1. try (rewrite H in H3; rewrite H1 in X2; rewrite H2 in X3; rewrite H0 in H3). (* compat 8.0 *) -apply - (interpG_plus G val unop binop pfun - (expr_mult (expr_binop b (NormG e0) (NormG e1)) expr_one) expr_zero x - (Zero:G) x). -algebra. -apply - (interpG_mult_int G val unop binop pfun (expr_binop b (NormG e0) (NormG e1)) - 1 x); algebra. -apply (interpG_binop G val unop binop pfun (NormG e0) (NormG e1) b x0 y); - algebra. -apply interpG_zero; algebra. - -inversion X0. - (* circumvent inversion bug in Type in coq 8.0 *) - try ((generalize Hx H2; clear Hx H2; rewrite H; intros Hx H2); - rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) -apply - (interpG_plus G val unop binop pfun - (expr_mult (expr_part p (NormG e0)) expr_one) expr_zero x ( - Zero:G) x). -algebra. -apply (interpG_mult_int G val unop binop pfun (expr_part p (NormG e0)) 1 x); - algebra. -apply (interpG_part G val unop binop pfun (NormG e0) p x0) with (Hx := Hx); - algebra. -apply interpG_zero; algebra. +Proof. + intro; elim e; intros; simpl in |- *. + apply (interpG_plus G val unop binop pfun (expr_mult (expr_var v) expr_one) expr_zero x (Zero:G) x). + algebra. + apply (interpG_mult_int G val unop binop pfun (expr_var v) 1 x); algebra. + apply interpG_zero; algebra. + auto. + inversion X1. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpG_wd with (x0[+]y). apply PP_plus_corr_G; auto. auto. + inversion X1. try (rewrite H in X2; rewrite <- H1; rewrite H0 in H2). (* compat 8.0 *) + simpl in |- *. apply interpG_wd with (zmult x0 k). + apply PP_mult_corr_G. apply interpG_mult_int with x0; algebra. auto. + auto. + inversion X0. try (rewrite H in H2; rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) + apply (interpG_plus G val unop binop pfun (expr_mult (expr_unop u (NormG e0)) expr_one) expr_zero x ( + Zero:G) x). + algebra. + apply (interpG_mult_int G val unop binop pfun (expr_unop u (NormG e0)) 1 x); algebra. + apply (interpG_unop G val unop binop pfun (NormG e0) u x0); algebra. + apply interpG_zero; algebra. + inversion X1. try (rewrite H in H3; rewrite H1 in X2; rewrite H2 in X3; rewrite H0 in H3). (* compat 8.0 *) + apply (interpG_plus G val unop binop pfun + (expr_mult (expr_binop b (NormG e0) (NormG e1)) expr_one) expr_zero x (Zero:G) x). + algebra. + apply (interpG_mult_int G val unop binop pfun (expr_binop b (NormG e0) (NormG e1)) 1 x); algebra. + apply (interpG_binop G val unop binop pfun (NormG e0) (NormG e1) b x0 y); algebra. + apply interpG_zero; algebra. + inversion X0. + (* circumvent inversion bug in Type in coq 8.0 *) + try ((generalize Hx H2; clear Hx H2; rewrite H; intros Hx H2); + rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) + apply (interpG_plus G val unop binop pfun (expr_mult (expr_part p (NormG e0)) expr_one) expr_zero x ( + Zero:G) x). + algebra. + apply (interpG_mult_int G val unop binop pfun (expr_part p (NormG e0)) 1 x); algebra. + apply (interpG_part G val unop binop pfun (NormG e0) p x0) with (Hx := Hx); algebra. + apply interpG_zero; algebra. Qed. Lemma Tactic_lemmaG : @@ -822,11 +630,12 @@ Lemma Tactic_lemmaG : (f : xexprG G val unop binop pfun y), eq_expr (NormG (xforgetG _ _ _ _ _ _ e)) (NormG (xforgetG _ _ _ _ _ _ f)) = true -> x[=]y. -intros x y e f H. -apply refl_interpG with val unop binop pfun (NormG (xforgetG _ _ _ _ _ _ e)). -apply NormG_corr_G; apply xexprG2interpG. -rewrite (eq_expr_corr _ _ H). -apply NormG_corr_G; apply xexprG2interpG. +Proof. + intros x y e f H. + apply refl_interpG with val unop binop pfun (NormG (xforgetG _ _ _ _ _ _ e)). + apply NormG_corr_G; apply xexprG2interpG. + rewrite (eq_expr_corr _ _ H). + apply NormG_corr_G; apply xexprG2interpG. Qed. End Group_NormCorrect. @@ -839,78 +648,78 @@ match l with let c := constr:(fun n:binopindex => (Mnth n bl (@csg_op G))) in let d := constr:(fun n:pfunindex => (Mnth n pl (total_eq_part _ (@cg_inv G)))) in match t with - | (csbf_fun _ _ _ csg_op ?x ?y) => + | (csbf_fun _ _ _ csg_op ?x ?y) => let x' := QuoteG G l x in let y' := QuoteG G l y in constr:(xexprG_plus G a b c d _ _ x' y') | (Zero) => constr:(xexprG_zero G a b c d) - | (csf_fun _ _ cg_inv ?x) => + | (csf_fun _ _ cg_inv ?x) => let x' := QuoteG G l x in constr:(xexprG_inv G a b c d _ x') - | (cg_minus ?x ?y) => + | (cg_minus ?x ?y) => let x' := QuoteG G l x in let y' := QuoteG G l y in constr:(xexprG_minus G a b c d _ _ x' y') - | (zmult ?x ?n) => + | (zmult ?x ?n) => match (ClosedZ n) with | true => let x' := QuoteG G l x in constr:(xexprG_mult_int G a b c d _ n x') end - | (pfpfun ?f ?x ?h) => + | (pfpfun ?f ?x ?h) => let x' := QuoteG G l x in let i := FindIndex f pl in - constr:(xexprG_part G a b c d _ i x' h) - | (csf_fun _ _ ?f ?x) => + constr:(xexprG_part G a b c d _ i x' h) + | (csf_fun _ _ ?f ?x) => let x' := QuoteG G l x in let i := FindIndex f ul in - constr:(xexprG_unop G a b c d _ i x') - | (csbf_fun _ _ _ ?f ?x ?y) => + constr:(xexprG_unop G a b c d _ i x') + | (csbf_fun _ _ _ ?f ?x ?y) => let x' := QuoteG G l x in let y' := QuoteG G l y in let i := FindIndex f bl in - constr:(xexprG_binop G a b c d _ _ i x' y') - | ?t => - let i := FindIndex t vl in + constr:(xexprG_binop G a b c d _ _ i x' y') + | ?t => + let i := FindIndex t vl in constr:(xexprG_var G a b c d i) end) end. -Ltac FindTermVariablesG t l := +Ltac FindTermVariablesG t l := match t with -| (csbf_fun _ _ _ csg_op ?x ?y) => +| (csbf_fun _ _ _ csg_op ?x ?y) => let l1 := FindTermVariablesG x l in let l2 := FindTermVariablesG y l1 in constr:l2 | (Zero) => constr:l -| (csf_fun _ _ cg_inv ?x) => +| (csf_fun _ _ cg_inv ?x) => let l1 := FindTermVariablesG x l in constr:l1 -| (cg_minus ?x ?y) => +| (cg_minus ?x ?y) => let l1 := FindTermVariablesG x l in let l2 := FindTermVariablesG y l1 in constr:l2 -| (zmult ?x ?n) => +| (zmult ?x ?n) => match (ClosedZ n) with | true => let l1 := FindTermVariablesG x l in constr:l1 end -| (pfpfun ?f ?x ?h) => +| (pfpfun ?f ?x ?h) => let l1 := FindTermVariablesG x l in match l1 with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad vl ul bl (Mcons f pl)) end -| (csf_fun _ _ ?f ?x) => +| (csf_fun _ _ ?f ?x) => let l1 := FindTermVariablesG x l in match l1 with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad vl (Mcons f ul) bl pl) end -| (csbf_fun _ _ _ ?f ?x ?y) => +| (csbf_fun _ _ _ ?f ?x ?y) => let l1 := FindTermVariablesG x l in let l2 := FindTermVariablesG y l1 in match l2 with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad vl ul (Mcons f bl) pl) end -| ?t => match l with +| ?t => match l with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad (Mcons t vl) ul bl pl) end end. @@ -920,10 +729,10 @@ Ltac FindTermsVariablesG fn t1 t2 := let l2 := FindTermVariablesG t2 l1 in constr:l2. -Ltac rationalG G x y := +Ltac rationalG G x y := let l:=FindTermsVariablesG G x y in - let t1:=(QuoteG G l x) in - let t2:=(QuoteG G l y) in + let t1:=(QuoteG G l x) in + let t2:=(QuoteG G l y) in eapply Tactic_lemmaG with (e:=t1) (f:=t2) ; reflexivity. (* end hide *) diff --git a/tactics/Rational.v b/tactics/Rational.v index 6b6931ec0..f72c7b764 100644 --- a/tactics/Rational.v +++ b/tactics/Rational.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export FieldReflection. Require Export RingReflection. Require Export GroupReflection. @@ -43,7 +43,7 @@ Inductive AlgebraName : Type := |cabgroup : CAbGroup -> AlgebraName. Ltac GetStructureName t := -match t with +match t with | (csg_crr (cm_crr (cg_crr (cag_crr ?s)))) => match s with | (cr_crr ?r) => @@ -55,10 +55,10 @@ match t with end end. -Ltac rational := +Ltac rational := match goal with -[|-@cs_eq (cs_crr ?T) ?x ?y] => - match GetStructureName T with +[|-@cs_eq (cs_crr ?T) ?x ?y] => + match GetStructureName T with |(cfield ?F) => rationalF F x y |(cring ?R) => rationalR R x y |(cabgroup ?G) => rationalG G x y diff --git a/tactics/RingReflection.v b/tactics/RingReflection.v index 1ba29ec2d..43fa89b92 100644 --- a/tactics/RingReflection.v +++ b/tactics/RingReflection.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) Require Export CRings. @@ -111,50 +111,31 @@ Fixpoint xforgetR (x:R) (e:xexprR x) {struct e} : expr := Definition xinterpR (x:R) (e:xexprR x) := x. Lemma xexprR2interpR : forall (x:R) (e:xexprR x), interpR (xforgetR _ e) x. -intros x e. -induction e. - -apply (interpR_var i); algebra. - -apply (interpR_int k); algebra. - -apply (interpR_plus (xforgetR _ e1) (xforgetR _ e2) x y (x[+]y)); algebra. - -apply (interpR_mult (xforgetR _ e1) (xforgetR _ e2) x y (x[*]y)); algebra. - -apply (interpR_unop (xforgetR _ e) f x (unop f x)); algebra. - -apply (interpR_binop (xforgetR _ e1) (xforgetR _ e2) f x y (binop f x y)); - algebra. - -eapply (interpR_part (xforgetR _ e) f x (pfun f x Hx)). - apply eq_reflexive_unfolded. -algebra. - -apply (interpR_int 0); algebra. - -apply (interpR_int 1); Step_final (One:R). - -apply (interpR_int (Z_of_nat n)); algebra. - -apply (interpR_mult (xforgetR _ e) (expr_int (-1)) x (zring (-1)) [--]x); - auto. -Step_final (zring (-1)[*]x). -apply (interpR_int (-1)); algebra. - -apply - (interpR_plus (xforgetR _ e1) (xforgetR _ (xexprR_inv _ e2)) x [--]y (x[-]y)); - algebra. -apply (interpR_mult (xforgetR _ e2) (expr_int (-1)) y (zring (-1)) [--]y); - auto. -Step_final (zring (-1)[*]y). -apply (interpR_int (-1)); algebra. - -induction n. - apply (interpR_int 1); Step_final (One:R). -apply - (interpR_mult (xforgetR _ e) (expr_power n (xforgetR _ e)) x ( - x[^]n) (x[^]S n)); algebra. +Proof. + intros x e. + induction e. + apply (interpR_var i); algebra. + apply (interpR_int k); algebra. + apply (interpR_plus (xforgetR _ e1) (xforgetR _ e2) x y (x[+]y)); algebra. + apply (interpR_mult (xforgetR _ e1) (xforgetR _ e2) x y (x[*]y)); algebra. + apply (interpR_unop (xforgetR _ e) f x (unop f x)); algebra. + apply (interpR_binop (xforgetR _ e1) (xforgetR _ e2) f x y (binop f x y)); algebra. + eapply (interpR_part (xforgetR _ e) f x (pfun f x Hx)). + apply eq_reflexive_unfolded. + algebra. + apply (interpR_int 0); algebra. + apply (interpR_int 1); Step_final (One:R). + apply (interpR_int (Z_of_nat n)); algebra. + apply (interpR_mult (xforgetR _ e) (expr_int (-1)) x (zring (-1)) [--]x); auto. + Step_final (zring (-1)[*]x). + apply (interpR_int (-1)); algebra. + apply (interpR_plus (xforgetR _ e1) (xforgetR _ (xexprR_inv _ e2)) x [--]y (x[-]y)); algebra. + apply (interpR_mult (xforgetR _ e2) (expr_int (-1)) y (zring (-1)) [--]y); auto. + Step_final (zring (-1)[*]y). + apply (interpR_int (-1)); algebra. + induction n. + apply (interpR_int 1); Step_final (One:R). + apply (interpR_mult (xforgetR _ e) (expr_power n (xforgetR _ e)) x ( x[^]n) (x[^]S n)); algebra. Qed. Definition xexprR_diagram_commutes : @@ -162,9 +143,10 @@ Definition xexprR_diagram_commutes : xexprR2interpR. Lemma xexprR2wfR : forall (x:R) (e:xexprR x), wfR (xforgetR _ e). -intros x e. -exists x. -apply xexprR2interpR. +Proof. + intros x e. + exists x. + apply xexprR2interpR. Qed. Record fexprR : Type := {finterpR : R; fexprR2xexprR : xexprR finterpR}. @@ -183,16 +165,18 @@ Definition fexprR_mult (e e':fexprR) := Definition fforgetR (e:fexprR) := xforgetR (finterpR e) (fexprR2xexprR e). Lemma fexprR2interp : forall e:fexprR, interpR (fforgetR e) (finterpR e). -intros e. -elim e. intros x e'. -unfold fforgetR in |- *. simpl in |- *. -apply xexprR2interpR. +Proof. + intros e. + elim e. intros x e'. + unfold fforgetR in |- *. simpl in |- *. + apply xexprR2interpR. Qed. Lemma fexprR2wf : forall e:fexprR, wfR (fforgetR e). -intro e. -unfold fforgetR in |- *. -apply xexprR2wfR. +Proof. + intro e. + unfold fforgetR in |- *. + apply xexprR2wfR. Qed. Opaque csg_crr. @@ -215,63 +199,56 @@ Opaque nexp_op. Lemma refl_interpR : forall (e:expr) (x y:R), interpR e x -> interpR e y -> x[=]y. -intro e. -induction e. - -intros x y Hx Hy. -inversion Hx. -inversion Hy. -Step_final (val v). - -intros x y Hx Hy. -inversion Hx. -inversion Hy. -Step_final (zring z:R). - -intros x y H1 H2. -inversion H1. -inversion H2. -astepl (x0[+]y0). -Step_final (x1[+]y1). - -intros x y H1 H2. -inversion H1. -inversion H2. -astepl (x0[*]y0). -Step_final (x1[*]y1). - -intros x y H0 H1. -inversion H0. - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (unop u x0); Step_final (unop u x1). - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (binop b x0 y0); Step_final (binop b x1 y1). - -intros x y H0 H1. -inversion H0. -inversion H1. -astepl (pfun p x0 Hx); Step_final (pfun p x1 Hx0). +Proof. + intro e. + induction e. + intros x y Hx Hy. + inversion Hx. + inversion Hy. + Step_final (val v). + intros x y Hx Hy. + inversion Hx. + inversion Hy. + Step_final (zring z:R). + intros x y H1 H2. + inversion H1. + inversion H2. + astepl (x0[+]y0). + Step_final (x1[+]y1). + intros x y H1 H2. + inversion H1. + inversion H2. + astepl (x0[*]y0). + Step_final (x1[*]y1). + intros x y H0 H1. + inversion H0. + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (unop u x0); Step_final (unop u x1). + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (binop b x0 y0); Step_final (binop b x1 y1). + intros x y H0 H1. + inversion H0. + inversion H1. + astepl (pfun p x0 Hx); Step_final (pfun p x1 Hx0). Qed. Lemma interpR_wd : forall (e:expr) (x y:R), interpR e x -> (x[=]y) -> interpR e y. -intros e x y H H0. -inversion H; - (* inversion bug fixed in V8.1 makes these rewritings useless *) - try (rewrite <- H2; rewrite H3 in H1). -apply interpR_var. Step_final x. -apply interpR_int. Step_final x. -apply interpR_plus with x0 y0; auto. Step_final x. -apply interpR_mult with x0 y0; auto. Step_final x. -apply interpR_unop with x0; auto. Step_final x. -apply interpR_binop with x0 y0; auto. Step_final x. -apply interpR_part with x0 Hx; auto. Step_final x. +Proof. + intros e x y H H0. + inversion H; (* inversion bug fixed in V8.1 makes these rewritings useless *) + try (rewrite <- H2; rewrite H3 in H1). + apply interpR_var. Step_final x. + apply interpR_int. Step_final x. + apply interpR_plus with x0 y0; auto. Step_final x. + apply interpR_mult with x0 y0; auto. Step_final x. + apply interpR_unop with x0; auto. Step_final x. + apply interpR_binop with x0 y0; auto. Step_final x. + apply interpR_part with x0 Hx; auto. Step_final x. Qed. End Ring_Interpretation_Function. @@ -303,402 +280,366 @@ P: sorted on M, all M's not an I Opaque Zmult. Lemma MI_mult_corr_R : forall (e f:expr) (x y:R), II e x -> II f y -> II (MI_mult e f) (x[*]y). -cut (forall x y:R, II (expr_int 0) y -> II (expr_int 0) (x[*]y)). -cut - (forall (e1 e2 f:expr) (x y:R), +Proof. + cut (forall x y:R, II (expr_int 0) y -> II (expr_int 0) (x[*]y)). + cut (forall (e1 e2 f:expr) (x y:R), (forall (f:expr) (x y:R), II e2 x -> II f y -> II (MI_mult e2 f) (x[*]y)) -> - II (expr_mult e1 e2) x -> - II f y -> II (expr_mult e1 (MI_mult e2 f)) (x[*]y)). -cut - (forall (i j:Z) (x y:R), - II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i * j)) (x[*]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -simple induction e; simple induction f; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z0; induction z; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -induction f; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z0; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -simple induction z; simpl in |- *; auto. -intros; apply interpR_mult with x y; algebra. -intros; apply interpR_wd with (zring (i * j):R). -apply interpR_int; algebra. -inversion X. inversion X0. -Step_final (zring i[*]zring j:R). -intros. inversion X0. + II (expr_mult e1 e2) x -> II f y -> II (expr_mult e1 (MI_mult e2 f)) (x[*]y)). + cut (forall (i j:Z) (x y:R), + II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i * j)) (x[*]y)). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + simple induction e; simple induction f; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z0; induction z; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + induction f; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z0; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + simple induction z; simpl in |- *; auto. + intros; apply interpR_mult with x y; algebra. + intros; apply interpR_wd with (zring (i * j):R). + apply interpR_int; algebra. + inversion X. inversion X0. + Step_final (zring i[*]zring j:R). + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpR_wd with (x0[*](y0[*]y)); algebra. -apply interpR_mult with x0 (y0[*]y); algebra. -Step_final (x0[*]y0[*]y). -intros. inversion X. - try (rewrite H in H0; rewrite H1 in H0). (* compat 8.0 *) -apply interpR_wd with (zring 0:R). -apply interpR_int; algebra. -astepl (Zero:R). -astepl (x[*]Zero). -Step_final (x[*]zring 0). + apply interpR_wd with (x0[*](y0[*]y)); algebra. + apply interpR_mult with x0 (y0[*]y); algebra. + Step_final (x0[*]y0[*]y). + intros. inversion X. + try (rewrite H in H0; rewrite H1 in H0). (* compat 8.0 *) + apply interpR_wd with (zring 0:R). + apply interpR_int; algebra. + astepl (Zero:R). + astepl (x[*]Zero). + Step_final (x[*]zring 0). Qed. Transparent Zmult. Opaque MI_mult. Lemma MV_mult_corr_R : forall (e f:expr) (x y:R), II e x -> II f y -> II (MV_mult e f) (x[*]y). -cut - (forall (e1 e2 f:expr) (x y:R), - (forall (f:expr) (x y:R), II e2 x -> II f y -> II (MV_mult e2 f) (x[*]y)) -> - II (expr_mult e1 e2) x -> - II f y -> II (expr_mult e1 (MV_mult e2 f)) (x[*]y)). -cut - (forall (e f:expr) (x y:R), - II e x -> II f y -> II (MI_mult (expr_mult f expr_one) e) (x[*]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult f e) (x[*]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -intros H H0 H1 H2 e. elim e. -simpl in |- *; auto. -simpl in |- *; auto. -intros e1 H3 e2 H4. -elim e1; simpl in |- *; auto. -intros e1 H3 e2 H4. -elim e1; simpl in |- *; auto. -intros n f. -elim f; simpl in |- *; auto. -intro m. -elim (lt_nat n m); simpl in |- *; auto. -intros u e0 H5 f. -elim f; simpl in |- *; auto. -intros u0 e3 H6. -elim lt_nat; simpl in |- *; auto. -elim andb; simpl in |- *; auto. -intros b e0 H6 e3 H7 f. -elim f; simpl in |- *; auto. -intros b0 e4 H8 e5 H9. -elim lt_nat; simpl in |- *; auto. -elim andb; simpl in |- *; auto. -elim andb; simpl in |- *; auto. -intros n f H5 f0. -elim f0; simpl in |- *; auto. -intros f1 e0 H6. -elim lt_nat; simpl in |- *; auto. -elim andb; simpl in |- *; auto. -intros. inversion X1. -intros n e0 H3 f. -elim f; simpl in |- *; auto. -intros n e0 H3 e1 H4 f. -elim f; simpl in |- *; auto. -intros n e0 H3 f. -elim f; simpl in |- *; auto. -intros; apply interpR_mult with x y; algebra. -intros; apply interpR_wd with (y[*]x); algebra. -apply interpR_mult with y x; algebra. -intros; apply interpR_wd with (y[*]One[*]x). -apply MI_mult_corr_R; auto. -apply interpR_mult with y (One:R); algebra. -apply (interpR_int R val unop binop pfun 1); algebra. -Step_final (x[*](y[*]One)). -intros. inversion X0. - try (rewrite H0 in H2; rewrite H in X2; rewrite H1 in X3). (* compat 8.0 *) -apply interpR_wd with (x0[*](y0[*]y)). -apply interpR_mult with x0 (y0[*]y); algebra. -Step_final (x0[*]y0[*]y). +Proof. + cut (forall (e1 e2 f:expr) (x y:R), + (forall (f:expr) (x y:R), II e2 x -> II f y -> II (MV_mult e2 f) (x[*]y)) -> + II (expr_mult e1 e2) x -> II f y -> II (expr_mult e1 (MV_mult e2 f)) (x[*]y)). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (MI_mult (expr_mult f expr_one) e) (x[*]y)). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult f e) (x[*]y)). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + intros H H0 H1 H2 e. elim e. + simpl in |- *; auto. + simpl in |- *; auto. + intros e1 H3 e2 H4. + elim e1; simpl in |- *; auto. + intros e1 H3 e2 H4. + elim e1; simpl in |- *; auto. + intros n f. + elim f; simpl in |- *; auto. + intro m. + elim (lt_nat n m); simpl in |- *; auto. + intros u e0 H5 f. + elim f; simpl in |- *; auto. + intros u0 e3 H6. + elim lt_nat; simpl in |- *; auto. + elim andb; simpl in |- *; auto. + intros b e0 H6 e3 H7 f. + elim f; simpl in |- *; auto. + intros b0 e4 H8 e5 H9. + elim lt_nat; simpl in |- *; auto. + elim andb; simpl in |- *; auto. + elim andb; simpl in |- *; auto. + intros n f H5 f0. + elim f0; simpl in |- *; auto. + intros f1 e0 H6. + elim lt_nat; simpl in |- *; auto. + elim andb; simpl in |- *; auto. + intros. inversion X1. + intros n e0 H3 f. + elim f; simpl in |- *; auto. + intros n e0 H3 e1 H4 f. + elim f; simpl in |- *; auto. + intros n e0 H3 f. + elim f; simpl in |- *; auto. + intros; apply interpR_mult with x y; algebra. + intros; apply interpR_wd with (y[*]x); algebra. + apply interpR_mult with y x; algebra. + intros; apply interpR_wd with (y[*]One[*]x). + apply MI_mult_corr_R; auto. + apply interpR_mult with y (One:R); algebra. + apply (interpR_int R val unop binop pfun 1); algebra. + Step_final (x[*](y[*]One)). + intros. inversion X0. + try (rewrite H0 in H2; rewrite H in X2; rewrite H1 in X3). (* compat 8.0 *) + apply interpR_wd with (x0[*](y0[*]y)). + apply interpR_mult with x0 (y0[*]y); algebra. + Step_final (x0[*]y0[*]y). Qed. Transparent MI_mult. Opaque MV_mult MI_mult. Lemma MM_mult_corr_R : forall (e f:expr) (x y:R), II e x -> II f y -> II (MM_mult e f) (x[*]y). -cut - (forall (e1 e2 f:expr) (x y:R), - (forall (f:expr) (x y:R), II e2 x -> II f y -> II (MM_mult e2 f) (x[*]y)) -> - II (expr_mult e1 e2) x -> - II f y -> II (MV_mult (MM_mult e2 f) e1) (x[*]y)). -cut - (forall (i:Z) (f:expr) (x y:R), +Proof. + cut (forall (e1 e2 f:expr) (x y:R), + (forall (f:expr) (x y:R), II e2 x -> II f y -> II (MM_mult e2 f) (x[*]y)) -> + II (expr_mult e1 e2) x -> II f y -> II (MV_mult (MM_mult e2 f) e1) (x[*]y)). + cut (forall (i:Z) (f:expr) (x y:R), II (expr_int i) x -> II f y -> II (MI_mult f (expr_int i)) (x[*]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -intros H H0 H1 e. -elim e; intros; simpl in |- *; auto. -intros; apply interpR_mult with x y; algebra. -intros; apply interpR_wd with (y[*]x); algebra. -apply MI_mult_corr_R; auto. -intros. inversion X0. - try (rewrite H0 in H2; rewrite H in X2; rewrite H1 in X3). (* compat 8.0 *) -apply interpR_wd with (y0[*]y[*]x0). -apply MV_mult_corr_R; auto. -astepl (x0[*](y0[*]y)). -Step_final (x0[*]y0[*]y). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + intros H H0 H1 e. + elim e; intros; simpl in |- *; auto. + intros; apply interpR_mult with x y; algebra. + intros; apply interpR_wd with (y[*]x); algebra. + apply MI_mult_corr_R; auto. + intros. inversion X0. + try (rewrite H0 in H2; rewrite H in X2; rewrite H1 in X3). (* compat 8.0 *) + apply interpR_wd with (y0[*]y[*]x0). + apply MV_mult_corr_R; auto. + astepl (x0[*](y0[*]y)). + Step_final (x0[*]y0[*]y). Qed. Transparent MV_mult MI_mult. Opaque MV_mult. Lemma MM_plus_corr_R : forall (e f:expr) (x y:R), II e x -> II f y -> II (MM_plus e f) (x[+]y). -cut - (forall (i j:Z) (x y:R), - II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i + j)) (x[+]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_plus e f) (x[+]y)). -intros H H0 e; elim e. -simpl in |- *; auto. -intros z f; elim f; simpl in |- *; auto. -simpl in |- *; auto. -intros e1 H1 e2 H2. -elim e1; simpl in |- *; auto. -intros n f. -elim f; simpl in |- *; auto. -intros f1 H3 f2 H4. -elim f1; simpl in |- *; auto. -intro m. -cut (eq_nat n m = true -> n = m). -elim (eq_nat n m); simpl in |- *; auto. -intros. inversion X. - try (rewrite H6 in X1; rewrite H8 in X2; rewrite H7 in H9). (* compat 8.0 *) -inversion X0. - try (rewrite H10 in X3; rewrite H12 in X4; rewrite H11 in H13). (* compat 8.0 *) -apply interpR_wd with ((y0[+]y1)[*]x0). -apply MV_mult_corr_R; auto. -astepl (x0[*](y0[+]y1)). -astepl (x0[*]y0[+]x0[*]y1). -cut (x0[=]x1). intro. -Step_final (x0[*]y0[+]x1[*]y1). -apply refl_interpR with val unop binop pfun (expr_var n). -assumption. -rewrite (H5 (refl_equal true)). assumption. -intros; apply eq_nat_corr; auto. - -intros u e0 H3 f. -elim f; simpl in |- *; auto. -intros e3 H4 e4 H5. -elim e3; simpl in |- *; auto. -intros u0 e5 H6. -cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> u = u0). -cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> e0 = e5). -elim andb; simpl in |- *; auto. -intros H' H''. intros. -inversion X. - try (rewrite -> H7 in X1; rewrite H9 in X2; rewrite H8 in H10). (* compat 8.0 *) -inversion X0. - try (rewrite H11 in X3; rewrite H13 in X4; rewrite H12 in H14). (* compat 8.0 *) -apply interpR_wd with ((y0[+]y1)[*]x0). -apply MV_mult_corr_R; auto. -astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). -apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. -apply refl_interpR with val unop binop pfun (expr_unop u e0). -auto. rewrite H'. rewrite H''. auto. auto. auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. - -intros u e0 H3 e3 H4 f. -elim f; simpl in |- *; auto. -intros e4 H5 e5 H6. -elim e4; simpl in |- *; auto. -intros u0 e6 H7 e7 H8. -cut - (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> u = u0). -cut - (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e0 = e6). -cut - (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e3 = e7). -elim andb; simpl in |- *; auto. -intros H' H'' H'''. intros. -inversion X. - try (rewrite H9 in X1; rewrite H11 in X2; rewrite H10 in H12). (* compat 8.0 *) -inversion X0. - try (rewrite H13 in X3; rewrite H15 in X4; rewrite H14 in H16). (* compat 8.0 *) -apply interpR_wd with ((y0[+]y1)[*]x0). -apply MV_mult_corr_R; auto. -astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). -apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. -apply refl_interpR with val unop binop pfun (expr_binop u e0 e3). -auto. rewrite H'. rewrite H''. rewrite H'''. auto. auto. auto. -auto. -intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. - apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. - apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H9); intros. apply eq_nat_corr; auto. - -intros f e0 H3. -intro f0. -elim f0; simpl in |- *; auto. -intros e3 H4 e4 H5. -elim e3; simpl in |- *; auto. -intros f1 e5 H6. -cut (andb (eq_nat f f1) (eq_expr e0 e5) = true -> f = f1). -cut (andb (eq_nat f f1) (eq_expr e0 e5) = true -> e0 = e5). -elim (andb (eq_nat f f1) (eq_expr e0 e5)); simpl in |- *; auto. -intros. -inversion X. - try (rewrite H9 in X1; rewrite H11 in X2; rewrite H10 in H12). (* compat 8.0 *) -inversion X0. - try (rewrite H13 in X3; rewrite H15 in X4; rewrite H14 in H16). (* compat 8.0 *) -apply interpR_wd with ((y0[+]y1)[*]x0). -apply MV_mult_corr_R; auto. -astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). -apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. -apply refl_interpR with val unop binop pfun (expr_part f e0). -auto. rewrite H7. rewrite H8; auto. auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. -intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. -simpl in |- *; auto. - -intros u e0 H1 f. -elim f; simpl in |- *; auto. -intros u e0 H1 e1 H2 f. -elim f; simpl in |- *; auto. -intros u e0 H1 f. -elim f; simpl in |- *; auto. - -intros; apply interpR_plus with x y; algebra. -intros. inversion X. - try (rewrite H1 in H0; rewrite H in H0). (* compat 8.0 *) -inversion X0. - try (rewrite H2 in H3; rewrite H4 in H3). (* compat 8.0 *) -apply interpR_wd with (zring (i + j):R). -apply interpR_int; algebra. -Step_final (zring i[+]zring j:R). +Proof. + cut (forall (i j:Z) (x y:R), + II (expr_int i) x -> II (expr_int j) y -> II (expr_int (i + j)) (x[+]y)). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + intros H H0 e; elim e. + simpl in |- *; auto. + intros z f; elim f; simpl in |- *; auto. + simpl in |- *; auto. + intros e1 H1 e2 H2. + elim e1; simpl in |- *; auto. + intros n f. + elim f; simpl in |- *; auto. + intros f1 H3 f2 H4. + elim f1; simpl in |- *; auto. + intro m. + cut (eq_nat n m = true -> n = m). + elim (eq_nat n m); simpl in |- *; auto. + intros. inversion X. + try (rewrite H6 in X1; rewrite H8 in X2; rewrite H7 in H9). (* compat 8.0 *) + inversion X0. + try (rewrite H10 in X3; rewrite H12 in X4; rewrite H11 in H13). (* compat 8.0 *) + apply interpR_wd with ((y0[+]y1)[*]x0). + apply MV_mult_corr_R; auto. + astepl (x0[*](y0[+]y1)). + astepl (x0[*]y0[+]x0[*]y1). + cut (x0[=]x1). intro. + Step_final (x0[*]y0[+]x1[*]y1). + apply refl_interpR with val unop binop pfun (expr_var n). + assumption. + rewrite (H5 (refl_equal true)). assumption. + intros; apply eq_nat_corr; auto. + intros u e0 H3 f. + elim f; simpl in |- *; auto. + intros e3 H4 e4 H5. + elim e3; simpl in |- *; auto. + intros u0 e5 H6. + cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> u = u0). + cut (andb (eq_nat u u0) (eq_expr e0 e5) = true -> e0 = e5). + elim andb; simpl in |- *; auto. + intros H' H''. intros. + inversion X. + try (rewrite -> H7 in X1; rewrite H9 in X2; rewrite H8 in H10). (* compat 8.0 *) + inversion X0. + try (rewrite H11 in X3; rewrite H13 in X4; rewrite H12 in H14). (* compat 8.0 *) + apply interpR_wd with ((y0[+]y1)[*]x0). + apply MV_mult_corr_R; auto. + astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). + apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. + apply refl_interpR with val unop binop pfun (expr_unop u e0). + auto. rewrite H'. rewrite H''. auto. auto. auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. + intros u e0 H3 e3 H4 f. + elim f; simpl in |- *; auto. + intros e4 H5 e5 H6. + elim e4; simpl in |- *; auto. + intros u0 e6 H7 e7 H8. + cut (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> u = u0). + cut (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e0 = e6). + cut (andb (eq_nat u u0) (andb (eq_expr e0 e6) (eq_expr e3 e7)) = true -> e3 = e7). + elim andb; simpl in |- *; auto. + intros H' H'' H'''. intros. + inversion X. + try (rewrite H9 in X1; rewrite H11 in X2; rewrite H10 in H12). (* compat 8.0 *) + inversion X0. + try (rewrite H13 in X3; rewrite H15 in X4; rewrite H14 in H16). (* compat 8.0 *) + apply interpR_wd with ((y0[+]y1)[*]x0). + apply MV_mult_corr_R; auto. + astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). + apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. + apply refl_interpR with val unop binop pfun (expr_binop u e0 e3). + auto. rewrite H'. rewrite H''. rewrite H'''. auto. auto. auto. + auto. + intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. + apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H9); intros. elim (andb_prop _ _ H11); intros. + apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H9); intros. apply eq_nat_corr; auto. + intros f e0 H3. + intro f0. + elim f0; simpl in |- *; auto. + intros e3 H4 e4 H5. + elim e3; simpl in |- *; auto. + intros f1 e5 H6. + cut (andb (eq_nat f f1) (eq_expr e0 e5) = true -> f = f1). + cut (andb (eq_nat f f1) (eq_expr e0 e5) = true -> e0 = e5). + elim (andb (eq_nat f f1) (eq_expr e0 e5)); simpl in |- *; auto. + intros. + inversion X. + try (rewrite H9 in X1; rewrite H11 in X2; rewrite H10 in H12). (* compat 8.0 *) + inversion X0. + try (rewrite H13 in X3; rewrite H15 in X4; rewrite H14 in H16). (* compat 8.0 *) + apply interpR_wd with ((y0[+]y1)[*]x0). + apply MV_mult_corr_R; auto. + astepr (x0[*]y0[+]x1[*]y1). astepl (y0[*]x0[+]y1[*]x0). + apply bin_op_wd_unfolded. algebra. astepr (y1[*]x1). apply mult_wdr. + apply refl_interpR with val unop binop pfun (expr_part f e0). + auto. rewrite H7. rewrite H8; auto. auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_expr_corr; auto. + intro. elim (andb_prop _ _ H7); intros. apply eq_nat_corr; auto. + simpl in |- *; auto. + intros u e0 H1 f. + elim f; simpl in |- *; auto. + intros u e0 H1 e1 H2 f. + elim f; simpl in |- *; auto. + intros u e0 H1 f. + elim f; simpl in |- *; auto. + intros; apply interpR_plus with x y; algebra. + intros. inversion X. + try (rewrite H1 in H0; rewrite H in H0). (* compat 8.0 *) + inversion X0. + try (rewrite H2 in H3; rewrite H4 in H3). (* compat 8.0 *) + apply interpR_wd with (zring (i + j):R). + apply interpR_int; algebra. + Step_final (zring i[+]zring j:R). Qed. Transparent MV_mult. Opaque MM_plus. Lemma PM_plus_corr_R : forall (e f:expr) (x y:R), II e x -> II f y -> II (PM_plus e f) (x[+]y). -cut - (forall (e1 e2 f:expr) (x y:R), - (forall (f:expr) (x y:R), II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (expr_plus e1 (PM_plus e2 f)) (x[+]y)). -cut - (forall (e1 e2 f:expr) (x y:R), +Proof. + cut (forall (e1 e2 f:expr) (x y:R), + (forall (f:expr) (x y:R), II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> + II (expr_plus e1 e2) x -> II f y -> II (expr_plus e1 (PM_plus e2 f)) (x[+]y)). + cut (forall (e1 e2 f:expr) (x y:R), (forall (f:expr) (x y:R), II e2 x -> II f y -> II (PM_plus e2 f) (x[+]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (PM_plus e2 (MM_plus e1 f)) (x[+]y)). -cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (MM_plus e f) (x[+]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_plus e f) (x[+]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_plus f e) (x[+]y)). -intros H H0 H1 H2 H3 e. elim e. -simpl in |- *; auto. -intros z f; elim f; intros; simpl in |- *; auto. -intros e1 H4 e2 H5 f. simpl in |- *. -elim (lt_monom e1 f); elim (eq_monom e1 f); elim f; intros; simpl in |- *; - auto. -simpl in |- *; auto. -simpl in |- *; auto. -simpl in |- *; auto. -simpl in |- *; auto. -simpl in |- *; auto. -intros; apply interpR_wd with (y[+]x); algebra. -apply interpR_plus with y x; algebra. -intros; apply interpR_plus with x y; algebra. -intros; apply MM_plus_corr_R; auto. -intros. inversion X0. + II (expr_plus e1 e2) x -> II f y -> II (PM_plus e2 (MM_plus e1 f)) (x[+]y)). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (MM_plus e f) (x[+]y)). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_plus f e) (x[+]y)). + intros H H0 H1 H2 H3 e. elim e. + simpl in |- *; auto. + intros z f; elim f; intros; simpl in |- *; auto. + intros e1 H4 e2 H5 f. simpl in |- *. + elim (lt_monom e1 f); elim (eq_monom e1 f); elim f; intros; simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + simpl in |- *; auto. + intros; apply interpR_wd with (y[+]x); algebra. + apply interpR_plus with y x; algebra. + intros; apply interpR_plus with x y; algebra. + intros; apply MM_plus_corr_R; auto. + intros. inversion X0. try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpR_wd with (y0[+](x0[+]y)). -apply X; auto. -apply MM_plus_corr_R; auto. -astepl (y0[+]x0[+]y). -Step_final (x0[+]y0[+]y). -intros. inversion X0. - try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpR_wd with (x0[+](y0[+]y)). -apply interpR_plus with x0 (y0[+]y); algebra. -Step_final (x0[+]y0[+]y). + apply interpR_wd with (y0[+](x0[+]y)). + apply X; auto. + apply MM_plus_corr_R; auto. + astepl (y0[+]x0[+]y). + Step_final (x0[+]y0[+]y). + intros. inversion X0. + try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpR_wd with (x0[+](y0[+]y)). + apply interpR_plus with x0 (y0[+]y); algebra. + Step_final (x0[+]y0[+]y). Qed. Transparent MM_plus. Opaque PM_plus. Lemma PP_plus_corr_R : forall (e f:expr) (x y:R), II e x -> II f y -> II (PP_plus e f) (x[+]y). -cut - (forall (e1 e2 f:expr) (x y:R), - (forall (f:expr) (x y:R), II e2 x -> II f y -> II (PP_plus e2 f) (x[+]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (PM_plus (PP_plus e2 f) e1) (x[+]y)). -cut - (forall (i:Z) (f:expr) (x y:R), +Proof. + cut (forall (e1 e2 f:expr) (x y:R), + (forall (f:expr) (x y:R), II e2 x -> II f y -> II (PP_plus e2 f) (x[+]y)) -> + II (expr_plus e1 e2) x -> II f y -> II (PM_plus (PP_plus e2 f) e1) (x[+]y)). + cut (forall (i:Z) (f:expr) (x y:R), II (expr_int i) x -> II f y -> II (PM_plus f (expr_int i)) (x[+]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_plus e f) (x[+]y)). -intros H H0 H1 e. -elim e; intros; simpl in |- *; auto. -intros. apply interpR_plus with x y; algebra. -intros. apply interpR_wd with (y[+]x); algebra. -apply PM_plus_corr_R; auto. -intros. inversion X0. - try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpR_wd with (y0[+]y[+]x0). -apply PM_plus_corr_R; auto. -astepl (x0[+](y0[+]y)). -Step_final (x0[+]y0[+]y). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_plus e f) (x[+]y)). + intros H H0 H1 e. + elim e; intros; simpl in |- *; auto. + intros. apply interpR_plus with x y; algebra. + intros. apply interpR_wd with (y[+]x); algebra. + apply PM_plus_corr_R; auto. + intros. inversion X0. + try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpR_wd with (y0[+]y[+]x0). + apply PM_plus_corr_R; auto. + astepl (x0[+](y0[+]y)). + Step_final (x0[+]y0[+]y). Qed. Transparent PM_plus. Opaque PM_plus MM_mult MI_mult. Lemma PM_mult_corr_R : forall (e f:expr) (x y:R), II e x -> II f y -> II (PM_mult e f) (x[*]y). -cut - (forall (e1 e2 f:expr) (x y:R), - (forall (f:expr) (x y:R), II e2 x -> II f y -> II (PM_mult e2 f) (x[*]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (PM_plus (PM_mult e2 f) (MM_mult e1 f)) (x[*]y)). -cut - (forall (i:Z) (f:expr) (x y:R), - II (expr_int i) x -> +Proof. + cut (forall (e1 e2 f:expr) (x y:R), + (forall (f:expr) (x y:R), II e2 x -> II f y -> II (PM_mult e2 f) (x[*]y)) -> + II (expr_plus e1 e2) x -> II f y -> II (PM_plus (PM_mult e2 f) (MM_mult e1 f)) (x[*]y)). + cut (forall (i:Z) (f:expr) (x y:R), II (expr_int i) x -> II f y -> II (PM_plus (expr_int 0) (MI_mult f (expr_int i))) (x[*]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -intros H H0 H1 e. -elim e; intros; simpl in |- *; auto. -intros. apply interpR_mult with x y; algebra. -intros. apply interpR_wd with (zring 0[+]y[*]x). -apply PM_plus_corr_R. -apply interpR_int; algebra. -apply MI_mult_corr_R; auto. -astepl (Zero[+]y[*]x). -Step_final (y[*]x). -intros. inversion X0. - try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpR_wd with (y0[*]y[+]x0[*]y). -apply PM_plus_corr_R; auto. -apply MM_mult_corr_R; auto. -astepl ((y0[+]x0)[*]y). -Step_final ((x0[+]y0)[*]y). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + intros H H0 H1 e. + elim e; intros; simpl in |- *; auto. + intros. apply interpR_mult with x y; algebra. + intros. apply interpR_wd with (zring 0[+]y[*]x). + apply PM_plus_corr_R. + apply interpR_int; algebra. + apply MI_mult_corr_R; auto. + astepl (Zero[+]y[*]x). + Step_final (y[*]x). + intros. inversion X0. + try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpR_wd with (y0[*]y[+]x0[*]y). + apply PM_plus_corr_R; auto. + apply MM_mult_corr_R; auto. + astepl ((y0[+]x0)[*]y). + Step_final ((x0[+]y0)[*]y). Qed. Opaque PM_mult. Lemma PP_mult_corr_R : forall (e f:expr) (x y:R), II e x -> II f y -> II (PP_mult e f) (x[*]y). -cut - (forall (e1 e2 f:expr) (x y:R), - (forall (f:expr) (x y:R), II e2 x -> II f y -> II (PP_mult e2 f) (x[*]y)) -> - II (expr_plus e1 e2) x -> - II f y -> II (PP_plus (PM_mult f e1) (PP_mult e2 f)) (x[*]y)). -cut - (forall (i:Z) (f:expr) (x y:R), +Proof. + cut (forall (e1 e2 f:expr) (x y:R), + (forall (f:expr) (x y:R), II e2 x -> II f y -> II (PP_mult e2 f) (x[*]y)) -> + II (expr_plus e1 e2) x -> II f y -> II (PP_plus (PM_mult f e1) (PP_mult e2 f)) (x[*]y)). + cut (forall (i:Z) (f:expr) (x y:R), II (expr_int i) x -> II f y -> II (PM_mult f (expr_int i)) (x[*]y)). -cut - (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). -intros H H0 H1 e. -elim e; intros; simpl in |- *; auto. -intros. apply interpR_mult with x y; algebra. -intros. apply interpR_wd with (y[*]x); algebra. -apply PM_mult_corr_R; auto. -intros. inversion X0. - try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) -apply interpR_wd with (y[*]x0[+]y0[*]y). -apply PP_plus_corr_R; auto. -apply PM_mult_corr_R; auto. -astepl (x0[*]y[+]y0[*]y). -Step_final ((x0[+]y0)[*]y). + cut (forall (e f:expr) (x y:R), II e x -> II f y -> II (expr_mult e f) (x[*]y)). + intros H H0 H1 e. + elim e; intros; simpl in |- *; auto. + intros. apply interpR_mult with x y; algebra. + intros. apply interpR_wd with (y[*]x); algebra. + apply PM_mult_corr_R; auto. + intros. inversion X0. + try (rewrite H in X2; rewrite H1 in X3; rewrite H0 in H2). (* compat 8.0 *) + apply interpR_wd with (y[*]x0[+]y0[*]y). + apply PP_plus_corr_R; auto. + apply PM_mult_corr_R; auto. + astepl (x0[*]y[+]y0[*]y). + Step_final ((x0[+]y0)[*]y). Qed. (* @@ -762,74 +703,51 @@ Qed. *) Lemma NormR_corr : forall (e:expr) (x:R), II e x -> II (NormR e) x. -intro; induction e; intros; simpl in |- *. - -apply - (interpR_plus R val unop binop pfun (expr_mult (expr_var v) expr_one) - expr_zero x (Zero:R) x). -algebra. -apply (interpR_mult R val unop binop pfun (expr_var v) expr_one x (One:R) x); - algebra. -apply (interpR_int R val unop binop pfun 1); algebra. -apply (interpR_int R val unop binop pfun 0); algebra. - -assumption. - -inversion X. - try (rewrite H in X0; rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) - apply interpR_wd with (x0[+]y). apply PP_plus_corr_R; auto. auto. - -inversion X. - try (rewrite H in X0; rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) - apply interpR_wd with (x0[*]y). apply PP_mult_corr_R; auto. auto. - -assumption. - -inversion X. - try (rewrite H in H2; rewrite H1 in X0; rewrite H0 in H2). (* compat 8.0 *) -apply - (interpR_plus R val unop binop pfun - (expr_mult (expr_unop u (NormR e)) expr_one) expr_zero x ( - Zero:R) x). -algebra. -apply - (interpR_mult R val unop binop pfun (expr_unop u (NormR e)) expr_one x - (One:R) x); algebra. -apply (interpR_unop R val unop binop pfun (NormR e) u x0); algebra. -apply (interpR_int R val unop binop pfun 1); algebra. -apply (interpR_int R val unop binop pfun 0); algebra. - -inversion X. +Proof. + intro; induction e; intros; simpl in |- *. + apply (interpR_plus R val unop binop pfun (expr_mult (expr_var v) expr_one) expr_zero x (Zero:R) x). + algebra. + apply (interpR_mult R val unop binop pfun (expr_var v) expr_one x (One:R) x); algebra. + apply (interpR_int R val unop binop pfun 1); algebra. + apply (interpR_int R val unop binop pfun 0); algebra. + assumption. + inversion X. + try (rewrite H in X0; rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) + apply interpR_wd with (x0[+]y). apply PP_plus_corr_R; auto. auto. + inversion X. + try (rewrite H in X0; rewrite H1 in X1; rewrite H0 in H2). (* compat 8.0 *) + apply interpR_wd with (x0[*]y). apply PP_mult_corr_R; auto. auto. + assumption. + inversion X. + try (rewrite H in H2; rewrite H1 in X0; rewrite H0 in H2). (* compat 8.0 *) + apply (interpR_plus R val unop binop pfun (expr_mult (expr_unop u (NormR e)) expr_one) expr_zero x ( + Zero:R) x). + algebra. + apply (interpR_mult R val unop binop pfun (expr_unop u (NormR e)) expr_one x (One:R) x); algebra. + apply (interpR_unop R val unop binop pfun (NormR e) u x0); algebra. + apply (interpR_int R val unop binop pfun 1); algebra. + apply (interpR_int R val unop binop pfun 0); algebra. + inversion X. (* compat 8.0 *) try (rewrite H in H3; rewrite H1 in X0; rewrite H2 in X1; rewrite H0 in H3). -apply - (interpR_plus R val unop binop pfun - (expr_mult (expr_binop b (NormR e1) (NormR e2)) expr_one) expr_zero x - (Zero:R) x). -algebra. -apply - (interpR_mult R val unop binop pfun (expr_binop b (NormR e1) (NormR e2)) - expr_one x (One:R) x); algebra. -apply (interpR_binop R val unop binop pfun (NormR e1) (NormR e2) b x0 y); - algebra. -apply (interpR_int R val unop binop pfun 1); algebra. -apply (interpR_int R val unop binop pfun 0); algebra. - -inversion X. - try ((generalize Hx H2; clear Hx H2; rewrite H; intros Hx H2); - rewrite H1 in X0; rewrite H0 in H2). (* compat 8.0 *) -apply - (interpR_plus R val unop binop pfun - (expr_mult (expr_part p (NormR e)) expr_one) expr_zero x ( - Zero:R) x). -algebra. -apply - (interpR_mult R val unop binop pfun (expr_part p (NormR e)) expr_one x - (One:R) x); algebra. -apply (interpR_part R val unop binop pfun (NormR e) p x0) with (Hx := Hx); - algebra. -apply (interpR_int R val unop binop pfun 1); algebra. -apply (interpR_int R val unop binop pfun 0); algebra. + apply (interpR_plus R val unop binop pfun + (expr_mult (expr_binop b (NormR e1) (NormR e2)) expr_one) expr_zero x (Zero:R) x). + algebra. + apply (interpR_mult R val unop binop pfun (expr_binop b (NormR e1) (NormR e2)) + expr_one x (One:R) x); algebra. + apply (interpR_binop R val unop binop pfun (NormR e1) (NormR e2) b x0 y); algebra. + apply (interpR_int R val unop binop pfun 1); algebra. + apply (interpR_int R val unop binop pfun 0); algebra. + inversion X. + try ((generalize Hx H2; clear Hx H2; rewrite H; intros Hx H2); + rewrite H1 in X0; rewrite H0 in H2). (* compat 8.0 *) + apply (interpR_plus R val unop binop pfun (expr_mult (expr_part p (NormR e)) expr_one) expr_zero x ( + Zero:R) x). + algebra. + apply (interpR_mult R val unop binop pfun (expr_part p (NormR e)) expr_one x (One:R) x); algebra. + apply (interpR_part R val unop binop pfun (NormR e) p x0) with (Hx := Hx); algebra. + apply (interpR_int R val unop binop pfun 1); algebra. + apply (interpR_int R val unop binop pfun 0); algebra. Qed. Lemma Tactic_lemmaR : @@ -837,11 +755,12 @@ Lemma Tactic_lemmaR : (f:xexprR R val unop binop pfun y), eq_expr (NormR (xforgetR _ _ _ _ _ _ e)) (NormR (xforgetR _ _ _ _ _ _ f)) = true -> x[=]y. -intros x y e f H. -apply refl_interpR with val unop binop pfun (NormR (xforgetR _ _ _ _ _ _ e)). -apply NormR_corr; apply xexprR2interpR. -rewrite (eq_expr_corr _ _ H). -apply NormR_corr; apply xexprR2interpR. +Proof. + intros x y e f H. + apply refl_interpR with val unop binop pfun (NormR (xforgetR _ _ _ _ _ _ e)). + apply NormR_corr; apply xexprR2interpR. + rewrite (eq_expr_corr _ _ H). + apply NormR_corr; apply xexprR2interpR. Qed. End Ring_NormCorrect. @@ -858,11 +777,11 @@ match l with match (ClosedZ k) with | true => constr:(xexprR_int R a b c d k) end - | (csbf_fun _ _ _ csg_op ?x ?y) => + | (csbf_fun _ _ _ csg_op ?x ?y) => let x' := QuoteR R l x in let y' := QuoteR R l y in constr:(xexprR_plus R a b c d _ _ x' y') - | (csbf_fun _ _ _ cr_mult ?x ?y) => + | (csbf_fun _ _ _ cr_mult ?x ?y) => let x' := QuoteR R l x in let y' := QuoteR R l y in constr:(xexprR_mult R a b c d _ _ x' y') @@ -872,86 +791,86 @@ match l with match (ClosedNat n) with | true => constr:(xexprR_nat R a b c d n) end - | (csf_fun _ _ cg_inv ?x) => + | (csf_fun _ _ cg_inv ?x) => let x' := QuoteR R l x in constr:(xexprR_inv R a b c d _ x') - | (cg_minus ?x ?y) => + | (cg_minus ?x ?y) => let x' := QuoteR R l x in let y' := QuoteR R l y in constr:(xexprR_minus R a b c d _ _ x' y') - | (csf_fun _ _ (@nexp_op _ ?n) ?x) => + | (csf_fun _ _ (@nexp_op _ ?n) ?x) => match (ClosedNat n) with | true => let x' := QuoteR R l x in constr:(xexprR_power R a b c d _ x' n) end - | (pfpfun ?f ?x ?h) => + | (pfpfun ?f ?x ?h) => let x' := QuoteR R l x in let i := FindIndex f pl in - constr:(xexprR_part R a b c d _ i x' h) - | (csf_fun _ _ ?f ?x) => + constr:(xexprR_part R a b c d _ i x' h) + | (csf_fun _ _ ?f ?x) => let x' := QuoteR R l x in let i := FindIndex f ul in - constr:(xexprR_unop R a b c d _ i x') - | (csbf_fun _ _ _ ?f ?x ?y) => + constr:(xexprR_unop R a b c d _ i x') + | (csbf_fun _ _ _ ?f ?x ?y) => let x' := QuoteR R l x in let y' := QuoteR R l y in let i := FindIndex f bl in - constr:(xexprR_binop R a b c d _ _ i x' y') - | ?t => - let i := FindIndex t vl in + constr:(xexprR_binop R a b c d _ _ i x' y') + | ?t => + let i := FindIndex t vl in constr:(xexprR_var R a b c d i) end) end. -Ltac FindTermVariablesR t l := +Ltac FindTermVariablesR t l := match t with | (zring ?k) => match (ClosedZ k) with | true => constr:l end -| (csbf_fun _ _ _ csg_op ?x ?y) => +| (csbf_fun _ _ _ csg_op ?x ?y) => let l1 := FindTermVariablesR x l in let l2 := FindTermVariablesR y l1 in constr:l2 -| (csbf_fun _ _ _ cr_mult ?x ?y) => +| (csbf_fun _ _ _ cr_mult ?x ?y) => let l1 := FindTermVariablesR x l in let l2 := FindTermVariablesR y l1 in constr:l2 | (Zero) => constr:l | (One) => constr:l -| (nring ?n) => +| (nring ?n) => match (ClosedNat n) with | true => constr:l end -| (csf_fun _ _ cg_inv ?x) => +| (csf_fun _ _ cg_inv ?x) => let l1 := FindTermVariablesR x l in constr:l1 -| (cg_minus ?x ?y) => +| (cg_minus ?x ?y) => let l1 := FindTermVariablesR x l in let l2 := FindTermVariablesR y l1 in constr:l2 -| (csf_fun _ _ (@nexp_op _ ?n) ?x) => +| (csf_fun _ _ (@nexp_op _ ?n) ?x) => match (ClosedNat n) with | true => let l1 := FindTermVariablesR x l in constr:l1 end -| (pfpfun ?f ?x ?h) => +| (pfpfun ?f ?x ?h) => let l1 := FindTermVariablesR x l in match l1 with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad vl ul bl (Mcons f pl)) end -| (csf_fun _ _ ?f ?x) => +| (csf_fun _ _ ?f ?x) => let l1 := FindTermVariablesR x l in match l1 with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad vl (Mcons f ul) bl pl) end -| (csbf_fun _ _ _ ?f ?x ?y) => +| (csbf_fun _ _ _ ?f ?x ?y) => let l1 := FindTermVariablesR x l in let l2 := FindTermVariablesR y l1 in match l2 with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad vl ul (Mcons f bl) pl) end -| ?t => match l with +| ?t => match l with (Quad ?vl ?ul ?bl ?pl) => constr:(Quad (Mcons t vl) ul bl pl) end end. @@ -961,10 +880,10 @@ Ltac FindTermsVariablesR fn t1 t2 := let l2 := FindTermVariablesR t2 l1 in constr:l2. -Ltac rationalR R x y := +Ltac rationalR R x y := let l:=FindTermsVariablesR R x y in - let t1:=(QuoteR R l x) in - let t2:=(QuoteR R l y) in + let t1:=(QuoteR R l x) in + let t2:=(QuoteR R l y) in eapply Tactic_lemmaR with (e:=t1) (f:=t2) ; reflexivity. diff --git a/tactics/Step.v b/tactics/Step.v index a52ea61f8..1488beb9b 100644 --- a/tactics/Step.v +++ b/tactics/Step.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (* begin hide *) Ltac algebra := auto with algebra_r algebra algebra_c algebra_s. diff --git a/tactics/csetoid_rewrite.v b/tactics/csetoid_rewrite.v index 22708e928..3e06ca05a 100644 --- a/tactics/csetoid_rewrite.v +++ b/tactics/csetoid_rewrite.v @@ -18,27 +18,27 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) -(** 200904: first experimental version submitted to corn; +(** 200904: first experimental version submitted to corn; things need to be improved and cleaned up!; hendriks@cs.ru.nl *) -(* -110204: renamed setoid_rewrite into csetoid_rewrite -in order to avoid name clashes with setoid_rewrite +(* +110204: renamed setoid_rewrite into csetoid_rewrite +in order to avoid name clashes with setoid_rewrite in Coq's initial environment. *) @@ -50,105 +50,102 @@ Lemma csr_wd : forall (S:CSetoid) (R:CSetoid_relation S) (x1 x2 y1 y2:S), R x1 x2 -> (x1[=]y1) -> (x2[=]y2) -> R y1 y2. Proof - fun S R x1 x2 y1 y2 h h0 h1 => - csr_wdl S R x1 y2 y1 (csr_wdr S R x1 x2 y2 h h1) h0. + fun S R x1 x2 y1 y2 h h0 h1 => csr_wdl S R x1 y2 y1 (csr_wdr S R x1 x2 y2 h h1) h0. Lemma Ccsr_wd : forall (S:CSetoid) (R:CCSetoid_relation S) (x1 x2 y1 y2:S), R x1 x2 -> (x1[=]y1) -> (x2[=]y2) -> R y1 y2. Proof - fun S R x1 x2 y1 y2 h h0 h1 => - Ccsr_wdl S R x1 y2 y1 (Ccsr_wdr S R x1 x2 y2 h h1) h0. + fun S R x1 x2 y1 y2 h h0 h1 => Ccsr_wdl S R x1 y2 y1 (Ccsr_wdr S R x1 x2 y2 h h1) h0. Lemma eq_wd : forall (S:CSetoid) (x1 x2 y1 y2:S), (x1[=]x2) -> (x1[=]y1) -> (x2[=]y2) -> y1[=]y2. Proof - fun S x1 x2 y1 y2 h h0 h1 => - eq_transitive S y1 x1 y2 (eq_symmetric S x1 y1 h0) - (eq_transitive S x1 x2 y2 h h1). + fun S x1 x2 y1 y2 h h0 h1 => eq_transitive S y1 x1 y2 (eq_symmetric S x1 y1 h0) + (eq_transitive S x1 x2 y2 h h1). Lemma ap_wd : forall (S:CSetoid) (x1 x2 y1 y2:S), (x1[#]x2) -> (x1[=]y1) -> (x2[=]y2) -> y1[#]y2. Proof - fun S x1 x2 y1 y2 h h0 h1 => - ap_wdl S x1 y2 y1 (ap_wdr S x1 x2 y2 h h1) h0. + fun S x1 x2 y1 y2 h h0 h1 => ap_wdl S x1 y2 y1 (ap_wdr S x1 x2 y2 h h1) h0. Lemma CAnd_proj1 : forall A B:CProp, A and B -> A. Proof. -intros A B h; elim h; exact (fun a _ => a). + intros A B h; elim h; exact (fun a _ => a). Qed. Lemma CAnd_proj2 : forall A B:CProp, A and B -> B. Proof. -intros A B h; elim h; exact (fun _ b => b). + intros A B h; elim h; exact (fun _ b => b). Qed. Lemma COr_elim : forall A B C:CProp, (A -> C) -> (B -> C) -> A or B -> C. -intros A B C H H0 H1. -elim H1; intro H2; [ exact (H H2) | exact (H0 H2) ]. +Proof. + intros A B C H H0 H1. + elim H1; intro H2; [ exact (H H2) | exact (H0 H2) ]. Qed. End move_us. -(** Definition of [csetoid_rewrite]: a rewrite tactic for setoid equality; -it rewrites within formulae of type [Prop] and [CProp], built up from -connectives [->], [and], [CAnd], [or], [COr], [iff], [Iff], [not], [Not], -[CNot], and atomic formulae [(P t)], [(R t s)], [t[=]s], [t[#]s] for -[T:CSetoid], [t,s:T], [P:(CSetoid_predicate T)], [R:(CSetoid_relation T)], -[R:(CCSetoid_relation T)]. Note that atoms are built up from predicates and +(** Definition of [csetoid_rewrite]: a rewrite tactic for setoid equality; +it rewrites within formulae of type [Prop] and [CProp], built up from +connectives [->], [and], [CAnd], [or], [COr], [iff], [Iff], [not], [Not], +[CNot], and atomic formulae [(P t)], [(R t s)], [t[=]s], [t[#]s] for +[T:CSetoid], [t,s:T], [P:(CSetoid_predicate T)], [R:(CSetoid_relation T)], +[R:(CCSetoid_relation T)]. Note that atoms are built up from predicates and relations that are well-defined with respect to setoid equality. -Setoid terms of type [T] are terms constructed by [(f s)], [(g s s')], -[(h s s_)], where [f:(CSetoid_fun S T)], [g:(CSetoid_bin_fun S S' T)], +Setoid terms of type [T] are terms constructed by [(f s)], [(g s s')], +[(h s s_)], where [f:(CSetoid_fun S T)], [g:(CSetoid_bin_fun S S' T)], [h:(CSetoid_part_fun S T)], [s:S], [s':S'], [s_:(cspf_dom S T f s)]; needless to say, those setoid functions respect setoid equality. -Tactic [csetoid_rewrite] is composed of tactics [total_csetoid_rewrite] and -[partial_csetoid_rewrite]. The former is applied in case there are no partial -setoid functions present in the goal. The latter if there are. We further -explain this separation. +Tactic [csetoid_rewrite] is composed of tactics [total_csetoid_rewrite] and +[partial_csetoid_rewrite]. The former is applied in case there are no partial +setoid functions present in the goal. The latter if there are. We further +explain this separation. To define the rewrite tactic we use the method of reflection, see [1]. -Because we have to deal with partial functions (see the definition of +Because we have to deal with partial functions (see the definition of [CSetoid_part_fun] in file [CSetoids.v]), we use %\emph{partial}% #partial# reflection, see [2]. Partial reflection means to have an -interpretation %\emph{relation}%#relation# instead of an +interpretation %\emph{relation}%#relation# instead of an interpretation function. Unfortunately, we were unable to define our tactic for the most general case, -that is, for terms that contain both partial functions as well as setoid +that is, for terms that contain both partial functions as well as setoid functions whose domain(s) and co-domain are not necessarily the same. -When proving lemmas involving statements [e II^r t] (saying [t] is an -interpretation of syntactic expression [e] under the variable assigment [r], -one often needs to reason by induction over [e] and then inverting the so -obtained instances of the inductively defined [e II^rho t]. However, in the -general case where we have to deal with functions whose domain and co-domain -differ, inversion doesn't yield the desired result. Consider, for instance, +When proving lemmas involving statements [e II^r t] (saying [t] is an +interpretation of syntactic expression [e] under the variable assigment [r], +one often needs to reason by induction over [e] and then inverting the so +obtained instances of the inductively defined [e II^rho t]. However, in the +general case where we have to deal with functions whose domain and co-domain +differ, inversion doesn't yield the desired result. Consider, for instance, [var II^r t]. Here, we want to perform inversion and obtain [t=r], for [var II^r r] is a defining clause of [II] and moreover the only one mentioning -[var]. However, inversion returns somthing like [ = ]. -This has got to do with the so-called elimination predicate which predicts -the type of the outcome of a case analysis dependent on the destructed +[var]. However, inversion returns somthing like [ = ]. +This has got to do with the so-called elimination predicate which predicts +the type of the outcome of a case analysis dependent on the destructed variable. For more info ask the author and see his related -# +# mail# to the coq-club. -We opted for the next best option of using two tactics, one using total -reflection, its application being restricted to terms constructed +We opted for the next best option of using two tactics, one using total +reflection, its application being restricted to terms constructed from total functions (domain(s) and co-domain are allowed to be distinct). The other using partial reflection, its application being restricted to terms built up from (partial as well as total) %\emph{operations}% -#operations# (i.e.%\% functions whose domain(s) and co-domain are +#operations# (i.e.%\% functions whose domain(s) and co-domain are equal). References: -[1] Boutin, "Using Reflection to Build Efficient and Certified Decision +[1] Boutin, "Using Reflection to Build Efficient and Certified Decision Procedures", TACS, LNCS 1281, pp.%\% 515--529, 1997. -[2] Geuvers, Wiedijk and Zwanenburg, "Equational Reasoning via Partial +[2] Geuvers, Wiedijk and Zwanenburg, "Equational Reasoning via Partial Reflection", TPHOLs, LNCS 1896, pp.%\% 162--178, 2000. *) @@ -156,7 +153,7 @@ Reflection", TPHOLs, LNCS 1896, pp.%\% 162--178, 2000. Section syntactic_total_setoid_expressions. -(** Syntactic setoid expressions reflecting setoid terms built from total +(** Syntactic setoid expressions reflecting setoid terms built from total setoid functions. [S] is the setoid of the subterm to be replaced. *) Inductive tot_set_exp (S:CSetoid) : CSetoid -> Type := @@ -186,19 +183,19 @@ Lemma tse_int_wd : forall (S T:CSetoid) (r1 r2:S), (r1[=]r2) -> forall e:tot_set_exp S T, tse_int S T r1 e[=]tse_int S T r2 e. Proof. -intros S T r1 r2 h. -induction e; simpl in |- *. -exact h. -apply csf_wd; assumption. -apply csbf_wd; assumption. -apply eq_reflexive. + intros S T r1 r2 h. + induction e; simpl in |- *. + exact h. + apply csf_wd; assumption. + apply csbf_wd; assumption. + apply eq_reflexive. Qed. End syntactic_total_setoid_expressions. -(** The `quote function' maps setoid terms [t:T] to syntactic expressions -[(tot_set_exp S T)]; term [r:S] (supposed to be a subterm of [t:T] to be -replaced later on) is mapped to [(tse_var r)]. Other `leafs' [t0:T'] of [t] +(** The `quote function' maps setoid terms [t:T] to syntactic expressions +[(tot_set_exp S T)]; term [r:S] (supposed to be a subterm of [t:T] to be +replaced later on) is mapped to [(tse_var r)]. Other `leafs' [t0:T'] of [t] are mapped to [(tse_con S T' t0)]. *) Ltac tse_quote S T r t := @@ -224,8 +221,8 @@ Ltac tse_quote S T r t := constr:(tse_con S T t0) end. -(** Given [S:CSetoid;r1,r2:S] and [A:Prop] or [A:CProp], -[(replace_in_formula1 S r1 r2 A)] +(** Given [S:CSetoid;r1,r2:S] and [A:Prop] or [A:CProp], +[(replace_in_formula1 S r1 r2 A)] replaces all occurrences of subterm [r1] in [A] by [r2]. *) Ltac tot_repl_in_form S r1 r2 A := @@ -319,8 +316,8 @@ Ltac tot_repl_in_form S r1 r2 A := (** Given [S:CSetoid;r1,r2:S;h:r1[=]r2;h0:r2[=]r1] and [A:CProp] or [A:Prop], we get [(tot_set_rewr_prf1 S r1 r2 h h0 A) : A->A[r1:=r2]] and -[(tot_set_rewr_prf2 S r1 r2 h h0 A) : A[r1:=r2]->A] where [A[r1:=r2]] denotes -[(tot_repl_in_form S r1 r2 A)]. The argument [h0:r2[=]r1] is present to avoid +[(tot_set_rewr_prf2 S r1 r2 h h0 A) : A[r1:=r2]->A] where [A[r1:=r2]] denotes +[(tot_repl_in_form S r1 r2 A)]. The argument [h0:r2[=]r1] is present to avoid iterated application of [eq_symmetric]. *) @@ -668,7 +665,7 @@ Inductive part_set_exp : Type := | pse_pop : CSetoid_part_op T -> part_set_exp -> part_set_exp | pse_con : T -> part_set_exp. -(** Interpretation as a relation between syntactic expressions and +(** Interpretation as a relation between syntactic expressions and (semantical) setoid terms; [r] is the term to be replaced (later on). *) Variable r : T. @@ -679,11 +676,11 @@ Inductive pse_int : part_set_exp -> T -> Type := forall (F:CSetoid_un_op T) (e:part_set_exp) (t:T), pse_int e t -> pse_int (pse_uop F e) (F t) | pse_int_bop : - forall (F:CSetoid_bin_op T) (e1 e2:part_set_exp) + forall (F:CSetoid_bin_op T) (e1 e2:part_set_exp) (t1 t2:T), pse_int e1 t1 -> pse_int e2 t2 -> pse_int (pse_bop F e1 e2) (F t1 t2) | pse_int_pop : - forall (F:CSetoid_part_op T) (e:part_set_exp) + forall (F:CSetoid_part_op T) (e:part_set_exp) (t:T), pse_int e t -> forall Ht:cspf_dom T T F t, pse_int (pse_pop F e) (F t Ht) @@ -704,7 +701,7 @@ Inductive part_set_xexp : T -> Type := part_set_xexp t -> part_set_xexp (F t Ht) | psxe_con : forall t:T, part_set_xexp t. -(** Interpretation of proof loaded (`heavy') syntactic expressions; +(** Interpretation of proof loaded (`heavy') syntactic expressions; extracts the semantical component from heavy expressions. *) Definition psxe_int t (_:part_set_xexp t) := t. @@ -721,31 +718,31 @@ Fixpoint forget (t:T) (e:part_set_xexp t) {struct e} : part_set_exp := | psxe_con t => pse_con t end. -(** The second extraction of an heavy expression is an interpretation +(** The second extraction of an heavy expression is an interpretation of its first extraction (note [(xexp_int t e)=t]). *) Lemma extract_correct : forall (t:T) (e:part_set_xexp t), pse_int (forget e) t. Proof. -simple induction e; clear e t; simpl in |- *. -exact pse_int_var. -intros F t e h. -apply pse_int_uop; exact h. -intros F t1 t2 e1 h1 e2 h2. -apply pse_int_bop with (1 := h1) (2 := h2). -intros F t Ht e h. -apply pse_int_pop; exact h. -exact pse_int_con. + simple induction e; clear e t; simpl in |- *. + exact pse_int_var. + intros F t e h. + apply pse_int_uop; exact h. + intros F t1 t2 e1 h1 e2 h2. + apply pse_int_bop with (1 := h1) (2 := h2). + intros F t Ht e h. + apply pse_int_pop; exact h. + exact pse_int_con. Defined. Lemma pse_int_var_inv : forall t:T, pse_int pse_var t -> t = r. Proof. -intros t h; inversion h; reflexivity. + intros t h; inversion h; reflexivity. Defined. Lemma pse_int_con_inv : forall c t:T, pse_int (pse_con c) t -> t = c. Proof. -intros c t h; inversion h; reflexivity. + intros c t h; inversion h; reflexivity. Defined. (** The interpretation relation [pse_int] is a partial function. *) @@ -753,24 +750,24 @@ Defined. Lemma pse_int_ext : forall (e:part_set_exp) (t t':T), pse_int e t -> pse_int e t' -> t[=]t'. Proof. -simple induction e; clear e. -intros t t' h h0. -rewrite (pse_int_var_inv h). -rewrite (pse_int_var_inv h0). -apply eq_reflexive. -intros F e IH t t' h h0. -inversion_clear h; inversion_clear h0. -apply csf_wd; apply IH; assumption. -intros F e1 IH1 e2 IH2 t t' h h0. -inversion_clear h; inversion_clear h0. -apply csbf_wd; [ apply IH1 | apply IH2 ]; assumption. -intros F e IH t t' h h0. -inversion_clear h; inversion_clear h0. -apply cspf_wd; apply IH; assumption. -intros c t t' h h0. -rewrite (pse_int_con_inv h). -rewrite (pse_int_con_inv h0). -apply eq_reflexive. + simple induction e; clear e. + intros t t' h h0. + rewrite (pse_int_var_inv h). + rewrite (pse_int_var_inv h0). + apply eq_reflexive. + intros F e IH t t' h h0. + inversion_clear h; inversion_clear h0. + apply csf_wd; apply IH; assumption. + intros F e1 IH1 e2 IH2 t t' h h0. + inversion_clear h; inversion_clear h0. + apply csbf_wd; [ apply IH1 | apply IH2 ]; assumption. + intros F e IH t t' h h0. + inversion_clear h; inversion_clear h0. + apply cspf_wd; apply IH; assumption. + intros c t t' h h0. + rewrite (pse_int_con_inv h). + rewrite (pse_int_con_inv h0). + apply eq_reflexive. Qed. End syntactic_partial_setoid_expressions. @@ -783,74 +780,74 @@ Lemma pse_int_wd : forall (e:part_set_exp T) (t t':T), pse_int r e t -> pse_int r' e t' -> t[=]t'. Proof. -intros T r r' h. -simple induction e; clear e. -intros t t' h0 h1. -rewrite (pse_int_var_inv h0). -rewrite (pse_int_var_inv h1). -exact h. -intros F e IH t t' h0 h1. -inversion_clear h0; inversion_clear h1. -apply csf_wd; apply IH; assumption. -intros F e1 IH1 e2 IH2 t t' h0 h1. -inversion_clear h0; inversion_clear h1. -apply csbf_wd; [ apply IH1 | apply IH2 ]; assumption. -intros F e IH t t' h0 h1. -inversion_clear h0; inversion_clear h1. -apply cspf_wd; apply IH; assumption. -intros c t t' h0 h1. -rewrite (pse_int_con_inv h0). -rewrite (pse_int_con_inv h1). -apply eq_reflexive. + intros T r r' h. + simple induction e; clear e. + intros t t' h0 h1. + rewrite (pse_int_var_inv h0). + rewrite (pse_int_var_inv h1). + exact h. + intros F e IH t t' h0 h1. + inversion_clear h0; inversion_clear h1. + apply csf_wd; apply IH; assumption. + intros F e1 IH1 e2 IH2 t t' h0 h1. + inversion_clear h0; inversion_clear h1. + apply csbf_wd; [ apply IH1 | apply IH2 ]; assumption. + intros F e IH t t' h0 h1. + inversion_clear h0; inversion_clear h1. + apply cspf_wd; apply IH; assumption. + intros c t t' h0 h1. + rewrite (pse_int_con_inv h0). + rewrite (pse_int_con_inv h1). + apply eq_reflexive. Defined. -(** The following lemma states that if [r1[=]r2] and [t1] is an interpretation -of [e] under the variable assigment [r1], then there exists an interpretation +(** The following lemma states that if [r1[=]r2] and [t1] is an interpretation +of [e] under the variable assigment [r1], then there exists an interpretation [t2] of [e] under the assignment [r2]. *) Lemma replacement_lemma : forall (T:CSetoid) (e:part_set_exp T) (r1 r2 t1:T), (r1[=]r2) -> pse_int r1 e t1 -> my_sigT T (pse_int r2 e). Proof. -intros T e r1 r2 t1 H H0. -elim H0; clear H0 e t1. -exists r2. -apply pse_int_var. -intros F e a1 Ha1 IH. -elim IH; intros a2 Ha2. -exists (F a2); apply pse_int_uop with (1 := Ha2). -intros F ea a1 eb b1 Ha1 IHa Hb1 IHb. -elim IHa; intros a2 Ha2. -elim IHb; intros b2 Hb2. -exists (F a2 b2); apply pse_int_bop with (1 := Ha2) (2 := Hb2). -intros F e a1 Ha1 IH Da1. -elim IH; intros a2 Ha2. -assert (Da2 := cspf_dom_wd T T F a1 a2 Da1 (pse_int_wd H Ha1 Ha2)). -exists (F a2 Da2). -apply pse_int_pop with (1 := Ha2). -intro t; exists t; apply pse_int_con. + intros T e r1 r2 t1 H H0. + elim H0; clear H0 e t1. + exists r2. + apply pse_int_var. + intros F e a1 Ha1 IH. + elim IH; intros a2 Ha2. + exists (F a2); apply pse_int_uop with (1 := Ha2). + intros F ea a1 eb b1 Ha1 IHa Hb1 IHb. + elim IHa; intros a2 Ha2. + elim IHb; intros b2 Hb2. + exists (F a2 b2); apply pse_int_bop with (1 := Ha2) (2 := Hb2). + intros F e a1 Ha1 IH Da1. + elim IH; intros a2 Ha2. + assert (Da2 := cspf_dom_wd T T F a1 a2 Da1 (pse_int_wd H Ha1 Ha2)). + exists (F a2 Da2). + apply pse_int_pop with (1 := Ha2). + intro t; exists t; apply pse_int_con. Defined. -(** Given [H:r1[=]r2] and [H0:(pse_int r1 e t1)], the first projection of -[(replacement_lemma H H0)] is the term [t2] obtained by replacing in [t1] -subterm [r1] by [r2]. The second projection is the proof of +(** Given [H:r1[=]r2] and [H0:(pse_int r1 e t1)], the first projection of +[(replacement_lemma H H0)] is the term [t2] obtained by replacing in [t1] +subterm [r1] by [r2]. The second projection is the proof of [(pse_int r2 e t2)]. *) -Definition replace_in_term (T:CSetoid) (r1 r2 t1:T) +Definition replace_in_term (T:CSetoid) (r1 r2 t1:T) (e:part_set_exp T) (H:r1[=]r2) (H0:pse_int r1 e t1) := proj1_my_sigT T (pse_int r2 e) (replacement_lemma H H0). -Definition replace_in_term_proof (T:CSetoid) (r1 r2 t1:T) +Definition replace_in_term_proof (T:CSetoid) (r1 r2 t1:T) (e:part_set_exp T) (H:r1[=]r2) (H0:pse_int r1 e t1) := proj2_my_sigT T (pse_int r2 e) (replacement_lemma H H0). Set Strict Implicit. Unset Implicit Arguments. -(** The `quote function' maps from the semantical level to heavy syntactic -expressions: given a setoid term [t:T], [psxe_quote] yields a -[(part_set_xexp T)]. Term [r:T] (supposed to be a subterm of [t:T] to be -replaced later on) is mapped to [(psxe_var r)]. Other `leafs' [t0] of [t] are +(** The `quote function' maps from the semantical level to heavy syntactic +expressions: given a setoid term [t:T], [psxe_quote] yields a +[(part_set_xexp T)]. Term [r:T] (supposed to be a subterm of [t:T] to be +replaced later on) is mapped to [(psxe_var r)]. Other `leafs' [t0] of [t] are mapped to [(psxe_con r t0)]. *) Ltac psxe_quote r t := @@ -875,7 +872,7 @@ Ltac psxe_quote r t := constr:(psxe_con r t0) end. -(** Given [H:r1[=]r2] and [A:Prop] or [A:CProp], [(replace_in_formula2 H A)] +(** Given [H:r1[=]r2] and [A:Prop] or [A:CProp], [(replace_in_formula2 H A)] replaces all occurrences of subterm [r1] in [A] by [r2]. *) Ltac part_repl_in_form H A := @@ -968,10 +965,10 @@ Ltac part_repl_in_form H A := end. (** -Given [T:CSetoid;r1,r2:T;H:r1[=]r2;H0:r2[=]r1] (checked by main call) -and [A:CProp] or [A:Prop], we get [(part_set_rewr_prf1 H H0 A) : A->A[r2/r1]] -and [(part_set_rewr_prf2 r1 r2 H H0 A) : A[r2/r1]->A] where [A[r2/r1]] denotes -[(part_repl_in_form H A)]. The argument [H0:r2[=]r1] is present to avoid +Given [T:CSetoid;r1,r2:T;H:r1[=]r2;H0:r2[=]r1] (checked by main call) +and [A:CProp] or [A:Prop], we get [(part_set_rewr_prf1 H H0 A) : A->A[r2/r1]] +and [(part_set_rewr_prf2 r1 r2 H H0 A) : A[r2/r1]->A] where [A[r2/r1]] denotes +[(part_repl_in_form H A)]. The argument [H0:r2[=]r1] is present to avoid iterated application of [eq_symmetric]. *) diff --git a/transc/ArTanH.v b/transc/ArTanH.v index e0e574237..5ec928584 100644 --- a/transc/ArTanH.v +++ b/transc/ArTanH.v @@ -5,16 +5,16 @@ * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Exponential. Require Import CornTac. @@ -31,240 +31,239 @@ Definition DomArTanH := olor ([--]One) One. Lemma proper_DomArTanH : proper DomArTanH. Proof. -simpl. -apply shift_zero_less_minus'. -rstepr (Two:IR). -apply pos_two. + simpl. + apply shift_zero_less_minus'. + rstepr (Two:IR). + apply pos_two. Qed. Lemma DomArTanH_Dom_ArTanH : included DomArTanH (Dom ArTangH). Proof. -intros x Hx. -split. - constructor. -assert (X:Dom (([-C-]One{+}FId){/}([-C-]One{-}FId)) x). - split. - repeat constructor. + intros x Hx. split. - repeat constructor. + constructor. + assert (X:Dom (([-C-]One{+}FId){/}([-C-]One{-}FId)) x). + split. + repeat constructor. + split. + repeat constructor. + simpl. + intros _. + apply Greater_imp_ap. + apply shift_zero_less_minus. + destruct Hx; assumption. + exists X. simpl. - intros _. - apply Greater_imp_ap. - apply shift_zero_less_minus. - destruct Hx; assumption. -exists X. -simpl. -apply div_resp_pos. + apply div_resp_pos. + apply shift_zero_less_minus. + destruct Hx; assumption. + rstepr (x[-][--]One). apply shift_zero_less_minus. destruct Hx; assumption. -rstepr (x[-][--]One). -apply shift_zero_less_minus. -destruct Hx; assumption. Qed. Lemma Dom_ArTanH_DomArTanH : included (Dom ArTangH) DomArTanH. Proof. -intros x [_ [Hx0 Hx1]]. -simpl in Hx1. -assert (Hx:=Hx0). -destruct Hx as [_ [_ H]]. -simpl in H. -assert (Hx:One[-]x[#]Zero). - apply H. - repeat constructor. -clear H. -destruct (ap_imp_less _ _ _ Hx) as [H|H]. - elim (less_irreflexive IR Zero). - eapply less_transitive_unfolded. + intros x [_ [Hx0 Hx1]]. + simpl in Hx1. + assert (Hx:=Hx0). + destruct Hx as [_ [_ H]]. + simpl in H. + assert (Hx:One[-]x[#]Zero). + apply H. + repeat constructor. + clear H. + destruct (ap_imp_less _ _ _ Hx) as [H|H]. + elim (less_irreflexive IR Zero). + eapply less_transitive_unfolded. + apply Hx1. + apply mult_cancel_less with (x[-]One). + apply inv_cancel_less. + rstepl (One[-]x). + rstepr (Zero:IR). + assumption. + rstepr (Zero[+][--]Zero:IR). + rstepl (One[-]x[+][--]Two). + apply plus_resp_less_both. + assumption. + apply inv_resp_less. + apply pos_two. + split. + apply shift_zero_less_minus'. + rstepr (One[+]x). + rstepl (Zero[*](One[-]x)). + eapply shift_mult_less. + assumption. apply Hx1. - apply mult_cancel_less with (x[-]One). - apply inv_cancel_less. - rstepl (One[-]x). - rstepr (Zero:IR). - assumption. - rstepr (Zero[+][--]Zero:IR). - rstepl (One[-]x[+][--]Two). - apply plus_resp_less_both. - assumption. - apply inv_resp_less. - apply pos_two. -split. apply shift_zero_less_minus'. - rstepr (One[+]x). - rstepl (Zero[*](One[-]x)). - eapply shift_mult_less. - assumption. - apply Hx1. -apply shift_zero_less_minus'. -assumption. + assumption. Qed. Definition ArTanH (x:IR) (Hx:DomArTanH x) := ArTangH x (DomArTanH_Dom_ArTanH x Hx). Lemma ArTanH_wd : forall (x y : IR) Hx Hy, x[=]y -> ArTanH x Hx[=]ArTanH y Hy. -intros x y Hx Hy H. -apply pfwdef. -assumption. +Proof. + intros x y Hx Hy H. + apply pfwdef. + assumption. Qed. Lemma ArTanH_maps_compact_lemma : maps_compacts_into DomArTanH (openl Zero) (([-C-]One{+}FId){/}([-C-]One{-}FId)). Proof. -intros a b Hab H. -assert (Ha : Zero[<]One[-]a). - apply shift_zero_less_minus. - destruct (H _ (compact_inc_lft _ _ Hab)) as [_ A]. - assumption. -assert (Ha' : One[-]a[#]Zero). - apply Greater_imp_ap. - assumption. -exists (One[+]a[/]_[//]Ha'). -assert (Hb : Zero[<]One[-]b). - apply shift_zero_less_minus. - destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. - assumption. -assert (Hb' : One[-]b[#]Zero). - apply Greater_imp_ap. - assumption. -exists (One[+](One[+]b[/]_[//]Hb')). -assert (Hcd : (One[+]a[/]_[//]Ha')[<](One[+](One[+]b[/]_[//]Hb'))). - rstepl (Zero[+](One[+]a[/]_[//]Ha')). - apply plus_resp_less_leEq. - apply pos_one. - apply shift_leEq_div; try assumption. - rstepl (((One[-]a[*]b)[+](a[-]b))[/]_[//]Ha'). - apply shift_div_leEq; try assumption. - rstepr ((One[-]a[*]b)[+](b[-]a)). - apply plus_resp_leEq_lft. - apply shift_minus_leEq. - rstepr (Two[*]b[-]a). - apply shift_leEq_minus. - rstepl (Two[*]a). - apply mult_resp_leEq_lft; try assumption. - apply less_leEq; apply pos_two. -exists Hcd. -split. - intros y [Hy _]. - apply: less_leEq_trans;[|apply Hy]. - apply div_resp_pos. + intros a b Hab H. + assert (Ha : Zero[<]One[-]a). + apply shift_zero_less_minus. + destruct (H _ (compact_inc_lft _ _ Hab)) as [_ A]. assumption. - destruct (H _ (compact_inc_lft _ _ Hab)) as [A _]. - rstepr (a[-][--]One). - apply shift_zero_less_minus. - assumption. -intros x Hx H0. -simpl. -assert (Zero[<]One[-]x). - destruct (H0) as [_ A]. - rstepr ((One[-]b)[+](b[-]x)). - rstepl (Zero[+]Zero:IR). - apply plus_resp_less_leEq. + assert (Ha' : One[-]a[#]Zero). + apply Greater_imp_ap. assumption. - apply shift_zero_leEq_minus. - assumption. -split. - apply shift_leEq_div; try assumption. - rstepl (((One[-]x[*]a)[+](a[-]x))[/]_[//]Ha'). - apply shift_div_leEq; try assumption. - rstepr ((One[-]x[*]a)[+](x[-]a)). - apply plus_resp_leEq_lft. - apply shift_minus_leEq. - rstepr (Two[*]x[-]a). - apply shift_leEq_minus. - rstepl (Two[*]a). - apply mult_resp_leEq_lft; try assumption. - destruct H0; assumption. - apply less_leEq; apply pos_two. -apply leEq_transitive with (Zero[+](One[+]b[/]_[//]Hb')). - apply shift_div_leEq; try assumption. - rstepr (((One[-]x[*]b)[+](b[-]x))[/]_[//]Hb'). - apply shift_leEq_div; try assumption. - rstepl ((One[-]x[*]b)[+](x[-]b)). - apply plus_resp_leEq_lft. - apply shift_minus_leEq. - rstepr (Two[*]b[-]x). - apply shift_leEq_minus. - rstepl (Two[*]x). - apply mult_resp_leEq_lft; try assumption. - destruct H0; assumption. - apply less_leEq; apply pos_two. -apply plus_resp_leEq. -apply less_leEq; apply pos_one. -Qed. - -Lemma Derivative_ArTanH : forall H, Derivative DomArTanH H ArTangH (Frecip ([-C-]One{-}FId{^}2)). -intros H. -assert (bnd_away_zero_in_P ([-C-]One{-}FId) DomArTanH). - clear H. - intros a b Hab H. - split. - Included. - exists (One[-]b). + exists (One[+]a[/]_[//]Ha'). + assert (Hb : Zero[<]One[-]b). + apply shift_zero_less_minus. destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. + assumption. + assert (Hb' : One[-]b[#]Zero). + apply Greater_imp_ap. + assumption. + exists (One[+](One[+]b[/]_[//]Hb')). + assert (Hcd : (One[+]a[/]_[//]Ha')[<](One[+](One[+]b[/]_[//]Hb'))). + rstepl (Zero[+](One[+]a[/]_[//]Ha')). + apply plus_resp_less_leEq. + apply pos_one. + apply shift_leEq_div; try assumption. + rstepl (((One[-]a[*]b)[+](a[-]b))[/]_[//]Ha'). + apply shift_div_leEq; try assumption. + rstepr ((One[-]a[*]b)[+](b[-]a)). + apply plus_resp_leEq_lft. + apply shift_minus_leEq. + rstepr (Two[*]b[-]a). + apply shift_leEq_minus. + rstepl (Two[*]a). + apply mult_resp_leEq_lft; try assumption. + apply less_leEq; apply pos_two. + exists Hcd. + split. + intros y [Hy _]. + apply: less_leEq_trans;[|apply Hy]. + apply div_resp_pos. + assumption. + destruct (H _ (compact_inc_lft _ _ Hab)) as [A _]. + rstepr (a[-][--]One). apply shift_zero_less_minus. assumption. - intros y Hy H0. + intros x Hx H0. simpl. - eapply leEq_transitive;[|apply leEq_AbsIR]. - apply plus_resp_leEq_lft. - apply inv_resp_leEq. - destruct H0; assumption. -unfold ArTangH. -unfold Half. -eapply Derivative_wdr; - [|apply Derivative_scal; + assert (Zero[<]One[-]x). + destruct (H0) as [_ A]. + rstepr ((One[-]b)[+](b[-]x)). + rstepl (Zero[+]Zero:IR). + apply plus_resp_less_leEq. + assumption. + apply shift_zero_leEq_minus. + assumption. + split. + apply shift_leEq_div; try assumption. + rstepl (((One[-]x[*]a)[+](a[-]x))[/]_[//]Ha'). + apply shift_div_leEq; try assumption. + rstepr ((One[-]x[*]a)[+](x[-]a)). + apply plus_resp_leEq_lft. + apply shift_minus_leEq. + rstepr (Two[*]x[-]a). + apply shift_leEq_minus. + rstepl (Two[*]a). + apply mult_resp_leEq_lft; try assumption. + destruct H0; assumption. + apply less_leEq; apply pos_two. + apply leEq_transitive with (Zero[+](One[+]b[/]_[//]Hb')). + apply shift_div_leEq; try assumption. + rstepr (((One[-]x[*]b)[+](b[-]x))[/]_[//]Hb'). + apply shift_leEq_div; try assumption. + rstepl ((One[-]x[*]b)[+](x[-]b)). + apply plus_resp_leEq_lft. + apply shift_minus_leEq. + rstepr (Two[*]b[-]x). + apply shift_leEq_minus. + rstepl (Two[*]x). + apply mult_resp_leEq_lft; try assumption. + destruct H0; assumption. + apply less_leEq; apply pos_two. + apply plus_resp_leEq. + apply less_leEq; apply pos_one. +Qed. + +Lemma Derivative_ArTanH : forall H, Derivative DomArTanH H ArTangH (Frecip ([-C-]One{-}FId{^}2)). +Proof. + intros H. + assert (bnd_away_zero_in_P ([-C-]One{-}FId) DomArTanH). + clear H. + intros a b Hab H. + split. + Included. + exists (One[-]b). + destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. + apply shift_zero_less_minus. + assumption. + intros y Hy H0. + simpl. + eapply leEq_transitive;[|apply leEq_AbsIR]. + apply plus_resp_leEq_lft. + apply inv_resp_leEq. + destruct H0; assumption. + unfold ArTangH. + unfold Half. + eapply Derivative_wdr; [|apply Derivative_scal; eapply (Derivative_comp DomArTanH (openl Zero) H CI);[apply ArTanH_maps_compact_lemma | Derivative_Help; apply Feq_reflexive|Deriv]]. - FEQ. - apply included_FScalMult. - apply included_FMult. - apply included_FComp. - Included. - intros x Hx Hx0. - split. + FEQ. + apply included_FScalMult. + apply included_FMult. + apply included_FComp. + Included. + intros x Hx Hx0. + split. + repeat constructor. + simpl; intros _. + apply div_resp_ap_zero_rev. + apply Greater_imp_ap. + rstepr (x[-][--]One). + apply shift_zero_less_minus. + destruct Hx0; assumption. + apply included_FDiv. + repeat constructor. repeat constructor. - simpl; intros _. - apply div_resp_ap_zero_rev. + intros x Hx0 Hx. + simpl. + apply Greater_imp_ap. + rstepr ((One[-]x)[^]2). + apply pos_square. apply Greater_imp_ap. - rstepr (x[-][--]One). apply shift_zero_less_minus. destruct Hx0; assumption. - apply included_FDiv. - repeat constructor. + apply included_FRecip. repeat constructor. intros x Hx0 Hx. simpl. + rstepl ((One[-]x)[*](x[-][--]One)). apply Greater_imp_ap. - rstepr ((One[-]x)[^]2). - apply pos_square. - apply Greater_imp_ap. - apply shift_zero_less_minus. - destruct Hx0; assumption. - apply included_FRecip. + apply mult_resp_pos; apply shift_zero_less_minus; destruct Hx0; assumption. + apply included_FDiv. + repeat constructor. repeat constructor. - intros x Hx0 Hx. + intros x H0 Hx. simpl. - rstepl ((One[-]x)[*](x[-][--]One)). + rstepl ((One[-]x)[^]2). apply Greater_imp_ap. - apply mult_resp_pos; - apply shift_zero_less_minus; - destruct Hx0; assumption. -apply included_FDiv. - repeat constructor. - repeat constructor. -intros x H0 Hx. -simpl. -rstepl ((One[-]x)[^]2). -apply Greater_imp_ap. -apply pos_square. -apply Greater_imp_ap. -apply shift_zero_less_minus. -destruct H0; assumption. + apply pos_square. + apply Greater_imp_ap. + apply shift_zero_less_minus. + destruct H0; assumption. Qed. Lemma Continuous_ArTanH : Continuous DomArTanH ArTangH. Proof. -eapply Derivative_imp_Continuous with (pI:=proper_DomArTanH). -apply Derivative_ArTanH. + eapply Derivative_imp_Continuous with (pI:=proper_DomArTanH). + apply Derivative_ArTanH. Qed. (* begin hide *) Hint Resolve ArTanH_wd: algebra. @@ -275,50 +274,50 @@ Hint Resolve Derivative_ArTanH: derivate. Lemma ArTanH_inv : forall x Hx Hx', ArTanH [--]x Hx[=][--](ArTanH x Hx'). Proof. -intros x Hx Hx'. -unfold ArTanH, ArTangH. -generalize (DomArTanH_Dom_ArTanH). -intros X. -simpl in X. -set (A:=(ProjT2 (Prj2 (X [--]x Hx)))). -set (B:=(ProjT2 (Prj2 (X x Hx')))). -change (Half (R:=IR)[*]Log _ A[=][--](Half (R:=IR)[*]Log _ B)). -generalize A B. -clear A B. -intros A B. -rstepr (Half[*][--](Log _ B)). -apply mult_wdr. -apply cg_inv_unique. -assert (C:=mult_resp_pos _ _ _ B A). -astepl (Log _ C). -astepr (Log _ (pos_one IR)). -apply Log_wd. -rational. + intros x Hx Hx'. + unfold ArTanH, ArTangH. + generalize (DomArTanH_Dom_ArTanH). + intros X. + simpl in X. + set (A:=(ProjT2 (Prj2 (X [--]x Hx)))). + set (B:=(ProjT2 (Prj2 (X x Hx')))). + change (Half (R:=IR)[*]Log _ A[=][--](Half (R:=IR)[*]Log _ B)). + generalize A B. + clear A B. + intros A B. + rstepr (Half[*][--](Log _ B)). + apply mult_wdr. + apply cg_inv_unique. + assert (C:=mult_resp_pos _ _ _ B A). + astepl (Log _ C). + astepr (Log _ (pos_one IR)). + apply Log_wd. + rational. Qed. Lemma ArTanH_zero : forall H, ArTanH Zero H[=]Zero. Proof. -intros H. -apply mult_cancel_lft with (Two:IR). - apply nringS_ap_zero. -rstepr (Zero:IR). -rstepl (ArTanH Zero H[+]ArTanH Zero H). -assert (X:DomArTanH [--]Zero). - eapply iprop_wd. - apply H. + intros H. + apply mult_cancel_lft with (Two:IR). + apply nringS_ap_zero. + rstepr (Zero:IR). + rstepl (ArTanH Zero H[+]ArTanH Zero H). + assert (X:DomArTanH [--]Zero). + eapply iprop_wd. + apply H. + rational. + astepl (ArTanH Zero H[+]ArTanH _ X). + csetoid_rewrite (ArTanH_inv _ X H). rational. -astepl (ArTanH Zero H[+]ArTanH _ X). -csetoid_rewrite (ArTanH_inv _ X H). -rational. Qed. (** PowerSeries for the Inverse Hyperbolic Tangent Function. *) Lemma ArTanH_series_coef_lemma : forall (R:COrdField) n, odd n -> (nring (R:=R) n)[#]Zero. Proof. -intros R [|n] H. - elimtype False. - inversion H. -apply nringS_ap_zero. + intros R [|n] H. + elimtype False. + inversion H. + apply nringS_ap_zero. Qed. Definition ArTanH_series_coef (n:nat) := @@ -336,36 +335,31 @@ Feq DomArTanH ((Log_ps n[o][-C-]One{+}FId){-}(Log_ps n[o][-C-]One{-}FId))) (ArTanH_ps n). Proof. -unfold Log_ps, ArTanH_ps. -unfold FPowerSeries. -intros n. -FEQ. - apply included_FScalMult. - apply included_FMinus; - apply included_FComp; Included; repeat constructor. -simpl. -change (Half (R:=IR)[*] - (Log_series_coef n[*](One[+]x[-]One)[^]n[-] - Log_series_coef n[*](One[-]x[-]One)[^]n)[=] - ArTanH_series_coef n[*]nexp IR n (x[-]Zero)). -unfold ArTanH_series_coef. -destruct n as [|n]. - destruct (even_odd_dec 0) as [A|A]; try inversion A. - simpl; rational. -rstepl (Half (R:=IR)[*] - (Log_series_coef (S n)[*](x[^]S n[-]([--]x)[^]S n))). -destruct (even_odd_dec (S n)) as [A|A]; - unfold cg_minus. - csetoid_rewrite (inv_nexp_even _ x _ A). - rational. -csetoid_rewrite (inv_nexp_odd _ x _ A). -unfold Half. -rstepl (Log_series_coef (S n)[*](x[^]S n)). -apply mult_wd;[|change (x[^]S n[=](x[+][--]Zero)[^]S n); rational]. + unfold Log_ps, ArTanH_ps. + unfold FPowerSeries. + intros n. + FEQ. + apply included_FScalMult. + apply included_FMinus; apply included_FComp; Included; repeat constructor. + simpl. + change (Half (R:=IR)[*] (Log_series_coef n[*](One[+]x[-]One)[^]n[-] + Log_series_coef n[*](One[-]x[-]One)[^]n)[=] ArTanH_series_coef n[*]nexp IR n (x[-]Zero)). + unfold ArTanH_series_coef. + destruct n as [|n]. + destruct (even_odd_dec 0) as [A|A]; try inversion A. + simpl; rational. + rstepl (Half (R:=IR)[*] (Log_series_coef (S n)[*](x[^]S n[-]([--]x)[^]S n))). + destruct (even_odd_dec (S n)) as [A|A]; unfold cg_minus. + csetoid_rewrite (inv_nexp_even _ x _ A). + rational. + csetoid_rewrite (inv_nexp_odd _ x _ A). + unfold Half. + rstepl (Log_series_coef (S n)[*](x[^]S n)). + apply mult_wd;[|change (x[^]S n[=](x[+][--]Zero)[^]S n); rational]. unfold Log_series_coef. -apply div_wd; try apply eq_reflexive. -csetoid_rewrite (inv_nexp_even IR One _ (even_S _ A)). -algebra. + apply div_wd; try apply eq_reflexive. + csetoid_rewrite (inv_nexp_even IR One _ (even_S _ A)). + algebra. Qed. Lemma ArTanH_series_lemma2 : @@ -373,183 +367,176 @@ fun_series_convergent_IR DomArTanH (fun n : nat => Half (R:=IR){**} ((Log_ps n[o][-C-]One{+}FId){-}(Log_ps n[o][-C-]One{-}FId))). -apply FSeries_Sum_scal_conv;[|Contin]. -apply FSeries_Sum_minus_conv; - apply FSeries_Sum_comp_conv with (olor Zero Two); - try apply Log_series_convergent_IR; try Contin; - intros a b Hab H; simpl. - exists (One[+]a); exists (One[+]b). - assert (H0:One[+]a[<=]One[+]b). - apply plus_resp_leEq_lft; assumption. +Proof. + apply FSeries_Sum_scal_conv;[|Contin]. + apply FSeries_Sum_minus_conv; apply FSeries_Sum_comp_conv with (olor Zero Two); + try apply Log_series_convergent_IR; try Contin; intros a b Hab H; simpl. + exists (One[+]a); exists (One[+]b). + assert (H0:One[+]a[<=]One[+]b). + apply plus_resp_leEq_lft; assumption. + exists H0. + split. + intros c [Hc0 Hc1]. + split. + eapply less_leEq_trans;[|apply Hc0]. + destruct (H _ (compact_inc_lft _ _ Hab)) as [A _]. + apply shift_less_plus'. + rstepl ([--]One:IR). + assumption. + eapply leEq_less_trans;[apply Hc1|]. + rstepr (One[+]One:IR). + apply plus_resp_less_lft. + destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. + assumption. + intros x _ [Hx0 Hx1]. + split; apply plus_resp_leEq_lft; assumption. + exists (One[-]b); exists (One[-]a). + assert (H0:One[-]b[<=]One[-]a). + apply plus_resp_leEq_lft. + apply inv_resp_leEq; assumption. exists H0. split. intros c [Hc0 Hc1]. split. eapply less_leEq_trans;[|apply Hc0]. - destruct (H _ (compact_inc_lft _ _ Hab)) as [A _]. - apply shift_less_plus'. - rstepl ([--]One:IR). + destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. + apply shift_zero_less_minus. assumption. eapply leEq_less_trans;[apply Hc1|]. - rstepr (One[+]One:IR). + rstepr (One[+][--][--]One:IR). apply plus_resp_less_lft. - destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. + apply inv_resp_less. + destruct (H _ (compact_inc_lft _ _ Hab)) as [A _]. assumption. intros x _ [Hx0 Hx1]. - split; apply plus_resp_leEq_lft; assumption. -exists (One[-]b); exists (One[-]a). -assert (H0:One[-]b[<=]One[-]a). - apply plus_resp_leEq_lft. - apply inv_resp_leEq; assumption. -exists H0. -split. - intros c [Hc0 Hc1]. - split. - eapply less_leEq_trans;[|apply Hc0]. - destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. - apply shift_zero_less_minus. - assumption. - eapply leEq_less_trans;[apply Hc1|]. - rstepr (One[+][--][--]One:IR). - apply plus_resp_less_lft. - apply inv_resp_less. - destruct (H _ (compact_inc_lft _ _ Hab)) as [A _]. - assumption. -intros x _ [Hx0 Hx1]. -split; apply plus_resp_leEq_lft; - apply inv_resp_leEq; assumption. + split; apply plus_resp_leEq_lft; apply inv_resp_leEq; assumption. Qed. Lemma ArTanH_series_convergent_IR : fun_series_convergent_IR DomArTanH ArTanH_ps. Proof. -eapply fun_series_convergent_wd_IR;[|apply ArTanH_series_lemma2]. -apply ArTanH_series_lemma. + eapply fun_series_convergent_wd_IR;[|apply ArTanH_series_lemma2]. + apply ArTanH_series_lemma. Qed. Lemma ArTanH_series : forall c : IR, forall (Hs:fun_series_convergent_IR DomArTanH ArTanH_ps) Hc0 Hc1, FSeries_Sum Hs c Hc0[=]ArTanH c Hc1. Proof. -intros c Hs Hc0 Hc1. -unfold ArTanH. -set (F:=([-C-](Half (R:=IR)){*} - ((Logarithm[o][-C-]One{+}FId){-}(Logarithm[o][-C-]One{-}FId)))). -assert (F0:Dom F c). - destruct Hc0 as [A B]. - repeat (constructor || exists (CAnd_intro _ _ CI CI)); - simpl. - apply shift_less_plus'. - rstepl ([--]One:IR). + intros c Hs Hc0 Hc1. + unfold ArTanH. + set (F:=([-C-](Half (R:=IR)){*} ((Logarithm[o][-C-]One{+}FId){-}(Logarithm[o][-C-]One{-}FId)))). + assert (F0:Dom F c). + destruct Hc0 as [A B]. + repeat (constructor || exists (CAnd_intro _ _ CI CI)); simpl. + apply shift_less_plus'. + rstepl ([--]One:IR). + assumption. + apply shift_zero_less_minus. assumption. - apply shift_zero_less_minus. - assumption. -apply eq_transitive with (F c F0). - apply (Feq_imp_eq DomArTanH); try assumption. - eapply Feq_transitive. - apply Feq_symmetric. - apply (FSeries_Sum_wd' _ _ _ ArTanH_series_lemma2 Hs ArTanH_series_lemma). - assert (B0:maps_compacts_into_weak DomArTanH (olor Zero Two) ([-C-]One{+}FId)). - intros a b Hab H; simpl. - exists (One[+]a); exists (One[+]b). - assert (H0:One[+]a[<=]One[+]b). - apply plus_resp_leEq_lft; assumption. - exists H0. - split. - clear c Hc0 Hc1 F0. - intros c [Hc0 Hc1]. + apply eq_transitive with (F c F0). + apply (Feq_imp_eq DomArTanH); try assumption. + eapply Feq_transitive. + apply Feq_symmetric. + apply (FSeries_Sum_wd' _ _ _ ArTanH_series_lemma2 Hs ArTanH_series_lemma). + assert (B0:maps_compacts_into_weak DomArTanH (olor Zero Two) ([-C-]One{+}FId)). + intros a b Hab H; simpl. + exists (One[+]a); exists (One[+]b). + assert (H0:One[+]a[<=]One[+]b). + apply plus_resp_leEq_lft; assumption. + exists H0. split. - eapply less_leEq_trans;[|apply Hc0]. + clear c Hc0 Hc1 F0. + intros c [Hc0 Hc1]. + split. + eapply less_leEq_trans;[|apply Hc0]. + destruct (H _ (compact_inc_lft _ _ Hab)) as [A _]. + apply shift_less_plus'. + rstepl ([--]One:IR). + assumption. + eapply leEq_less_trans;[apply Hc1|]. + rstepr (One[+]One:IR). + apply plus_resp_less_lft. + destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. + assumption. + intros x _ [Hx0 Hx1]. + split; apply plus_resp_leEq_lft; assumption. + assert (A0:fun_series_convergent_IR DomArTanH (fun n : nat => Log_ps n[o]([-C-]One{+}FId))). + apply FSeries_Sum_comp_conv with (olor Zero Two); try apply Log_series_convergent_IR; try Contin. + assert (B1:maps_compacts_into_weak DomArTanH (olor Zero Two) ([-C-]One{-}FId)). + intros a b Hab H; simpl. + exists (One[-]b); exists (One[-]a). + assert (H0:One[-]b[<=]One[-]a). + apply plus_resp_leEq_lft. + apply inv_resp_leEq; assumption. + exists H0. + split. + clear c Hc0 Hc1 F0. + intros c [Hc0 Hc1]. + split. + eapply less_leEq_trans;[|apply Hc0]. + destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. + apply shift_zero_less_minus. + assumption. + eapply leEq_less_trans;[apply Hc1|]. + rstepr (One[+][--][--]One:IR). + apply plus_resp_less_lft. + apply inv_resp_less. destruct (H _ (compact_inc_lft _ _ Hab)) as [A _]. - apply shift_less_plus'. - rstepl ([--]One:IR). assumption. - eapply leEq_less_trans;[apply Hc1|]. - rstepr (One[+]One:IR). - apply plus_resp_less_lft. - destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. - assumption. - intros x _ [Hx0 Hx1]. - split; apply plus_resp_leEq_lft; assumption. - assert (A0:fun_series_convergent_IR DomArTanH (fun n : nat => Log_ps n[o]([-C-]One{+}FId))). - apply FSeries_Sum_comp_conv with (olor Zero Two); - try apply Log_series_convergent_IR; try Contin. - assert (B1:maps_compacts_into_weak DomArTanH (olor Zero Two) ([-C-]One{-}FId)). - intros a b Hab H; simpl. - exists (One[-]b); exists (One[-]a). - assert (H0:One[-]b[<=]One[-]a). - apply plus_resp_leEq_lft. - apply inv_resp_leEq; assumption. - exists H0. - split. - clear c Hc0 Hc1 F0. - intros c [Hc0 Hc1]. + intros x _ [Hx0 Hx1]. + split; apply plus_resp_leEq_lft; apply inv_resp_leEq; assumption. + assert (A1:fun_series_convergent_IR DomArTanH (fun n : nat => Log_ps n[o]([-C-]One{-}FId))). + apply FSeries_Sum_comp_conv with (olor Zero Two); try apply Log_series_convergent_IR; try Contin. + assert (A2:fun_series_convergent_IR DomArTanH (fun n : nat => ((Log_ps n[o][-C-]One{+}FId){-}(Log_ps n[o][-C-]One{-}FId)))). + apply FSeries_Sum_minus_conv; assumption. + assert (A3:Feq (olor Zero Two) (FSeries_Sum (J:=olor Zero Two) (f:=Log_ps) Log_series_convergent_IR) Logarithm). split. - eapply less_leEq_trans;[|apply Hc0]. - destruct (H _ (compact_inc_rht _ _ Hab)) as [_ A]. - apply shift_zero_less_minus. + Included. + split. + intros x [H _]. assumption. - eapply leEq_less_trans;[apply Hc1|]. - rstepr (One[+][--][--]One:IR). - apply plus_resp_less_lft. - apply inv_resp_less. - destruct (H _ (compact_inc_lft _ _ Hab)) as [A _]. - assumption. - intros x _ [Hx0 Hx1]. - split; apply plus_resp_leEq_lft; - apply inv_resp_leEq; assumption. - assert (A1:fun_series_convergent_IR DomArTanH (fun n : nat => Log_ps n[o]([-C-]One{-}FId))). - apply FSeries_Sum_comp_conv with (olor Zero Two); - try apply Log_series_convergent_IR; try Contin. - assert (A2:fun_series_convergent_IR DomArTanH (fun n : nat => ((Log_ps n[o][-C-]One{+}FId){-}(Log_ps n[o][-C-]One{-}FId)))). - apply FSeries_Sum_minus_conv; assumption. - assert (A3:Feq (olor Zero Two) (FSeries_Sum (J:=olor Zero Two) (f:=Log_ps) Log_series_convergent_IR) Logarithm). - split. - Included. - split. - intros x [H _]. - assumption. - intros; apply Log_series. - eapply Feq_transitive. - unfold Fscalmult. - eapply (FSeries_Sum_scal _ _ A2). - Contin. - unfold F. - apply Feq_mult. - apply Feq_reflexive. - repeat constructor. - eapply Feq_transitive. - apply (FSeries_Sum_minus _ _ _ A0 A1). - apply Feq_minus. + intros; apply Log_series. + eapply Feq_transitive. + unfold Fscalmult. + eapply (FSeries_Sum_scal _ _ A2). + Contin. + unfold F. + apply Feq_mult. + apply Feq_reflexive. + repeat constructor. + eapply Feq_transitive. + apply (FSeries_Sum_minus _ _ _ A0 A1). + apply Feq_minus. + eapply Feq_transitive. + apply (FSeries_Sum_comp DomArTanH (olor Zero Two)); try assumption. + Contin. + assert (X:forall (x : IR) (Hx : Dom ([-C-]One{+}FId) x), + DomArTanH x -> olor Zero Two (([-C-]One{+}FId) x Hx)). + intros x Hx [C0 C1]. + simpl; split. + apply shift_less_plus'. + rstepl ([--]One:IR). + assumption. + rstepr (One[+]One:IR). + apply plus_resp_less_lft. + assumption. + eapply Feq_comp; try apply A3; try (apply Feq_reflexive; Included); assumption. eapply Feq_transitive. apply (FSeries_Sum_comp DomArTanH (olor Zero Two)); try assumption. Contin. - assert (X:forall (x : IR) (Hx : Dom ([-C-]One{+}FId) x), - DomArTanH x -> olor Zero Two (([-C-]One{+}FId) x Hx)). + assert (X:forall (x : IR) (Hx : Dom ([-C-]One{-}FId) x), + DomArTanH x -> olor Zero Two (([-C-]One{-}FId) x Hx)). intros x Hx [C0 C1]. simpl; split. - apply shift_less_plus'. - rstepl ([--]One:IR). + apply shift_less_minus. + rstepl (x:IR). assumption. - rstepr (One[+]One:IR). + rstepr (One[-][--]One:IR). apply plus_resp_less_lft. + apply inv_resp_less. assumption. eapply Feq_comp; try apply A3; try (apply Feq_reflexive; Included); assumption. - eapply Feq_transitive. - apply (FSeries_Sum_comp DomArTanH (olor Zero Two)); try assumption. - Contin. - assert (X:forall (x : IR) (Hx : Dom ([-C-]One{-}FId) x), - DomArTanH x -> olor Zero Two (([-C-]One{-}FId) x Hx)). - intros x Hx [C0 C1]. - simpl; split. - apply shift_less_minus. - rstepl (x:IR). - assumption. - rstepr (One[-][--]One:IR). - apply plus_resp_less_lft. - apply inv_resp_less. - assumption. - eapply Feq_comp; try apply A3; try (apply Feq_reflexive; Included); assumption. -apply: mult_wdr. -apply eq_symmetric. -apply: Log_div. -Qed. \ No newline at end of file + apply: mult_wdr. + apply eq_symmetric. + apply: Log_div. +Qed. diff --git a/transc/Exponential.v b/transc/Exponential.v index 3464127d7..447b9dae3 100644 --- a/transc/Exponential.v +++ b/transc/Exponential.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export TaylorSeries. @@ -49,70 +49,59 @@ Exponential is strongly extensional and well defined. *) Lemma Exp_strext : forall x y : IR, Exp x [#] Exp y -> x [#] y. -intros x y H. -exact (un_op_strext_unfolded _ _ _ _ H). +Proof. + intros x y H. + exact (un_op_strext_unfolded _ _ _ _ H). Qed. Lemma Exp_wd : forall x y : IR, x [=] y -> Exp x [=] Exp y. -intros x y H. -unfold Exp in |- *; algebra. +Proof. + intros x y H. + unfold Exp in |- *; algebra. Qed. Hint Resolve Exp_wd: algebra. Lemma Exp_zero : Exp Zero [=] One. -unfold Exp in |- *; simpl in |- *. -set - (h := (fun n : nat => match n with - | O => One - | S p => Zero - end):nat -> IR) in *. -cut - (forall n : nat, - h n [=] (One[/] _[//]nring_fac_ap_zero _ n) [*]nexp _ n (Zero[-]Zero)). -intro H. -cut (convergent h). -intro H0. -apply eq_transitive_unfolded with (series_sum h H0). - apply series_sum_wd; algebra. -unfold series_sum in |- *. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. - apply Lim_const. -apply Lim_seq_eq_Lim_subseq with (f := fun n : nat => S n). - auto with arith. - intro n; exists (S n); split; auto with arith. -intro n; simpl in |- *. -induction n as [| n Hrecn]; simpl in |- *; - [ algebra | Step_final (OneR[+]Zero) ]. - -apply - convergent_wd - with - (fun n : nat => - (One[/] _[//]nring_fac_ap_zero IR n) [*]nexp _ n (Zero[-]Zero)). - algebra. -exact - (fun_series_conv_imp_conv Zero Zero (leEq_reflexive IR Zero) Exp_ps - (Exp_conv Zero Zero (leEq_reflexive IR Zero) - (compact_single_iprop realline Zero CI)) Zero - (compact_single_prop Zero) - (fun_series_inc_IR realline Exp_ps Exp_conv Zero CI)). - -simple destruct n; simpl in |- *; intros; rational. +Proof. + unfold Exp in |- *; simpl in |- *. + set (h := (fun n : nat => match n with | O => One | S p => Zero end):nat -> IR) in *. + cut (forall n : nat, h n [=] (One[/] _[//]nring_fac_ap_zero _ n) [*]nexp _ n (Zero[-]Zero)). + intro H. + cut (convergent h). + intro H0. + apply eq_transitive_unfolded with (series_sum h H0). + apply series_sum_wd; algebra. + unfold series_sum in |- *. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + apply Lim_const. + apply Lim_seq_eq_Lim_subseq with (f := fun n : nat => S n). + auto with arith. + intro n; exists (S n); split; auto with arith. + intro n; simpl in |- *. + induction n as [| n Hrecn]; simpl in |- *; [ algebra | Step_final (OneR[+]Zero) ]. + apply convergent_wd with (fun n : nat => + (One[/] _[//]nring_fac_ap_zero IR n) [*]nexp _ n (Zero[-]Zero)). + algebra. + exact (fun_series_conv_imp_conv Zero Zero (leEq_reflexive IR Zero) Exp_ps + (Exp_conv Zero Zero (leEq_reflexive IR Zero) (compact_single_iprop realline Zero CI)) Zero + (compact_single_prop Zero) (fun_series_inc_IR realline Exp_ps Exp_conv Zero CI)). + simple destruct n; simpl in |- *; intros; rational. Qed. (** $e^1=e$#e1=e#, where [e] was defined a long time ago. *) Lemma Exp_one : Exp One [=] E. -unfold E, Exp, e_series in |- *; simpl in |- *. -apply series_sum_wd; intro n. -astepr ((One[/] _[//]nring_fac_ap_zero IR n) [*]One); apply mult_wdr. -astepl ((One[+][--]ZeroR) [^]n). -eapply eq_transitive_unfolded. - 2: apply (one_nexp IR n). -apply nexp_wd; rational. +Proof. + unfold E, Exp, e_series in |- *; simpl in |- *. + apply series_sum_wd; intro n. + astepr ((One[/] _[//]nring_fac_ap_zero IR n) [*]One); apply mult_wdr. + astepl ((One[+][--]ZeroR) [^]n). + eapply eq_transitive_unfolded. + 2: apply (one_nexp IR n). + apply nexp_wd; rational. Qed. Hint Resolve Exp_zero Exp_one: algebra. @@ -122,27 +111,26 @@ The exponential function is its own derivative, and continuous. *) Lemma Derivative_Exp : forall H, Derivative realline H Expon Expon. -intro H. -unfold Expon, Exp_ps in |- *. -cut - (fun_series_convergent_IR realline - (FPowerSeries' Zero (fun n : nat => (fun _ : nat => One) (S n)))). -intro H0. -eapply Derivative_wdr. - 2: apply - Derivative_FPowerSeries1' with (a := fun _ : nat => OneR) (Hg := H0). -FEQ. -simpl in |- *. -apply series_sum_wd; algebra. - -fold Exp_ps in |- *; apply Exp_conv. +Proof. + intro H. + unfold Expon, Exp_ps in |- *. + cut (fun_series_convergent_IR realline + (FPowerSeries' Zero (fun n : nat => (fun _ : nat => One) (S n)))). + intro H0. + eapply Derivative_wdr. + 2: apply Derivative_FPowerSeries1' with (a := fun _ : nat => OneR) (Hg := H0). + FEQ. + simpl in |- *. + apply series_sum_wd; algebra. + fold Exp_ps in |- *; apply Exp_conv. Qed. Hint Resolve Derivative_Exp: derivate. Lemma Continuous_Exp : Continuous realline Expon. -apply Derivative_imp_Continuous with CI Expon. -apply Derivative_Exp. +Proof. + apply Derivative_imp_Continuous with CI Expon. + apply Derivative_Exp. Qed. Hint Resolve Continuous_Exp: continuous. @@ -152,50 +140,53 @@ Negative numbers are projected into the interval [[0,1]]. *) Lemma One_less_Exp : forall x : IR, Zero [<] x -> One [<] Exp x. -unfold Exp in |- *; simpl in |- *; intros x H. -unfold series_sum in |- *. -apply less_leEq_trans with (One[+]x). - astepl (OneR[+]Zero); apply plus_resp_less_lft; auto. -apply str_leEq_seq_so_leEq_Lim. -exists 2; intros i Hi. -simpl in |- *. -unfold seq_part_sum in |- *. -induction i as [| i Hreci]. - elimtype False; inversion Hi. -clear Hreci. -induction i as [| i Hreci]. - elimtype False; inversion Hi; inversion H1. -clear Hreci. -induction i as [| i Hreci]. +Proof. + unfold Exp in |- *; simpl in |- *; intros x H. + unfold series_sum in |- *. + apply less_leEq_trans with (One[+]x). + astepl (OneR[+]Zero); apply plus_resp_less_lft; auto. + apply str_leEq_seq_so_leEq_Lim. + exists 2; intros i Hi. simpl in |- *. - apply eq_imp_leEq; rational. -eapply leEq_transitive. - apply Hreci; auto with arith. -clear Hreci. -eapply leEq_wdl. - 2: apply cm_rht_unit_unfolded. -set (j := S (S i)) in *; clearbody j. -simpl in |- *; apply plus_resp_leEq_lft. -apply less_leEq; apply mult_resp_pos. - apply recip_resp_pos; apply pos_nring_fac. -astepr ((x[+][--]Zero) [^]j); apply nexp_resp_pos. -rstepr x; auto. + unfold seq_part_sum in |- *. + induction i as [| i Hreci]. + elimtype False; inversion Hi. + clear Hreci. + induction i as [| i Hreci]. + elimtype False; inversion Hi; inversion H1. + clear Hreci. + induction i as [| i Hreci]. + simpl in |- *. + apply eq_imp_leEq; rational. + eapply leEq_transitive. + apply Hreci; auto with arith. + clear Hreci. + eapply leEq_wdl. + 2: apply cm_rht_unit_unfolded. + set (j := S (S i)) in *; clearbody j. + simpl in |- *; apply plus_resp_leEq_lft. + apply less_leEq; apply mult_resp_pos. + apply recip_resp_pos; apply pos_nring_fac. + astepr ((x[+][--]Zero) [^]j); apply nexp_resp_pos. + rstepr x; auto. Qed. Lemma One_leEq_Exp : forall x : IR, Zero [<=] x -> One [<=] Exp x. -intros x H. -astepl (Exp Zero). -apply resp_leEq_char; auto. - algebra. -intro H0; astepl OneR. -apply One_less_Exp; auto. +Proof. + intros x H. + astepl (Exp Zero). + apply resp_leEq_char; auto. + algebra. + intro H0; astepl OneR. + apply One_less_Exp; auto. Qed. Lemma Exp_pos' : forall x : IR, Zero [<] x -> Zero [<] Exp x. -intros x H. -apply less_leEq_trans with OneR. - apply pos_one. -apply One_leEq_Exp; apply less_leEq; auto. +Proof. + intros x H. + apply less_leEq_trans with OneR. + apply pos_one. + apply One_leEq_Exp; apply less_leEq; auto. Qed. (** @@ -205,140 +196,132 @@ its own derivative. Lemma Exp_unique_lemma : forall H F, Derivative realline H F F -> forall n, Derivative_n n realline H F F. -intros H F H0 n; induction n as [| n Hrecn]. - apply Derivative_n_O; Included. -apply Derivative_n_plus with n 1 F; auto. -apply Derivative_n_1; auto. +Proof. + intros H F H0 n; induction n as [| n Hrecn]. + apply Derivative_n_O; Included. + apply Derivative_n_plus with n 1 F; auto. + apply Derivative_n_1; auto. Qed. Lemma Exp_bnd : Taylor_bnd (fun n => Expon). -apply bnd_imp_Taylor_bnd with Expon. - intros n x Hx Hx'; apply eq_imp_leEq; algebra. - Contin. -Included. +Proof. + apply bnd_imp_Taylor_bnd with Expon. + intros n x Hx Hx'; apply eq_imp_leEq; algebra. + Contin. + Included. Qed. Lemma Exp_unique : forall F, Derivative realline CI F F -> (forall H1, F Zero H1 [=] One) -> Feq realline Expon F. -intros F H H0. -cut (forall n : nat, Derivative_n n realline CI Expon Expon). -intro derF. -cut (Taylor_bnd (fun n : nat => Expon)); [ intro bndf | apply Exp_bnd ]. -cut (forall n : nat, Derivative_n n realline CI F F). -intros derG. -apply - Taylor_unique_crit - with - (f := fun _ : nat => Expon) - (a := ZeroR) - (g := fun n : nat => F) - (bndf := bndf) - (derF := derF); auto. - apply bnd_imp_Taylor_bnd with F. - intros; apply eq_imp_leEq; algebra. - apply Derivative_n_imp_Continuous with CI 1 F; auto with arith. - intro n. - change (included realline (Dom F)) in |- *. - apply Derivative_n_imp_inc with CI 1 F; auto with arith. - intros; astepr OneR. - astepr (Exp Zero). - Opaque Expon. - unfold Exp in |- *; simpl in |- *; algebra. - Transparent Expon. -apply Taylor_Series_conv_to_fun; auto. - -apply Exp_unique_lemma; auto. - -apply Exp_unique_lemma; apply Derivative_Exp. +Proof. + intros F H H0. + cut (forall n : nat, Derivative_n n realline CI Expon Expon). + intro derF. + cut (Taylor_bnd (fun n : nat => Expon)); [ intro bndf | apply Exp_bnd ]. + cut (forall n : nat, Derivative_n n realline CI F F). + intros derG. + apply Taylor_unique_crit with (f := fun _ : nat => Expon) (a := ZeroR) (g := fun n : nat => F) + (bndf := bndf) (derF := derF); auto. + apply bnd_imp_Taylor_bnd with F. + intros; apply eq_imp_leEq; algebra. + apply Derivative_n_imp_Continuous with CI 1 F; auto with arith. + intro n. + change (included realline (Dom F)) in |- *. + apply Derivative_n_imp_inc with CI 1 F; auto with arith. + intros; astepr OneR. + astepr (Exp Zero). + Opaque Expon. + unfold Exp in |- *; simpl in |- *; algebra. + Transparent Expon. + apply Taylor_Series_conv_to_fun; auto. + apply Exp_unique_lemma; auto. + apply Exp_unique_lemma; apply Derivative_Exp. Qed. Opaque Expon. Lemma Exp_plus_pos : forall z, Zero [<] z -> forall x, Exp (x[+]z) [=] Exp x[*]Exp z. -intros z H x. -set - (F := - (One[/] _[//]pos_ap_zero _ _ (Exp_pos' _ H)) {**} (Expon[o]FId{+}[-C-]z)) - in *. -apply eq_symmetric_unfolded. -rstepr ((Exp (x[+]z) [/] _[//]pos_ap_zero _ _ (Exp_pos' _ H)) [*]Exp z). -apply mult_wdl. -unfold Exp at 1 in |- *. -simpl in |- *. -assert (H0 : Dom F x). repeat split; exists (CAnd_intro _ _ CI CI); apply Exp_domain. -apply eq_transitive_unfolded with (Part F x H0). - 2: unfold F, Exp in |- *; simpl in |- *; rational. -apply Feq_imp_eq with realline. - apply Exp_unique. - assert (H1 : Derivative realline CI Expon Expon). apply Derivative_Exp. - unfold F in |- *; Derivative_Help. - apply eq_imp_Feq. - apply included_FScalMult; apply included_FMult. - apply included_FComp; Included. - Included. - apply included_FScalMult; apply included_FComp; Included. - intros; simpl in |- *; rational. - apply Derivative_scal. - apply Derivative_comp with realline CI; Deriv. - red in |- *; intros a b Hab H2. - exists (a[+]z); exists (b[+]z[+]One). - cut (a[+]z [<] b[+]z[+]One). - intro H3. - exists H3; repeat split; simpl in |- *; try rename H4 into X; - elim X; try intros H5 H6. - apply plus_resp_leEq; auto. - apply leEq_transitive with (b[+]z). - apply plus_resp_leEq; auto. - apply less_leEq; apply less_plusOne. - - apply leEq_less_trans with (b[+]z). - apply plus_resp_leEq; auto. - apply less_plusOne. - intro H1; simpl in |- *. - rational. -split. +Proof. + intros z H x. + set (F := (One[/] _[//]pos_ap_zero _ _ (Exp_pos' _ H)) {**} (Expon[o]FId{+}[-C-]z)) in *. + apply eq_symmetric_unfolded. + rstepr ((Exp (x[+]z) [/] _[//]pos_ap_zero _ _ (Exp_pos' _ H)) [*]Exp z). + apply mult_wdl. + unfold Exp at 1 in |- *. + simpl in |- *. + assert (H0 : Dom F x). repeat split; exists (CAnd_intro _ _ CI CI); apply Exp_domain. + apply eq_transitive_unfolded with (Part F x H0). + 2: unfold F, Exp in |- *; simpl in |- *; rational. + apply Feq_imp_eq with realline. + apply Exp_unique. + assert (H1 : Derivative realline CI Expon Expon). apply Derivative_Exp. + unfold F in |- *; Derivative_Help. + apply eq_imp_Feq. + apply included_FScalMult; apply included_FMult. + apply included_FComp; Included. + Included. + apply included_FScalMult; apply included_FComp; Included. + intros; simpl in |- *; rational. + apply Derivative_scal. + apply Derivative_comp with realline CI; Deriv. + red in |- *; intros a b Hab H2. + exists (a[+]z); exists (b[+]z[+]One). + cut (a[+]z [<] b[+]z[+]One). + intro H3. + exists H3; repeat split; simpl in |- *; try rename H4 into X; elim X; try intros H5 H6. + apply plus_resp_leEq; auto. + apply leEq_transitive with (b[+]z). + apply plus_resp_leEq; auto. + apply less_leEq; apply less_plusOne. + apply leEq_less_trans with (b[+]z). + apply plus_resp_leEq; auto. + apply less_plusOne. + intro H1; simpl in |- *. + rational. + split. Qed. (** The usual rules for computing the exponential of a sum. *) Lemma Exp_plus : forall x y : IR, Exp (x[+]y) [=] Exp x[*]Exp y. -intros x y. -set (z := Max One (One[-]y)) in *. -cut (Zero [<] z). -intro H. -apply mult_cancel_rht with (Exp z). - apply Greater_imp_ap; apply Exp_pos'; auto. -eapply eq_transitive_unfolded. - apply eq_symmetric_unfolded; apply Exp_plus_pos; auto. -astepl (Exp (x[+] (y[+]z))). -eapply eq_transitive_unfolded. - apply Exp_plus_pos. - 2: astepr (Exp x[*] (Exp y[*]Exp z)); apply mult_wdr; apply Exp_plus_pos; - auto. -unfold z in |- *. -apply shift_less_plus'; astepl ( [--]y). -apply less_leEq_trans with (One[-]y). - eapply less_wdr. - apply less_plusOne. - rational. -apply rht_leEq_Max. - -apply less_leEq_trans with OneR. - apply pos_one. -unfold z in |- *; apply lft_leEq_Max. +Proof. + intros x y. + set (z := Max One (One[-]y)) in *. + cut (Zero [<] z). + intro H. + apply mult_cancel_rht with (Exp z). + apply Greater_imp_ap; apply Exp_pos'; auto. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply Exp_plus_pos; auto. + astepl (Exp (x[+] (y[+]z))). + eapply eq_transitive_unfolded. + apply Exp_plus_pos. + 2: astepr (Exp x[*] (Exp y[*]Exp z)); apply mult_wdr; apply Exp_plus_pos; auto. + unfold z in |- *. + apply shift_less_plus'; astepl ( [--]y). + apply less_leEq_trans with (One[-]y). + eapply less_wdr. + apply less_plusOne. + rational. + apply rht_leEq_Max. + apply less_leEq_trans with OneR. + apply pos_one. + unfold z in |- *; apply lft_leEq_Max. Qed. Hint Resolve Exp_plus: algebra. Lemma Exp_plus' : forall x y z : IR, z [=] x[+]y -> Exp z [=] Exp x[*]Exp y. -intros x y z H. -Step_final (Exp (x[+]y)). +Proof. + intros x y z H. + Step_final (Exp (x[+]y)). Qed. Lemma Exp_inv_char : forall x : IR, Exp x[*]Exp [--]x [=] One. -intro x. -astepr (Exp Zero). -apply eq_symmetric_unfolded; apply Exp_plus'. -algebra. +Proof. + intro x. + astepr (Exp Zero). + apply eq_symmetric_unfolded; apply Exp_plus'. + algebra. Qed. Hint Resolve Exp_inv_char: algebra. @@ -348,69 +331,66 @@ from zero. *) Lemma Exp_pos : forall x : IR, Zero [<] Exp x. -intro x. -cut (Exp x[*]Exp [--]x [=] One); [ intro | apply Exp_inv_char ]. -cut ( [--]One [<=] OneR). -intro H0. -cut (Continuous_I H0 Expon). -intro H1. -elim H1; intros Hinc contExp. -elim (contExp _ (pos_half IR)); clear H1 Hinc contExp; intros d H1 H2. -cut (Zero [<] Min d One); [ intro H3 | apply less_Min; auto; apply pos_one ]. -cut ( [--] (Min d One) [<] Zero); - [ intro H4 | astepr ( [--]ZeroR); apply inv_resp_less; auto ]. -elim (less_cotransitive _ _ _ H4 x); intro H5. - elim (less_cotransitive _ _ _ H3 x); intro H6. - apply Exp_pos'; auto. - apply less_leEq_trans with (Half:IR). - apply pos_half. - apply leEq_wdl with (One[-] (Half:IR)). - 2: unfold Half in |- *; rational. - apply shift_minus_leEq; apply shift_leEq_plus'. - astepl (Exp Zero[-]Exp x). - eapply leEq_transitive. - apply leEq_AbsIR. - simpl in |- *; apply H2. - split; apply less_leEq. - astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. - apply pos_one. - split; apply less_leEq. - apply leEq_less_trans with ( [--] (Min d One)). - apply inv_resp_leEq; apply Min_leEq_rht. - auto. - apply less_leEq_trans with (Min d One). - auto. - apply Min_leEq_rht. - astepl (AbsIR [--]x). - eapply leEq_wdl. - 2: apply AbsIR_inv. - simpl in |- *; unfold ABSIR in |- *; apply less_leEq; apply Max_less. - apply less_leEq_trans with (Min d One); auto; apply Min_leEq_lft. - apply less_leEq_trans with ( [--][--] (Min d One)). - apply inv_resp_less; auto. - astepl (Min d One); apply Min_leEq_lft. -clear H4 H3 H2 H1 d H0. -apply mult_cancel_less with (Exp [--]x). - apply Exp_pos'. - astepl ( [--]ZeroR); apply inv_resp_less; auto. -astepl ZeroR; astepr OneR; apply pos_one. - -apply included_imp_Continuous with realline; - [ apply Continuous_Exp | repeat split ]. - -apply leEq_transitive with ZeroR; - [ astepr ( [--]ZeroR) | apply less_leEq; apply pos_one ]. -apply inv_resp_leEq; apply less_leEq; apply pos_one. +Proof. + intro x. + cut (Exp x[*]Exp [--]x [=] One); [ intro | apply Exp_inv_char ]. + cut ( [--]One [<=] OneR). + intro H0. + cut (Continuous_I H0 Expon). + intro H1. + elim H1; intros Hinc contExp. + elim (contExp _ (pos_half IR)); clear H1 Hinc contExp; intros d H1 H2. + cut (Zero [<] Min d One); [ intro H3 | apply less_Min; auto; apply pos_one ]. + cut ( [--] (Min d One) [<] Zero); [ intro H4 | astepr ( [--]ZeroR); apply inv_resp_less; auto ]. + elim (less_cotransitive _ _ _ H4 x); intro H5. + elim (less_cotransitive _ _ _ H3 x); intro H6. + apply Exp_pos'; auto. + apply less_leEq_trans with (Half:IR). + apply pos_half. + apply leEq_wdl with (One[-] (Half:IR)). + 2: unfold Half in |- *; rational. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl (Exp Zero[-]Exp x). + eapply leEq_transitive. + apply leEq_AbsIR. + simpl in |- *; apply H2. + split; apply less_leEq. + astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. + apply pos_one. + split; apply less_leEq. + apply leEq_less_trans with ( [--] (Min d One)). + apply inv_resp_leEq; apply Min_leEq_rht. + auto. + apply less_leEq_trans with (Min d One). + auto. + apply Min_leEq_rht. + astepl (AbsIR [--]x). + eapply leEq_wdl. + 2: apply AbsIR_inv. + simpl in |- *; unfold ABSIR in |- *; apply less_leEq; apply Max_less. + apply less_leEq_trans with (Min d One); auto; apply Min_leEq_lft. + apply less_leEq_trans with ( [--][--] (Min d One)). + apply inv_resp_less; auto. + astepl (Min d One); apply Min_leEq_lft. + clear H4 H3 H2 H1 d H0. + apply mult_cancel_less with (Exp [--]x). + apply Exp_pos'. + astepl ( [--]ZeroR); apply inv_resp_less; auto. + astepl ZeroR; astepr OneR; apply pos_one. + apply included_imp_Continuous with realline; [ apply Continuous_Exp | repeat split ]. + apply leEq_transitive with ZeroR; [ astepr ( [--]ZeroR) | apply less_leEq; apply pos_one ]. + apply inv_resp_leEq; apply less_leEq; apply pos_one. Qed. Lemma Exp_ap_zero : forall x : IR, Exp x [#] Zero. -intro; apply Greater_imp_ap; apply Exp_pos. +Proof. + intro; apply Greater_imp_ap; apply Exp_pos. Qed. Lemma pos_E : Zero [<] E. Proof. -astepr (Exp One). -apply Exp_pos. + astepr (Exp One). + apply Exp_pos. Qed. (** @@ -418,69 +398,77 @@ And the rules for the exponential of differences. *) Lemma Exp_inv : forall x : IR, Exp [--]x [=] (One[/] _[//]Exp_ap_zero x). -intro x. -apply mult_cancel_lft with (Exp x). - apply Exp_ap_zero. -rstepr OneR; algebra. +Proof. + intro x. + apply mult_cancel_lft with (Exp x). + apply Exp_ap_zero. + rstepr OneR; algebra. Qed. Hint Resolve Exp_inv: algebra. Lemma Exp_minus : forall x y : IR, Exp (x[-]y) [=] (Exp x[/] _[//]Exp_ap_zero y). -intros x y. -unfold cg_minus in |- *; astepl (Exp x[*]Exp [--]y). -rstepr (Exp x[*] (One[/] _[//]Exp_ap_zero y)). -algebra. +Proof. + intros x y. + unfold cg_minus in |- *; astepl (Exp x[*]Exp [--]y). + rstepr (Exp x[*] (One[/] _[//]Exp_ap_zero y)). + algebra. Qed. Hint Resolve Exp_minus: algebra. Lemma Exp_inv' : forall x y : IR, y [=] [--]x -> Exp y [=] (One[/] _[//]Exp_ap_zero x). -intros x y Hxy. -Step_final (Exp [--]x). +Proof. + intros x y Hxy. + Step_final (Exp [--]x). Qed. Lemma Exp_minus' : forall x y z : IR, z [=] x[-]y -> Exp z [=] (Exp x[/] Exp y[//]Exp_ap_zero _). -intros x y z H. -Step_final (Exp (x[-]y)). +Proof. + intros x y z H. + Step_final (Exp (x[-]y)). Qed. (** Exponential is a monotonous function. *) Lemma Exp_less_One : forall x : IR, x [<] Zero -> Exp x [<] One. -intros x H. -astepr (Exp x[*]Exp [--]x). -astepl (Exp x[*]One). -apply mult_resp_less_lft. - apply One_less_Exp; astepl ( [--]ZeroR); apply inv_resp_less; auto. -apply Exp_pos. +Proof. + intros x H. + astepr (Exp x[*]Exp [--]x). + astepl (Exp x[*]One). + apply mult_resp_less_lft. + apply One_less_Exp; astepl ( [--]ZeroR); apply inv_resp_less; auto. + apply Exp_pos. Qed. Lemma Exp_leEq_One : forall x : IR, x [<=] Zero -> Exp x [<=] One. -intros x H. -astepr (Exp x[*]Exp [--]x). -astepl (Exp x[*]One). -apply mult_resp_leEq_lft. - apply One_leEq_Exp; astepl ( [--]ZeroR); apply inv_resp_leEq; auto. -apply less_leEq; apply Exp_pos. +Proof. + intros x H. + astepr (Exp x[*]Exp [--]x). + astepl (Exp x[*]One). + apply mult_resp_leEq_lft. + apply One_leEq_Exp; astepl ( [--]ZeroR); apply inv_resp_leEq; auto. + apply less_leEq; apply Exp_pos. Qed. Lemma Exp_resp_less : forall x y : IR, x [<] y -> Exp x [<] Exp y. -intros x y H. -apply less_wdr with (Exp (x[+] (y[-]x))). - 2: apply Exp_wd; rational. -astepr (Exp x[*]Exp (y[-]x)). -astepl (Exp x[*]One). -apply mult_resp_less_lft. - apply One_less_Exp. - apply shift_less_minus; astepl x; auto. -apply Exp_pos. +Proof. + intros x y H. + apply less_wdr with (Exp (x[+] (y[-]x))). + 2: apply Exp_wd; rational. + astepr (Exp x[*]Exp (y[-]x)). + astepl (Exp x[*]One). + apply mult_resp_less_lft. + apply One_less_Exp. + apply shift_less_minus; astepl x; auto. + apply Exp_pos. Qed. Lemma Exp_resp_leEq : forall x y : IR, x [<=] y -> Exp x [<=] Exp y. -intros x y; apply resp_leEq_char. - algebra. -intro H; apply Exp_resp_less; auto. +Proof. + intros x y; apply resp_leEq_char. + algebra. + intro H; apply Exp_resp_less; auto. Qed. (** @@ -490,16 +478,18 @@ The logarithm is a continuous function with derivative [One[/]x]. *) Lemma Derivative_Log : forall H, Derivative (openl Zero) H Logarithm {1/}FId. -intro H. -unfold Logarithm in |- *. -Deriv. +Proof. + intro H. + unfold Logarithm in |- *. + Deriv. Qed. Hint Resolve Derivative_Log: derivate. Lemma Continuous_Log : Continuous (openl Zero) Logarithm. -apply Derivative_imp_Continuous with CI ( {1/} (Fid IR)). -Deriv. +Proof. + apply Derivative_imp_Continuous with CI ( {1/} (Fid IR)). + Deriv. Qed. Hint Resolve Continuous_Log: continuous. @@ -507,8 +497,9 @@ Hint Resolve Continuous_Log: continuous. (** Logarithm of [One]. *) Lemma Log_one : forall H, Log One H [=] Zero. -intro H; unfold Log in |- *; simpl in |- *. -apply Integral_empty; algebra. +Proof. + intro H; unfold Log in |- *; simpl in |- *. + apply Integral_empty; algebra. Qed. Hint Resolve Log_one: algebra. @@ -516,14 +507,16 @@ Hint Resolve Log_one: algebra. (** The logarithm is (strongly) extensional. *) Lemma Log_strext : forall (x y : IR) Hx Hy, Log x Hx [#] Log y Hy -> x [#] y. -intros x y Hx Hy H. -unfold Log in H. -exact (pfstrx _ _ _ _ _ _ H). +Proof. + intros x y Hx Hy H. + unfold Log in H. + exact (pfstrx _ _ _ _ _ _ H). Qed. Lemma Log_wd : forall (x y : IR) Hx Hy, x [=] y -> Log x Hx [=] Log y Hy. -intros x y Hx Hy H. -unfold Log in |- *; algebra. +Proof. + intros x y Hx Hy H. + unfold Log in |- *; algebra. Qed. Hint Resolve Log_wd: algebra. @@ -531,118 +524,109 @@ Hint Resolve Log_wd: algebra. (** The rule for the logarithm of the product. *) Lemma Log_mult : forall x y Hx Hy Hxy, Log (x[*]y) Hxy [=] Log x Hx[+]Log y Hy. -intros x y Hx Hy Hxy. -set (G := (Logarithm[o]y{**}FId) {-}[-C-] (Log y Hy)) in *. -cut (proper (openl Zero)); [ intro H | simpl in |- *; auto ]. -cut (Derivative (openl Zero) H G {1/}FId). -intro H0. -cut (Derivative (openl Zero) H Logarithm {1/}FId); [ intro H1 | Deriv ]. -elim (FTC2 (openl Zero) {1/}FId log_defn_lemma One (pos_one IR) H G H0); - intros c Hc. -fold Logarithm in Hc. -elim Hc; intros H2' H2''. -elim H2''; intros H2 H5. -clear Hc H2 H2' H2''. -cut (c [=] Zero). -intro H2. -cut (forall z w t : IR, w[-] (z[-]t) [=] Zero -> z [=] w[+]t). -intro H3. -apply H3; clear H3. -astepr c; clear H2. -cut (Dom (Logarithm{-}G) x); [ intro H2 | repeat split; simpl in |- *; auto ]. -eapply eq_transitive_unfolded. - 2: apply (H5 x Hx H2 CI). -Opaque Logarithm. -simpl in |- *; algebra. - -clear H5. -exists (CAnd_intro _ _ CI CI); apply mult_resp_pos; auto. - -intros z w t H3. -rstepl (z[-]t[+]t). -apply bin_op_wd_unfolded. - 2: algebra. -apply cg_inv_unique_2. -astepr ( [--]ZeroR). -rstepl ( [--] (w[-] (z[-]t))). -apply un_op_wd_unfolded; auto. - -cut (Dom (Logarithm{-}G) One); - [ intro H2 | repeat split; simpl in |- *; auto ]. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. - 2: apply (H5 One (pos_one IR) H2 CI). -simpl in |- *. -rstepl (Zero[-] (Log y Hy[-]Log y Hy)). -algebra. - -Transparent Logarithm. -simpl in |- *; apply pos_one. - -exists (CAnd_intro _ _ CI CI); simpl in |- *; apply mult_resp_pos; auto; - apply pos_one. - -unfold G in |- *. -cut (Derivative (openl Zero) H Logarithm {1/}FId); - [ intro H0 | unfold Logarithm in |- *; apply FTC1 ]. -Derivative_Help. - apply eq_imp_Feq. - repeat split. - exists (CAnd_intro _ _ CI CI); simpl in |- *. - repeat split. - intros; apply Greater_imp_ap; apply mult_resp_pos; auto. - Included. - intros; simpl in |- *; rational. -apply Derivative_minus. - apply Derivative_comp with (openl Zero) H; Deriv. - clear H0; red in |- *; intros a b Hab H0. - simpl in |- *; exists (y[*]a); exists (y[*]b[+]One). - cut (y[*]a [<] y[*]b[+]One). - intro H1; exists H1; split. - intros x0 H2. - elim H2; intros H3 H4; simpl in |- *. - apply less_leEq_trans with (y[*]a). - apply mult_resp_pos; auto. - apply H0; apply compact_inc_lft. - auto. - intros x0 Hx0 H2; elim H2; intros H3 H4; split. - apply mult_resp_leEq_lft; auto. - apply less_leEq; auto. - apply leEq_transitive with (y[*]b). - apply mult_resp_leEq_lft; auto. - apply less_leEq; auto. - apply less_leEq; apply less_plusOne. - - apply leEq_less_trans with (y[*]b). - apply mult_resp_leEq_lft; auto. - apply less_leEq; auto. - apply less_plusOne. -Deriv. +Proof. + intros x y Hx Hy Hxy. + set (G := (Logarithm[o]y{**}FId) {-}[-C-] (Log y Hy)) in *. + cut (proper (openl Zero)); [ intro H | simpl in |- *; auto ]. + cut (Derivative (openl Zero) H G {1/}FId). + intro H0. + cut (Derivative (openl Zero) H Logarithm {1/}FId); [ intro H1 | Deriv ]. + elim (FTC2 (openl Zero) {1/}FId log_defn_lemma One (pos_one IR) H G H0); intros c Hc. + fold Logarithm in Hc. + elim Hc; intros H2' H2''. + elim H2''; intros H2 H5. + clear Hc H2 H2' H2''. + cut (c [=] Zero). + intro H2. + cut (forall z w t : IR, w[-] (z[-]t) [=] Zero -> z [=] w[+]t). + intro H3. + apply H3; clear H3. + astepr c; clear H2. + cut (Dom (Logarithm{-}G) x); [ intro H2 | repeat split; simpl in |- *; auto ]. + eapply eq_transitive_unfolded. + 2: apply (H5 x Hx H2 CI). + Opaque Logarithm. + simpl in |- *; algebra. + clear H5. + exists (CAnd_intro _ _ CI CI); apply mult_resp_pos; auto. + intros z w t H3. + rstepl (z[-]t[+]t). + apply bin_op_wd_unfolded. + 2: algebra. + apply cg_inv_unique_2. + astepr ( [--]ZeroR). + rstepl ( [--] (w[-] (z[-]t))). + apply un_op_wd_unfolded; auto. + cut (Dom (Logarithm{-}G) One); [ intro H2 | repeat split; simpl in |- *; auto ]. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply (H5 One (pos_one IR) H2 CI). + simpl in |- *. + rstepl (Zero[-] (Log y Hy[-]Log y Hy)). + algebra. + Transparent Logarithm. + simpl in |- *; apply pos_one. + exists (CAnd_intro _ _ CI CI); simpl in |- *; apply mult_resp_pos; auto; apply pos_one. + unfold G in |- *. + cut (Derivative (openl Zero) H Logarithm {1/}FId); + [ intro H0 | unfold Logarithm in |- *; apply FTC1 ]. + Derivative_Help. + apply eq_imp_Feq. + repeat split. + exists (CAnd_intro _ _ CI CI); simpl in |- *. + repeat split. + intros; apply Greater_imp_ap; apply mult_resp_pos; auto. + Included. + intros; simpl in |- *; rational. + apply Derivative_minus. + apply Derivative_comp with (openl Zero) H; Deriv. + clear H0; red in |- *; intros a b Hab H0. + simpl in |- *; exists (y[*]a); exists (y[*]b[+]One). + cut (y[*]a [<] y[*]b[+]One). + intro H1; exists H1; split. + intros x0 H2. + elim H2; intros H3 H4; simpl in |- *. + apply less_leEq_trans with (y[*]a). + apply mult_resp_pos; auto. + apply H0; apply compact_inc_lft. + auto. + intros x0 Hx0 H2; elim H2; intros H3 H4; split. + apply mult_resp_leEq_lft; auto. + apply less_leEq; auto. + apply leEq_transitive with (y[*]b). + apply mult_resp_leEq_lft; auto. + apply less_leEq; auto. + apply less_leEq; apply less_plusOne. + apply leEq_less_trans with (y[*]b). + apply mult_resp_leEq_lft; auto. + apply less_leEq; auto. + apply less_plusOne. + Deriv. Qed. Hint Resolve Log_mult: algebra. Lemma Log_mult' : forall x y z Hx Hy Hz, z [=] x[*]y -> Log z Hz [=] Log x Hx[+]Log y Hy. -intros. -Step_final (Log (x[*]y) (mult_resp_pos _ _ _ Hx Hy)). +Proof. + intros. + Step_final (Log (x[*]y) (mult_resp_pos _ _ _ Hx Hy)). Qed. Lemma Log_nexp : forall x n Hx Hxn, Log (x[^]n) Hxn [=] (nring n)[*]Log x Hx. Proof. -induction n. + induction n. + intros Hx Hn. + simpl. + rstepr (Zero:IR). + apply Log_one. intros Hx Hn. - simpl. - rstepr (Zero:IR). - apply Log_one. -intros Hx Hn. -assert (X:Zero[<]x[^]n). - apply nexp_resp_pos. - assumption. -stepl (Log _ X[+]Log x Hx) by - (apply eq_symmetric; apply (Log_mult _ _ X Hx)). -astepr ((nring n [+] One)[*]Log x Hx). -rstepr (nring n[*]Log x Hx[+]Log x Hx). -apply bin_op_wd_unfolded; try apply eq_reflexive. -apply IHn. + assert (X:Zero[<]x[^]n). + apply nexp_resp_pos. + assumption. + stepl (Log _ X[+]Log x Hx) by (apply eq_symmetric; apply (Log_mult _ _ X Hx)). + astepr ((nring n [+] One)[*]Log x Hx). + rstepr (nring n[*]Log x Hx[+]Log x Hx). + apply bin_op_wd_unfolded; try apply eq_reflexive. + apply IHn. Qed. Hint Resolve Log_nexp: algebra. @@ -650,7 +634,8 @@ Hint Resolve Log_nexp: algebra. (** A characterization of the domain of the logarithm. *) Lemma Log_domain : forall x : IR, Zero [<] x -> Dom Logarithm x. -intros; auto. +Proof. + intros; auto. Qed. Opaque Expon Logarithm. @@ -660,65 +645,62 @@ numerical and as a functional equation. *) Lemma Log_Exp_inv : Feq realline (Logarithm[o]Expon) FId. -apply Feq_criterium with CI (Fconst (S:=IR) One) ZeroR. - cut (Derivative realline CI Expon Expon); - [ intro H | apply Derivative_Exp ]. - cut (Derivative (openl Zero) CI Logarithm {1/}FId); - [ intro H0 | apply Derivative_Log ]. - Derivative_Help. - apply eq_imp_Feq. - split; auto. - exists CI. - split; auto. - intro; simpl in |- *; apply Greater_imp_ap. - apply less_wdr with (Exp x); [ apply Exp_pos | simpl in |- *; algebra ]. - Included. - intros; simpl in |- *; rational. - apply Derivative_comp with (openl Zero) CI; Deriv. - red in |- *; intros a b Hab H1. - exists (Exp a); exists (Exp b[+]One); - exists - (leEq_less_trans _ _ _ _ (Exp_resp_leEq _ _ Hab) (less_plusOne _ _)). - split. - red in |- *; intros x H2. - elim H2; intros H3 H4. - simpl in |- *. - apply less_leEq_trans with (Exp a); auto. - apply Exp_pos. - intros x Hx H2; elim H2; intros H3 H4; split. - apply leEq_wdr with (Exp x). - apply Exp_resp_leEq; auto. - simpl in |- *; algebra. - apply less_leEq; apply leEq_less_trans with (Exp b). - apply leEq_wdl with (Exp x). - apply Exp_resp_leEq; auto. - simpl in |- *; algebra. - apply less_plusOne. - Deriv. - split. -intros; simpl in |- *. -astepr (Log One (pos_one _)). -unfold Log in |- *; apply pfwdef. -astepr (Exp Zero). -simpl in |- *; algebra. +Proof. + apply Feq_criterium with CI (Fconst (S:=IR) One) ZeroR. + cut (Derivative realline CI Expon Expon); [ intro H | apply Derivative_Exp ]. + cut (Derivative (openl Zero) CI Logarithm {1/}FId); [ intro H0 | apply Derivative_Log ]. + Derivative_Help. + apply eq_imp_Feq. + split; auto. + exists CI. + split; auto. + intro; simpl in |- *; apply Greater_imp_ap. + apply less_wdr with (Exp x); [ apply Exp_pos | simpl in |- *; algebra ]. + Included. + intros; simpl in |- *; rational. + apply Derivative_comp with (openl Zero) CI; Deriv. + red in |- *; intros a b Hab H1. + exists (Exp a); exists (Exp b[+]One); exists + (leEq_less_trans _ _ _ _ (Exp_resp_leEq _ _ Hab) (less_plusOne _ _)). + split. + red in |- *; intros x H2. + elim H2; intros H3 H4. + simpl in |- *. + apply less_leEq_trans with (Exp a); auto. + apply Exp_pos. + intros x Hx H2; elim H2; intros H3 H4; split. + apply leEq_wdr with (Exp x). + apply Exp_resp_leEq; auto. + simpl in |- *; algebra. + apply less_leEq; apply leEq_less_trans with (Exp b). + apply leEq_wdl with (Exp x). + apply Exp_resp_leEq; auto. + simpl in |- *; algebra. + apply less_plusOne. + Deriv. + split. + intros; simpl in |- *. + astepr (Log One (pos_one _)). + unfold Log in |- *; apply pfwdef. + astepr (Exp Zero). + simpl in |- *; algebra. Qed. Lemma Log_Exp : forall x H, Log (Exp x) H [=] x. -intros x H. -cut (Dom (Logarithm[o]Expon) x). -intro H0. -unfold Log in |- *; simpl in |- *; - apply eq_transitive_unfolded with (Part _ _ H0). +Proof. + intros x H. + cut (Dom (Logarithm[o]Expon) x). + intro H0. + unfold Log in |- *; simpl in |- *; apply eq_transitive_unfolded with (Part _ _ H0). + simpl in |- *; algebra. + astepr (Part FId x CI). + apply Feq_imp_eq with realline. + apply Log_Exp_inv. + split. + exists CI. + apply Log_domain. + apply less_wdr with (Exp x); auto. simpl in |- *; algebra. -astepr (Part FId x CI). -apply Feq_imp_eq with realline. - apply Log_Exp_inv. -split. - -exists CI. -apply Log_domain. -apply less_wdr with (Exp x); auto. -simpl in |- *; algebra. Qed. Transparent Logarithm. @@ -726,58 +708,55 @@ Transparent Logarithm. Hint Resolve Log_Exp: algebra. Lemma Exp_Log_lemma : forall x y Hx Hy, Zero [=] Log y Hy[-]Log x Hx -> y [<=] x. -intros x y Hx Hy H; rewrite leEq_def; intro H0. -cut ((y[-]x[/] _[//]pos_ap_zero _ _ Hy) [<=] Zero). -intro H1. -apply less_irreflexive_unfolded with (x := x). -apply less_leEq_trans with y; auto. -astepr (x[+]Zero); apply shift_leEq_plus'. -rstepl ((y[-]x[/] _[//]pos_ap_zero _ _ Hy) [*]y). -apply shift_mult_leEq with (pos_ap_zero _ _ Hy); auto. -rstepr ZeroR; auto. - -astepr (Log y Hy[-]Log x Hx). -unfold Log in |- *; simpl in |- *. -apply leEq_wdr with (Integral (prim_lemma _ _ log_defn_lemma x Hx y Hy)). - 2: rstepl - (Integral (prim_lemma _ _ log_defn_lemma One (pos_one _) x Hx) [+] - Integral (prim_lemma _ _ log_defn_lemma x Hx y Hy) [-] +Proof. + intros x y Hx Hy H; rewrite leEq_def; intro H0. + cut ((y[-]x[/] _[//]pos_ap_zero _ _ Hy) [<=] Zero). + intro H1. + apply less_irreflexive_unfolded with (x := x). + apply less_leEq_trans with y; auto. + astepr (x[+]Zero); apply shift_leEq_plus'. + rstepl ((y[-]x[/] _[//]pos_ap_zero _ _ Hy) [*]y). + apply shift_mult_leEq with (pos_ap_zero _ _ Hy); auto. + rstepr ZeroR; auto. + astepr (Log y Hy[-]Log x Hx). + unfold Log in |- *; simpl in |- *. + apply leEq_wdr with (Integral (prim_lemma _ _ log_defn_lemma x Hx y Hy)). + 2: rstepl (Integral (prim_lemma _ _ log_defn_lemma One (pos_one _) x Hx) [+] + Integral (prim_lemma _ _ log_defn_lemma x Hx y Hy) [-] Integral (prim_lemma _ _ log_defn_lemma One (pos_one _) x Hx)). - 2: apply cg_minus_wd; algebra. - 2: apply eq_symmetric_unfolded; - apply Integral_plus_Integral with (Min3_leEq_Max3 One y x). - 2: apply included_imp_Continuous with (openl Zero); - [ apply log_defn_lemma | intros x0 H1; inversion_clear H1 ]. - 2: simpl in |- *; apply less_leEq_trans with (Min (Min One y) x); auto; - repeat apply less_Min; auto; apply pos_one. -cut (Continuous_I (less_leEq _ _ _ H0) {1/}FId). -intro H1. -apply leEq_wdr with (integral _ _ _ _ H1). - 2: apply eq_symmetric_unfolded; apply Integral_integral. -rstepl ((One[/] _[//]pos_ap_zero _ _ Hy) [*] (y[-]x)). -apply lb_integral. -intros x0 H2 Hx0; simpl in |- *. -elim H2; intros H3 H4; apply recip_resp_leEq; auto. -apply less_leEq_trans with x; auto. - -apply included_imp_Continuous with (openl Zero); - [ apply log_defn_lemma | red in |- *; intros x0 X ]. -inversion_clear X; simpl in |- *; apply less_leEq_trans with x; auto. + 2: apply cg_minus_wd; algebra. + 2: apply eq_symmetric_unfolded; apply Integral_plus_Integral with (Min3_leEq_Max3 One y x). + 2: apply included_imp_Continuous with (openl Zero); + [ apply log_defn_lemma | intros x0 H1; inversion_clear H1 ]. + 2: simpl in |- *; apply less_leEq_trans with (Min (Min One y) x); auto; + repeat apply less_Min; auto; apply pos_one. + cut (Continuous_I (less_leEq _ _ _ H0) {1/}FId). + intro H1. + apply leEq_wdr with (integral _ _ _ _ H1). + 2: apply eq_symmetric_unfolded; apply Integral_integral. + rstepl ((One[/] _[//]pos_ap_zero _ _ Hy) [*] (y[-]x)). + apply lb_integral. + intros x0 H2 Hx0; simpl in |- *. + elim H2; intros H3 H4; apply recip_resp_leEq; auto. + apply less_leEq_trans with x; auto. + apply included_imp_Continuous with (openl Zero); [ apply log_defn_lemma | red in |- *; intros x0 X ]. + inversion_clear X; simpl in |- *; apply less_leEq_trans with x; auto. Qed. (** The converse expression. *) Lemma Exp_Log : forall x H, Exp (Log x H) [=] x. -intros x H. -set (y := Exp (Log x H)) in *. -cut (Zero [<] y); [ intro H0 | unfold y in |- *; apply Exp_pos ]. -cut (Log y H0 [=] Log x H); [ intro H1 | unfold y in |- *; algebra ]. -cut (Zero [=] Log y H0[-]Log x H); - [ clear H1; intro H1 | apply eq_symmetric_unfolded; apply x_minus_x; auto ]. -apply leEq_imp_eq. - apply Exp_Log_lemma with H H0; auto. -apply Exp_Log_lemma with H0 H. -astepl ( [--]ZeroR); rstepr ( [--] (Log y H0[-]Log x H)); algebra. +Proof. + intros x H. + set (y := Exp (Log x H)) in *. + cut (Zero [<] y); [ intro H0 | unfold y in |- *; apply Exp_pos ]. + cut (Log y H0 [=] Log x H); [ intro H1 | unfold y in |- *; algebra ]. + cut (Zero [=] Log y H0[-]Log x H); + [ clear H1; intro H1 | apply eq_symmetric_unfolded; apply x_minus_x; auto ]. + apply leEq_imp_eq. + apply Exp_Log_lemma with H H0; auto. + apply Exp_Log_lemma with H0 H. + astepl ( [--]ZeroR); rstepr ( [--] (Log y H0[-]Log x H)); algebra. Qed. Hint Resolve Exp_Log: algebra. @@ -785,13 +764,15 @@ Hint Resolve Exp_Log: algebra. (** Exponential and logarithm are injective. *) Lemma Exp_cancel : forall x y : IR, Exp x [=] Exp y -> x [=] y. -intros. -astepl (Log (Exp x) (Exp_pos x)); Step_final (Log (Exp y) (Exp_pos y)). +Proof. + intros. + astepl (Log (Exp x) (Exp_pos x)); Step_final (Log (Exp y) (Exp_pos y)). Qed. Lemma Log_cancel : forall (x y : IR) Hx Hy, Log x Hx [=] Log y Hy -> x [=] y. -intros. -astepl (Exp (Log x Hx)); Step_final (Exp (Log y Hy)). +Proof. + intros. + astepl (Exp (Log x Hx)); Step_final (Exp (Log y Hy)). Qed. Opaque Logarithm. @@ -799,18 +780,20 @@ Opaque Logarithm. (** And the final characterization as inverse functions. *) Lemma Exp_Log_inv : Feq (openl Zero) (Expon[o]Logarithm) FId. -apply eq_imp_Feq. - red in |- *; intros x H. - simpl in H; exists H; apply Exp_domain. - Included. -intros x H Hx Hx'; simpl in |- *. -astepr (Exp (Log x H)). -unfold Log in |- *; simpl in |- *; algebra. +Proof. + apply eq_imp_Feq. + red in |- *; intros x H. + simpl in H; exists H; apply Exp_domain. + Included. + intros x H Hx Hx'; simpl in |- *. + astepr (Exp (Log x H)). + unfold Log in |- *; simpl in |- *; algebra. Qed. Lemma Log_E : forall He, Log E He [=] One. -intro. -Step_final (Log (Exp One) (Exp_pos One)). +Proof. + intro. + Step_final (Log (Exp One) (Exp_pos One)). Qed. Hint Resolve Log_E: algebra. @@ -818,168 +801,180 @@ Hint Resolve Log_E: algebra. (** Several rules regarding inequalities. *) Lemma Log_cancel_less : forall x y Hx Hy, Log x Hx [<] Log y Hy -> x [<] y. -intros x y Hx Hy H. -astepl (Exp (Log x Hx)). -astepr (Exp (Log y Hy)). -apply Exp_resp_less; auto. +Proof. + intros x y Hx Hy H. + astepl (Exp (Log x Hx)). + astepr (Exp (Log y Hy)). + apply Exp_resp_less; auto. Qed. Lemma Log_cancel_leEq : forall x y Hx Hy, Log x Hx [<=] Log y Hy -> x [<=] y. -intros x y Hx Hy H. -astepl (Exp (Log x Hx)). -astepr (Exp (Log y Hy)). -apply Exp_resp_leEq; auto. +Proof. + intros x y Hx Hy H. + astepl (Exp (Log x Hx)). + astepr (Exp (Log y Hy)). + apply Exp_resp_leEq; auto. Qed. Lemma Log_resp_less : forall (x y : IR) Hx Hy, x [<] y -> Log x Hx [<] Log y Hy. -intros x y Hx Hy H. -unfold Log in |- *; - apply Derivative_imp_resp_less with (openl Zero) CI ( {1/} (Fid IR)); - simpl in |- *; auto. - apply Derivative_Log. -intro contF. -apply less_wdr with (One[/] _[//]pos_ap_zero _ _ Hy). - apply recip_resp_pos; auto. -apply glb_charact. -split. - intros z Hz. - elim Hz; intros t H1. - elim H1; intros H2 H3. - elim H3; clear Hz H1 H3; intros H1 H3. - assert (H0 := H3 H1); simpl in H0. - astepr (One[/] t[//]ext2 (P:=fun _ : IR => CTrue) H1). - elim H2; intros HMin HMax. - apply recip_resp_leEq; auto. - apply less_leEq_trans with (Min x y); auto. - apply less_Min; auto. - apply leEq_wdr with (Max x y); auto. - apply leEq_imp_Max_is_rht; apply less_leEq; auto. -intros e He. -exists (One[/] _[//]pos_ap_zero _ _ Hy). -exists y. +Proof. + intros x y Hx Hy H. + unfold Log in |- *; apply Derivative_imp_resp_less with (openl Zero) CI ( {1/} (Fid IR)); + simpl in |- *; auto. + apply Derivative_Log. + intro contF. + apply less_wdr with (One[/] _[//]pos_ap_zero _ _ Hy). + apply recip_resp_pos; auto. + apply glb_charact. split. - split; [ apply Min_leEq_rht | apply rht_leEq_Max ]. + intros z Hz. + elim Hz; intros t H1. + elim H1; intros H2 H3. + elim H3; clear Hz H1 H3; intros H1 H3. + assert (H0 := H3 H1); simpl in H0. + astepr (One[/] t[//]ext2 (P:=fun _ : IR => CTrue) H1). + elim H2; intros HMin HMax. + apply recip_resp_leEq; auto. + apply less_leEq_trans with (Min x y); auto. + apply less_Min; auto. + apply leEq_wdr with (Max x y); auto. + apply leEq_imp_Max_is_rht; apply less_leEq; auto. + intros e He. + exists (One[/] _[//]pos_ap_zero _ _ Hy). + exists y. + split. + split; [ apply Min_leEq_rht | apply rht_leEq_Max ]. repeat split. - intro; simpl in |- *; apply pos_ap_zero; auto. - simpl in |- *; algebra. -astepl ZeroR; auto. + intro; simpl in |- *; apply pos_ap_zero; auto. + simpl in |- *; algebra. + astepl ZeroR; auto. Qed. Lemma Log_resp_leEq : forall (x y : IR) Hx Hy, x [<=] y -> Log x Hx [<=] Log y Hy. -intros x y Hx Hy; apply resp_leEq_char' with (P := fun x : IR => Zero [<] x). - algebra. -apply Log_resp_less. +Proof. + intros x y Hx Hy; apply resp_leEq_char' with (P := fun x : IR => Zero [<] x). + algebra. + apply Log_resp_less. Qed. Lemma Exp_cancel_less : forall x y, Exp x [<] Exp y -> x [<] y. -intros x y H. -astepl (Log (Exp x) (Exp_pos x)). -astepr (Log (Exp y) (Exp_pos y)). -apply Log_resp_less; auto. +Proof. + intros x y H. + astepl (Log (Exp x) (Exp_pos x)). + astepr (Log (Exp y) (Exp_pos y)). + apply Log_resp_less; auto. Qed. Lemma Exp_cancel_leEq : forall x y : IR, Exp x [<=] Exp y -> x [<=] y. -intros x y H. -astepl (Log (Exp x) (Exp_pos x)). -astepr (Log (Exp y) (Exp_pos y)). -apply Log_resp_leEq; auto. +Proof. + intros x y H. + astepl (Log (Exp x) (Exp_pos x)). + astepr (Log (Exp y) (Exp_pos y)). + apply Log_resp_leEq; auto. Qed. Lemma Log_less_Zero : forall (x : IR) Hx, x [<] One -> Log x Hx [<] Zero. -intros x Hx H. -astepr (Log (Exp Zero) (Exp_pos Zero)). -apply Log_resp_less. -astepr OneR; auto. +Proof. + intros x Hx H. + astepr (Log (Exp Zero) (Exp_pos Zero)). + apply Log_resp_less. + astepr OneR; auto. Qed. Lemma Log_leEq_Zero : forall (x : IR) Hx, x [<=] One -> Log x Hx [<=] Zero. -intros x Hx H. -astepr (Log (Exp Zero) (Exp_pos Zero)). -apply Log_resp_leEq. -astepr OneR; auto. +Proof. + intros x Hx H. + astepr (Log (Exp Zero) (Exp_pos Zero)). + apply Log_resp_leEq. + astepr OneR; auto. Qed. Lemma Zero_less_Log : forall (x : IR) Hx, One [<] x -> Zero [<] Log x Hx. -intros x Hx H. -astepl (Log (Exp Zero) (Exp_pos Zero)). -apply Log_resp_less. -astepl OneR; auto. +Proof. + intros x Hx H. + astepl (Log (Exp Zero) (Exp_pos Zero)). + apply Log_resp_less. + astepl OneR; auto. Qed. Lemma Zero_leEq_Log : forall (x : IR) Hx, One [<=] x -> Zero [<=] Log x Hx. -intros x Hx H. -astepl (Log (Exp Zero) (Exp_pos Zero)). -apply Log_resp_leEq. -astepl OneR; auto. +Proof. + intros x Hx H. + astepl (Log (Exp Zero) (Exp_pos Zero)). + apply Log_resp_leEq. + astepl OneR; auto. Qed. (** Finally, rules for logarithm of quotients. *) Lemma Log_recip_char : forall x Hx Hx' Hx'', Log (One[/] x[//]Hx) Hx'[+]Log x Hx'' [=] Zero. -intros x Hx Hx' Hx''. -astepl (Log _ (mult_resp_pos _ _ _ Hx' Hx'')). -astepr (Log _ (pos_one IR)). -apply Log_wd; rational. +Proof. + intros x Hx Hx' Hx''. + astepl (Log _ (mult_resp_pos _ _ _ Hx' Hx'')). + astepr (Log _ (pos_one IR)). + apply Log_wd; rational. Qed. Lemma Log_recip : forall x Hx Hx' Hx'', Log (One[/] x[//]Hx) Hx' [=] [--] (Log x Hx''). -intros x Hx Hx' Hx''. -apply cg_inv_unique'; apply Log_recip_char. +Proof. + intros x Hx Hx' Hx''. + apply cg_inv_unique'; apply Log_recip_char. Qed. Hint Resolve Log_recip: algebra. Lemma Log_recip' : forall x y Hx Hx' Hy, y [=] (One[/] x[//]Hx) -> Log y Hy [=] [--] (Log x Hx'). -intros x y Hx Hx' Hy H. -Step_final (Log (One[/] _[//]Hx) (recip_resp_pos _ _ Hx Hx')). +Proof. + intros x y Hx Hx' Hy H. + Step_final (Log (One[/] _[//]Hx) (recip_resp_pos _ _ Hx Hx')). Qed. Lemma Log_div : forall x y Hx Hy Hy' Hxy, Log (x[/] y[//]Hy') Hxy [=] Log x Hx[-]Log y Hy. -intros x y Hx Hy Hy' Hxy. -unfold cg_minus in |- *. -apply - eq_transitive_unfolded - with (Log _ (mult_resp_pos _ _ _ Hx (recip_resp_pos _ _ Hy' Hy))). - apply Log_wd; rational. -Step_final (Log _ Hx[+]Log _ (recip_resp_pos _ _ Hy' Hy)). +Proof. + intros x y Hx Hy Hy' Hxy. + unfold cg_minus in |- *. + apply eq_transitive_unfolded with (Log _ (mult_resp_pos _ _ _ Hx (recip_resp_pos _ _ Hy' Hy))). + apply Log_wd; rational. + Step_final (Log _ Hx[+]Log _ (recip_resp_pos _ _ Hy' Hy)). Qed. Hint Resolve Log_div: algebra. Lemma Log_div' : forall x y z Hx Hy Hy' Hz, z [=] (x[/] y[//]Hy') -> Log z Hz [=] Log x Hx[-]Log y Hy. -intros x y z Hx Hy Hy' Hz H. -Step_final (Log _ (div_resp_pos _ _ _ Hy' Hy Hx)). +Proof. + intros x y z Hx Hy Hy' Hz H. + Step_final (Log _ (div_resp_pos _ _ _ Hy' Hy Hx)). Qed. Lemma Log_zexp : forall x n Hx Hx0 Hxn, Log ((x[//]Hx0)[^^]n) Hxn [=] (zring n)[*]Log x Hx. Proof. -intros x [|n|n] Hx Hx0 Hxn. - simpl. - rstepr (Zero:IR). - algebra. - assert (X:Zero[<]x[^](nat_of_P n)). - astepr ((x[//]Hx0)[^^]n). + intros x [|n|n] Hx Hx0 Hxn. + simpl. + rstepr (Zero:IR). + algebra. + assert (X:Zero[<]x[^](nat_of_P n)). + astepr ((x[//]Hx0)[^^]n). + assumption. + change (Log (x[^](nat_of_P n)) Hxn[=]zring (R:=IR) n[*]Log x Hx). + astepl (nring (nat_of_P n)[*]Log x Hx). + apply mult_wdl. + apply eq_symmetric. + rewrite <- inject_nat_convert. + refine (zring_plus_nat IR (nat_of_P n)). + simpl. + change (Log ((One[/]x[//]Hx0)[^](nat_of_P n)) Hxn[=][--](zring n)[*]Log x Hx). + assert (X:Zero[<](One[/]x[//]Hx0)). + apply recip_resp_pos. assumption. - change (Log (x[^](nat_of_P n)) Hxn[=]zring (R:=IR) n[*]Log x Hx). - astepl (nring (nat_of_P n)[*]Log x Hx). + astepl ((nring (nat_of_P n))[*](Log _ X)). + astepl ((nring (nat_of_P n))[*]([--](Log _ Hx))). + rstepl ([--](nring (nat_of_P n))[*](Log x Hx)). apply mult_wdl. - apply eq_symmetric. + apply un_op_wd_unfolded. rewrite <- inject_nat_convert. + apply eq_symmetric. refine (zring_plus_nat IR (nat_of_P n)). -simpl. -change (Log ((One[/]x[//]Hx0)[^](nat_of_P n)) Hxn[=][--](zring n)[*]Log x Hx). -assert (X:Zero[<](One[/]x[//]Hx0)). - apply recip_resp_pos. - assumption. -astepl ((nring (nat_of_P n))[*](Log _ X)). -astepl ((nring (nat_of_P n))[*]([--](Log _ Hx))). -rstepl ([--](nring (nat_of_P n))[*](Log x Hx)). -apply mult_wdl. -apply un_op_wd_unfolded. -rewrite <- inject_nat_convert. -apply eq_symmetric. -refine (zring_plus_nat IR (nat_of_P n)). Qed. Hint Resolve Log_zexp: algebra. @@ -996,360 +991,340 @@ Definition Log_ps := FPowerSeries One Log_series_coef. Lemma Log_series_convergent_IR : fun_series_convergent_IR (olor Zero Two) Log_ps. Proof. -intros a b Hab Hinc. -apply fun_ratio_test_conv. - unfold Log_ps; unfold FPowerSeries; Contin. -exists 1. -pose (c:=Max (AbsIR (a[-]One)) (AbsIR (b[-]One))). -assert (Z0:c[<]One). - unfold c. - destruct (Hinc _ (compact_inc_lft _ _ Hab)). - destruct (Hinc _ (compact_inc_rht _ _ Hab)). - apply Max_less; apply AbsIR_less; - first [apply shift_minus_less; rstepr (Two:IR) - |apply shift_less_minus; rstepl (Zero:IR)]; + intros a b Hab Hinc. + apply fun_ratio_test_conv. + unfold Log_ps; unfold FPowerSeries; Contin. + exists 1. + pose (c:=Max (AbsIR (a[-]One)) (AbsIR (b[-]One))). + assert (Z0:c[<]One). + unfold c. + destruct (Hinc _ (compact_inc_lft _ _ Hab)). + destruct (Hinc _ (compact_inc_rht _ _ Hab)). + apply Max_less; apply AbsIR_less; first [apply shift_minus_less; rstepr (Two:IR) + |apply shift_less_minus; rstepl (Zero:IR)]; assumption. + assert (Z1:Zero[<=]c). + unfold c. + eapply leEq_transitive. + apply AbsIR_nonneg. + apply lft_leEq_Max. + exists c. assumption. -assert (Z1:Zero[<=]c). - unfold c. - eapply leEq_transitive. - apply AbsIR_nonneg. - apply lft_leEq_Max. -exists c. - assumption. -split. - assumption. -intros x [Hx0 Hx1] n Hn Hx Hx'. -destruct n. - elimtype False; auto with *. -unfold Log_ps, FPowerSeries, Log_series_coef. -generalize (nringS_ap_zero IR (S n)). -generalize (nringS_ap_zero IR (n)). -intros Y0 Y1. -stepl ( - (nexp IR (S (S n)) (AbsIR (x[-]One)))[/]nring (R:=IR) (S (S n))[//]Y1). - apply shift_div_leEq. - apply nring_pos; auto with *. - stepr ((((nexp IR (S n) (AbsIR (x[-]One))[*]c)[*](nring (R:=IR) (S (S n))))[/]nring (R:=IR) (S n)[//]Y0)). - apply shift_leEq_div. + split. + assumption. + intros x [Hx0 Hx1] n Hn Hx Hx'. + destruct n. + elimtype False; auto with *. + unfold Log_ps, FPowerSeries, Log_series_coef. + generalize (nringS_ap_zero IR (S n)). + generalize (nringS_ap_zero IR (n)). + intros Y0 Y1. + stepl ( (nexp IR (S (S n)) (AbsIR (x[-]One)))[/]nring (R:=IR) (S (S n))[//]Y1). + apply shift_div_leEq. apply nring_pos; auto with *. - apply mult_resp_leEq_both. - apply (nexp_resp_nonneg _ (AbsIR (x[-]One)) (S (S n))). - apply AbsIR_nonneg. - apply nring_nonneg; auto with *. - change (nexp IR (S (S n)) (AbsIR (x[-]One))) - with ((nexp IR (S n) (AbsIR (x[-]One)))[*](AbsIR (x[-]One))). - apply mult_resp_leEq_lft. - apply AbsSmall_imp_AbsIR. - split. - apply shift_zero_leEq_minus'. - rstepr (c[-]([--](x[-]One))). - apply shift_zero_leEq_minus. + stepr ((((nexp IR (S n) (AbsIR (x[-]One))[*]c)[*](nring (R:=IR) (S (S n))))[/]nring (R:=IR) (S n)[//]Y0)). + apply shift_leEq_div. + apply nring_pos; auto with *. + apply mult_resp_leEq_both. + apply (nexp_resp_nonneg _ (AbsIR (x[-]One)) (S (S n))). + apply AbsIR_nonneg. + apply nring_nonneg; auto with *. + change (nexp IR (S (S n)) (AbsIR (x[-]One))) + with ((nexp IR (S n) (AbsIR (x[-]One)))[*](AbsIR (x[-]One))). + apply mult_resp_leEq_lft. + apply AbsSmall_imp_AbsIR. + split. + apply shift_zero_leEq_minus'. + rstepr (c[-]([--](x[-]One))). + apply shift_zero_leEq_minus. + unfold c. + eapply leEq_transitive;[|apply lft_leEq_Max]. + eapply leEq_transitive;[|apply inv_leEq_AbsIR]. + apply inv_resp_leEq. + apply minus_resp_leEq. + assumption. unfold c. - eapply leEq_transitive;[|apply lft_leEq_Max]. - eapply leEq_transitive;[|apply inv_leEq_AbsIR]. - apply inv_resp_leEq. + eapply leEq_transitive;[|apply rht_leEq_Max]. + eapply leEq_transitive;[|apply leEq_AbsIR]. apply minus_resp_leEq. assumption. - unfold c. - eapply leEq_transitive;[|apply rht_leEq_Max]. - eapply leEq_transitive;[|apply leEq_AbsIR]. - apply minus_resp_leEq. - assumption. - apply (nexp_resp_nonneg _ (AbsIR (x[-]One)) (S n)). - apply AbsIR_nonneg. - apply nring_leEq; auto with *. - rstepl (c[*](nexp IR (S n) (AbsIR (x[-]One))[/] - nring (R:=IR) (S n)[//]Y0)[*]nring (R:=IR) (S (S n))). - apply mult_wdl. - apply mult_wdr. - stepl (AbsIR ((x[-]One)[^](S n))[/]_[//](AbsIR_resp_ap_zero _ Y0)). + apply (nexp_resp_nonneg _ (AbsIR (x[-]One)) (S n)). + apply AbsIR_nonneg. + apply nring_leEq; auto with *. + rstepl (c[*](nexp IR (S n) (AbsIR (x[-]One))[/] + nring (R:=IR) (S n)[//]Y0)[*]nring (R:=IR) (S (S n))). + apply mult_wdl. + apply mult_wdr. + stepl (AbsIR ((x[-]One)[^](S n))[/]_[//](AbsIR_resp_ap_zero _ Y0)). + eapply eq_transitive. + apply eq_symmetric. + apply (AbsIR_division ((x[-]One)[^]S n) _ Y0). + stepr (AbsIR (([--]One)[^](S (S n)))[*]AbsIR ((x[-]One)[^]S n[/]nring (R:=IR) (S n)[//]Y0)). + rstepl (One[*]AbsIR ((x[-]One)[^]S n[/]nring (R:=IR) (S n)[//]Y0)). + apply mult_wdl. + csetoid_rewrite (AbsIR_nexp_op (S (S n)) ([--]One)). + csetoid_replace (AbsIR ([--]One)) (One:IR). + apply eq_symmetric. + apply (one_nexp IR (S (S n))). + rstepr ([--][--]One:IR). + apply AbsIR_eq_inv_x. + apply shift_zero_leEq_minus'. + rstepr (One:IR). + apply less_leEq; apply pos_one. + eapply eq_transitive. + apply eq_symmetric; apply AbsIR_resp_mult. + apply AbsIR_wd. + change ((([--]One[^]S (S n)[/]nring (R:=IR) (S n)[//]Y0){**}(FId{-}[-C-]One){^}S n) x Hx) + with ((([--]One[^]S (S n)[/]nring (R:=IR) (S n)[//]Y0)[*](x[-]One)[^]S n)). + rational. + apply div_wd. + apply (AbsIR_nexp (x[-]One) (S n)). + apply AbsIR_eq_x. + apply nring_nonneg. + stepl (AbsIR ((x[-]One)[^](S (S n)))[/]_[//](AbsIR_resp_ap_zero _ Y1)). eapply eq_transitive. apply eq_symmetric. - apply (AbsIR_division ((x[-]One)[^]S n) _ Y0). - stepr (AbsIR (([--]One)[^](S (S n)))[*]AbsIR ((x[-]One)[^]S n[/]nring (R:=IR) (S n)[//]Y0)). - rstepl (One[*]AbsIR ((x[-]One)[^]S n[/]nring (R:=IR) (S n)[//]Y0)). + apply (AbsIR_division ((x[-]One)[^]S (S n)) _ Y1). + stepr (AbsIR (([--]One[^]S (S (S n))[*]((x[-]One)[^]S (S n)[/]_[//]Y1)))). + eapply eq_transitive;[|apply eq_symmetric; apply AbsIR_resp_mult]. + rstepl (One[*]AbsIR ((x[-]One)[^]S (S n)[/]nring (R:=IR) (S (S n))[//]Y1)). apply mult_wdl. - csetoid_rewrite (AbsIR_nexp_op (S (S n)) ([--]One)). + csetoid_rewrite (AbsIR_nexp_op (S (S (S n))) [--]One). csetoid_replace (AbsIR ([--]One)) (One:IR). apply eq_symmetric. - apply (one_nexp IR (S (S n))). + apply (one_nexp IR). rstepr ([--][--]One:IR). apply AbsIR_eq_inv_x. apply shift_zero_leEq_minus'. rstepr (One:IR). apply less_leEq; apply pos_one. - eapply eq_transitive. - apply eq_symmetric; apply AbsIR_resp_mult. apply AbsIR_wd. - change ((([--]One[^]S (S n)[/]nring (R:=IR) (S n)[//]Y0){**}(FId{-}[-C-]One){^}S n) x Hx) - with ((([--]One[^]S (S n)[/]nring (R:=IR) (S n)[//]Y0)[*](x[-]One)[^]S n)). + change ((([--]One[^]S (S (S n))[/]nring (R:=IR) (S (S n))[//]Y1){**}(FId{-}[-C-]One){^}S (S n)) x Hx') + with ((([--]One[^]S (S (S n))[/]nring (R:=IR) (S (S n))[//]Y1)[*](x[-]One)[^]S (S n))). rational. apply div_wd. - apply (AbsIR_nexp (x[-]One) (S n)). + apply (AbsIR_nexp (x[-]One) (S (S n))). apply AbsIR_eq_x. apply nring_nonneg. -stepl (AbsIR ((x[-]One)[^](S (S n)))[/]_[//](AbsIR_resp_ap_zero _ Y1)). - eapply eq_transitive. - apply eq_symmetric. - apply (AbsIR_division ((x[-]One)[^]S (S n)) _ Y1). - stepr (AbsIR (([--]One[^]S (S (S n))[*]((x[-]One)[^]S (S n)[/]_[//]Y1)))). - eapply eq_transitive;[|apply eq_symmetric; apply AbsIR_resp_mult]. - rstepl (One[*]AbsIR ((x[-]One)[^]S (S n)[/]nring (R:=IR) (S (S n))[//]Y1)). - apply mult_wdl. - csetoid_rewrite (AbsIR_nexp_op (S (S (S n))) [--]One). - csetoid_replace (AbsIR ([--]One)) (One:IR). - apply eq_symmetric. - apply (one_nexp IR). - rstepr ([--][--]One:IR). - apply AbsIR_eq_inv_x. - apply shift_zero_leEq_minus'. - rstepr (One:IR). - apply less_leEq; apply pos_one. - apply AbsIR_wd. - change ((([--]One[^]S (S (S n))[/]nring (R:=IR) (S (S n))[//]Y1){**}(FId{-}[-C-]One){^}S (S n)) x Hx') - with ((([--]One[^]S (S (S n))[/]nring (R:=IR) (S (S n))[//]Y1)[*](x[-]One)[^]S (S n))). - rational. -apply div_wd. - apply (AbsIR_nexp (x[-]One) (S (S n))). -apply AbsIR_eq_x. -apply nring_nonneg. Qed. Lemma Log_series : forall c : IR, forall (Hs:fun_series_convergent_IR (olor Zero Two) Log_ps) Hc0 Hc1, FSeries_Sum Hs c Hc0[=]Log c Hc1. Proof. -intros c Hs Hc0 Hc1. -Transparent Logarithm. -assert (Z:fun_series_convergent_IR (olor Zero Two) - (fun n : nat => Log_ps (S n))). - generalize Log_ps Hs. - intros p Hp; clear - Hp. - intros a b Hab Hinc. - destruct (Hp a b Hab Hinc) as [A B]. - exists (fun n => (A (S n))). - intros e He. - destruct (B e He) as [C D]. - exists (C). - intros m n Hm Hn x Hx. - assert (D' := (D (S m) (S n))). - stepl (AbsIR - (fun_seq_part_sum p (S m) x - (contin_imp_inc a b Hab (fun_seq_part_sum p (S m)) - (fun_seq_part_sum_cont a b Hab p A (S m)) x Hx)[-] - fun_seq_part_sum p (S n) x - (contin_imp_inc a b Hab (fun_seq_part_sum p (S n)) - (fun_seq_part_sum_cont a b Hab p A (S n)) x Hx))). - apply D'; auto with *. - apply AbsIR_wd. - set (g:=(fun (y n0 : nat) => - Part (p n0) x - (contin_imp_inc a b Hab (fun_seq_part_sum p y) - (fun_seq_part_sum_cont a b Hab p A y) x Hx n0))). - set (g':=(fun y n0 : nat => - Part (p (S n0)) x - (contin_imp_inc a b Hab (fun_seq_part_sum (fun n1 : nat => p (S n1)) y) - (fun_seq_part_sum_cont a b Hab (fun n1 : nat => p (S n1)) - (fun n1 : nat => A (S n1)) y) x Hx n0))). - change (Sum0 (G:=IR) (S m) (g (S m))[-](Sum0 (G:=IR) (S n) (g (S n)))[=] - Sum0 (G:=IR) m (g' m)[-]Sum0 (G:=IR) n (g' n)). - stepr ((g (S m) 0[+]Sum0 (G:=IR) m (g' m))[-](g (S n) 0[+]Sum0 (G:=IR) n (g' n))). - unfold cg_minus. - apply eq_symmetric; - apply bin_op_wd_unfolded; try apply un_op_wd_unfolded; - apply Sum0_shift; - intros i; unfold g', g; - apply pfwdef; - apply eq_reflexive. - apply cg_cancel_lft with (g (S n) 0[-](Sum0 (G:=IR) m (g' m)[-]Sum0 (G:=IR) n (g' n))). - rstepr (g (S n) 0). - rstepl (g (S m) 0). - unfold g; apply pfwdef; apply eq_reflexive. -assert (Z0:=insert_series_sum _ _ Z). -set (Hs':=(insert_series_conv (olor Zero Two) (fun n : nat => Log_ps (S n)) Z)) in *. -apply eq_transitive with (FSeries_Sum (J:=olor Zero Two) - (f:=insert_series (fun n : nat => Log_ps (S n))) Hs' c Hc0). - simpl. - apply series_sum_wd. - intros [|n]. - simpl; rational. - simpl; rational. -apply eq_transitive with (FSeries_Sum Z c Hc0). - apply Feq_imp_eq with (olor Zero Two). - apply Feq_symmetric. - apply (insert_series_sum _ _ Z). - assumption. -simpl. -unfold series_sum. -apply eq_symmetric. -apply Limits_unique. -simpl. -unfold Log, Logarithm. -simpl. -assert (X:forall n, Continuous_I (Min_leEq_Max One c) (([-C-]One{-}FId){^}n)). - Contin. -apply Cauchy_Lim_prop2_wd with (fun n => Integral (fun_seq_part_sum_cont _ _ _ _ X n)). - assert (A0:Continuous (olor Zero Two) ({1/}FId)). - apply Continuous_recip. - Contin. + intros c Hs Hc0 Hc1. + Transparent Logarithm. + assert (Z:fun_series_convergent_IR (olor Zero Two) (fun n : nat => Log_ps (S n))). + generalize Log_ps Hs. + intros p Hp; clear - Hp. intros a b Hab Hinc. - split. - Included. - exists a. - destruct (Hinc _ (compact_inc_lft _ _ Hab)); assumption. + destruct (Hp a b Hab Hinc) as [A B]. + exists (fun n => (A (S n))). + intros e He. + destruct (B e He) as [C D]. + exists (C). + intros m n Hm Hn x Hx. + assert (D' := (D (S m) (S n))). + stepl (AbsIR (fun_seq_part_sum p (S m) x (contin_imp_inc a b Hab (fun_seq_part_sum p (S m)) + (fun_seq_part_sum_cont a b Hab p A (S m)) x Hx)[-] fun_seq_part_sum p (S n) x + (contin_imp_inc a b Hab (fun_seq_part_sum p (S n)) + (fun_seq_part_sum_cont a b Hab p A (S n)) x Hx))). + apply D'; auto with *. + apply AbsIR_wd. + set (g:=(fun (y n0 : nat) => Part (p n0) x (contin_imp_inc a b Hab (fun_seq_part_sum p y) + (fun_seq_part_sum_cont a b Hab p A y) x Hx n0))). + set (g':=(fun y n0 : nat => Part (p (S n0)) x + (contin_imp_inc a b Hab (fun_seq_part_sum (fun n1 : nat => p (S n1)) y) + (fun_seq_part_sum_cont a b Hab (fun n1 : nat => p (S n1)) + (fun n1 : nat => A (S n1)) y) x Hx n0))). + change (Sum0 (G:=IR) (S m) (g (S m))[-](Sum0 (G:=IR) (S n) (g (S n)))[=] + Sum0 (G:=IR) m (g' m)[-]Sum0 (G:=IR) n (g' n)). + stepr ((g (S m) 0[+]Sum0 (G:=IR) m (g' m))[-](g (S n) 0[+]Sum0 (G:=IR) n (g' n))). + unfold cg_minus. + apply eq_symmetric; apply bin_op_wd_unfolded; try apply un_op_wd_unfolded; apply Sum0_shift; + intros i; unfold g', g; apply pfwdef; apply eq_reflexive. + apply cg_cancel_lft with (g (S n) 0[-](Sum0 (G:=IR) m (g' m)[-]Sum0 (G:=IR) n (g' n))). + rstepr (g (S n) 0). + rstepl (g (S m) 0). + unfold g; apply pfwdef; apply eq_reflexive. + assert (Z0:=insert_series_sum _ _ Z). + set (Hs':=(insert_series_conv (olor Zero Two) (fun n : nat => Log_ps (S n)) Z)) in *. + apply eq_transitive with (FSeries_Sum (J:=olor Zero Two) + (f:=insert_series (fun n : nat => Log_ps (S n))) Hs' c Hc0). simpl. - intros y _ Hy. - stepr y. - destruct Hy; assumption. - apply eq_symmetric. - apply AbsIR_eq_x. - apply less_leEq; destruct (Hinc _ Hy); assumption. - assert (A1:forall n : nat, Continuous (olor Zero Two) (fun_seq_part_sum (Fnth (R:=IR) ([-C-]One{-}FId)) n)). - intros n. - split. - repeat constructor. - intros a b Hab Hinc. + apply series_sum_wd. + intros [|n]. + simpl; rational. + simpl; rational. + apply eq_transitive with (FSeries_Sum Z c Hc0). + apply Feq_imp_eq with (olor Zero Two). + apply Feq_symmetric. + apply (insert_series_sum _ _ Z). + assumption. + simpl. + unfold series_sum. + apply eq_symmetric. + apply Limits_unique. + simpl. + unfold Log, Logarithm. + simpl. + assert (X:forall n, Continuous_I (Min_leEq_Max One c) (([-C-]One{-}FId){^}n)). Contin. - eapply (limit_of_Integral (olor Zero Two) _ _ A1 A0). - unfold fun_seq_part_sum. - assert (A2:fun_series_convergent_IR (olor Zero Two) - (Fnth (R:=IR) ([-C-]One{-}FId))). - cut (fun_series_convergent_IR (olor Zero Two) (fun n => FId{^}n[o]([-C-]One{-}FId))). - apply fun_series_convergent_wd_IR. - intros n. - FEQ. - intros x Hx. - assert (W:Dom ([-C-]One{-}FId) x). - repeat constructor. - exists W. + apply Cauchy_Lim_prop2_wd with (fun n => Integral (fun_seq_part_sum_cont _ _ _ _ X n)). + assert (A0:Continuous (olor Zero Two) ({1/}FId)). + apply Continuous_recip. + Contin. + intros a b Hab Hinc. + split. + Included. + exists a. + destruct (Hinc _ (compact_inc_lft _ _ Hab)); assumption. + simpl. + intros y _ Hy. + stepr y. + destruct Hy; assumption. + apply eq_symmetric. + apply AbsIR_eq_x. + apply less_leEq; destruct (Hinc _ Hy); assumption. + assert (A1:forall n : nat, Continuous (olor Zero Two) (fun_seq_part_sum (Fnth (R:=IR) ([-C-]One{-}FId)) n)). + intros n. + split. repeat constructor. - apply FSeries_Sum_comp_conv with (olor [--]One One). - intros a b Hab Hinc. - exists (One[-]b). - exists (One[-]a). - assert (W:One[-]b[<=]One[-]a). - unfold cg_minus. - apply plus_resp_leEq_lft. - apply inv_resp_leEq. - assumption. + intros a b Hab Hinc. + Contin. + eapply (limit_of_Integral (olor Zero Two) _ _ A1 A0). + unfold fun_seq_part_sum. + assert (A2:fun_series_convergent_IR (olor Zero Two) (Fnth (R:=IR) ([-C-]One{-}FId))). + cut (fun_series_convergent_IR (olor Zero Two) (fun n => FId{^}n[o]([-C-]One{-}FId))). + apply fun_series_convergent_wd_IR. + intros n. + FEQ. + intros x Hx. + assert (W:Dom ([-C-]One{-}FId) x). + repeat constructor. exists W. - split. - intros x [Hx0 Hx1]. + repeat constructor. + apply FSeries_Sum_comp_conv with (olor [--]One One). + intros a b Hab Hinc. + exists (One[-]b). + exists (One[-]a). + assert (W:One[-]b[<=]One[-]a). + unfold cg_minus. + apply plus_resp_leEq_lft. + apply inv_resp_leEq. + assumption. + exists W. split. - eapply less_leEq_trans;[|apply Hx0]. - apply shift_less_minus. - apply shift_plus_less'. - rstepr (Two:IR). - destruct (Hinc _ (compact_inc_rht _ _ Hab)); assumption. - eapply leEq_less_trans;[apply Hx1|]. - apply shift_minus_less. - apply shift_less_plus'. - rstepl (Zero:IR). - destruct (Hinc _ (compact_inc_lft _ _ Hab)); assumption. - intros x Hx [Hx0 Hx1]. - split; simpl. + intros x [Hx0 Hx1]. + split. + eapply less_leEq_trans;[|apply Hx0]. + apply shift_less_minus. + apply shift_plus_less'. + rstepr (Two:IR). + destruct (Hinc _ (compact_inc_rht _ _ Hab)); assumption. + eapply leEq_less_trans;[apply Hx1|]. + apply shift_minus_less. + apply shift_less_plus'. + rstepl (Zero:IR). + destruct (Hinc _ (compact_inc_lft _ _ Hab)); assumption. + intros x Hx [Hx0 Hx1]. + split; simpl. + apply shift_leEq_minus'. + apply shift_plus_leEq. + rstepr b. + assumption. apply shift_leEq_minus'. apply shift_plus_leEq. - rstepr b. + rstepr x. assumption. - apply shift_leEq_minus'. - apply shift_plus_leEq. - rstepr x. - assumption. + Contin. + apply fun_power_series_conv_IR. + assert (A3:Continuous (olor Zero Two) + (FSeries_Sum (J:=olor Zero Two) (f:=Fnth (R:=IR) ([-C-]One{-}FId)) A2)). Contin. - apply fun_power_series_conv_IR. - assert (A3:Continuous (olor Zero Two) - (FSeries_Sum (J:=olor Zero Two) (f:=Fnth (R:=IR) ([-C-]One{-}FId)) A2)). - Contin. - eapply (conv_fun_seq'_wdr_IR);[|apply (FSeries_conv _ _ A2 A1 A3)]. - FEQ. - assert (Y:AbsIR (One[-]x)[<]One). - destruct X0. - apply AbsIR_less. - apply shift_minus_less. - apply shift_less_plus'. - rstepl (Zero:IR); assumption. - apply shift_less_minus'. - apply shift_plus_less. - rstepr (Two:IR); assumption. - assert (Y0:One[-](One[-]x)[#]Zero). - rstepl (x). - apply Greater_imp_ap. - destruct X0; assumption. - apply eq_transitive with (One[/]_[//]Y0). - eapply eq_transitive;[|apply (power_series_sum _ Y Y0 (power_series_conv _ Y))]. + eapply (conv_fun_seq'_wdr_IR);[|apply (FSeries_conv _ _ A2 A1 A3)]. + FEQ. + assert (Y:AbsIR (One[-]x)[<]One). + destruct X0. + apply AbsIR_less. + apply shift_minus_less. + apply shift_less_plus'. + rstepl (Zero:IR); assumption. + apply shift_less_minus'. + apply shift_plus_less. + rstepr (Two:IR); assumption. + assert (Y0:One[-](One[-]x)[#]Zero). + rstepl (x). + apply Greater_imp_ap. + destruct X0; assumption. + apply eq_transitive with (One[/]_[//]Y0). + eapply eq_transitive;[|apply (power_series_sum _ Y Y0 (power_series_conv _ Y))]. + simpl. + apply series_sum_wd. + intros n; apply eq_reflexive. simpl. - apply series_sum_wd. - intros n; apply eq_reflexive. + rational. + intros x [Hx0 Hx1]. + split. + apply less_leEq_trans with (Min One c); try assumption. + apply less_Min; try assumption. + apply pos_one. + apply leEq_less_trans with (Max One c); try assumption. + destruct Hc0. + apply Max_less; try assumption. + apply one_less_two. + intros n. + induction n. simpl. - rational. - intros x [Hx0 Hx1]. - split. - apply less_leEq_trans with (Min One c); try assumption. - apply less_Min; try assumption. - apply pos_one. - apply leEq_less_trans with (Max One c); try assumption. - destruct Hc0. - apply Max_less; try assumption. - apply one_less_two. -intros n. -induction n. + rstepr (Zero[*](c[-]One)). + eapply eq_transitive;[|apply (Integral_const _ _ (Min_leEq_Max One c) Zero (Continuous_I_const _ _ _ _))]. + apply Integral_wd. + FEQ. + auto with *. + simpl. + csetoid_rewrite_rev IHn. + assert (Y:Continuous_I (Min_leEq_Max One c) (([-C-]One{-}FId){^}n)). + Contin. + csetoid_replace ((nexp IR n [--]One[*][--]One[*][--]One[/]nring (R:=IR) n[+]One[//] + nringS_ap_zero IR n)[*](nexp IR n (c[-]One)[*](c[-]One))) (Integral Y). + assert (Y0:=Continuous_I_plus _ _ _ _ _ (fun_seq_part_sum_cont (Min One c) (Max One c) (Min_leEq_Max One c) + (Fnth (R:=IR) ([-C-]One{-}FId)) X n) Y). + stepl (Integral Y0). + apply Integral_plus. + apply Integral_wd. + apply eq_imp_Feq; try Included. + intros x Hx; split; constructor. + intros x H Hx Hx'. + simpl. + apply eq_reflexive. + rstepl ((nexp IR n [--]One[/]nring (R:=IR) n[+]One[//] + nringS_ap_zero IR n)[*](nexp IR n (c[-]One)[*](c[-]One))). + change ((nexp IR n [--]One[/]nring (R:=IR) n[+]One[//]nringS_ap_zero IR n)[*] + (nexp IR n (c[-]One)[*](c[-]One))) + with (([--]One[^]n[/]_[//]nringS_ap_zero IR n)[*](c[-]One)[^](S n)). + pose (G:=(([--]One[/]_[//]nringS_ap_zero IR n){**}([-C-]One{-}FId){^}(S n))). + assert (X0:Derivative (olor Zero Two) (pos_two IR) G (([-C-]One{-}FId){^}n)). + unfold G. + Derivative_Help; [|apply Derivative_scal;refine (Derivative_nth _ _ _ _ _ _);Deriv]. + FEQ. + repeat constructor. + assert (X1:Continuous (olor Zero Two) (([-C-]One{-}FId){^}n)). + Contin. + assert (X2:(olor Zero Two One)). + split. + apply pos_one. + apply one_less_two. + eapply eq_transitive. + 2:apply eq_symmetric. + 2:apply (fun A => Barrow (olor Zero Two) _ X1 _ _ X0 _ _ A X2 Hc0). simpl. - rstepr (Zero[*](c[-]One)). - eapply eq_transitive;[|apply (Integral_const _ _ (Min_leEq_Max One c) Zero (Continuous_I_const _ _ _ _))]. - apply Integral_wd. - FEQ. - auto with *. -simpl. -csetoid_rewrite_rev IHn. -assert (Y:Continuous_I (Min_leEq_Max One c) (([-C-]One{-}FId){^}n)). - Contin. -csetoid_replace ((nexp IR n [--]One[*][--]One[*][--]One[/]nring (R:=IR) n[+]One[//] - nringS_ap_zero IR n)[*](nexp IR n (c[-]One)[*](c[-]One))) - (Integral Y). - assert (Y0:=Continuous_I_plus _ _ _ _ _ (fun_seq_part_sum_cont (Min One c) (Max One c) (Min_leEq_Max One c) - (Fnth (R:=IR) ([-C-]One{-}FId)) X n) Y). - stepl (Integral Y0). - apply Integral_plus. - apply Integral_wd. - apply eq_imp_Feq; try Included. - intros x Hx; split; constructor. - intros x H Hx Hx'. + rstepr (([--]One[/]nring (R:=IR) n[+]One[//]nringS_ap_zero IR n)[*] + (nexp IR n (One[-]c)[*](One[-]c))). + change (([--]One[^]n[/]_[//]nringS_ap_zero IR n)[*] ((c[-]One)[^](S n))[=] + ([--]One[/]_[//]nringS_ap_zero IR n)[*] ((One[-]c)[^](S n))). + rstepr (([--]One[/]nring (R:=IR) (S n)[//]nringS_ap_zero IR n)[*] ([--]One[*](c[-]One))[^]S n). + csetoid_rewrite (mult_nexp IR ([--]One) (c[-]One) (S n)). simpl. - apply eq_reflexive. -rstepl ((nexp IR n [--]One[/]nring (R:=IR) n[+]One[//] - nringS_ap_zero IR n)[*](nexp IR n (c[-]One)[*](c[-]One))). -change ((nexp IR n [--]One[/]nring (R:=IR) n[+]One[//]nringS_ap_zero IR n)[*] -(nexp IR n (c[-]One)[*](c[-]One))) - with (([--]One[^]n[/]_[//]nringS_ap_zero IR n)[*](c[-]One)[^](S n)). -pose (G:=(([--]One[/]_[//]nringS_ap_zero IR n){**}([-C-]One{-}FId){^}(S n))). -assert (X0:Derivative (olor Zero Two) (pos_two IR) G (([-C-]One{-}FId){^}n)). - unfold G. - Derivative_Help; - [|apply Derivative_scal;refine (Derivative_nth _ _ _ _ _ _);Deriv]. - FEQ. - repeat constructor. -assert (X1:Continuous (olor Zero Two) (([-C-]One{-}FId){^}n)). - Contin. -assert (X2:(olor Zero Two One)). - split. - apply pos_one. - apply one_less_two. -eapply eq_transitive. - 2:apply eq_symmetric. - 2:apply (fun A => Barrow (olor Zero Two) _ X1 _ _ X0 _ _ A X2 Hc0). -simpl. -rstepr (([--]One[/]nring (R:=IR) n[+]One[//]nringS_ap_zero IR n)[*] -(nexp IR n (One[-]c)[*](One[-]c))). -change (([--]One[^]n[/]_[//]nringS_ap_zero IR n)[*] - ((c[-]One)[^](S n))[=] - ([--]One[/]_[//]nringS_ap_zero IR n)[*] - ((One[-]c)[^](S n))). -rstepr (([--]One[/]nring (R:=IR) (S n)[//]nringS_ap_zero IR n)[*] - ([--]One[*](c[-]One))[^]S n). -csetoid_rewrite (mult_nexp IR ([--]One) (c[-]One) (S n)). -simpl. -rational. + rational. Qed. End Log_Series. diff --git a/transc/InvTrigonom.v b/transc/InvTrigonom.v index ea7d5f6c4..e13786928 100644 --- a/transc/InvTrigonom.v +++ b/transc/InvTrigonom.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export RealPowers. Require Export TrigMon. @@ -61,84 +61,88 @@ Arccosine is defined in terms of arcsine by the relation Opaque Sine Cosine Expon Logarithm. Lemma ArcSin_def_lemma : Continuous (olor [--]One One) (( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ)). -split. -unfold FPower in |- *. -apply included_FComp. -apply included_FMult. -Included. -apply included_FComp. -Included. -intros; apply Log_domain. -inversion_clear X. -simpl in |- *; apply shift_less_minus; astepl (x[^]2). -astepr (OneR[^]2). -apply AbsIR_less_square. -simpl in |- *; unfold ABSIR in |- *; apply Max_less; auto. -apply inv_cancel_less; astepr x; auto. -intros; apply Exp_domain. -intros a b Hab H. -apply continuous_I_power. -Contin. -Contin. -split. -Included. -simpl in H. -set (c := Max (AbsIR a) (AbsIR b)) in *. -cut (Zero [<=] c); intros. -2: unfold c in |- *; apply leEq_transitive with (AbsIR a); +Proof. + split. + unfold FPower in |- *. + apply included_FComp. + apply included_FMult. + Included. + apply included_FComp. + Included. + intros; apply Log_domain. + inversion_clear X. + simpl in |- *; apply shift_less_minus; astepl (x[^]2). + astepr (OneR[^]2). + apply AbsIR_less_square. + simpl in |- *; unfold ABSIR in |- *; apply Max_less; auto. + apply inv_cancel_less; astepr x; auto. + intros; apply Exp_domain. + intros a b Hab H. + apply continuous_I_power. + Contin. + Contin. + split. + Included. + simpl in H. + set (c := Max (AbsIR a) (AbsIR b)) in *. + cut (Zero [<=] c); intros. + 2: unfold c in |- *; apply leEq_transitive with (AbsIR a); [ apply AbsIR_nonneg | apply lft_leEq_Max ]. -elim (H _ (compact_inc_lft _ _ Hab)); intros. -elim (H _ (compact_inc_rht _ _ Hab)); intros. -assert (H1 : c [<] One). - unfold c in |- *. - apply Max_less; simpl in |- *; unfold ABSIR in |- *; apply Max_less; auto; - apply inv_cancel_less. - astepr a; auto. astepr b; auto. -assert (Hc : [--]c [<=] c). apply leEq_transitive with ZeroR; auto. - astepr ( [--]ZeroR); apply inv_resp_leEq; auto. -cut (included (Compact Hab) (Compact Hc)). intro H2. -exists (One[-]c[^]2). -apply shift_less_minus. -astepl (c[^]2); astepr (OneR[^]2). -apply nexp_resp_less; auto. -intros y H3 Hy. -astepr (One[-]y[^]2). -apply minus_resp_leEq_both. -apply leEq_reflexive. -apply AbsIR_leEq_square. -elim (H2 _ H3); intros. -simpl in |- *; unfold ABSIR in |- *; apply Max_leEq; auto. -astepr ( [--] [--]c); apply inv_resp_leEq; auto. -intros x H2. -inversion_clear H2; unfold c in |- *; split. -astepr ( [--] [--]x); apply inv_resp_leEq. -apply leEq_transitive with ( [--]a). -apply inv_resp_leEq; auto. -eapply leEq_transitive; [ apply inv_leEq_AbsIR | apply lft_leEq_Max ]. -apply leEq_transitive with b; auto. -eapply leEq_transitive; [ apply leEq_AbsIR | apply rht_leEq_Max ]. + elim (H _ (compact_inc_lft _ _ Hab)); intros. + elim (H _ (compact_inc_rht _ _ Hab)); intros. + assert (H1 : c [<] One). + unfold c in |- *. + apply Max_less; simpl in |- *; unfold ABSIR in |- *; apply Max_less; auto; apply inv_cancel_less. + astepr a; auto. astepr b; auto. + assert (Hc : [--]c [<=] c). apply leEq_transitive with ZeroR; auto. + astepr ( [--]ZeroR); apply inv_resp_leEq; auto. + cut (included (Compact Hab) (Compact Hc)). intro H2. + exists (One[-]c[^]2). + apply shift_less_minus. + astepl (c[^]2); astepr (OneR[^]2). + apply nexp_resp_less; auto. + intros y H3 Hy. + astepr (One[-]y[^]2). + apply minus_resp_leEq_both. + apply leEq_reflexive. + apply AbsIR_leEq_square. + elim (H2 _ H3); intros. + simpl in |- *; unfold ABSIR in |- *; apply Max_leEq; auto. + astepr ( [--] [--]c); apply inv_resp_leEq; auto. + intros x H2. + inversion_clear H2; unfold c in |- *; split. + astepr ( [--] [--]x); apply inv_resp_leEq. + apply leEq_transitive with ( [--]a). + apply inv_resp_leEq; auto. + eapply leEq_transitive; [ apply inv_leEq_AbsIR | apply lft_leEq_Max ]. + apply leEq_transitive with b; auto. + eapply leEq_transitive; [ apply leEq_AbsIR | apply rht_leEq_Max ]. Qed. Lemma ArcSin_def_zero : olor [--]One One Zero. -split. -astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. -apply pos_one. +Proof. + split. + astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. + apply pos_one. Qed. Definition ArcSin := ( [-S-]ArcSin_def_lemma) _ ArcSin_def_zero. Lemma ArcSin_domain : forall x, [--]One [<] x -> x [<] One -> Dom ArcSin x. -intros; split; auto. +Proof. + intros; split; auto. Qed. Lemma Continuous_ArcSin : Continuous (olor [--]One One) ArcSin. -unfold ArcSin in |- *; apply Continuous_prim. +Proof. + unfold ArcSin in |- *; apply Continuous_prim. Qed. Lemma Derivative_ArcSin : forall H, Derivative (olor [--]One One) H ArcSin (( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ)). -intros; unfold ArcSin in |- *. -apply FTC1. +Proof. + intros; unfold ArcSin in |- *. + apply FTC1. Qed. Hint Resolve Derivative_ArcSin: derivate. @@ -151,31 +155,32 @@ Hint Resolve Continuous_ArcSin: continuous. Definition ArcCos := [-C-] (Pi [/]TwoNZ) {-}ArcSin. Lemma ArcCos_domain : forall x : IR, [--]One [<] x -> x [<] One -> Dom ArcCos x. -intros; repeat split; auto. +Proof. + intros; repeat split; auto. Qed. Lemma Continuous_ArcCos : Continuous (olor [--]One One) ArcCos. -unfold ArcCos in |- *; Contin. +Proof. + unfold ArcCos in |- *; Contin. Qed. Lemma Derivative_ArcCos : forall H, Derivative (olor [--]One One) H ArcCos {--} (( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ)). -intros; unfold ArcCos in |- *. -apply - Derivative_wdr - with ( [-C-]Zero{-} ( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ)). -2: Deriv. -apply eq_imp_Feq. -apply included_FMinus. -Included. -apply Continuous_imp_inc; apply ArcSin_def_lemma. -apply included_FInv. -apply Continuous_imp_inc; apply ArcSin_def_lemma. -intros. -astepl (Part _ _ (ProjIR1 Hx) [-]Part _ _ (ProjIR2 Hx)). -astepl (Zero[-]Part _ _ (ProjIR2 Hx)). -astepl ( [--] (Part _ _ (ProjIR2 Hx))). -Step_final ( [--] ((( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ)) x Hx')). +Proof. + intros; unfold ArcCos in |- *. + apply Derivative_wdr with ( [-C-]Zero{-} ( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ)). + 2: Deriv. + apply eq_imp_Feq. + apply included_FMinus. + Included. + apply Continuous_imp_inc; apply ArcSin_def_lemma. + apply included_FInv. + apply Continuous_imp_inc; apply ArcSin_def_lemma. + intros. + astepl (Part _ _ (ProjIR1 Hx) [-]Part _ _ (ProjIR2 Hx)). + astepl (Zero[-]Part _ _ (ProjIR2 Hx)). + astepl ( [--] (Part _ _ (ProjIR2 Hx))). + Step_final ( [--] ((( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ)) x Hx')). Qed. (** @@ -183,42 +188,46 @@ Qed. *) Lemma ArcTan_def_lemma : Continuous realline {1/} ( [-C-]One{+}FId{^}2). -apply Continuous_recip. -Contin. -red in |- *; intros. -split. -Included. -exists OneR. -apply pos_one. -intros; simpl in |- *. -eapply leEq_transitive. -2: apply leEq_AbsIR. -apply shift_leEq_plus'. -astepl ZeroR; astepr (y[^]2). -apply sqr_nonneg. +Proof. + apply Continuous_recip. + Contin. + red in |- *; intros. + split. + Included. + exists OneR. + apply pos_one. + intros; simpl in |- *. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + apply shift_leEq_plus'. + astepl ZeroR; astepr (y[^]2). + apply sqr_nonneg. Qed. Definition ArcTang := ( [-S-]ArcTan_def_lemma) Zero CI. Lemma ArcTan_domain : forall x : IR, Dom ArcTang x. -intros; simpl in |- *; auto. +Proof. + intros; simpl in |- *; auto. Qed. Definition ArcTan (x : IR) := ArcTang x CI. Lemma Continuous_ArcTan : Continuous realline ArcTang. -unfold ArcTang in |- *; Contin. +Proof. + unfold ArcTang in |- *; Contin. Qed. Lemma Derivative_ArcTan : forall H, Derivative realline H ArcTang {1/} ( [-C-]One{+}FId{^}2). -intros; unfold ArcTang in |- *; apply FTC1. +Proof. + intros; unfold ArcTang in |- *; apply FTC1. Qed. Lemma ArcTan_wd : forall x y, x[=]y -> ArcTan x [=] ArcTan y. Proof. -intros. -refine (pfwdef _ _ _ _ _ _ _). -assumption. + intros. + refine (pfwdef _ _ _ _ _ _ _). + assumption. Qed. Hint Resolve ArcTan_wd: algebra. @@ -236,299 +245,287 @@ We now prove that this functions are in fact inverses to the corresponding trigo *) Lemma maps_Sin : maps_compacts_into (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) (olor [--]One One) Sine. -intros a b Hab H. -set (min := Min (Sin a) [--] (One [/]TwoNZ)) in *. -set (max := Max (Sin b) (One [/]TwoNZ)) in *. -cut (min [<] max). intro H0. -exists min; exists max; exists H0. -elim (H _ (compact_inc_lft _ _ Hab)); intros Ha1 Ha2. -elim (H _ (compact_inc_rht _ _ Hab)); intros Hb1 Hb2. -split. -intros x H1. -unfold min, max in H1; inversion_clear H1; split. -apply less_leEq_trans with min. -unfold min in |- *; apply less_Min. -apply inv_cancel_less; astepr OneR. -eapply leEq_less_trans. -apply inv_leEq_AbsIR. -apply Abs_Sin_less_One; auto. -apply inv_resp_less; apply (half_lt1 IR). -auto. -eapply leEq_less_trans. -apply H3. -apply Max_less. -eapply leEq_less_trans. -apply leEq_AbsIR. -apply Abs_Sin_less_One; auto. -apply (half_lt1 IR). -intros x Hx H1. -apply compact_wd with (Sin x). -2: simpl in |- *; algebra. -unfold min, max in |- *; inversion_clear H1. -split. -eapply leEq_transitive; [ apply Min_leEq_lft | apply Sin_resp_leEq; auto ]. -apply less_leEq; auto. -apply less_leEq; apply leEq_less_trans with b; auto. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply Sin_resp_leEq; auto. -apply leEq_transitive with a; auto; apply less_leEq; auto. -apply less_leEq; auto. -unfold min, max in |- *; apply less_transitive_unfolded with ZeroR. -eapply leEq_less_trans. -apply Min_leEq_rht. -astepr ( [--]Zero:IR); apply inv_resp_less; apply (pos_half IR). -eapply less_leEq_trans; [ apply (pos_half IR) | apply rht_leEq_Max ]. +Proof. + intros a b Hab H. + set (min := Min (Sin a) [--] (One [/]TwoNZ)) in *. + set (max := Max (Sin b) (One [/]TwoNZ)) in *. + cut (min [<] max). intro H0. + exists min; exists max; exists H0. + elim (H _ (compact_inc_lft _ _ Hab)); intros Ha1 Ha2. + elim (H _ (compact_inc_rht _ _ Hab)); intros Hb1 Hb2. + split. + intros x H1. + unfold min, max in H1; inversion_clear H1; split. + apply less_leEq_trans with min. + unfold min in |- *; apply less_Min. + apply inv_cancel_less; astepr OneR. + eapply leEq_less_trans. + apply inv_leEq_AbsIR. + apply Abs_Sin_less_One; auto. + apply inv_resp_less; apply (half_lt1 IR). + auto. + eapply leEq_less_trans. + apply H3. + apply Max_less. + eapply leEq_less_trans. + apply leEq_AbsIR. + apply Abs_Sin_less_One; auto. + apply (half_lt1 IR). + intros x Hx H1. + apply compact_wd with (Sin x). + 2: simpl in |- *; algebra. + unfold min, max in |- *; inversion_clear H1. + split. + eapply leEq_transitive; [ apply Min_leEq_lft | apply Sin_resp_leEq; auto ]. + apply less_leEq; auto. + apply less_leEq; apply leEq_less_trans with b; auto. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply Sin_resp_leEq; auto. + apply leEq_transitive with a; auto; apply less_leEq; auto. + apply less_leEq; auto. + unfold min, max in |- *; apply less_transitive_unfolded with ZeroR. + eapply leEq_less_trans. + apply Min_leEq_rht. + astepr ( [--]Zero:IR); apply inv_resp_less; apply (pos_half IR). + eapply less_leEq_trans; [ apply (pos_half IR) | apply rht_leEq_Max ]. Qed. Lemma ArcSin_Sin_inv : Feq (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) (ArcSin[o]Sine) FId. -set (HPi1 := pos_HalfPi) in *. -set (HPi2 := neg_invHalfPi) in *. -set - (H := invHalfPi_less_HalfPi:proper (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ))) - in *. -apply Feq_criterium with H ( [-C-]One:PartIR) ZeroR. -assert (H0 : Derivative _ H Sine Cosine). - apply Included_imp_Derivative with realline CI; Deriv. -assert (H1 : [--]One [<] OneR). - set (H' := pos_one IR) in *; apply less_transitive_unfolded with ZeroR; auto. - astepr ( [--]ZeroR); apply inv_resp_less; auto. -set (H2 := Derivative_ArcSin H1) in *. -eapply Derivative_wdr. -2: apply (Derivative_comp _ _ _ _ _ _ _ _ maps_Sin H0 H2). -apply eq_imp_Feq. -apply included_FMult. -apply included_FComp. -Included. -intros. -unfold FPower in |- *. -cut - (Dom ( [-C-] [--] (One [/]TwoNZ) {*} (Logarithm[o] [-C-]One{-}FId{^}2)) - (Part _ _ Hx)). intro H3. -exists H3; apply Exp_domain. -split. -auto. -exists (CAnd_intro _ _ CI CI). -apply Log_domain. -astepr (One[-]Sine x Hx[^]2). -astepl (OneR[-]One). -unfold cg_minus in |- *; apply plus_resp_less_lft. -apply inv_resp_less. -astepr (OneR[^]2); apply AbsIR_less_square. -apply less_wdl with (AbsIR (Sin x)). -inversion_clear X; apply Abs_Sin_less_One; auto. -apply AbsIR_wd; simpl in |- *; algebra. -split. -split. -intros x H3 Hx Hx'. -astepr OneR. -cut (Zero [<] One[-]Sin x[^]2). intro H4. -apply - eq_transitive_unfolded - with ((One[-]Sin x[^]2) [!] [--] (One [/]TwoNZ) [//]H4[*]Cos x). -unfold power, FPower in |- *. -unfold FPower in Hx. -astepl (Part _ _ (ProjIR1 Hx) [*]Part _ _ (ProjIR2 Hx)). -apply mult_wd. -2: simpl in |- *; algebra. -elim Hx; clear Hx; intros Hx Hx1. -astepl (Part _ _ Hx); clear Hx1. -astepl (Part _ _ (ProjT2 Hx)). -elim Hx; clear Hx; intros Hx1 Hx2. -astepl (Part _ _ Hx2). -astepl (Part _ _ (ProjT2 Hx2)). -simpl in |- *; apply pfwdef. -elim Hx2; intros Hx3 Hx4. -astepl (Part _ _ Hx3). -clear Hx4 Hx2. -astepl ( [--] (One [/]TwoNZ) [*]Part _ _ (ProjIR2 Hx3)). -elim Hx3; clear Hx3; intros Hx2 Hx3. -astepl ( [--] (One [/]TwoNZ) [*]Part _ _ Hx3). -apply mult_wdr. -astepl (Part _ _ (ProjT2 Hx3)). -unfold Log in |- *; apply pfwdef. -elim Hx3; intros Hx4 Hx5. -astepl (Part _ _ Hx4). -astepl (Part _ _ (ProjIR1 Hx4) [-]Part _ _ (ProjIR2 Hx4)). -elim Hx4; clear Hx5 Hx4 Hx3 Hx2; intros Hx2 Hx3. -astepl (Part _ _ Hx2[-]Part _ _ Hx3). -apply cg_minus_wd. -algebra. -simpl in |- *; algebra. -unfold power in |- *. -astepl (Exp [--] (One [/]TwoNZ[*]Log _ H4) [*]Cos x). -astepl ((One[/] _[//]Exp_ap_zero (One [/]TwoNZ[*]Log _ H4)) [*]Cos x). -astepr - (Exp (One [/]TwoNZ[*]Log _ H4) [/] _[//]Exp_ap_zero (One [/]TwoNZ[*]Log _ H4)). -rstepl (Cos x[/] _[//]Exp_ap_zero (One [/]TwoNZ[*]Log _ H4)). -apply div_wd. -2: algebra. -astepr (Exp (Log _ H4[*]One [/]TwoNZ)). -assert (H5 : Zero [<] Cos x). inversion_clear H3; apply Cos_pos; auto. -astepl (Exp (Log _ H5)). -apply Exp_wd. -rstepl ((Log _ H5[+]Log _ H5) [/]TwoNZ). -rstepr (Log _ H4 [/]TwoNZ). -apply div_wd. -2: algebra. -astepl (Log _ (mult_resp_pos _ _ _ H5 H5)). -astepl (Log _ (pos_square _ _ (pos_ap_zero _ _ H5))). -apply Log_wd. -astepr (Cos x[^]2[+]Sin x[^]2[-]Sin x[^]2); rational. -astepl (OneR[-]One). -unfold cg_minus in |- *; apply plus_resp_less_lft. -apply inv_resp_less. -astepr (OneR[^]2); apply AbsIR_less_square. -inversion_clear H3; apply Abs_Sin_less_One; auto. -Deriv. -split; auto. -intros; simpl in |- *; apply Integral_empty. -astepl (Sin Zero); simpl in |- *; algebra. +Proof. + set (HPi1 := pos_HalfPi) in *. + set (HPi2 := neg_invHalfPi) in *. + set (H := invHalfPi_less_HalfPi:proper (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ))) in *. + apply Feq_criterium with H ( [-C-]One:PartIR) ZeroR. + assert (H0 : Derivative _ H Sine Cosine). + apply Included_imp_Derivative with realline CI; Deriv. + assert (H1 : [--]One [<] OneR). + set (H' := pos_one IR) in *; apply less_transitive_unfolded with ZeroR; auto. + astepr ( [--]ZeroR); apply inv_resp_less; auto. + set (H2 := Derivative_ArcSin H1) in *. + eapply Derivative_wdr. + 2: apply (Derivative_comp _ _ _ _ _ _ _ _ maps_Sin H0 H2). + apply eq_imp_Feq. + apply included_FMult. + apply included_FComp. + Included. + intros. + unfold FPower in |- *. + cut (Dom ( [-C-] [--] (One [/]TwoNZ) {*} (Logarithm[o] [-C-]One{-}FId{^}2)) (Part _ _ Hx)). intro H3. + exists H3; apply Exp_domain. + split. + auto. + exists (CAnd_intro _ _ CI CI). + apply Log_domain. + astepr (One[-]Sine x Hx[^]2). + astepl (OneR[-]One). + unfold cg_minus in |- *; apply plus_resp_less_lft. + apply inv_resp_less. + astepr (OneR[^]2); apply AbsIR_less_square. + apply less_wdl with (AbsIR (Sin x)). + inversion_clear X; apply Abs_Sin_less_One; auto. + apply AbsIR_wd; simpl in |- *; algebra. + split. + split. + intros x H3 Hx Hx'. + astepr OneR. + cut (Zero [<] One[-]Sin x[^]2). intro H4. + apply eq_transitive_unfolded with ((One[-]Sin x[^]2) [!] [--] (One [/]TwoNZ) [//]H4[*]Cos x). + unfold power, FPower in |- *. + unfold FPower in Hx. + astepl (Part _ _ (ProjIR1 Hx) [*]Part _ _ (ProjIR2 Hx)). + apply mult_wd. + 2: simpl in |- *; algebra. + elim Hx; clear Hx; intros Hx Hx1. + astepl (Part _ _ Hx); clear Hx1. + astepl (Part _ _ (ProjT2 Hx)). + elim Hx; clear Hx; intros Hx1 Hx2. + astepl (Part _ _ Hx2). + astepl (Part _ _ (ProjT2 Hx2)). + simpl in |- *; apply pfwdef. + elim Hx2; intros Hx3 Hx4. + astepl (Part _ _ Hx3). + clear Hx4 Hx2. + astepl ( [--] (One [/]TwoNZ) [*]Part _ _ (ProjIR2 Hx3)). + elim Hx3; clear Hx3; intros Hx2 Hx3. + astepl ( [--] (One [/]TwoNZ) [*]Part _ _ Hx3). + apply mult_wdr. + astepl (Part _ _ (ProjT2 Hx3)). + unfold Log in |- *; apply pfwdef. + elim Hx3; intros Hx4 Hx5. + astepl (Part _ _ Hx4). + astepl (Part _ _ (ProjIR1 Hx4) [-]Part _ _ (ProjIR2 Hx4)). + elim Hx4; clear Hx5 Hx4 Hx3 Hx2; intros Hx2 Hx3. + astepl (Part _ _ Hx2[-]Part _ _ Hx3). + apply cg_minus_wd. + algebra. + simpl in |- *; algebra. + unfold power in |- *. + astepl (Exp [--] (One [/]TwoNZ[*]Log _ H4) [*]Cos x). + astepl ((One[/] _[//]Exp_ap_zero (One [/]TwoNZ[*]Log _ H4)) [*]Cos x). + astepr (Exp (One [/]TwoNZ[*]Log _ H4) [/] _[//]Exp_ap_zero (One [/]TwoNZ[*]Log _ H4)). + rstepl (Cos x[/] _[//]Exp_ap_zero (One [/]TwoNZ[*]Log _ H4)). + apply div_wd. + 2: algebra. + astepr (Exp (Log _ H4[*]One [/]TwoNZ)). + assert (H5 : Zero [<] Cos x). inversion_clear H3; apply Cos_pos; auto. + astepl (Exp (Log _ H5)). + apply Exp_wd. + rstepl ((Log _ H5[+]Log _ H5) [/]TwoNZ). + rstepr (Log _ H4 [/]TwoNZ). + apply div_wd. + 2: algebra. + astepl (Log _ (mult_resp_pos _ _ _ H5 H5)). + astepl (Log _ (pos_square _ _ (pos_ap_zero _ _ H5))). + apply Log_wd. + astepr (Cos x[^]2[+]Sin x[^]2[-]Sin x[^]2); rational. + astepl (OneR[-]One). + unfold cg_minus in |- *; apply plus_resp_less_lft. + apply inv_resp_less. + astepr (OneR[^]2); apply AbsIR_less_square. + inversion_clear H3; apply Abs_Sin_less_One; auto. + Deriv. + split; auto. + intros; simpl in |- *; apply Integral_empty. + astepl (Sin Zero); simpl in |- *; algebra. Qed. Opaque ArcSin. Lemma ArcSin_Sin : forall x, [--] (Pi [/]TwoNZ) [<] x -> x [<] Pi [/]TwoNZ -> forall H, ArcSin (Sin x) H [=] x. -intros. -unfold Sin in |- *. -astepr (FId x CI). -cut (Dom (ArcSin[o]Sine) x). intro H2. -apply eq_transitive_unfolded with ((ArcSin[o]Sine) x H2). -simpl in |- *; algebra. -apply Feq_imp_eq with (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)). -apply ArcSin_Sin_inv. -split; auto. -exists CI; auto. +Proof. + intros. + unfold Sin in |- *. + astepr (FId x CI). + cut (Dom (ArcSin[o]Sine) x). intro H2. + apply eq_transitive_unfolded with ((ArcSin[o]Sine) x H2). + simpl in |- *; algebra. + apply Feq_imp_eq with (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)). + apply ArcSin_Sin_inv. + split; auto. + exists CI; auto. Qed. Lemma ArcSin_range : forall x Hx, [--] (Pi [/]TwoNZ) [<] ArcSin x Hx and ArcSin x Hx [<] Pi [/]TwoNZ. -intros. -Transparent ArcSin. -cut - {y : IR | olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ) y | - forall Hy, Sine y Hy [=] x}. -intros H; elim H; clear H; intros y H H0. -elim H; clear H; intros H1 H2. -assert (H : Sin y [=] x). simpl in |- *; algebra. -assert (H3 : Dom ArcSin (Sin y)). apply dom_wd with x; algebra. -split. -astepr (ArcSin _ H3). -apply less_wdr with y; auto. -apply eq_symmetric_unfolded; apply ArcSin_Sin; auto. -astepl (ArcSin _ H3). -apply less_wdl with y; auto. -apply eq_symmetric_unfolded; apply ArcSin_Sin; auto. -elim Hx; intros H H0. -set (H1 := less_leEq _ _ _ invHalfPi_less_HalfPi) in *. -cut (Continuous_I H1 Sine). intro H2. -apply IVT'_I with H1 H2; auto. -PiSolve. -intros x0 y H3 H4 H5 Hx0 Hy. -2: astepl (Sine [--] (Pi [/]TwoNZ) CI); astepl (Sin [--] (Pi [/]TwoNZ)); - astepl ( [--] (Sin (Pi [/]TwoNZ))); astepl ( [--]OneR); - auto. -2: astepr (Sine (Pi [/]TwoNZ) CI); astepr (Sin (Pi [/]TwoNZ)); astepr OneR; - auto. -2: apply included_imp_Continuous with realline; Contin. -apply less_wdl with (Sin x0). -2: simpl in |- *; algebra. -apply less_wdr with (Sin y). -2: simpl in |- *; algebra. -inversion_clear H3; inversion_clear H4; apply Sin_resp_less; auto. +Proof. + intros. + Transparent ArcSin. + cut {y : IR | olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ) y | forall Hy, Sine y Hy [=] x}. + intros H; elim H; clear H; intros y H H0. + elim H; clear H; intros H1 H2. + assert (H : Sin y [=] x). simpl in |- *; algebra. + assert (H3 : Dom ArcSin (Sin y)). apply dom_wd with x; algebra. + split. + astepr (ArcSin _ H3). + apply less_wdr with y; auto. + apply eq_symmetric_unfolded; apply ArcSin_Sin; auto. + astepl (ArcSin _ H3). + apply less_wdl with y; auto. + apply eq_symmetric_unfolded; apply ArcSin_Sin; auto. + elim Hx; intros H H0. + set (H1 := less_leEq _ _ _ invHalfPi_less_HalfPi) in *. + cut (Continuous_I H1 Sine). intro H2. + apply IVT'_I with H1 H2; auto. + PiSolve. + intros x0 y H3 H4 H5 Hx0 Hy. + 2: astepl (Sine [--] (Pi [/]TwoNZ) CI); astepl (Sin [--] (Pi [/]TwoNZ)); + astepl ( [--] (Sin (Pi [/]TwoNZ))); astepl ( [--]OneR); auto. + 2: astepr (Sine (Pi [/]TwoNZ) CI); astepr (Sin (Pi [/]TwoNZ)); astepr OneR; auto. + 2: apply included_imp_Continuous with realline; Contin. + apply less_wdl with (Sin x0). + 2: simpl in |- *; algebra. + apply less_wdr with (Sin y). + 2: simpl in |- *; algebra. + inversion_clear H3; inversion_clear H4; apply Sin_resp_less; auto. Qed. Lemma Sin_ArcSin : forall (x : IR) Hx, x [=] Sin (ArcSin x Hx). -intros. -set (y := Sin (ArcSin x Hx)) in *. -cut (Dom ArcSin y). intro H. -cut (ArcSin x Hx [=] ArcSin y H). intro H0. -2: unfold y in |- *; inversion_clear H. -2: apply eq_symmetric_unfolded. -Transparent ArcSin. -simpl in H0. -unfold y in H0. -cut - (Continuous_I (Min_leEq_Max x y) - (( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ))). intro H1. -cut (Integral H1 [=] Zero). intro H2. -clear H0. -elim H; intros H0 H3. -elim Hx; clear H; intros H H4. -apply Integral_eq_zero with (contF := H1) (x := x). -exact (CAnd_intro _ _ (Min_leEq_lft x y) (lft_leEq_Max x y)). -unfold FPower in |- *; intros. -astepr (Part _ _ (ProjT2 Hx0)). -apply less_wdr with (Exp (Part _ _ (ProjT1 Hx0))). -apply Exp_pos. -simpl in |- *; algebra. -unfold FPower in |- *; intros. -apply less_leEq; astepr (Part _ _ (ProjT2 Hx0)). -apply less_wdr with (Exp (Part _ _ (ProjT1 Hx0))). -apply Exp_pos. -simpl in |- *; algebra. -auto. -apply eq_transitive_unfolded with (ArcSin y H[-]ArcSin x Hx). -rstepl (ArcSin x Hx[+]Integral H1[-]ArcSin x Hx). -apply cg_minus_wd; [ simpl in |- * | algebra ]. -apply eq_symmetric_unfolded; - apply Integral_plus_Integral with (Min3_leEq_Max3 Zero y x). -apply included_imp_Continuous with (olor [--]One One). -exact ArcSin_def_lemma. -apply included3_interval; auto. -split. -astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. -apply pos_one. -apply x_minus_x; simpl in |- *; algebra. -apply included_imp_Continuous with (olor [--]One One). -exact ArcSin_def_lemma. -apply included_interval; auto. -elim (ArcSin_range x Hx); intros; apply ArcSin_Sin; auto. -elim (ArcSin_range x Hx); intros; apply ArcSin_domain. -unfold y in |- *. -astepr ( [--] [--] (Sin (ArcSin x Hx))); astepr ( [--] (Sin [--] (ArcSin x Hx))); - apply inv_resp_less. -apply Sin_less_One. -apply Cos_pos. -apply inv_resp_less; auto. -astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; auto. -unfold y in |- *; apply Sin_less_One. -apply Cos_pos; auto. +Proof. + intros. + set (y := Sin (ArcSin x Hx)) in *. + cut (Dom ArcSin y). intro H. + cut (ArcSin x Hx [=] ArcSin y H). intro H0. + 2: unfold y in |- *; inversion_clear H. + 2: apply eq_symmetric_unfolded. + Transparent ArcSin. + simpl in H0. + unfold y in H0. + cut (Continuous_I (Min_leEq_Max x y) + (( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ))). intro H1. + cut (Integral H1 [=] Zero). intro H2. + clear H0. + elim H; intros H0 H3. + elim Hx; clear H; intros H H4. + apply Integral_eq_zero with (contF := H1) (x := x). + exact (CAnd_intro _ _ (Min_leEq_lft x y) (lft_leEq_Max x y)). + unfold FPower in |- *; intros. + astepr (Part _ _ (ProjT2 Hx0)). + apply less_wdr with (Exp (Part _ _ (ProjT1 Hx0))). + apply Exp_pos. + simpl in |- *; algebra. + unfold FPower in |- *; intros. + apply less_leEq; astepr (Part _ _ (ProjT2 Hx0)). + apply less_wdr with (Exp (Part _ _ (ProjT1 Hx0))). + apply Exp_pos. + simpl in |- *; algebra. + auto. + apply eq_transitive_unfolded with (ArcSin y H[-]ArcSin x Hx). + rstepl (ArcSin x Hx[+]Integral H1[-]ArcSin x Hx). + apply cg_minus_wd; [ simpl in |- * | algebra ]. + apply eq_symmetric_unfolded; apply Integral_plus_Integral with (Min3_leEq_Max3 Zero y x). + apply included_imp_Continuous with (olor [--]One One). + exact ArcSin_def_lemma. + apply included3_interval; auto. + split. + astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. + apply pos_one. + apply x_minus_x; simpl in |- *; algebra. + apply included_imp_Continuous with (olor [--]One One). + exact ArcSin_def_lemma. + apply included_interval; auto. + elim (ArcSin_range x Hx); intros; apply ArcSin_Sin; auto. + elim (ArcSin_range x Hx); intros; apply ArcSin_domain. + unfold y in |- *. + astepr ( [--] [--] (Sin (ArcSin x Hx))); astepr ( [--] (Sin [--] (ArcSin x Hx))); + apply inv_resp_less. + apply Sin_less_One. + apply Cos_pos. + apply inv_resp_less; auto. + astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; auto. + unfold y in |- *; apply Sin_less_One. + apply Cos_pos; auto. Qed. Lemma Sin_ArcSin_inv : Feq (olor [--]One One) (Sine[o]ArcSin) FId. -apply eq_imp_Feq. -apply included_FComp. -Included. -intros; apply sin_domain. -Included. -intros x H Hx Hx'. -elim Hx; intros x0 H0. -astepr x; astepl (Part _ _ (ProjT2 Hx)); astepl (Part _ _ H0). -apply eq_transitive_unfolded with (Sin (ArcSin x x0)). -simpl in |- *; algebra. -apply eq_symmetric_unfolded; apply Sin_ArcSin. -algebra. +Proof. + apply eq_imp_Feq. + apply included_FComp. + Included. + intros; apply sin_domain. + Included. + intros x H Hx Hx'. + elim Hx; intros x0 H0. + astepr x; astepl (Part _ _ (ProjT2 Hx)); astepl (Part _ _ H0). + apply eq_transitive_unfolded with (Sin (ArcSin x x0)). + simpl in |- *; algebra. + apply eq_symmetric_unfolded; apply Sin_ArcSin. + algebra. Qed. Lemma ArcSin_resp_leEq : forall x y, [--]One [<] x -> x [<=] y -> y [<] One -> forall Hx Hy, ArcSin x Hx [<=] ArcSin y Hy. -intros x y H H0 H1 Hx Hy. -assert (H2 : [--]One [<] OneR). - apply less_transitive_unfolded with ZeroR; - [ astepr ( [--]ZeroR); apply inv_resp_less | idtac ]; - apply pos_one. -apply - Derivative_imp_resp_leEq - with (olor [--]One One) H2 (( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ)); - Deriv. -intros; apply leEq_glb; intro z; intros. -elim Hy0; intros. -apply - leEq_wdr - with - (Exp (( [-C-] [--] (One [/]TwoNZ) {*} (Logarithm[o] [-C-]One{-}FId{^}2)) z x0)). -apply less_leEq; apply Exp_pos. -simpl in |- *; algebra. +Proof. + intros x y H H0 H1 Hx Hy. + assert (H2 : [--]One [<] OneR). + apply less_transitive_unfolded with ZeroR; [ astepr ( [--]ZeroR); apply inv_resp_less | idtac ]; + apply pos_one. + apply Derivative_imp_resp_leEq + with (olor [--]One One) H2 (( [-C-]One{-}FId{^}2) {!} [-C-] [--] (One [/]TwoNZ)); Deriv. + intros; apply leEq_glb; intro z; intros. + elim Hy0; intros. + apply leEq_wdr with (Exp (( [-C-] [--] (One [/]TwoNZ) {*} (Logarithm[o] [-C-]One{-}FId{^}2)) z x0)). + apply less_leEq; apply Exp_pos. + simpl in |- *; algebra. Qed. (** @@ -536,80 +533,85 @@ Qed. *) Lemma ArcCos_Cos : forall x, Zero [<] x -> x [<] Pi -> forall H, ArcCos (Cos x) H [=] x. -intros x H H0 H1. -assert (H2 : Dom ArcCos (Sin (Pi [/]TwoNZ[-]x))). - apply dom_wd with (Cos x); algebra. -astepl (Part _ _ H2). -unfold ArcCos in |- *. -astepl (Pi [/]TwoNZ[-]Part _ _ (ProjIR2 H2)). -rstepr (Pi [/]TwoNZ[-] (Pi [/]TwoNZ[-]x)). -apply cg_minus_wd. -algebra. -apply ArcSin_Sin. -apply shift_less_minus; apply shift_plus_less'. -rstepr Pi; auto. -apply shift_minus_less; apply shift_less_plus'. -astepl ZeroR; auto. +Proof. + intros x H H0 H1. + assert (H2 : Dom ArcCos (Sin (Pi [/]TwoNZ[-]x))). + apply dom_wd with (Cos x); algebra. + astepl (Part _ _ H2). + unfold ArcCos in |- *. + astepl (Pi [/]TwoNZ[-]Part _ _ (ProjIR2 H2)). + rstepr (Pi [/]TwoNZ[-] (Pi [/]TwoNZ[-]x)). + apply cg_minus_wd. + algebra. + apply ArcSin_Sin. + apply shift_less_minus; apply shift_plus_less'. + rstepr Pi; auto. + apply shift_minus_less; apply shift_less_plus'. + astepl ZeroR; auto. Qed. Lemma Cos_ArcCos : forall (x : IR) Hx, x [=] Cos (ArcCos x Hx). -intros. -unfold ArcCos in |- *. -astepr (Cos (Pi [/]TwoNZ[-]ArcSin x (ProjIR2 Hx))). -astepr (Sin (ArcSin x (ProjIR2 Hx))). -apply Sin_ArcSin. +Proof. + intros. + unfold ArcCos in |- *. + astepr (Cos (Pi [/]TwoNZ[-]ArcSin x (ProjIR2 Hx))). + astepr (Sin (ArcSin x (ProjIR2 Hx))). + apply Sin_ArcSin. Qed. Lemma ArcCos_Cos_inv : Feq (olor Zero Pi) (ArcCos[o]Cosine) FId. -apply eq_imp_Feq. -apply included_FComp. -Included. -intros. -apply ArcCos_domain. -apply less_wdr with (Cos x). -2: simpl in |- *; algebra. -apply inv_cancel_less. -astepr OneR. -eapply leEq_less_trans. -apply inv_leEq_AbsIR. -inversion_clear X; apply Abs_Cos_less_One; auto. -apply less_wdl with (Cos x). -2: simpl in |- *; algebra. -eapply leEq_less_trans. -apply leEq_AbsIR. -inversion_clear X; apply Abs_Cos_less_One; auto. -Included. -intros. -astepl (Part _ _ (ProjT2 Hx)); astepr x. -cut (Dom ArcCos (Cos x)). intro H0. -apply eq_transitive_unfolded with (ArcCos (Cos x) H0). -apply pfwdef; simpl in |- *; algebra. -inversion_clear X; apply ArcCos_Cos; auto. -inversion_clear Hx. -apply dom_wd with (Cosine x x0); auto. -simpl in |- *; algebra. +Proof. + apply eq_imp_Feq. + apply included_FComp. + Included. + intros. + apply ArcCos_domain. + apply less_wdr with (Cos x). + 2: simpl in |- *; algebra. + apply inv_cancel_less. + astepr OneR. + eapply leEq_less_trans. + apply inv_leEq_AbsIR. + inversion_clear X; apply Abs_Cos_less_One; auto. + apply less_wdl with (Cos x). + 2: simpl in |- *; algebra. + eapply leEq_less_trans. + apply leEq_AbsIR. + inversion_clear X; apply Abs_Cos_less_One; auto. + Included. + intros. + astepl (Part _ _ (ProjT2 Hx)); astepr x. + cut (Dom ArcCos (Cos x)). intro H0. + apply eq_transitive_unfolded with (ArcCos (Cos x) H0). + apply pfwdef; simpl in |- *; algebra. + inversion_clear X; apply ArcCos_Cos; auto. + inversion_clear Hx. + apply dom_wd with (Cosine x x0); auto. + simpl in |- *; algebra. Qed. Lemma Cos_ArcCos_inv : Feq (olor [--]One One) (Cosine[o]ArcCos) FId. -apply eq_imp_Feq. -apply included_FComp. -unfold ArcCos in |- *; Included. -intros; apply cos_domain. -Included. -intros. -inversion_clear Hx. -astepr x; astepl (Part _ _ (ProjT2 Hx)); astepl (Part _ _ X0). -apply eq_transitive_unfolded with (Cos (ArcCos x x0)). -simpl in |- *; algebra. -apply eq_symmetric_unfolded; apply Cos_ArcCos. +Proof. + apply eq_imp_Feq. + apply included_FComp. + unfold ArcCos in |- *; Included. + intros; apply cos_domain. + Included. + intros. + inversion_clear Hx. + astepr x; astepl (Part _ _ (ProjT2 Hx)); astepl (Part _ _ X0). + apply eq_transitive_unfolded with (Cos (ArcCos x x0)). + simpl in |- *; algebra. + apply eq_symmetric_unfolded; apply Cos_ArcCos. Qed. Lemma ArcCos_resp_leEq : forall x y, [--]One [<] x -> x [<=] y -> y [<] One -> forall Hx Hy, ArcCos y Hy [<=] ArcCos x Hx. -intros. -Opaque ArcSin. -simpl in |- *; unfold cg_minus in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq; apply ArcSin_resp_leEq; auto. +Proof. + intros. + Opaque ArcSin. + simpl in |- *; unfold cg_minus in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq; apply ArcSin_resp_leEq; auto. Qed. (** @@ -617,269 +619,255 @@ Qed. *) Lemma maps_Tan : maps_compacts_into (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) realline Tang. -intros a b Hab H. -elim (H _ (compact_inc_lft _ _ Hab)); intros Ha1 Ha2. -elim (H _ (compact_inc_rht _ _ Hab)); intros Hb1 Hb2. -cut (Dom Tang b). cut (Dom Tang a). intros H0 H1. -set (min := Min (Tan a H0) Zero) in *. -set (max := Max (Tan b H1) One) in *. -cut (min [<] max). intro H2. -exists min; exists max; exists H2. -split. -Included. -intros x Hx H3. -fold (Tan x Hx) in |- *. -unfold min, max in |- *; inversion_clear H3. -split. -eapply leEq_transitive; [ apply Min_leEq_lft | apply Tan_resp_leEq; auto ]. -apply leEq_less_trans with b; auto. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply Tan_resp_leEq; auto. -apply less_leEq_trans with a; auto. -unfold min, max in |- *. -eapply leEq_less_trans. -apply Min_leEq_rht. -eapply less_leEq_trans; [ apply pos_one | apply rht_leEq_Max ]. -split. -apply sin_domain. -split. -apply cos_domain. -intros; apply ap_wdl with (Cos a). -apply Greater_imp_ap; apply Cos_pos; auto. -simpl in |- *; algebra. -split. -apply sin_domain. -split. -apply cos_domain. -intros; apply ap_wdl with (Cos b). -apply Greater_imp_ap; apply Cos_pos; auto. -simpl in |- *; algebra. +Proof. + intros a b Hab H. + elim (H _ (compact_inc_lft _ _ Hab)); intros Ha1 Ha2. + elim (H _ (compact_inc_rht _ _ Hab)); intros Hb1 Hb2. + cut (Dom Tang b). cut (Dom Tang a). intros H0 H1. + set (min := Min (Tan a H0) Zero) in *. + set (max := Max (Tan b H1) One) in *. + cut (min [<] max). intro H2. + exists min; exists max; exists H2. + split. + Included. + intros x Hx H3. + fold (Tan x Hx) in |- *. + unfold min, max in |- *; inversion_clear H3. + split. + eapply leEq_transitive; [ apply Min_leEq_lft | apply Tan_resp_leEq; auto ]. + apply leEq_less_trans with b; auto. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply Tan_resp_leEq; auto. + apply less_leEq_trans with a; auto. + unfold min, max in |- *. + eapply leEq_less_trans. + apply Min_leEq_rht. + eapply less_leEq_trans; [ apply pos_one | apply rht_leEq_Max ]. + split. + apply sin_domain. + split. + apply cos_domain. + intros; apply ap_wdl with (Cos a). + apply Greater_imp_ap; apply Cos_pos; auto. + simpl in |- *; algebra. + split. + apply sin_domain. + split. + apply cos_domain. + intros; apply ap_wdl with (Cos b). + apply Greater_imp_ap; apply Cos_pos; auto. + simpl in |- *; algebra. Qed. Lemma ArcTan_Tan_inv : Feq (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) (ArcTang[o]Tang) FId. -set (HPi1 := pos_HalfPi) in *. -set (HPi2 := neg_invHalfPi) in *. -set (H := invHalfPi_less_HalfPi) in *. -apply Feq_criterium with H ( [-C-]One:PartIR) ZeroR. -set (H0 := Derivative_Tan_2 H) in *. -set (H2 := Derivative_ArcTan CI) in *. -Derivative_Help. -apply eq_imp_Feq. -apply included_FMult. -apply included_FComp. -Included. -intros. -split. -repeat split. -intros. -astepl (One[+]Tang x Hx[^]2). -apply pos_ap_zero. -astepl (ZeroR[+]Zero); apply plus_resp_less_leEq. -apply pos_one. -apply sqr_nonneg. -Included. -Included. -intros. -astepr OneR. -astepl (Part _ _ (ProjIR1 Hx) [*]Part _ _ (ProjIR2 Hx)). -elim Hx; intros H3 H4. -astepl (Part _ _ H3[*]Part _ _ H4). -astepl - (Part _ _ (ProjT2 H3) [*] (Part _ _ (ProjIR1 H4) [+]Part _ _ (ProjIR2 H4))). -elim H3; intros x0 H5; elim H4; intros H6 H7. -astepl (Part _ _ H5[*] (Part _ _ H6[+]Part _ _ H7)). -astepl (Part _ _ H5[*] (One[+]Tang x H7[^]2)). -simpl in |- *; rational. -apply Derivative_comp with realline CI. -apply maps_Tan. -Deriv. -Deriv. -Deriv. -split; auto. -intros. -astepr ZeroR. -inversion_clear Hx. -Opaque Tang. -simpl in |- *. -apply Integral_empty. -algebra. +Proof. + set (HPi1 := pos_HalfPi) in *. + set (HPi2 := neg_invHalfPi) in *. + set (H := invHalfPi_less_HalfPi) in *. + apply Feq_criterium with H ( [-C-]One:PartIR) ZeroR. + set (H0 := Derivative_Tan_2 H) in *. + set (H2 := Derivative_ArcTan CI) in *. + Derivative_Help. + apply eq_imp_Feq. + apply included_FMult. + apply included_FComp. + Included. + intros. + split. + repeat split. + intros. + astepl (One[+]Tang x Hx[^]2). + apply pos_ap_zero. + astepl (ZeroR[+]Zero); apply plus_resp_less_leEq. + apply pos_one. + apply sqr_nonneg. + Included. + Included. + intros. + astepr OneR. + astepl (Part _ _ (ProjIR1 Hx) [*]Part _ _ (ProjIR2 Hx)). + elim Hx; intros H3 H4. + astepl (Part _ _ H3[*]Part _ _ H4). + astepl (Part _ _ (ProjT2 H3) [*] (Part _ _ (ProjIR1 H4) [+]Part _ _ (ProjIR2 H4))). + elim H3; intros x0 H5; elim H4; intros H6 H7. + astepl (Part _ _ H5[*] (Part _ _ H6[+]Part _ _ H7)). + astepl (Part _ _ H5[*] (One[+]Tang x H7[^]2)). + simpl in |- *; rational. + apply Derivative_comp with realline CI. + apply maps_Tan. + Deriv. + Deriv. + Deriv. + split; auto. + intros. + astepr ZeroR. + inversion_clear Hx. + Opaque Tang. + simpl in |- *. + apply Integral_empty. + algebra. Qed. Transparent Tang. Opaque ArcTang. Lemma ArcTan_Tan : forall x, [--] (Pi [/]TwoNZ) [<] x -> x [<] Pi [/]TwoNZ -> forall H, ArcTan (Tan x H) [=] x. -intros. -unfold Tan, ArcTan in |- *. -astepr (FId x CI). -cut (Dom (ArcTang[o]Tang) x). intro H2. -apply eq_transitive_unfolded with ((ArcTang[o]Tang) x H2). -simpl in |- *; algebra. -apply Feq_imp_eq with (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)). -apply ArcTan_Tan_inv. -split; auto. -exists H; apply CI. +Proof. + intros. + unfold Tan, ArcTan in |- *. + astepr (FId x CI). + cut (Dom (ArcTang[o]Tang) x). intro H2. + apply eq_transitive_unfolded with ((ArcTang[o]Tang) x H2). + simpl in |- *; algebra. + apply Feq_imp_eq with (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)). + apply ArcTan_Tan_inv. + split; auto. + exists H; apply CI. Qed. Lemma Tan_ilim : forall x, {y : IR | olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ) y | forall Hy, x [<=] Tan y Hy}. -intros. -set (aux_val := sqrt _ (less_leEq _ _ _ (pos_two IR)) [/]TwoNZ) in *. -assert (H : Zero [<] aux_val). - unfold aux_val in |- *. - apply shift_less_div; [ apply pos_two | apply power_cancel_less with 2 ]. - apply sqrt_nonneg. - astepl (ZeroR[^]2); astepl ZeroR; astepr (Two:IR); apply pos_two. -assert (H0 : sqrt _ (less_leEq _ _ _ (pos_two _)) [#] Zero). - apply mult_cancel_ap_zero_lft with (OneR [/]TwoNZ). - eapply ap_wdl_unfolded; - [ apply pos_ap_zero; apply H | unfold aux_val in |- *; rational ]. -assert (H1 : aux_val [=] (One[/] _[//]H0)). - unfold aux_val in |- *. - apply eq_div; astepr (Two:IR); - Step_final (sqrt _ (less_leEq _ _ _ (pos_two _)) [^]2). -assert (H2 : aux_val [<] One). - apply power_cancel_less with 2. - apply less_leEq; apply pos_one. - unfold aux_val in |- *; - rstepl ((sqrt _ (less_leEq _ _ _ (pos_two IR)) [^]2) [/]FourNZ); - astepr OneR. - apply shift_div_less; [ apply pos_four | astepl (Two:IR); astepr (Four:IR) ]; - apply two_less_four. -elim (less_cotransitive_unfolded _ _ _ H2 x); intros. -2: exists (Pi [/]FourNZ); repeat split; PiSolve. -2: intro; astepr OneR; apply less_leEq; auto. -assert (H3 : Two[*]x [#] Zero). - apply mult_resp_ap_zero. - apply two_ap_zero. - apply pos_ap_zero; apply less_transitive_unfolded with aux_val; auto. -assert (H4 : Dom ArcCos (One[/] _[//]H3)). - repeat split. - apply less_transitive_unfolded with ZeroR; - [ astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one - | apply recip_resp_pos ]. - apply mult_resp_pos; - [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. - apply shift_div_less. - apply mult_resp_pos; - [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. - astepr (Two[*]x); apply less_transitive_unfolded with (Two[*]aux_val). - 2: apply mult_resp_less_lft; auto; apply pos_two. - unfold aux_val in |- *; rstepr (sqrt _ (less_leEq _ _ _ (pos_two _))). - apply power_cancel_less with 2. - apply sqrt_nonneg. - astepl OneR; astepr (Two:IR); apply one_less_two. -assert (H5 : Pi [/]FourNZ [<=] ArcCos _ H4). - assert (H5 : Dom ArcCos aux_val). - repeat split; auto; unfold aux_val in |- *. - apply less_transitive_unfolded with ZeroR; auto; astepr ( [--]ZeroR); - apply inv_resp_less; apply pos_one. - apply leEq_wdl with (ArcCos _ H5). - 2: assert (H6 : Dom ArcCos (Cos (Pi [/]FourNZ))). - 2: apply dom_wd with aux_val; auto. - 2: Step_final (One[/] _[//]H0). - 2: apply eq_transitive_unfolded with (ArcCos _ H6). - 3: apply ArcCos_Cos; PiSolve. - 2: apply pfwdef; unfold aux_val in |- *. - 2: Step_final (One[/] _[//]H0). - apply ArcCos_resp_leEq. - apply less_transitive_unfolded with ZeroR. - astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. - apply recip_resp_pos; apply mult_resp_pos; try apply pos_two; - apply less_transitive_unfolded with aux_val; auto. - apply shift_div_leEq. - apply mult_resp_pos; - [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. - apply leEq_wdl with (aux_val[*] (Two[*]aux_val)). - repeat apply mult_resp_leEq_lft; apply less_leEq; auto; apply pos_two. - unfold aux_val in |- *. - rstepl ((sqrt _ (less_leEq _ _ _ (pos_two _)) [^]2) [/]TwoNZ). - Step_final ((Two:IR) [/]TwoNZ). +Proof. + intros. + set (aux_val := sqrt _ (less_leEq _ _ _ (pos_two IR)) [/]TwoNZ) in *. + assert (H : Zero [<] aux_val). + unfold aux_val in |- *. + apply shift_less_div; [ apply pos_two | apply power_cancel_less with 2 ]. + apply sqrt_nonneg. + astepl (ZeroR[^]2); astepl ZeroR; astepr (Two:IR); apply pos_two. + assert (H0 : sqrt _ (less_leEq _ _ _ (pos_two _)) [#] Zero). + apply mult_cancel_ap_zero_lft with (OneR [/]TwoNZ). + eapply ap_wdl_unfolded; [ apply pos_ap_zero; apply H | unfold aux_val in |- *; rational ]. + assert (H1 : aux_val [=] (One[/] _[//]H0)). + unfold aux_val in |- *. + apply eq_div; astepr (Two:IR); Step_final (sqrt _ (less_leEq _ _ _ (pos_two _)) [^]2). + assert (H2 : aux_val [<] One). + apply power_cancel_less with 2. + apply less_leEq; apply pos_one. + unfold aux_val in |- *; rstepl ((sqrt _ (less_leEq _ _ _ (pos_two IR)) [^]2) [/]FourNZ); astepr OneR. + apply shift_div_less; [ apply pos_four | astepl (Two:IR); astepr (Four:IR) ]; apply two_less_four. + elim (less_cotransitive_unfolded _ _ _ H2 x); intros. + 2: exists (Pi [/]FourNZ); repeat split; PiSolve. + 2: intro; astepr OneR; apply less_leEq; auto. + assert (H3 : Two[*]x [#] Zero). + apply mult_resp_ap_zero. + apply two_ap_zero. + apply pos_ap_zero; apply less_transitive_unfolded with aux_val; auto. + assert (H4 : Dom ArcCos (One[/] _[//]H3)). + repeat split. + apply less_transitive_unfolded with ZeroR; [ astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one + | apply recip_resp_pos ]. + apply mult_resp_pos; [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. + apply shift_div_less. + apply mult_resp_pos; [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. + astepr (Two[*]x); apply less_transitive_unfolded with (Two[*]aux_val). + 2: apply mult_resp_less_lft; auto; apply pos_two. + unfold aux_val in |- *; rstepr (sqrt _ (less_leEq _ _ _ (pos_two _))). + apply power_cancel_less with 2. + apply sqrt_nonneg. + astepl OneR; astepr (Two:IR); apply one_less_two. + assert (H5 : Pi [/]FourNZ [<=] ArcCos _ H4). + assert (H5 : Dom ArcCos aux_val). + repeat split; auto; unfold aux_val in |- *. + apply less_transitive_unfolded with ZeroR; auto; astepr ( [--]ZeroR); + apply inv_resp_less; apply pos_one. + apply leEq_wdl with (ArcCos _ H5). + 2: assert (H6 : Dom ArcCos (Cos (Pi [/]FourNZ))). + 2: apply dom_wd with aux_val; auto. + 2: Step_final (One[/] _[//]H0). + 2: apply eq_transitive_unfolded with (ArcCos _ H6). + 3: apply ArcCos_Cos; PiSolve. + 2: apply pfwdef; unfold aux_val in |- *. + 2: Step_final (One[/] _[//]H0). + apply ArcCos_resp_leEq. + apply less_transitive_unfolded with ZeroR. + astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. + apply recip_resp_pos; apply mult_resp_pos; try apply pos_two; + apply less_transitive_unfolded with aux_val; auto. + apply shift_div_leEq. + apply mult_resp_pos; [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. + apply leEq_wdl with (aux_val[*] (Two[*]aux_val)). + repeat apply mult_resp_leEq_lft; apply less_leEq; auto; apply pos_two. + unfold aux_val in |- *. + rstepl ((sqrt _ (less_leEq _ _ _ (pos_two _)) [^]2) [/]TwoNZ). + Step_final ((Two:IR) [/]TwoNZ). + auto. + exists (ArcCos _ H4). + Opaque iprop. + unfold ArcCos in |- *; simpl in |- *. + Transparent iprop. + elim H4; intros H6' H7; elim H7; intros. + apply iprop_wd with (Pi [/]TwoNZ[-]ArcSin _ H7). + 2: algebra. + elim (ArcSin_range _ H7); intros; split. + apply shift_less_minus; apply shift_plus_less'. + rstepr Pi; apply less_transitive_unfolded with (Pi [/]TwoNZ); PiSolve. + apply shift_minus_less; apply shift_less_plus'. + astepl ZeroR. + assert (H6 : Dom ArcSin (Sin Zero)). + apply dom_wd with ZeroR; [ split | algebra ]; [ astepr ( [--]ZeroR); apply inv_resp_less | idtac ]; + apply pos_one. + apply less_wdl with (ArcSin _ H6). + 2: apply ArcSin_Sin; PiSolve. + apply leEq_not_eq. + apply ArcSin_resp_leEq; auto. + astepr ZeroR; astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. + astepl ZeroR; apply less_leEq; apply recip_resp_pos. + apply mult_resp_pos; [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. + apply pfstrx with Sine CI CI. + apply ap_wdl_unfolded with ZeroR. + apply ap_wdr_unfolded with (One[/] _[//]H3). + apply ap_symmetric_unfolded; apply pos_ap_zero; apply recip_resp_pos. + apply mult_resp_pos; [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. + apply eq_transitive_unfolded with (Sin (ArcSin _ H7)); [ apply Sin_ArcSin | simpl in |- *; algebra ]. + apply eq_transitive_unfolded with (Sin (ArcSin _ H6)); + [ astepl (Sin Zero); apply Sin_ArcSin | simpl in |- *; algebra ]. + intros; unfold Tan, Tang in |- *. + assert (H6 : Cos (ArcCos _ H4) [#] Zero). + eapply ap_wdl_unfolded. + 2: apply Cos_ArcCos. + apply recip_ap_zero; auto. + apply leEq_wdr with (Sin (ArcCos _ H4) [/] _[//]H6). + 2: simpl in |- *; algebra. + apply shift_leEq_div. + Opaque Cos. + unfold ArcCos in |- *; simpl in |- *. + astepr (Sin (ArcSin _ (ProjIR2 H4))). + eapply less_wdr. + 2: apply Sin_ArcSin. + apply recip_resp_pos; apply mult_resp_pos; + [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. + apply leEq_wdl with (x[*] (One[/] _[//]H3)). + 2: apply mult_wdr; apply Cos_ArcCos. + rstepl (OneR [/]TwoNZ). + apply leEq_transitive with (One[/] _[//]H0). + apply recip_resp_leEq. + astepl (ZeroR[*]Two); apply shift_mult_less with (two_ap_zero IR); auto; apply pos_two. + apply power_cancel_leEq with 2; auto. + apply less_leEq; apply pos_two. + astepl (Two:IR); rstepr (Four:IR); apply less_leEq; apply two_less_four. + astepl (Sin (Pi [/]FourNZ)); apply Sin_resp_leEq. + PiSolve. + astepl (Pi [/]TwoNZ[-]ArcSin _ (ProjIR2 H4)). + apply shift_minus_leEq; apply shift_leEq_plus'; astepl ZeroR. + assert (H7 : Dom ArcSin (Sin Zero)). + apply dom_wd with ZeroR; [ split | algebra ]; [ astepr ( [--]ZeroR); apply inv_resp_less | idtac ]; + apply pos_one. + apply leEq_wdl with (ArcSin _ H7). + 2: apply ArcSin_Sin; PiSolve. + apply ArcSin_resp_leEq. + astepr ZeroR; astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. + astepl ZeroR; apply less_leEq; apply recip_resp_pos. + apply mult_resp_pos; [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. + apply shift_div_less. + apply mult_resp_pos; [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. + astepr (Two[*]x); apply less_transitive_unfolded with (Two[*]aux_val). + 2: apply mult_resp_less_lft; auto; apply pos_two. + unfold aux_val in |- *; rstepr (sqrt _ (less_leEq _ _ _ (pos_two _))). + apply power_cancel_less with 2. + apply sqrt_nonneg. + astepl OneR; astepr (Two:IR); apply one_less_two. auto. -exists (ArcCos _ H4). -Opaque iprop. -unfold ArcCos in |- *; simpl in |- *. -Transparent iprop. -elim H4; intros H6' H7; elim H7; intros. -apply iprop_wd with (Pi [/]TwoNZ[-]ArcSin _ H7). -2: algebra. -elim (ArcSin_range _ H7); intros; split. -apply shift_less_minus; apply shift_plus_less'. -rstepr Pi; apply less_transitive_unfolded with (Pi [/]TwoNZ); PiSolve. -apply shift_minus_less; apply shift_less_plus'. -astepl ZeroR. -assert (H6 : Dom ArcSin (Sin Zero)). - apply dom_wd with ZeroR; [ split | algebra ]; - [ astepr ( [--]ZeroR); apply inv_resp_less | idtac ]; - apply pos_one. -apply less_wdl with (ArcSin _ H6). -2: apply ArcSin_Sin; PiSolve. -apply leEq_not_eq. -apply ArcSin_resp_leEq; auto. -astepr ZeroR; astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. -astepl ZeroR; apply less_leEq; apply recip_resp_pos. -apply mult_resp_pos; - [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. -apply pfstrx with Sine CI CI. -apply ap_wdl_unfolded with ZeroR. -apply ap_wdr_unfolded with (One[/] _[//]H3). -apply ap_symmetric_unfolded; apply pos_ap_zero; apply recip_resp_pos. -apply mult_resp_pos; - [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. -apply eq_transitive_unfolded with (Sin (ArcSin _ H7)); - [ apply Sin_ArcSin | simpl in |- *; algebra ]. -apply eq_transitive_unfolded with (Sin (ArcSin _ H6)); - [ astepl (Sin Zero); apply Sin_ArcSin | simpl in |- *; algebra ]. -intros; unfold Tan, Tang in |- *. -assert (H6 : Cos (ArcCos _ H4) [#] Zero). - eapply ap_wdl_unfolded. - 2: apply Cos_ArcCos. - apply recip_ap_zero; auto. -apply leEq_wdr with (Sin (ArcCos _ H4) [/] _[//]H6). -2: simpl in |- *; algebra. -apply shift_leEq_div. -Opaque Cos. -unfold ArcCos in |- *; simpl in |- *. -astepr (Sin (ArcSin _ (ProjIR2 H4))). -eapply less_wdr. -2: apply Sin_ArcSin. -apply recip_resp_pos; apply mult_resp_pos; - [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. -apply leEq_wdl with (x[*] (One[/] _[//]H3)). -2: apply mult_wdr; apply Cos_ArcCos. -rstepl (OneR [/]TwoNZ). -apply leEq_transitive with (One[/] _[//]H0). -apply recip_resp_leEq. -astepl (ZeroR[*]Two); apply shift_mult_less with (two_ap_zero IR); auto; - apply pos_two. -apply power_cancel_leEq with 2; auto. -apply less_leEq; apply pos_two. -astepl (Two:IR); rstepr (Four:IR); apply less_leEq; apply two_less_four. -astepl (Sin (Pi [/]FourNZ)); apply Sin_resp_leEq. -PiSolve. -astepl (Pi [/]TwoNZ[-]ArcSin _ (ProjIR2 H4)). -apply shift_minus_leEq; apply shift_leEq_plus'; astepl ZeroR. -assert (H7 : Dom ArcSin (Sin Zero)). - apply dom_wd with ZeroR; [ split | algebra ]; - [ astepr ( [--]ZeroR); apply inv_resp_less | idtac ]; - apply pos_one. -apply leEq_wdl with (ArcSin _ H7). -2: apply ArcSin_Sin; PiSolve. -apply ArcSin_resp_leEq. -astepr ZeroR; astepr ( [--]ZeroR); apply inv_resp_less; apply pos_one. -astepl ZeroR; apply less_leEq; apply recip_resp_pos. -apply mult_resp_pos; - [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. -apply shift_div_less. -apply mult_resp_pos; - [ apply pos_two | apply less_transitive_unfolded with aux_val; auto ]. -astepr (Two[*]x); apply less_transitive_unfolded with (Two[*]aux_val). -2: apply mult_resp_less_lft; auto; apply pos_two. -unfold aux_val in |- *; rstepr (sqrt _ (less_leEq _ _ _ (pos_two _))). -apply power_cancel_less with 2. -apply sqrt_nonneg. -astepl OneR; astepr (Two:IR); apply one_less_two. -auto. Qed. Opaque Min. @@ -894,83 +882,93 @@ Let min := proj1_sig2T _ _ _ (Tan_ilim x). Let max := proj1_sig2T _ _ _ (Tan_ilim [--]x). Let min1 : [--] (Pi [/]TwoNZ) [<] min. -elim (proj2a_sig2T _ _ _ (Tan_ilim x)); auto. +Proof. + elim (proj2a_sig2T _ _ _ (Tan_ilim x)); auto. Qed. Let min2 : min [<] Pi [/]TwoNZ. -elim (proj2a_sig2T _ _ _ (Tan_ilim x)); auto. +Proof. + elim (proj2a_sig2T _ _ _ (Tan_ilim x)); auto. Qed. Let min3 : Dom Tang min. -split. -apply sin_domain. -split. -apply cos_domain. -intro; apply ap_wdl_unfolded with (Cos min). -2: simpl in |- *; algebra. -apply pos_ap_zero; apply Cos_pos. -apply min1. -apply min2. +Proof. + split. + apply sin_domain. + split. + apply cos_domain. + intro; apply ap_wdl_unfolded with (Cos min). + 2: simpl in |- *; algebra. + apply pos_ap_zero; apply Cos_pos. + apply min1. + apply min2. Qed. Let min4 : x [<=] Tan min min3 := proj2b_sig2T _ _ _ (Tan_ilim x) min3. Let max1 : [--] (Pi [/]TwoNZ) [<] max. -elim (proj2a_sig2T _ _ _ (Tan_ilim [--]x)); auto. +Proof. + elim (proj2a_sig2T _ _ _ (Tan_ilim [--]x)); auto. Qed. Let max2 : max [<] Pi [/]TwoNZ. -elim (proj2a_sig2T _ _ _ (Tan_ilim [--]x)); auto. +Proof. + elim (proj2a_sig2T _ _ _ (Tan_ilim [--]x)); auto. Qed. Let max3 : Dom Tang max. -split. -apply sin_domain. -split. -apply cos_domain. -intro; apply ap_wdl_unfolded with (Cos max). -2: simpl in |- *; algebra. -apply pos_ap_zero; apply Cos_pos. -apply max1. -apply max2. +Proof. + split. + apply sin_domain. + split. + apply cos_domain. + intro; apply ap_wdl_unfolded with (Cos max). + 2: simpl in |- *; algebra. + apply pos_ap_zero; apply Cos_pos. + apply max1. + apply max2. Qed. Let max4 : [--]x [<=] Tan max max3 := proj2b_sig2T _ _ _ (Tan_ilim [--]x) max3. Let min5 : Dom Tang [--]min. -split. -apply sin_domain. -split. -apply cos_domain. -intro; apply ap_wdl_unfolded with (Cos [--]min). -2: simpl in |- *; algebra. -astepl (Cos min). -apply pos_ap_zero; apply Cos_pos. -apply min1. -apply min2. +Proof. + split. + apply sin_domain. + split. + apply cos_domain. + intro; apply ap_wdl_unfolded with (Cos [--]min). + 2: simpl in |- *; algebra. + astepl (Cos min). + apply pos_ap_zero; apply Cos_pos. + apply min1. + apply min2. Qed. Let min6 : Tan [--]min min5 [<=] [--]x. -astepl ( [--] (Tan _ min3)); apply inv_resp_leEq. -apply min4. +Proof. + astepl ( [--] (Tan _ min3)); apply inv_resp_leEq. + apply min4. Qed. Let max5 : Dom Tang [--]max. -split. -apply sin_domain. -split. -apply cos_domain. -intro; apply ap_wdl_unfolded with (Cos [--]max). -2: simpl in |- *; algebra. -astepl (Cos max). -apply pos_ap_zero; apply Cos_pos. -apply max1. -apply max2. +Proof. + split. + apply sin_domain. + split. + apply cos_domain. + intro; apply ap_wdl_unfolded with (Cos [--]max). + 2: simpl in |- *; algebra. + astepl (Cos max). + apply pos_ap_zero; apply Cos_pos. + apply max1. + apply max2. Qed. Let max6 : Tan [--]max max5 [<=] x. -astepl ( [--] (Tan _ max3)); astepr ( [--] [--]x); apply inv_resp_leEq. -apply max4. +Proof. + astepl ( [--] (Tan _ max3)); astepr ( [--] [--]x); apply inv_resp_leEq. + apply max4. Qed. Let a := @@ -978,76 +976,81 @@ Let a := Min [--] (Pi [/]FourNZ) (Min (Min min [--]min) (Min max [--]max))) [/]TwoNZ. Let a1 : [--] (Pi [/]TwoNZ) [<] a. -unfold a in |- *; clear a. -apply shift_less_div. -apply pos_two. -apply shift_less_plus'; rstepl ( [--] (Pi [/]TwoNZ)). -repeat apply less_Min. -PiSolve. -apply min1. -apply inv_resp_less; apply min2. -apply max1. -apply inv_resp_less; apply max2. +Proof. + unfold a in |- *; clear a. + apply shift_less_div. + apply pos_two. + apply shift_less_plus'; rstepl ( [--] (Pi [/]TwoNZ)). + repeat apply less_Min. + PiSolve. + apply min1. + apply inv_resp_less; apply min2. + apply max1. + apply inv_resp_less; apply max2. Qed. Let a2 : a [<] min. -unfold a in |- *. -apply shift_div_less. -apply pos_two. -apply shift_plus_less'. -eapply leEq_less_trans. -apply Min_leEq_rht. -eapply leEq_less_trans. -apply Min_leEq_lft. -eapply leEq_less_trans. -apply Min_leEq_lft. -apply shift_less_minus; apply shift_plus_less'. -rstepr min; apply min1. +Proof. + unfold a in |- *. + apply shift_div_less. + apply pos_two. + apply shift_plus_less'. + eapply leEq_less_trans. + apply Min_leEq_rht. + eapply leEq_less_trans. + apply Min_leEq_lft. + eapply leEq_less_trans. + apply Min_leEq_lft. + apply shift_less_minus; apply shift_plus_less'. + rstepr min; apply min1. Qed. Let a3 : a [<] [--]min. -unfold a in |- *. -apply shift_div_less. -apply pos_two. -apply shift_plus_less'. -eapply leEq_less_trans. -apply Min_leEq_rht. -eapply leEq_less_trans. -apply Min_leEq_lft. -eapply leEq_less_trans. -apply Min_leEq_rht. -apply shift_less_minus; apply shift_plus_less'. -rstepr ( [--]min); apply inv_resp_less; apply min2. +Proof. + unfold a in |- *. + apply shift_div_less. + apply pos_two. + apply shift_plus_less'. + eapply leEq_less_trans. + apply Min_leEq_rht. + eapply leEq_less_trans. + apply Min_leEq_lft. + eapply leEq_less_trans. + apply Min_leEq_rht. + apply shift_less_minus; apply shift_plus_less'. + rstepr ( [--]min); apply inv_resp_less; apply min2. Qed. Let a4 : a [<] max. -unfold a in |- *. -apply shift_div_less. -apply pos_two. -apply shift_plus_less'. -eapply leEq_less_trans. -apply Min_leEq_rht. -eapply leEq_less_trans. -apply Min_leEq_rht. -eapply leEq_less_trans. -apply Min_leEq_lft. -apply shift_less_minus; apply shift_plus_less'. -rstepr max; apply max1. +Proof. + unfold a in |- *. + apply shift_div_less. + apply pos_two. + apply shift_plus_less'. + eapply leEq_less_trans. + apply Min_leEq_rht. + eapply leEq_less_trans. + apply Min_leEq_rht. + eapply leEq_less_trans. + apply Min_leEq_lft. + apply shift_less_minus; apply shift_plus_less'. + rstepr max; apply max1. Qed. Let a5 : a [<] [--]max. -unfold a in |- *. -apply shift_div_less. -apply pos_two. -apply shift_plus_less'. -eapply leEq_less_trans. -apply Min_leEq_rht. -eapply leEq_less_trans. -apply Min_leEq_rht. -eapply leEq_less_trans. -apply Min_leEq_rht. -apply shift_less_minus; apply shift_plus_less'. -rstepr ( [--]max); apply inv_resp_less; apply max2. +Proof. + unfold a in |- *. + apply shift_div_less. + apply pos_two. + apply shift_plus_less'. + eapply leEq_less_trans. + apply Min_leEq_rht. + eapply leEq_less_trans. + apply Min_leEq_rht. + eapply leEq_less_trans. + apply Min_leEq_rht. + apply shift_less_minus; apply shift_plus_less'. + rstepr ( [--]max); apply inv_resp_less; apply max2. Qed. Let b := @@ -1055,209 +1058,212 @@ Let b := [/]TwoNZ. Let b1 : b [<] Pi [/]TwoNZ. -unfold b in |- *. -apply shift_div_less. -apply pos_two. -apply shift_plus_less'; rstepr (Pi [/]TwoNZ). -repeat apply Max_less. -PiSolve. -apply min2. -astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; apply min1. -apply max2. -astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; apply max1. +Proof. + unfold b in |- *. + apply shift_div_less. + apply pos_two. + apply shift_plus_less'; rstepr (Pi [/]TwoNZ). + repeat apply Max_less. + PiSolve. + apply min2. + astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; apply min1. + apply max2. + astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; apply max1. Qed. Let b2 : min [<] b. -unfold b in |- *. -apply shift_less_div. -apply pos_two. -apply shift_less_plus'. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -eapply less_leEq_trans. -2: apply lft_leEq_Max. -eapply less_leEq_trans. -2: apply lft_leEq_Max. -apply shift_minus_less; apply shift_less_plus'. -rstepl min; apply min2. +Proof. + unfold b in |- *. + apply shift_less_div. + apply pos_two. + apply shift_less_plus'. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + eapply less_leEq_trans. + 2: apply lft_leEq_Max. + eapply less_leEq_trans. + 2: apply lft_leEq_Max. + apply shift_minus_less; apply shift_less_plus'. + rstepl min; apply min2. Qed. Let b3 : [--]min [<] b. -unfold b in |- *. -apply shift_less_div. -apply pos_two. -apply shift_less_plus'. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -eapply less_leEq_trans. -2: apply lft_leEq_Max. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -apply shift_minus_less; apply shift_less_plus'. -rstepl ( [--]min); astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; - apply min1. +Proof. + unfold b in |- *. + apply shift_less_div. + apply pos_two. + apply shift_less_plus'. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + eapply less_leEq_trans. + 2: apply lft_leEq_Max. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + apply shift_minus_less; apply shift_less_plus'. + rstepl ( [--]min); astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; apply min1. Qed. Let b4 : max [<] b. -unfold b in |- *. -apply shift_less_div. -apply pos_two. -apply shift_less_plus'. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -eapply less_leEq_trans. -2: apply lft_leEq_Max. -apply shift_minus_less; apply shift_less_plus'. -rstepl max; apply max2. +Proof. + unfold b in |- *. + apply shift_less_div. + apply pos_two. + apply shift_less_plus'. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + eapply less_leEq_trans. + 2: apply lft_leEq_Max. + apply shift_minus_less; apply shift_less_plus'. + rstepl max; apply max2. Qed. Let b5 : [--]max [<] b. -unfold b in |- *. -apply shift_less_div. -apply pos_two. -apply shift_less_plus'. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -apply shift_minus_less; apply shift_less_plus'. -rstepl ( [--]max); astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; - apply max1. +Proof. + unfold b in |- *. + apply shift_less_div. + apply pos_two. + apply shift_less_plus'. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + apply shift_minus_less; apply shift_less_plus'. + rstepl ( [--]max); astepr ( [--] [--] (Pi [/]TwoNZ)); apply inv_resp_less; apply max1. Qed. Let ab : a [<] b. -apply less_transitive_unfolded with min; [ apply a2 | apply b2 ]. +Proof. + apply less_transitive_unfolded with min; [ apply a2 | apply b2 ]. Qed. Lemma ArcTan_range_lemma : {y : IR | olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ) y | forall Hy, Tang y Hy [=] x}. -assert (H : Continuous (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) Tang). - eapply Derivative_imp_Continuous; - apply (Derivative_Tan_1 invHalfPi_less_HalfPi). -assert (H0 : Continuous_I (less_leEq _ _ _ ab) Tang). - eapply included_imp_Continuous; [ apply H | apply compact_included ]. - split; - [ apply a1 - | apply less_transitive_unfolded with b; [ apply ab | apply b1 ] ]. - split; - [ apply less_transitive_unfolded with a; [ apply a1 | apply ab ] - | apply b1 ]. -elim IVT'_I with (contF := H0) (z := x). -intros y H1 H2; exists y; auto. -inversion_clear H1; split. -apply less_transitive_unfolded with a; auto; apply a1. -apply less_transitive_unfolded with b; auto; apply b1. -apply ab. -intros x0 y H1 H2 H3 Hx Hy. -fold (Tan x0 Hx) in |- *; fold (Tan y Hy) in |- *. -inversion_clear H1; inversion_clear H2; apply Tan_resp_less; auto. -apply less_leEq_trans with a; auto; apply a1. -apply leEq_less_trans with b; auto; apply b1. -fold (Tan a (contin_imp_inc _ _ _ _ H0 _ (compact_inc_lft _ _ _))) in |- *. -apply less_leEq_trans with (Tan [--]max max5). -apply Tan_resp_less. -apply a1. -apply less_transitive_unfolded with b; [ apply b5 | apply b1 ]. -apply a5. -apply max6. -fold (Tan b (contin_imp_inc _ _ _ _ H0 _ (compact_inc_rht _ _ _))) in |- *. -apply leEq_less_trans with (Tan min min3). -apply min4. -apply Tan_resp_less. -apply min1. -apply b1. -apply b2. +Proof. + assert (H : Continuous (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) Tang). + eapply Derivative_imp_Continuous; apply (Derivative_Tan_1 invHalfPi_less_HalfPi). + assert (H0 : Continuous_I (less_leEq _ _ _ ab) Tang). + eapply included_imp_Continuous; [ apply H | apply compact_included ]. + split; [ apply a1 | apply less_transitive_unfolded with b; [ apply ab | apply b1 ] ]. + split; [ apply less_transitive_unfolded with a; [ apply a1 | apply ab ] | apply b1 ]. + elim IVT'_I with (contF := H0) (z := x). + intros y H1 H2; exists y; auto. + inversion_clear H1; split. + apply less_transitive_unfolded with a; auto; apply a1. + apply less_transitive_unfolded with b; auto; apply b1. + apply ab. + intros x0 y H1 H2 H3 Hx Hy. + fold (Tan x0 Hx) in |- *; fold (Tan y Hy) in |- *. + inversion_clear H1; inversion_clear H2; apply Tan_resp_less; auto. + apply less_leEq_trans with a; auto; apply a1. + apply leEq_less_trans with b; auto; apply b1. + fold (Tan a (contin_imp_inc _ _ _ _ H0 _ (compact_inc_lft _ _ _))) in |- *. + apply less_leEq_trans with (Tan [--]max max5). + apply Tan_resp_less. + apply a1. + apply less_transitive_unfolded with b; [ apply b5 | apply b1 ]. + apply a5. + apply max6. + fold (Tan b (contin_imp_inc _ _ _ _ H0 _ (compact_inc_rht _ _ _))) in |- *. + apply leEq_less_trans with (Tan min min3). + apply min4. + apply Tan_resp_less. + apply min1. + apply b1. + apply b2. Qed. (* end hide *) Lemma ArcTan_range : [--] (Pi [/]TwoNZ) [<] ArcTan x and ArcTan x [<] Pi [/]TwoNZ. -intros. -Transparent ArcTang. -elim ArcTan_range_lemma; intros y H H0. -elim H; intros. -cut (Dom Tang y). intro H1. -assert (H2 : Tan y H1 [=] x). unfold Tan in |- *; algebra. -split. -apply less_wdr with y; auto. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply ArcTan_Tan with (H := H1); auto. -unfold ArcTan in |- *; algebra. -apply less_wdl with y; auto. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply ArcTan_Tan with (H := H1); auto. -unfold ArcTan in |- *; algebra. -repeat split. -intro; apply Greater_imp_ap. -apply less_wdr with (Cos y); [ apply Cos_pos; auto | simpl in |- *; algebra ]. +Proof. + intros. + Transparent ArcTang. + elim ArcTan_range_lemma; intros y H H0. + elim H; intros. + cut (Dom Tang y). intro H1. + assert (H2 : Tan y H1 [=] x). unfold Tan in |- *; algebra. + split. + apply less_wdr with y; auto. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply ArcTan_Tan with (H := H1); auto. + unfold ArcTan in |- *; algebra. + apply less_wdl with y; auto. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply ArcTan_Tan with (H := H1); auto. + unfold ArcTan in |- *; algebra. + repeat split. + intro; apply Greater_imp_ap. + apply less_wdr with (Cos y); [ apply Cos_pos; auto | simpl in |- *; algebra ]. Qed. End ArcTan_Range. Lemma Tan_ArcTan : forall (x : IR) Hx, x [=] Tan (ArcTan x) Hx. -intros. -set (y := Tan (ArcTan x) Hx) in *. -assert (H : ArcTan x [=] ArcTan y). - unfold y in |- *; apply eq_symmetric_unfolded; elim ArcTan_range with x; - intros; apply ArcTan_Tan; auto. -Transparent ArcTang. -cut (Continuous_I (Min_leEq_Max x y) {1/} ( [-C-]One{+}FId{^}2)). intro H0. -cut (Integral H0 [=] Zero). intro H1. -elim Hx; intros H2 H3. -apply Integral_eq_zero with (contF := H0) (x := x). -exact (CAnd_intro _ _ (Min_leEq_lft x y) (lft_leEq_Max x y)). -intros. -simpl in |- *; apply recip_resp_pos. -astepl (ZeroR[+]Zero); apply plus_resp_less_leEq. -apply pos_one. -astepr (x[^]2); apply sqr_nonneg. -intros x0 H4 Hx0; simpl in |- *. -apply less_leEq; apply recip_resp_pos. -astepl (ZeroR[+]Zero); apply plus_resp_less_leEq. -apply pos_one. -astepr (x0[^]2); apply sqr_nonneg. -auto. -apply eq_transitive_unfolded with (ArcTan y[-]ArcTan x). -rstepl (ArcTan x[+]Integral H0[-]ArcTan x). -apply cg_minus_wd; [ simpl in |- * | algebra ]. -apply eq_symmetric_unfolded; unfold ArcTan in |- *; simpl in |- *. -apply Integral_plus_Integral with (Min3_leEq_Max3 Zero y x). -apply included_imp_Continuous with realline. -exact ArcTan_def_lemma. -apply included3_interval; split. -apply x_minus_x; simpl in |- *; algebra. -apply included_imp_Continuous with realline. -exact ArcTan_def_lemma. -apply included_interval; split. +Proof. + intros. + set (y := Tan (ArcTan x) Hx) in *. + assert (H : ArcTan x [=] ArcTan y). + unfold y in |- *; apply eq_symmetric_unfolded; elim ArcTan_range with x; + intros; apply ArcTan_Tan; auto. + Transparent ArcTang. + cut (Continuous_I (Min_leEq_Max x y) {1/} ( [-C-]One{+}FId{^}2)). intro H0. + cut (Integral H0 [=] Zero). intro H1. + elim Hx; intros H2 H3. + apply Integral_eq_zero with (contF := H0) (x := x). + exact (CAnd_intro _ _ (Min_leEq_lft x y) (lft_leEq_Max x y)). + intros. + simpl in |- *; apply recip_resp_pos. + astepl (ZeroR[+]Zero); apply plus_resp_less_leEq. + apply pos_one. + astepr (x[^]2); apply sqr_nonneg. + intros x0 H4 Hx0; simpl in |- *. + apply less_leEq; apply recip_resp_pos. + astepl (ZeroR[+]Zero); apply plus_resp_less_leEq. + apply pos_one. + astepr (x0[^]2); apply sqr_nonneg. + auto. + apply eq_transitive_unfolded with (ArcTan y[-]ArcTan x). + rstepl (ArcTan x[+]Integral H0[-]ArcTan x). + apply cg_minus_wd; [ simpl in |- * | algebra ]. + apply eq_symmetric_unfolded; unfold ArcTan in |- *; simpl in |- *. + apply Integral_plus_Integral with (Min3_leEq_Max3 Zero y x). + apply included_imp_Continuous with realline. + exact ArcTan_def_lemma. + apply included3_interval; split. + apply x_minus_x; simpl in |- *; algebra. + apply included_imp_Continuous with realline. + exact ArcTan_def_lemma. + apply included_interval; split. Qed. Lemma Tan_ArcTan_inv : Feq realline (Tang[o]ArcTang) FId. -apply eq_imp_Feq. -apply included_FComp. -Included. -intros; split. -auto. -split. -auto. -intros. -apply ap_wdl with (Cos (ArcTan x)). -Opaque ArcTang. -2: unfold ArcTan in |- *; simpl in |- *; algebra. -elim ArcTan_range with x; intros. -apply pos_ap_zero; apply Cos_pos; auto. -Included. -intros; inversion_clear Hx. -astepr x; astepl (Part _ _ (ProjT2 Hx)); astepl (Part _ _ X0). -cut (Dom Tang (ArcTan x)); intros. -apply eq_transitive_unfolded with (Tan (ArcTan x) X1). -unfold Tan, ArcTan in |- *; algebra. -apply eq_symmetric_unfolded; apply Tan_ArcTan. -apply dom_wd with (ArcTang x x0); auto. -unfold ArcTan in |- *; algebra. +Proof. + apply eq_imp_Feq. + apply included_FComp. + Included. + intros; split. + auto. + split. + auto. + intros. + apply ap_wdl with (Cos (ArcTan x)). + Opaque ArcTang. + 2: unfold ArcTan in |- *; simpl in |- *; algebra. + elim ArcTan_range with x; intros. + apply pos_ap_zero; apply Cos_pos; auto. + Included. + intros; inversion_clear Hx. + astepr x; astepl (Part _ _ (ProjT2 Hx)); astepl (Part _ _ X0). + cut (Dom Tang (ArcTan x)); intros. + apply eq_transitive_unfolded with (Tan (ArcTan x) X1). + unfold Tan, ArcTan in |- *; algebra. + apply eq_symmetric_unfolded; apply Tan_ArcTan. + apply dom_wd with (ArcTang x x0); auto. + unfold ArcTan in |- *; algebra. Qed. End Inverses. diff --git a/transc/MoreArcTan.v b/transc/MoreArcTan.v index b3e2afd79..e0aa78832 100644 --- a/transc/MoreArcTan.v +++ b/transc/MoreArcTan.v @@ -26,324 +26,310 @@ Require Import CornTac. Lemma Dom_Tang_ArcTan : forall x, (Dom Tang (ArcTan x)). Proof. -intros x. -apply Tang_Domain'. -apply ArcTan_range. + intros x. + apply Tang_Domain'. + apply ArcTan_range. Qed. Lemma ArcTan_zero : ArcTan Zero[=]Zero. Proof. -assert (Z:Dom Tang Zero). - apply Tang_Domain'. - split; auto with *. -stepl (ArcTan (Tan _ Z)). - apply ArcTan_Tan; auto with *. -apply pfwdef. -apply Tan_zero. + assert (Z:Dom Tang Zero). + apply Tang_Domain'. + split; auto with *. + stepl (ArcTan (Tan _ Z)). + apply ArcTan_Tan; auto with *. + apply pfwdef. + apply Tan_zero. Qed. Lemma ArcTan_one : ArcTan One[=]Pi[/]FourNZ. Proof. -assert (Z:Dom Tang (Pi[/]FourNZ)). - apply Tang_Domain'. - split; auto with *. -stepl (ArcTan (Tan _ Z)). - apply ArcTan_Tan; auto with *. -apply pfwdef. -apply Tan_QuarterPi. + assert (Z:Dom Tang (Pi[/]FourNZ)). + apply Tang_Domain'. + split; auto with *. + stepl (ArcTan (Tan _ Z)). + apply ArcTan_Tan; auto with *. + apply pfwdef. + apply Tan_QuarterPi. Qed. Hint Resolve ArcTan_zero ArcTan_one: algebra. Lemma ArcTan_inv : forall x, ArcTan [--]x[=][--](ArcTan x). Proof. -intros x. -stepr (ArcTan [--](Tan (ArcTan x) (Dom_Tang_ArcTan x))). - apply ArcTan_wd. - apply un_op_wd_unfolded. - apply Tan_ArcTan. -assert (H:(olor ([--](Pi[/]TwoNZ)) (Pi[/]TwoNZ) [--](ArcTan x))). - destruct (ArcTan_range x). - split. + intros x. + stepr (ArcTan [--](Tan (ArcTan x) (Dom_Tang_ArcTan x))). + apply ArcTan_wd. + apply un_op_wd_unfolded. + apply Tan_ArcTan. + assert (H:(olor ([--](Pi[/]TwoNZ)) (Pi[/]TwoNZ) [--](ArcTan x))). + destruct (ArcTan_range x). + split. + apply inv_resp_less; assumption. + rstepr ([--][--](Pi[/]TwoNZ)). apply inv_resp_less; assumption. - rstepr ([--][--](Pi[/]TwoNZ)). - apply inv_resp_less; assumption. -stepr (ArcTan (Tan _ (Tang_Domain' _ H))). - apply ArcTan_wd. - apply eq_symmetric. - apply Tan_inv. -destruct H. -apply ArcTan_Tan; assumption. + stepr (ArcTan (Tan _ (Tang_Domain' _ H))). + apply ArcTan_wd. + apply eq_symmetric. + apply Tan_inv. + destruct H. + apply ArcTan_Tan; assumption. Qed. Lemma ArcTan_resp_less : forall x y, x[<]y -> ArcTan x[<]ArcTan y. Proof. -intros x y H. -unfold ArcTan. -eapply (Derivative_imp_resp_less realline CI). - apply Derivative_ArcTan. - assumption. + intros x y H. + unfold ArcTan. + eapply (Derivative_imp_resp_less realline CI). + apply Derivative_ArcTan. + assumption. + constructor. constructor. - constructor. -intros contF'. -set (F:={1/}([-C-]One{+}FId{^}2):PartIR) in *. -assert (Hz0:forall z:IR, Zero[<]One[+]One[*]z[*]z). - intros z. - apply less_leEq_trans with One. + intros contF'. + set (F:={1/}([-C-]One{+}FId{^}2):PartIR) in *. + assert (Hz0:forall z:IR, Zero[<]One[+]One[*]z[*]z). + intros z. + apply less_leEq_trans with One. + apply pos_one. + apply shift_leEq_plus'. + rstepl (Zero:IR). + rstepr (z[^]2). + apply sqr_nonneg. + assert (Hz:forall z, Dom F z). + intros z. + repeat constructor. + simpl. + intros _. + apply Greater_imp_ap. + apply Hz0. + set (z:=Max (AbsIR x) (AbsIR y)). + apply less_leEq_trans with (F z (Hz z)). + simpl. + apply shift_less_div. + apply Hz0. + rstepl (Zero:IR). apply pos_one. - apply shift_leEq_plus'. - rstepl (Zero:IR). - rstepr (z[^]2). - apply sqr_nonneg. -assert (Hz:forall z, Dom F z). - intros z. - repeat constructor. + apply leEq_glb. simpl. - intros _. - apply Greater_imp_ap. - apply Hz0. -set (z:=Max (AbsIR x) (AbsIR y)). -apply less_leEq_trans with (F z (Hz z)). - simpl. - apply shift_less_div. + intros a [Ha0 Ha1] H0. + apply recip_resp_leEq. apply Hz0. - rstepl (Zero:IR). - apply pos_one. -apply leEq_glb. -simpl. -intros a [Ha0 Ha1] H0. -apply recip_resp_leEq. - apply Hz0. -clear H0 contF' F Hz. -apply plus_resp_leEq_lft. -apply shift_leEq_rht. -rstepr ((z[-]a)[*](z[-][--]a)). -unfold z. -apply mult_resp_nonneg; - apply shift_leEq_lft; eapply leEq_transitive. - apply Ha1. - apply Max_leEq; - (eapply leEq_transitive;[apply leEq_AbsIR|]). - apply lft_leEq_Max. - apply rht_leEq_Max. - apply inv_resp_leEq. - apply Ha0. -unfold MIN, Min. -rstepl (Max [--]x [--]y). -apply Max_leEq; - (eapply leEq_transitive;[apply inv_leEq_AbsIR|]). - apply lft_leEq_Max. -apply rht_leEq_Max. + clear H0 contF' F Hz. + apply plus_resp_leEq_lft. + apply shift_leEq_rht. + rstepr ((z[-]a)[*](z[-][--]a)). + unfold z. + apply mult_resp_nonneg; apply shift_leEq_lft; eapply leEq_transitive. + apply Ha1. + apply Max_leEq; (eapply leEq_transitive;[apply leEq_AbsIR|]). + apply lft_leEq_Max. + apply rht_leEq_Max. + apply inv_resp_leEq. + apply Ha0. + unfold MIN, Min. + rstepl (Max [--]x [--]y). + apply Max_leEq; (eapply leEq_transitive;[apply inv_leEq_AbsIR|]). + apply lft_leEq_Max. + apply rht_leEq_Max. Qed. Lemma ArcTan_resp_leEq : forall x y, x[<=]y -> ArcTan x[<=]ArcTan y. Proof. -intros x y Hxy. -rewrite leEq_def. -intros H. -apply (leEq_less_or_equal _ _ _ Hxy). -intros H0. -generalize H; clear H. -change (Not (ArcTan y[<]ArcTan x)). -rewrite <- leEq_def. -destruct H0. - apply less_leEq. - apply ArcTan_resp_less. + intros x y Hxy. + rewrite leEq_def. + intros H. + apply (leEq_less_or_equal _ _ _ Hxy). + intros H0. + generalize H; clear H. + change (Not (ArcTan y[<]ArcTan x)). + rewrite <- leEq_def. + destruct H0. + apply less_leEq. + apply ArcTan_resp_less. + assumption. + stepr (ArcTan x). + apply leEq_reflexive. + apply ArcTan_wd. assumption. -stepr (ArcTan x). - apply leEq_reflexive. -apply ArcTan_wd. -assumption. Qed. Lemma ArcTan_pos : forall x, Zero[<]x -> Zero[<]ArcTan x. Proof. -intros x Hx. -csetoid_rewrite_rev ArcTan_zero. -apply ArcTan_resp_less. -assumption. + intros x Hx. + csetoid_rewrite_rev ArcTan_zero. + apply ArcTan_resp_less. + assumption. Qed. Lemma ArcTan_recip : forall x Hx, Zero[<]x -> ArcTan (One[/]x[//]Hx)[=]Pi[/]TwoNZ[-](ArcTan x). Proof. -intros x Hx Hx0. -assert (H0:olor [--](Pi [/]TwoNZ) (Pi [/]TwoNZ) ([--](ArcTan x)[+]Pi[/]TwoNZ)). - split. - apply shift_less_plus. - rstepl ([--]Pi). + intros x Hx Hx0. + assert (H0:olor [--](Pi [/]TwoNZ) (Pi [/]TwoNZ) ([--](ArcTan x)[+]Pi[/]TwoNZ)). + split. + apply shift_less_plus. + rstepl ([--]Pi). + apply inv_resp_less. + apply less_transitive_unfolded with (Pi[/]TwoNZ). + destruct (ArcTan_range x); assumption. + auto with *. + apply shift_plus_less. + rstepr ([--]Zero:IR). apply inv_resp_less. - apply less_transitive_unfolded with (Pi[/]TwoNZ). - destruct (ArcTan_range x); assumption. - auto with *. - apply shift_plus_less. - rstepr ([--]Zero:IR). - apply inv_resp_less. - apply ArcTan_pos. - assumption. -rstepr ([--](ArcTan x)[+]Pi[/]TwoNZ). -stepr (ArcTan (Tan _ (Tang_Domain' _ H0))) by - destruct H0; apply ArcTan_Tan; assumption. -apply ArcTan_wd. -apply eq_symmetric. -assert (H1:Dom Tang ([--](ArcTan x))). - apply Tang_Domain'. - destruct (ArcTan_range x). - split. - apply inv_resp_less; assumption. - rstepr ([--][--](Pi[/]TwoNZ)). - apply inv_resp_less. - assumption. -assert (H2:(Tan [--](ArcTan x) H1)[#]Zero). - stepl ([--](Tan (ArcTan x) (Dom_Tang_ArcTan x))) by - apply eq_symmetric; apply Tan_inv. - rstepr ([--]Zero:IR). - apply inv_resp_ap. - apply Greater_imp_ap. - csetoid_rewrite_rev (Tan_ArcTan x (Dom_Tang_ArcTan x)). - assumption. -eapply eq_transitive. - apply (Tan_plus_HalfPi _ (Tang_Domain' _ H0) H1 H2). -apply mult_cancel_lft with (Tan [--](ArcTan x) H1). - assumption. -apply mult_cancel_lft with x. - apply Greater_imp_ap; assumption. -rstepl ([--]x:IR). -rstepr (Tan [--](ArcTan x) H1). -stepr ([--](Tan (ArcTan x) (Dom_Tang_ArcTan x))). - apply un_op_wd_unfolded. - apply Tan_ArcTan. -apply eq_symmetric. -apply Tan_inv. + apply ArcTan_pos. + assumption. + rstepr ([--](ArcTan x)[+]Pi[/]TwoNZ). + stepr (ArcTan (Tan _ (Tang_Domain' _ H0))) by destruct H0; apply ArcTan_Tan; assumption. + apply ArcTan_wd. + apply eq_symmetric. + assert (H1:Dom Tang ([--](ArcTan x))). + apply Tang_Domain'. + destruct (ArcTan_range x). + split. + apply inv_resp_less; assumption. + rstepr ([--][--](Pi[/]TwoNZ)). + apply inv_resp_less. + assumption. + assert (H2:(Tan [--](ArcTan x) H1)[#]Zero). + stepl ([--](Tan (ArcTan x) (Dom_Tang_ArcTan x))) by apply eq_symmetric; apply Tan_inv. + rstepr ([--]Zero:IR). + apply inv_resp_ap. + apply Greater_imp_ap. + csetoid_rewrite_rev (Tan_ArcTan x (Dom_Tang_ArcTan x)). + assumption. + eapply eq_transitive. + apply (Tan_plus_HalfPi _ (Tang_Domain' _ H0) H1 H2). + apply mult_cancel_lft with (Tan [--](ArcTan x) H1). + assumption. + apply mult_cancel_lft with x. + apply Greater_imp_ap; assumption. + rstepl ([--]x:IR). + rstepr (Tan [--](ArcTan x) H1). + stepr ([--](Tan (ArcTan x) (Dom_Tang_ArcTan x))). + apply un_op_wd_unfolded. + apply Tan_ArcTan. + apply eq_symmetric. + apply Tan_inv. Qed. Lemma ArcTan_plus_ArcTan : forall x y Hxy, ([--]One[<=]x) -> (x[<=]One) -> ([--]One[<=]y) -> (y[<=]One) -> ArcTan x [+] ArcTan y [=] ArcTan ((x[+]y)[/](One[-]x[*]y)[//]Hxy). Proof. -cut (forall x y Hxy, - ([--]One[<=]x) -> (x[<=]One) -> ([--]One[<=]y) -> (y[<]One) -> - ArcTan x [+] ArcTan y [=] ArcTan ((x[+]y)[/](One[-]x[*]y)[//]Hxy)). - intros G x y Hxy Hx0 Hx1 Hy0 Hy1. - apply (not_ap_imp_eq). - intros H. - apply (leEq_less_or_equal _ _ _ Hx1). - intros Hx1'. - apply (leEq_less_or_equal _ _ _ Hy1). - intros Hy1'. - generalize H; clear H. - apply (eq_imp_not_ap). - clear Hy1. - destruct Hy1' as [Hy1|Hy1]. - apply G; assumption. - assert (Hxy':(One[-]y[*]x)[#]Zero). - rstepl (One[-]x[*]y). - assumption. - rstepl (ArcTan y[+]ArcTan x). - stepr (ArcTan ((y[+]x)[/](One[-]y[*]x)[//]Hxy')) by - apply ArcTan_wd; rational. - apply G; try assumption. - stepl (One:IR) by apply eq_symmetric; assumption. - apply leEq_reflexive. - destruct Hx1' as [c|c]; try assumption. - elimtype False. - refine (eq_imp_not_ap _ _ _ _ Hxy'). - unfold cg_minus. - csetoid_rewrite c. - csetoid_rewrite Hy1. - rstepl (Zero:IR). - apply eq_reflexive. - -cut (forall x y Hxy, - ([--]One[<=]x) -> (x[<=]One) -> ([--]One[<]y) -> (y[<]One) -> - ArcTan x [+] ArcTan y [=] ArcTan ((x[+]y)[/](One[-]x[*]y)[//]Hxy)). - intros G x y Hxy Hx0 Hx1 Hy0 Hy1. - apply (not_ap_imp_eq). - intros H. - apply (leEq_less_or_equal _ _ _ Hx0). - intros Hx0'. - apply (leEq_less_or_equal _ _ _ Hx1). - intros Hx1'. - apply (leEq_less_or_equal _ _ _ Hy0). - intros Hy0'. - generalize H; clear H. - apply (eq_imp_not_ap). - clear Hy0. - destruct Hy0' as [Hy0|Hy0]. - apply G; assumption. - assert (Hxy':(One[-]y[*]x)[#]Zero). - rstepl (One[-]x[*]y). - assumption. - destruct Hx0' as [Hx0'|Hx0']; - destruct Hx1' as [Hx1'|Hx1']. - rstepl (ArcTan y[+]ArcTan x). - stepr (ArcTan ((y[+]x)[/](One[-]y[*]x)[//]Hxy')) by - apply ArcTan_wd; rational. - apply G; try assumption. - stepr ([--]One:IR) by assumption. - apply leEq_reflexive. - stepl ([--]One:IR) by assumption. - apply shift_zero_leEq_minus'. - rstepr (Two:IR). - apply less_leEq; apply pos_two. - csetoid_replace (ArcTan y) ([--](ArcTan x)). - rstepl (Zero:IR). - stepl (ArcTan Zero) by apply ArcTan_zero. - apply ArcTan_wd. - rstepl (Zero[/](One[-]x[*]y)[//]Hxy). - apply div_wd. - csetoid_rewrite Hx1'. - csetoid_rewrite_rev Hy0. - rational. - apply eq_reflexive. - stepl (ArcTan ([--]x)). - apply ArcTan_inv. - apply ArcTan_wd. - csetoid_rewrite Hx1'. + cut (forall x y Hxy, ([--]One[<=]x) -> (x[<=]One) -> ([--]One[<=]y) -> (y[<]One) -> + ArcTan x [+] ArcTan y [=] ArcTan ((x[+]y)[/](One[-]x[*]y)[//]Hxy)). + intros G x y Hxy Hx0 Hx1 Hy0 Hy1. + apply (not_ap_imp_eq). + intros H. + apply (leEq_less_or_equal _ _ _ Hx1). + intros Hx1'. + apply (leEq_less_or_equal _ _ _ Hy1). + intros Hy1'. + generalize H; clear H. + apply (eq_imp_not_ap). + clear Hy1. + destruct Hy1' as [Hy1|Hy1]. + apply G; assumption. + assert (Hxy':(One[-]y[*]x)[#]Zero). + rstepl (One[-]x[*]y). assumption. + rstepl (ArcTan y[+]ArcTan x). + stepr (ArcTan ((y[+]x)[/](One[-]y[*]x)[//]Hxy')) by apply ArcTan_wd; rational. + apply G; try assumption. + stepl (One:IR) by apply eq_symmetric; assumption. + apply leEq_reflexive. + destruct Hx1' as [c|c]; try assumption. elimtype False. refine (eq_imp_not_ap _ _ _ _ Hxy'). unfold cg_minus. - csetoid_rewrite_rev Hx0'. - csetoid_rewrite_rev Hy0. - rational. - elimtype False. + csetoid_rewrite c. + csetoid_rewrite Hy1. + rstepl (Zero:IR). + apply eq_reflexive. + cut (forall x y Hxy, ([--]One[<=]x) -> (x[<=]One) -> ([--]One[<]y) -> (y[<]One) -> + ArcTan x [+] ArcTan y [=] ArcTan ((x[+]y)[/](One[-]x[*]y)[//]Hxy)). + intros G x y Hxy Hx0 Hx1 Hy0 Hy1. + apply (not_ap_imp_eq). + intros H. + apply (leEq_less_or_equal _ _ _ Hx0). + intros Hx0'. + apply (leEq_less_or_equal _ _ _ Hx1). + intros Hx1'. + apply (leEq_less_or_equal _ _ _ Hy0). + intros Hy0'. + generalize H; clear H. + apply (eq_imp_not_ap). + clear Hy0. + destruct Hy0' as [Hy0|Hy0]. + apply G; assumption. + assert (Hxy':(One[-]y[*]x)[#]Zero). + rstepl (One[-]x[*]y). + assumption. + destruct Hx0' as [Hx0'|Hx0']; destruct Hx1' as [Hx1'|Hx1']. + rstepl (ArcTan y[+]ArcTan x). + stepr (ArcTan ((y[+]x)[/](One[-]y[*]x)[//]Hxy')) by apply ArcTan_wd; rational. + apply G; try assumption. + stepr ([--]One:IR) by assumption. + apply leEq_reflexive. + stepl ([--]One:IR) by assumption. + apply shift_zero_leEq_minus'. + rstepr (Two:IR). + apply less_leEq; apply pos_two. + csetoid_replace (ArcTan y) ([--](ArcTan x)). + rstepl (Zero:IR). + stepl (ArcTan Zero) by apply ArcTan_zero. + apply ArcTan_wd. + rstepl (Zero[/](One[-]x[*]y)[//]Hxy). + apply div_wd. + csetoid_rewrite Hx1'. + csetoid_rewrite_rev Hy0. + rational. + apply eq_reflexive. + stepl (ArcTan ([--]x)). + apply ArcTan_inv. + apply ArcTan_wd. + csetoid_rewrite Hx1'. + assumption. + elimtype False. + refine (eq_imp_not_ap _ _ _ _ Hxy'). + unfold cg_minus. + csetoid_rewrite_rev Hx0'. + csetoid_rewrite_rev Hy0. + rational. + elimtype False. refine (eq_imp_not_ap _ [--]One One _ _). - stepr x by assumption. - assumption. - apply ap_symmetric. - apply zero_minus_apart. - rstepl (Two:IR). - apply two_ap_zero. - -intros x y Hxy Hx0 Hx1 Hy0 Hy1. -assert (X:olor [--](Pi [/]TwoNZ) (Pi [/]TwoNZ) (ArcTan x[+]ArcTan y)). - split. - rstepl ([--](Pi[/]FourNZ)[+][--](Pi[/]FourNZ)). + stepr x by assumption. + assumption. + apply ap_symmetric. + apply zero_minus_apart. + rstepl (Two:IR). + apply two_ap_zero. + intros x y Hxy Hx0 Hx1 Hy0 Hy1. + assert (X:olor [--](Pi [/]TwoNZ) (Pi [/]TwoNZ) (ArcTan x[+]ArcTan y)). + split. + rstepl ([--](Pi[/]FourNZ)[+][--](Pi[/]FourNZ)). + csetoid_rewrite_rev (ArcTan_one). + csetoid_replace ([--](ArcTan One)) (ArcTan ([--]One)). + apply plus_resp_leEq_less. + apply ArcTan_resp_leEq; assumption. + apply ArcTan_resp_less; assumption. + apply eq_symmetric; apply ArcTan_inv. + rstepr ((Pi[/]FourNZ)[+](Pi[/]FourNZ)). csetoid_rewrite_rev (ArcTan_one). - csetoid_replace ([--](ArcTan One)) (ArcTan ([--]One)). - apply plus_resp_leEq_less. - apply ArcTan_resp_leEq; assumption. - apply ArcTan_resp_less; assumption. - apply eq_symmetric; apply ArcTan_inv. - rstepr ((Pi[/]FourNZ)[+](Pi[/]FourNZ)). - csetoid_rewrite_rev (ArcTan_one). - apply plus_resp_leEq_less. - apply ArcTan_resp_leEq; assumption. - apply ArcTan_resp_less; assumption. -elim X; intros X0 X1. -csetoid_rewrite_rev (ArcTan_Tan _ X0 X1 (Tang_Domain' _ X)). -apply ArcTan_wd. -assert (Y:(One[-]Tan _ (Dom_Tang_ArcTan x)[*]Tan _ (Dom_Tang_ArcTan y))[#]Zero). - unfold cg_minus. - csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan x)). - csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan y)). - assumption. -stepr (Tan _ (Dom_Tang_ArcTan x)[+]Tan _ (Dom_Tang_ArcTan y)[/]_[//]Y). - apply Tan_plus. -apply div_wd; unfold cg_minus; - csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan x)); - csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan y)); - apply eq_reflexive. + apply plus_resp_leEq_less. + apply ArcTan_resp_leEq; assumption. + apply ArcTan_resp_less; assumption. + elim X; intros X0 X1. + csetoid_rewrite_rev (ArcTan_Tan _ X0 X1 (Tang_Domain' _ X)). + apply ArcTan_wd. + assert (Y:(One[-]Tan _ (Dom_Tang_ArcTan x)[*]Tan _ (Dom_Tang_ArcTan y))[#]Zero). + unfold cg_minus. + csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan x)). + csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan y)). + assumption. + stepr (Tan _ (Dom_Tang_ArcTan x)[+]Tan _ (Dom_Tang_ArcTan y)[/]_[//]Y). + apply Tan_plus. + apply div_wd; unfold cg_minus; csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan x)); + csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan y)); apply eq_reflexive. Qed. Section ArcTan_Series. @@ -357,114 +343,110 @@ First we show the convergence of the series for 1/(1+x^2) Lemma bellcurve_series_convergent_IR : fun_series_convergent_IR (olor ([--]One) One) (fun (i:nat) => ([--]One)[^]i{**}Fid IR{^}(2*i)). Proof. -apply fun_series_convergent_wd_IR with (fun i => Fid IR{^}i[o]({--}(Fid IR{^}2))). - intros n. - FEQ. - change ([--](One[*]x[*]x)[^]n[=]([--]One)[^]n[*]x[^](2*n)). - rstepl (([--]One[*](x[*]x))[^]n). - stepl (([--]One)[^]n[*]((x[*]x)[^]n)) by apply eq_symmetric; apply mult_nexp. - apply mult_wdr. - replace (2*n)%nat with (n+n)%nat by auto with *. - eapply eq_transitive. - apply mult_nexp. - apply nexp_plus. -apply FSeries_Sum_comp_conv with (olor [--]One One); - [|Contin|apply fun_power_series_conv_IR]. -intros a b Hab Hinc. -set (c:=Max (AbsIR a) (AbsIR b)). -exists ([--](c[^]2)). -exists (c[^]2). -assert (X:[--](c[^]2)[<=]c[^]2). - apply leEq_transitive with (Zero:IR). - rstepr ([--]Zero:IR). - apply inv_resp_leEq. + apply fun_series_convergent_wd_IR with (fun i => Fid IR{^}i[o]({--}(Fid IR{^}2))). + intros n. + FEQ. + change ([--](One[*]x[*]x)[^]n[=]([--]One)[^]n[*]x[^](2*n)). + rstepl (([--]One[*](x[*]x))[^]n). + stepl (([--]One)[^]n[*]((x[*]x)[^]n)) by apply eq_symmetric; apply mult_nexp. + apply mult_wdr. + replace (2*n)%nat with (n+n)%nat by auto with *. + eapply eq_transitive. + apply mult_nexp. + apply nexp_plus. + apply FSeries_Sum_comp_conv with (olor [--]One One); [|Contin|apply fun_power_series_conv_IR]. + intros a b Hab Hinc. + set (c:=Max (AbsIR a) (AbsIR b)). + exists ([--](c[^]2)). + exists (c[^]2). + assert (X:[--](c[^]2)[<=]c[^]2). + apply leEq_transitive with (Zero:IR). + rstepr ([--]Zero:IR). + apply inv_resp_leEq. + apply sqr_nonneg. apply sqr_nonneg. - apply sqr_nonneg. -exists X. -assert (A0:(c[^]2)[<]One). - rstepr (One[^]2:IR). + exists X. + assert (A0:(c[^]2)[<]One). + rstepr (One[^]2:IR). + unfold c. + apply nexp_resp_less. + auto with *. + eapply leEq_transitive. + apply AbsIR_nonneg. + apply lft_leEq_Max. + apply Max_less; [destruct (Hinc _ (compact_inc_lft _ _ Hab)) + |destruct (Hinc _ (compact_inc_rht _ _ Hab))]; apply AbsIR_less; assumption. + assert (A1:[--]One[<][--](c[^]2)). + apply inv_resp_less. + assumption. + split. + intros d [Hd0 Hd1]. + split. + apply less_leEq_trans with ([--](c[^]2)); assumption. + apply leEq_less_trans with (c[^]2); assumption. + intros x Hx [Hx0 Hx1]. + simpl. + cut (AbsSmall (c[^]2) ([--](x[^]2))). + intros [A B]; split; assumption. + apply inv_resp_AbsSmall. + rstepl (c[*]c). + rstepr (x[*]x). + cut (AbsSmall c x). + intros; apply mult_AbsSmall; assumption. unfold c. - apply nexp_resp_less. - auto with *. - eapply leEq_transitive. - apply AbsIR_nonneg. - apply lft_leEq_Max. - apply Max_less; - [destruct (Hinc _ (compact_inc_lft _ _ Hab)) - |destruct (Hinc _ (compact_inc_rht _ _ Hab))]; - apply AbsIR_less; assumption. -assert (A1:[--]One[<][--](c[^]2)). - apply inv_resp_less. - assumption. -split. - intros d [Hd0 Hd1]. split. - apply less_leEq_trans with ([--](c[^]2)); assumption. - apply leEq_less_trans with (c[^]2); assumption. -intros x Hx [Hx0 Hx1]. -simpl. -cut (AbsSmall (c[^]2) ([--](x[^]2))). - intros [A B]; split; assumption. -apply inv_resp_AbsSmall. -rstepl (c[*]c). -rstepr (x[*]x). -cut (AbsSmall c x). - intros; apply mult_AbsSmall; assumption. -unfold c. -split. - rstepr ([--][--]x). - apply inv_resp_leEq. - eapply leEq_transitive;[|apply lft_leEq_Max]. - eapply leEq_transitive;[|apply inv_leEq_AbsIR]. - apply inv_resp_leEq. + rstepr ([--][--]x). + apply inv_resp_leEq. + eapply leEq_transitive;[|apply lft_leEq_Max]. + eapply leEq_transitive;[|apply inv_leEq_AbsIR]. + apply inv_resp_leEq. + assumption. + eapply leEq_transitive;[|apply rht_leEq_Max]. + eapply leEq_transitive;[|apply leEq_AbsIR]. assumption. -eapply leEq_transitive;[|apply rht_leEq_Max]. -eapply leEq_transitive;[|apply leEq_AbsIR]. -assumption. Qed. Lemma bellcurve_series : forall (Hs:fun_series_convergent_IR (olor ([--]One) One) (fun (i:nat) => ([--]One)[^]i{**}Fid IR{^}(2*i))), Feq (olor ([--]One) One) (FSeries_Sum Hs) ({1/}([-C-]One{+}FId{^}2)). Proof. -intros Hs. -split. + intros Hs. + split. + simpl. + apply included_refl. + split. + apply included_trans with realline. + intros x _; constructor. + apply Continuous_imp_inc. + apply ArcTan_def_lemma. + intros c [Hc0 Hc1] D0 D1. + assert (X:AbsIR ([--](c[^]2))[<]One). + csetoid_rewrite_rev (AbsIR_inv (c[^]2)). + csetoid_rewrite (AbsIR_nexp_op 2 c). + rstepr (One[^]2:IR). + apply nexp_resp_less. + auto with *. + apply AbsIR_nonneg. + apply AbsIR_less; assumption. simpl. - apply included_refl. -split. - apply included_trans with realline. - intros x _; constructor. - apply Continuous_imp_inc. - apply ArcTan_def_lemma. -intros c [Hc0 Hc1] D0 D1. -assert (X:AbsIR ([--](c[^]2))[<]One). - csetoid_rewrite_rev (AbsIR_inv (c[^]2)). - csetoid_rewrite (AbsIR_nexp_op 2 c). - rstepr (One[^]2:IR). - apply nexp_resp_less. - auto with *. - apply AbsIR_nonneg. - apply AbsIR_less; assumption. -simpl. -generalize - (ext2 (S:=IR) (P:=Conj (fun _ : IR => CTrue) (fun _ : IR => CTrue)) + generalize (ext2 (S:=IR) (P:=Conj (fun _ : IR => CTrue) (fun _ : IR => CTrue)) (R:=fun (x : IR) (_ : Conj (fun _ : IR => CTrue) (fun _ : IR => CTrue) x) => - One[+]One[*]x[*]x[#]Zero) (x:=c) D1). -intros H. -assert (Y:One[-]([--](c[^]2))[#]Zero). - rstepl (One[+]One[*]c[*]c). - assumption. -rstepr (One[/](One[-]([--](c[^]2)))[//]Y). -stepr (series_sum (power_series [--](c[^]2)) (power_series_conv [--](c[^]2) X)) by - apply (power_series_sum ([--](c[^]2)) X Y (power_series_conv _ X)). -apply series_sum_wd. -intros n. -simpl. -change ((([--]One)[^]n)[*]c[^](2*n)[=][--](One[*]c[*]c)[^]n). -rstepr ((([--]One)[*]c[*]c)[^]n). -csetoid_rewrite_rev (nexp_mult _ c 2 n). -csetoid_rewrite_rev (mult_nexp _ ([--]One) (c[^]2) n). -rational. + One[+]One[*]x[*]x[#]Zero) (x:=c) D1). + intros H. + assert (Y:One[-]([--](c[^]2))[#]Zero). + rstepl (One[+]One[*]c[*]c). + assumption. + rstepr (One[/](One[-]([--](c[^]2)))[//]Y). + stepr (series_sum (power_series [--](c[^]2)) (power_series_conv [--](c[^]2) X)) by + apply (power_series_sum ([--](c[^]2)) X Y (power_series_conv _ X)). + apply series_sum_wd. + intros n. + simpl. + change ((([--]One)[^]n)[*]c[^](2*n)[=][--](One[*]c[*]c)[^]n). + rstepr ((([--]One)[*]c[*]c)[^]n). + csetoid_rewrite_rev (nexp_mult _ c 2 n). + csetoid_rewrite_rev (mult_nexp _ ([--]One) (c[^]2) n). + rational. Qed. (** Finally we show the convergence of the series for arctan.*) @@ -473,185 +455,177 @@ Qed. this proof only shows convergence on the open interval (-1,1). *) -Lemma arctan_series_convergent_IR : fun_series_convergent_IR (olor ([--]One) One) +Lemma arctan_series_convergent_IR : fun_series_convergent_IR (olor ([--]One) One) (fun (i:nat) => (([--]One)[^]i[/]nring (S (2*i))[//]nringS_ap_zero _ (2*i)){**}Fid IR{^}(2*i+1)). Proof. -intros y z Hyz Hinc. -pose (C:=Max (AbsIR y) (AbsIR z)). -assert (C[<]One). - unfold C. - destruct (Hinc _ (compact_inc_lft _ _ Hyz)). - destruct (Hinc _ (compact_inc_rht _ _ Hyz)). - apply Max_less; apply AbsIR_less; assumption. -assert (Zero[<=]C). - unfold C. - eapply leEq_transitive. - apply AbsIR_nonneg. - apply lft_leEq_Max. -apply fun_ratio_test_conv. - intros n. - Contin. -exists 0. -exists C. - assumption. -split. - assumption. -intros x Hx n _ Hx0 Hx1. -generalize (nringS_ap_zero IR (2 * S n)). -generalize (nringS_ap_zero IR (2 * n)). -intros Z0 Z1. -set (a := S (2 * S n)). -set (b := 2*S n + 1). -set (c:= S (2 * n)). -set (d:= 2*n + 1). -change (AbsIR (([--]One[^]S n[/]nring (R:=IR) a[//]Z1)[*]x[^]b)[<=] -C[*]AbsIR (([--]One[^]n[/]nring (R:=IR) c[//]Z0)[*]x[^]d)). -stepl (AbsIR (([--]One[^]S n[/]nring (R:=IR) a[//]Z1))[*]AbsIR (x[^]b)) by - apply eq_symmetric; apply AbsIR_resp_mult. -stepr (C[*](AbsIR (([--]One[^]n[/]nring (R:=IR) c[//]Z0))[*]AbsIR(x[^]d))) by - apply mult_wdr; apply eq_symmetric; apply AbsIR_resp_mult. -rstepr (AbsIR (([--]One[^]n[/]nring (R:=IR) c[//]Z0))[*](C[*]AbsIR(x[^]d))). -apply mult_resp_leEq_both; try apply AbsIR_nonneg. - stepl (AbsIR ([--]One[^]S n)[/]_[//](AbsIR_resp_ap_zero _ Z1)) by - apply eq_symmetric; apply AbsIR_division. - stepr ((AbsIR ([--]One[^]n)[/]_[//](AbsIR_resp_ap_zero _ Z0))) by - apply eq_symmetric; apply AbsIR_division. - assert (H0:forall n, AbsIR([--]One[^]n)[=]One). - intros i. - csetoid_rewrite (AbsIR_nexp_op i ([--]One:IR)). - csetoid_rewrite_rev (AbsIR_inv One). - stepl ((One:IR)[^]i). - apply one_nexp. - apply nexp_wd. - apply eq_symmetric; apply AbsIR_eq_x. - apply less_leEq; apply pos_one. - stepl (One[/]AbsIR (nring (R:=IR) (S (2 * S n)))[//] - AbsIR_resp_ap_zero (nring (R:=IR) (S (2 * S n))) Z1) by - apply div_wd; try apply eq_reflexive; apply eq_symmetric; apply H0. - stepr (One[/]AbsIR (nring (R:=IR) (S (2 * n)))[//] - AbsIR_resp_ap_zero (nring (R:=IR) (S (2 * n))) Z0) by - apply div_wd; try apply eq_reflexive; apply eq_symmetric; apply H0. - apply recip_resp_leEq; try (apply AbsIR_pos; assumption). - eapply leEq_transitive;[|apply leEq_AbsIR]. - apply AbsSmall_imp_AbsIR. - apply leEq_imp_AbsSmall. - apply nring_nonneg. - apply nring_leEq. - auto with *. -replace b with (2+d);[|unfold b, d; auto with *]. -stepl (AbsIR x[^](2+d)) by apply eq_symmetric; apply AbsIR_nexp_op. -stepl (AbsIR x[^]2[*]AbsIR x[^]d) by apply nexp_plus. -stepr (C[*]AbsIR x[^]d) by - apply mult_wdr; apply eq_symmetric; apply AbsIR_nexp_op. -apply mult_resp_leEq_rht; try (apply nexp_resp_nonneg; apply AbsIR_nonneg). -apply leEq_transitive with (C[^]2). - stepl (AbsIR(x[^]2)) by apply AbsIR_nexp_op. - stepl (x[^]2) by apply eq_symmetric; apply AbsIR_eq_x; apply sqr_nonneg. - apply shift_zero_leEq_minus'. - rstepr ((C[-]x)[*](C[-][--]x)). - unfold C. - destruct Hx as [Y0 Y1]. - apply mult_resp_nonneg; apply shift_zero_leEq_minus. + intros y z Hyz Hinc. + pose (C:=Max (AbsIR y) (AbsIR z)). + assert (C[<]One). + unfold C. + destruct (Hinc _ (compact_inc_lft _ _ Hyz)). + destruct (Hinc _ (compact_inc_rht _ _ Hyz)). + apply Max_less; apply AbsIR_less; assumption. + assert (Zero[<=]C). + unfold C. eapply leEq_transitive. - apply Y1. + apply AbsIR_nonneg. + apply lft_leEq_Max. + apply fun_ratio_test_conv. + intros n. + Contin. + exists 0. + exists C. + assumption. + split. + assumption. + intros x Hx n _ Hx0 Hx1. + generalize (nringS_ap_zero IR (2 * S n)). + generalize (nringS_ap_zero IR (2 * n)). + intros Z0 Z1. + set (a := S (2 * S n)). + set (b := 2*S n + 1). + set (c:= S (2 * n)). + set (d:= 2*n + 1). + change (AbsIR (([--]One[^]S n[/]nring (R:=IR) a[//]Z1)[*]x[^]b)[<=] + C[*]AbsIR (([--]One[^]n[/]nring (R:=IR) c[//]Z0)[*]x[^]d)). + stepl (AbsIR (([--]One[^]S n[/]nring (R:=IR) a[//]Z1))[*]AbsIR (x[^]b)) by + apply eq_symmetric; apply AbsIR_resp_mult. + stepr (C[*](AbsIR (([--]One[^]n[/]nring (R:=IR) c[//]Z0))[*]AbsIR(x[^]d))) by + apply mult_wdr; apply eq_symmetric; apply AbsIR_resp_mult. + rstepr (AbsIR (([--]One[^]n[/]nring (R:=IR) c[//]Z0))[*](C[*]AbsIR(x[^]d))). + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + stepl (AbsIR ([--]One[^]S n)[/]_[//](AbsIR_resp_ap_zero _ Z1)) by + apply eq_symmetric; apply AbsIR_division. + stepr ((AbsIR ([--]One[^]n)[/]_[//](AbsIR_resp_ap_zero _ Z0))) by + apply eq_symmetric; apply AbsIR_division. + assert (H0:forall n, AbsIR([--]One[^]n)[=]One). + intros i. + csetoid_rewrite (AbsIR_nexp_op i ([--]One:IR)). + csetoid_rewrite_rev (AbsIR_inv One). + stepl ((One:IR)[^]i). + apply one_nexp. + apply nexp_wd. + apply eq_symmetric; apply AbsIR_eq_x. + apply less_leEq; apply pos_one. + stepl (One[/]AbsIR (nring (R:=IR) (S (2 * S n)))[//] + AbsIR_resp_ap_zero (nring (R:=IR) (S (2 * S n))) Z1) by + apply div_wd; try apply eq_reflexive; apply eq_symmetric; apply H0. + stepr (One[/]AbsIR (nring (R:=IR) (S (2 * n)))[//] + AbsIR_resp_ap_zero (nring (R:=IR) (S (2 * n))) Z0) by + apply div_wd; try apply eq_reflexive; apply eq_symmetric; apply H0. + apply recip_resp_leEq; try (apply AbsIR_pos; assumption). + eapply leEq_transitive;[|apply leEq_AbsIR]. + apply AbsSmall_imp_AbsIR. + apply leEq_imp_AbsSmall. + apply nring_nonneg. + apply nring_leEq. + auto with *. + replace b with (2+d);[|unfold b, d; auto with *]. + stepl (AbsIR x[^](2+d)) by apply eq_symmetric; apply AbsIR_nexp_op. + stepl (AbsIR x[^]2[*]AbsIR x[^]d) by apply nexp_plus. + stepr (C[*]AbsIR x[^]d) by apply mult_wdr; apply eq_symmetric; apply AbsIR_nexp_op. + apply mult_resp_leEq_rht; try (apply nexp_resp_nonneg; apply AbsIR_nonneg). + apply leEq_transitive with (C[^]2). + stepl (AbsIR(x[^]2)) by apply AbsIR_nexp_op. + stepl (x[^]2) by apply eq_symmetric; apply AbsIR_eq_x; apply sqr_nonneg. + apply shift_zero_leEq_minus'. + rstepr ((C[-]x)[*](C[-][--]x)). + unfold C. + destruct Hx as [Y0 Y1]. + apply mult_resp_nonneg; apply shift_zero_leEq_minus. + eapply leEq_transitive. + apply Y1. + eapply leEq_transitive. + apply leEq_AbsIR. + apply rht_leEq_Max. eapply leEq_transitive. - apply leEq_AbsIR. - apply rht_leEq_Max. - eapply leEq_transitive. - apply inv_resp_leEq. - apply Y0. - eapply leEq_transitive. - apply inv_leEq_AbsIR. - apply lft_leEq_Max. -rstepl (C[*]C). -rstepr (C[*]One). -apply mult_resp_leEq_lft. - apply less_leEq; assumption. -assumption. + apply inv_resp_leEq. + apply Y0. + eapply leEq_transitive. + apply inv_leEq_AbsIR. + apply lft_leEq_Max. + rstepl (C[*]C). + rstepr (C[*]One). + apply mult_resp_leEq_lft. + apply less_leEq; assumption. + assumption. Qed. Lemma arctan_series : forall c : IR, forall (Hs:fun_series_convergent_IR (olor ([--]One) One) (fun (i:nat) => (([--]One)[^]i[/]nring (S (2*i))[//]nringS_ap_zero _ (2*i)){**}Fid IR{^}(2*i+1))) Hc, FSeries_Sum Hs c Hc[=]ArcTan c. Proof. -intros c Hs Hc. -set (J:=olor [--]One One). -assert (HJ:proper J). - simpl. - apply shift_zero_less_minus'. - rstepr (Two:IR). - apply pos_nring_S. -assert (Y0 : included J realline). - intros a b; constructor. -assert (Y1 : J Zero). - split;[rstepr ([--]Zero:IR);apply inv_resp_less|]; - apply pos_one. -stepl (([-S-] - Included_imp_Continuous realline {1/}([-C-]One{+}FId{^}2) - ArcTan_def_lemma J Y0) Zero Y1 c Hc). - apply: Integral_wd. - apply Feq_reflexive. - intros d Hd. - eapply Continuous_imp_inc. - apply ArcTan_def_lemma. - constructor. -apply cg_inv_unique_2. -cut (Derivative J HJ (FSeries_Sum Hs) {1/}([-C-]One{+}FId{^}2)). - intros X. - destruct (FTC2 J _ (Included_imp_Continuous _ _ ArcTan_def_lemma J Y0) Zero Y1 _ _ X) as [z Hz]. - clear X. - apply eq_transitive with z. - eapply eq_transitive; - [|apply (Feq_imp_eq _ _ _ Hz _ Hc (CAnd_intro _ _ Hc Hc) CI)]. - apply: bin_op_wd_unfolded;[|apply un_op_wd_unfolded]; apply pfwdef; apply eq_reflexive. - apply eq_symmetric. - eapply eq_transitive; - [|apply (Feq_imp_eq _ _ _ Hz _ Y1 (CAnd_intro _ _ Y1 Y1) CI)]. - rstepl (Zero[-]Zero:IR). - apply: cg_minus_wd. - stepr (ArcTan Zero). - assert (Z:Dom Tang Zero). - repeat split; try constructor. - intros []. - stepl (One:IR). - apply ring_non_triv. - apply eq_symmetric. - apply Cos_zero. - stepl (ArcTan (Tan _ Z)). - apply pfwdef. - apply Tan_zero. - apply ArcTan_Tan; - [rstepr ([--]Zero:IR); apply inv_resp_less|]; - apply pos_HalfPi. - unfold ArcTan, ArcTang. + intros c Hs Hc. + set (J:=olor [--]One One). + assert (HJ:proper J). + simpl. + apply shift_zero_less_minus'. + rstepr (Two:IR). + apply pos_nring_S. + assert (Y0 : included J realline). + intros a b; constructor. + assert (Y1 : J Zero). + split;[rstepr ([--]Zero:IR);apply inv_resp_less|]; apply pos_one. + stepl (([-S-] Included_imp_Continuous realline {1/}([-C-]One{+}FId{^}2) + ArcTan_def_lemma J Y0) Zero Y1 c Hc). apply: Integral_wd. apply Feq_reflexive. intros d Hd. eapply Continuous_imp_inc. apply ArcTan_def_lemma. constructor. - eapply eq_transitive. + apply cg_inv_unique_2. + cut (Derivative J HJ (FSeries_Sum Hs) {1/}([-C-]One{+}FId{^}2)). + intros X. + destruct (FTC2 J _ (Included_imp_Continuous _ _ ArcTan_def_lemma J Y0) Zero Y1 _ _ X) as [z Hz]. + clear X. + apply eq_transitive with z. + eapply eq_transitive; [|apply (Feq_imp_eq _ _ _ Hz _ Hc (CAnd_intro _ _ Hc Hc) CI)]. + apply: bin_op_wd_unfolded;[|apply un_op_wd_unfolded]; apply pfwdef; apply eq_reflexive. apply eq_symmetric. - eapply (series_sum_zero conv_zero_series). - simpl; apply series_sum_wd. - intros n. - eapply eq_transitive. + eapply eq_transitive; [|apply (Feq_imp_eq _ _ _ Hz _ Y1 (CAnd_intro _ _ Y1 Y1) CI)]. + rstepl (Zero[-]Zero:IR). + apply: cg_minus_wd. + stepr (ArcTan Zero). + assert (Z:Dom Tang Zero). + repeat split; try constructor. + intros []. + stepl (One:IR). + apply ring_non_triv. + apply eq_symmetric. + apply Cos_zero. + stepl (ArcTan (Tan _ Z)). + apply pfwdef. + apply Tan_zero. + apply ArcTan_Tan; [rstepr ([--]Zero:IR); apply inv_resp_less|]; apply pos_HalfPi. + unfold ArcTan, ArcTang. + apply: Integral_wd. + apply Feq_reflexive. + intros d Hd. + eapply Continuous_imp_inc. + apply ArcTan_def_lemma. + constructor. + eapply eq_transitive. + apply eq_symmetric. + eapply (series_sum_zero conv_zero_series). + simpl; apply series_sum_wd. + intros n. + eapply eq_transitive. + apply eq_symmetric. + apply cring_mult_zero. + apply mult_wdr. apply eq_symmetric. - apply cring_mult_zero. - apply mult_wdr. - apply eq_symmetric. - apply (zero_nexp IR (2*n+1)). - auto with *. -clear -J. -eapply Derivative_wdr. - apply (bellcurve_series bellcurve_series_convergent_IR). -apply Derivative_FSeries. -intros n. -rewrite plus_comm. -simpl. -Derivative_Help; - [|apply Derivative_scal;apply Derivative_nth;Deriv]. -FEQ. + apply (zero_nexp IR (2*n+1)). + auto with *. + clear -J. + eapply Derivative_wdr. + apply (bellcurve_series bellcurve_series_convergent_IR). + apply Derivative_FSeries. + intros n. + rewrite plus_comm. + simpl. + Derivative_Help; [|apply Derivative_scal;apply Derivative_nth;Deriv]. + FEQ. Qed. End ArcTan_Series. diff --git a/transc/Pi.v b/transc/Pi.v index 63d9e0e07..84eee70c0 100644 --- a/transc/Pi.v +++ b/transc/Pi.v @@ -19,21 +19,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Import CornTac. Require Export SinCos. @@ -59,87 +59,80 @@ Opaque Cosine. (* begin hide *) Lemma pi_seq_lemma : forall n, Zero [<=] pi_seq n and (forall t : IR, Zero [<=] t -> t [<=] pi_seq n -> Zero [<] Cos t). -intro; induction n as [| n Hrecn]. -split; intros. -simpl in |- *; apply leEq_reflexive. - -simpl in H0. -cut (t [=] Zero); [ intro | apply leEq_imp_eq; auto ]. -astepr (Cos Zero). -astepr OneR. -apply pos_one. - -inversion_clear Hrecn; split. - -astepr (pi_seq n[+]Cos (pi_seq n)). -astepl (ZeroR[+]Zero); apply plus_resp_leEq_both. -auto. -apply less_leEq; apply X; auto. -apply leEq_reflexive. - -simpl in |- *. -rename X into H0. intros t H1 H2. -apply - Continuous_imp_pos - with (Hac := leEq_transitive _ _ _ _ H1 H2) (b := pi_seq n); - auto. -simpl in |- *. -apply shift_less_plus'; astepl ZeroR. -simpl in H0; apply H0; auto. -apply leEq_reflexive. -apply included_imp_Continuous with realline; Contin. -intros. -apply less_wdr with (Cos t0). -2: simpl in |- *; algebra. -auto. - -clear H2 H1 t; intros t H1 H2 Ht. -set (x := pi_seq n) in *. -apply less_wdr with (Cosine x CI[+] ( {--}Cosine x CI[-] {--}Cosine t Ht)). -2: simpl in |- *; rational. -assert (H3 : Derivative realline CI {--}Cosine Sine). - apply Derivative_wdr with ( {--}{--}Sine). -Opaque Sine. - FEQ. Deriv. -assert (H4 : Continuous_I (Min_leEq_Max x t) Sine). - apply included_imp_Continuous with realline; Contin. -set (B := Barrow _ _ Continuous_Sin CI {--}Cosine) in *. -set (B' := B H3 x t H4 CI CI) in *. -apply less_wdr with (Cosine x CI[-]Integral H4). -2: unfold cg_minus at 1 in |- *; apply bin_op_wd_unfolded. -2: algebra. -2: rstepr ( [--] ( {--}Cosine t Ht[-] {--}Cosine x CI)). -2: apply un_op_wd_unfolded; eapply eq_transitive_unfolded. -2: apply B'. -2: algebra. -clear B' B H3. -apply less_wdl with (Cos (pi_seq n) [-] (pi_seq (S n) [-]pi_seq n)). -2: simpl in |- *; rational. -unfold cg_minus at 1 3 in |- *. -apply plus_resp_less_lft. -apply inv_resp_less. -apply less_leEq_trans with (t[-]x). -2: apply minus_resp_leEq; auto. -eapply leEq_less_trans. -apply leEq_AbsIR. -eapply less_leEq_trans. -apply (ub_Integral _ _ _ _ H4 (less_imp_ap _ _ _ H1) One) with x CI. -intros. -apply leEq_wdl with (AbsIR (Sin x0)). -apply AbsIR_Sin_leEq_One. -apply AbsIR_wd; simpl in |- *; algebra. -apply compact_map2 with (Hab := less_leEq _ _ _ H1). -apply compact_inc_lft. -apply less_wdl with (AbsIR (Sin x)). -2: simpl in |- *; algebra. -apply AbsIR_Sin_less_One. -apply H0; auto. -apply leEq_reflexive. -apply eq_imp_leEq. -astepl (AbsIR (t[-]x)). -apply AbsIR_eq_x. -apply shift_leEq_minus; apply less_leEq. -astepl x; auto. +Proof. + intro; induction n as [| n Hrecn]. + split; intros. + simpl in |- *; apply leEq_reflexive. + simpl in H0. + cut (t [=] Zero); [ intro | apply leEq_imp_eq; auto ]. + astepr (Cos Zero). + astepr OneR. + apply pos_one. + inversion_clear Hrecn; split. + astepr (pi_seq n[+]Cos (pi_seq n)). + astepl (ZeroR[+]Zero); apply plus_resp_leEq_both. + auto. + apply less_leEq; apply X; auto. + apply leEq_reflexive. + simpl in |- *. + rename X into H0. intros t H1 H2. + apply Continuous_imp_pos with (Hac := leEq_transitive _ _ _ _ H1 H2) (b := pi_seq n); auto. + simpl in |- *. + apply shift_less_plus'; astepl ZeroR. + simpl in H0; apply H0; auto. + apply leEq_reflexive. + apply included_imp_Continuous with realline; Contin. + intros. + apply less_wdr with (Cos t0). + 2: simpl in |- *; algebra. + auto. + clear H2 H1 t; intros t H1 H2 Ht. + set (x := pi_seq n) in *. + apply less_wdr with (Cosine x CI[+] ( {--}Cosine x CI[-] {--}Cosine t Ht)). + 2: simpl in |- *; rational. + assert (H3 : Derivative realline CI {--}Cosine Sine). + apply Derivative_wdr with ( {--}{--}Sine). + Opaque Sine. + FEQ. Deriv. + assert (H4 : Continuous_I (Min_leEq_Max x t) Sine). + apply included_imp_Continuous with realline; Contin. + set (B := Barrow _ _ Continuous_Sin CI {--}Cosine) in *. + set (B' := B H3 x t H4 CI CI) in *. + apply less_wdr with (Cosine x CI[-]Integral H4). + 2: unfold cg_minus at 1 in |- *; apply bin_op_wd_unfolded. + 2: algebra. + 2: rstepr ( [--] ( {--}Cosine t Ht[-] {--}Cosine x CI)). + 2: apply un_op_wd_unfolded; eapply eq_transitive_unfolded. + 2: apply B'. + 2: algebra. + clear B' B H3. + apply less_wdl with (Cos (pi_seq n) [-] (pi_seq (S n) [-]pi_seq n)). + 2: simpl in |- *; rational. + unfold cg_minus at 1 3 in |- *. + apply plus_resp_less_lft. + apply inv_resp_less. + apply less_leEq_trans with (t[-]x). + 2: apply minus_resp_leEq; auto. + eapply leEq_less_trans. + apply leEq_AbsIR. + eapply less_leEq_trans. + apply (ub_Integral _ _ _ _ H4 (less_imp_ap _ _ _ H1) One) with x CI. + intros. + apply leEq_wdl with (AbsIR (Sin x0)). + apply AbsIR_Sin_leEq_One. + apply AbsIR_wd; simpl in |- *; algebra. + apply compact_map2 with (Hab := less_leEq _ _ _ H1). + apply compact_inc_lft. + apply less_wdl with (AbsIR (Sin x)). + 2: simpl in |- *; algebra. + apply AbsIR_Sin_less_One. + apply H0; auto. + apply leEq_reflexive. + apply eq_imp_leEq. + astepl (AbsIR (t[-]x)). + apply AbsIR_eq_x. + apply shift_leEq_minus; apply less_leEq. + astepl x; auto. Qed. (* end hide *) @@ -150,334 +143,332 @@ sequence is strictly increasing. *) Lemma pi_seq_nonneg : forall n : nat, Zero [<=] pi_seq n. -intro; elim (pi_seq_lemma n); auto. +Proof. + intro; elim (pi_seq_lemma n); auto. Qed. Lemma cos_pi_seq_pos : forall n t, Zero [<=] t -> t [<=] pi_seq n -> Zero [<] Cos t. -intro; elim (pi_seq_lemma n); auto. +Proof. + intro; elim (pi_seq_lemma n); auto. Qed. Lemma pi_seq_incr : forall n : nat, pi_seq n [<] pi_seq (S n). -intro; astepr (pi_seq n[+]Cos (pi_seq n)). -apply shift_less_plus'; astepl ZeroR. -apply cos_pi_seq_pos with n. -apply pi_seq_nonneg. -apply leEq_reflexive. +Proof. + intro; astepr (pi_seq n[+]Cos (pi_seq n)). + apply shift_less_plus'; astepl ZeroR. + apply cos_pi_seq_pos with n. + apply pi_seq_nonneg. + apply leEq_reflexive. Qed. (** Trivial---but useful---consequences. *) Lemma sin_pi_seq_mon : forall x y n, Zero [<=] x -> x [<=] y -> y [<=] pi_seq n -> Sin x [<=] Sin y. -intros; simpl in |- *. -apply Derivative_imp_resp_leEq with realline CI Cosine. -Deriv. -auto. -simpl in |- *; auto. -simpl in |- *; auto. -intros. -apply leEq_glb. -intros y0 H2 Hy. -apply less_leEq. -apply less_wdr with (Cos y0). -2: simpl in |- *; algebra. -inversion_clear H2. -apply cos_pi_seq_pos with n. -apply leEq_transitive with x; auto. -eapply leEq_wdl. -apply H3. -eapply eq_transitive_unfolded. -apply Min_comm. -apply leEq_imp_Min_is_lft; auto. -apply leEq_transitive with y; auto. -eapply leEq_wdr. -apply H4. -eapply eq_transitive_unfolded. -apply Max_comm. -apply leEq_imp_Max_is_rht; auto. +Proof. + intros; simpl in |- *. + apply Derivative_imp_resp_leEq with realline CI Cosine. + Deriv. + auto. + simpl in |- *; auto. + simpl in |- *; auto. + intros. + apply leEq_glb. + intros y0 H2 Hy. + apply less_leEq. + apply less_wdr with (Cos y0). + 2: simpl in |- *; algebra. + inversion_clear H2. + apply cos_pi_seq_pos with n. + apply leEq_transitive with x; auto. + eapply leEq_wdl. + apply H3. + eapply eq_transitive_unfolded. + apply Min_comm. + apply leEq_imp_Min_is_lft; auto. + apply leEq_transitive with y; auto. + eapply leEq_wdr. + apply H4. + eapply eq_transitive_unfolded. + apply Max_comm. + apply leEq_imp_Max_is_rht; auto. Qed. Lemma sin_pi_seq_nonneg : forall n : nat, Zero [<=] Sin (pi_seq n). -intro. -astepl (Sin Zero). -apply sin_pi_seq_mon with n. -apply leEq_reflexive. -apply pi_seq_nonneg. -apply leEq_reflexive. +Proof. + intro. + astepl (Sin Zero). + apply sin_pi_seq_mon with n. + apply leEq_reflexive. + apply pi_seq_nonneg. + apply leEq_reflexive. Qed. Lemma sin_pi_seq_gt_one : forall t n, One [<=] t -> t [<=] pi_seq (S n) -> Sin One [<=] Sin t. -intros. -apply sin_pi_seq_mon with (S n); auto. -apply less_leEq; apply pos_one. +Proof. + intros. + apply sin_pi_seq_mon with (S n); auto. + apply less_leEq; apply pos_one. Qed. Lemma cos_pi_seq_mon : forall x y n, Zero [<=] x -> x [<=] y -> y [<=] pi_seq n -> Cos y [<=] Cos x. -intros. -apply power_cancel_leEq with 2. -auto. -apply less_leEq; apply cos_pi_seq_pos with n. -auto. -apply leEq_transitive with y; auto. -apply inv_cancel_leEq. -rstepl (One[-]Cos x[^]2[-]One). -rstepr (One[-]Cos y[^]2[-]One). -apply minus_resp_leEq. -apply leEq_wdl with (Sin x[^]2). -apply leEq_wdr with (Sin y[^]2). -apply nexp_resp_leEq. -astepl (Sin Zero); apply sin_pi_seq_mon with n. -apply leEq_reflexive. -auto. -apply leEq_transitive with y; auto. -apply sin_pi_seq_mon with n; auto. -astepl (Sin y[^]2[+]Cos y[^]2[-]Cos y[^]2). -apply cg_minus_wd. -Step_final (Cos y[^]2[+]Sin y[^]2). -algebra. -astepl (Sin x[^]2[+]Cos x[^]2[-]Cos x[^]2). -apply cg_minus_wd. -Step_final (Cos x[^]2[+]Sin x[^]2). -algebra. +Proof. + intros. + apply power_cancel_leEq with 2. + auto. + apply less_leEq; apply cos_pi_seq_pos with n. + auto. + apply leEq_transitive with y; auto. + apply inv_cancel_leEq. + rstepl (One[-]Cos x[^]2[-]One). + rstepr (One[-]Cos y[^]2[-]One). + apply minus_resp_leEq. + apply leEq_wdl with (Sin x[^]2). + apply leEq_wdr with (Sin y[^]2). + apply nexp_resp_leEq. + astepl (Sin Zero); apply sin_pi_seq_mon with n. + apply leEq_reflexive. + auto. + apply leEq_transitive with y; auto. + apply sin_pi_seq_mon with n; auto. + astepl (Sin y[^]2[+]Cos y[^]2[-]Cos y[^]2). + apply cg_minus_wd. + Step_final (Cos y[^]2[+]Sin y[^]2). + algebra. + astepl (Sin x[^]2[+]Cos x[^]2[-]Cos x[^]2). + apply cg_minus_wd. + Step_final (Cos x[^]2[+]Sin x[^]2). + algebra. Qed. (* begin hide *) Lemma pi_seq_gt_one : forall n : nat, One [<=] pi_seq (S n). -intros. -apply leEq_wdl with (pi_seq 1). -2: simpl in |- *. -2: Step_final (Cos Zero). -apply local_mon_imp_mon'. -intro; apply pi_seq_incr; auto. -auto with arith. +Proof. + intros. + apply leEq_wdl with (pi_seq 1). + 2: simpl in |- *. + 2: Step_final (Cos Zero). + apply local_mon_imp_mon'. + intro; apply pi_seq_incr; auto. + auto with arith. Qed. Lemma pi_seq_bnd : forall n : nat, - pi_seq (S (S (S n))) [-]pi_seq (S (S n)) [<=] + pi_seq (S (S (S n))) [-]pi_seq (S (S n)) [<=] (One[-]Sin One) [*] (pi_seq (S (S n)) [-]pi_seq (S n)). -intros. -set (F := FId{+}Cosine) in *. -assert (H : Derivative realline CI F ( [-C-]One{+}{--}Sine)). unfold F in |- *; Deriv. -astepr (Zero[+] (One[-]Sin One) [*] (pi_seq (S (S n)) [-]pi_seq (S n))). -apply shift_leEq_plus. -apply approach_zero_weak; intros e H0. -elim (Law_of_the_Mean _ _ _ _ H (pi_seq (S n)) (pi_seq (S (S n)))) with e. -2: simpl in |- *; auto. -2: simpl in |- *; auto. -2: auto. -intros t H1 H2. -unfold F in H2. -apply - leEq_transitive - with - (pi_seq (S (S (S n))) [-]pi_seq (S (S n)) [-] - (One[-]Sin t) [*] (pi_seq (S (S n)) [-]pi_seq (S n))). -unfold cg_minus at 1 5 in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq. -apply mult_resp_leEq_rht. -unfold cg_minus in |- *; apply plus_resp_leEq_lft. -apply inv_resp_leEq; inversion_clear H1. -apply sin_pi_seq_gt_one with (S (S n)). -eapply leEq_transitive. -2: apply H3. -apply leEq_Min; apply pi_seq_gt_one. -eapply leEq_transitive. -apply H4. -apply Max_leEq; apply less_leEq. -eapply less_transitive_unfolded; apply pi_seq_incr. -apply pi_seq_incr. -apply shift_leEq_minus; apply less_leEq. -astepl (pi_seq (S n)); apply pi_seq_incr. -eapply leEq_transitive. -apply leEq_AbsIR. -set (H3 := CAnd_intro _ _ CI CI) in *. -eapply leEq_wdl. -apply (H2 H3 H3 H3). -apply AbsIR_wd. -Opaque Sine Cosine. -simpl in |- *; rational. +Proof. + intros. + set (F := FId{+}Cosine) in *. + assert (H : Derivative realline CI F ( [-C-]One{+}{--}Sine)). unfold F in |- *; Deriv. + astepr (Zero[+] (One[-]Sin One) [*] (pi_seq (S (S n)) [-]pi_seq (S n))). + apply shift_leEq_plus. + apply approach_zero_weak; intros e H0. + elim (Law_of_the_Mean _ _ _ _ H (pi_seq (S n)) (pi_seq (S (S n)))) with e. + 2: simpl in |- *; auto. + 2: simpl in |- *; auto. + 2: auto. + intros t H1 H2. + unfold F in H2. + apply leEq_transitive with (pi_seq (S (S (S n))) [-]pi_seq (S (S n)) [-] + (One[-]Sin t) [*] (pi_seq (S (S n)) [-]pi_seq (S n))). + unfold cg_minus at 1 5 in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq. + apply mult_resp_leEq_rht. + unfold cg_minus in |- *; apply plus_resp_leEq_lft. + apply inv_resp_leEq; inversion_clear H1. + apply sin_pi_seq_gt_one with (S (S n)). + eapply leEq_transitive. + 2: apply H3. + apply leEq_Min; apply pi_seq_gt_one. + eapply leEq_transitive. + apply H4. + apply Max_leEq; apply less_leEq. + eapply less_transitive_unfolded; apply pi_seq_incr. + apply pi_seq_incr. + apply shift_leEq_minus; apply less_leEq. + astepl (pi_seq (S n)); apply pi_seq_incr. + eapply leEq_transitive. + apply leEq_AbsIR. + set (H3 := CAnd_intro _ _ CI CI) in *. + eapply leEq_wdl. + apply (H2 H3 H3 H3). + apply AbsIR_wd. + Opaque Sine Cosine. + simpl in |- *; rational. Qed. Lemma pi_seq_bnd' : forall n : nat, - pi_seq (S (S (S n))) [-]pi_seq (S (S n)) [<=] + pi_seq (S (S (S n))) [-]pi_seq (S (S n)) [<=] (One[-]Sin One) [^]S n[*] (pi_seq 2[-]pi_seq 1). -intro; induction n as [| n Hrecn]. -eapply leEq_wdr. -apply pi_seq_bnd. -algebra. -eapply leEq_transitive. -apply pi_seq_bnd. -apply - leEq_wdr - with ((One[-]Sin One) [*] ((One[-]Sin One) [^]S n[*] (pi_seq 2[-]pi_seq 1))). -2: simpl in |- *; rational. -apply mult_resp_leEq_lft. -auto. -apply shift_leEq_minus; astepl (Sin One). -eapply leEq_transitive. -apply leEq_AbsIR. -apply AbsIR_Sin_leEq_One. +Proof. + intro; induction n as [| n Hrecn]. + eapply leEq_wdr. + apply pi_seq_bnd. + algebra. + eapply leEq_transitive. + apply pi_seq_bnd. + apply leEq_wdr with ((One[-]Sin One) [*] ((One[-]Sin One) [^]S n[*] (pi_seq 2[-]pi_seq 1))). + 2: simpl in |- *; rational. + apply mult_resp_leEq_lft. + auto. + apply shift_leEq_minus; astepl (Sin One). + eapply leEq_transitive. + apply leEq_AbsIR. + apply AbsIR_Sin_leEq_One. Qed. Lemma pi_seq_bnd'' : forall n : nat, 2 <= n -> pi_seq (S n) [-]pi_seq n [<=] (One[-]Sin One) [^]pred n[*] (pi_seq 2[-]pi_seq 1). -intro; case n. -intros; elimtype False; inversion H. -clear n. -intro; case n; intros. -elimtype False; inversion H; inversion H1. -eapply leEq_wdr. -apply pi_seq_bnd'. -algebra. +Proof. + intro; case n. + intros; elimtype False; inversion H. + clear n. + intro; case n; intros. + elimtype False; inversion H; inversion H1. + eapply leEq_wdr. + apply pi_seq_bnd'. + algebra. Qed. (* end hide *) (** An auxiliary result. *) Lemma Sin_One_pos : Zero [<] Sin One. -astepl (Sin Zero). -simpl in |- *. -apply Derivative_imp_resp_less with realline CI Cosine. -Deriv. -apply pos_one. -simpl in |- *; auto. -simpl in |- *; auto. -intros. -apply less_leEq_trans with (Cos One). -apply less_wdr with (Cos (pi_seq 1)). -2: astepl (Cos (Zero[+]Cos Zero)); apply Cos_wd; Step_final (Cos Zero). -apply cos_pi_seq_pos with 1. -simpl in |- *. -astepr (Cos Zero); astepr OneR. -apply less_leEq; apply pos_one. -apply leEq_reflexive. -apply leEq_glb. -intros y H Hy; apply leEq_wdr with (Cos y). -2: simpl in |- *; algebra. -inversion_clear H. -apply cos_pi_seq_mon with 1. -eapply leEq_wdl. -apply H0. -apply leEq_imp_Min_is_lft; apply less_leEq; apply pos_one. -eapply leEq_wdr. -apply H1. -apply leEq_imp_Max_is_rht; apply less_leEq; apply pos_one. -apply eq_imp_leEq; simpl in |- *. -Step_final (Cos Zero). +Proof. + astepl (Sin Zero). + simpl in |- *. + apply Derivative_imp_resp_less with realline CI Cosine. + Deriv. + apply pos_one. + simpl in |- *; auto. + simpl in |- *; auto. + intros. + apply less_leEq_trans with (Cos One). + apply less_wdr with (Cos (pi_seq 1)). + 2: astepl (Cos (Zero[+]Cos Zero)); apply Cos_wd; Step_final (Cos Zero). + apply cos_pi_seq_pos with 1. + simpl in |- *. + astepr (Cos Zero); astepr OneR. + apply less_leEq; apply pos_one. + apply leEq_reflexive. + apply leEq_glb. + intros y H Hy; apply leEq_wdr with (Cos y). + 2: simpl in |- *; algebra. + inversion_clear H. + apply cos_pi_seq_mon with 1. + eapply leEq_wdl. + apply H0. + apply leEq_imp_Min_is_lft; apply less_leEq; apply pos_one. + eapply leEq_wdr. + apply H1. + apply leEq_imp_Max_is_rht; apply less_leEq; apply pos_one. + apply eq_imp_leEq; simpl in |- *. + Step_final (Cos Zero). Qed. -(** We can now prove that this is a Cauchy sequence. We define [Pi] as +(** We can now prove that this is a Cauchy sequence. We define [Pi] as twice its limit. *) Lemma pi_seq_Cauchy : Cauchy_prop pi_seq. -intros e H. -cut (Zero [<] pi_seq 2[-]pi_seq 1). intro H0. -assert (H1 : pi_seq 2[-]pi_seq 1 [#] Zero). apply Greater_imp_ap; auto. -cut (Sin One [<] One). -intro Sin_One_less_One. -elim qi_yields_zero with (e := Sin One[*]e[/] _[//]H1) (q := One[-]Sin One). -intros N HN. -exists (S (S N)); intros. -apply AbsIR_imp_AbsSmall. -apply leEq_wdl with (pi_seq m[-]pi_seq (S (S N))). -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply shift_leEq_minus; astepl (pi_seq (S (S N))). -2: apply local_mon_imp_mon'. -2: intro; apply pi_seq_incr; auto. -2: auto. -cut (m = S (pred m)); [ intro | apply S_pred with (S N); auto ]. -apply - leEq_wdl - with (Sum (S (S N)) (pred m) (fun i : nat => pi_seq (S i) [-]pi_seq i)). -2: eapply eq_transitive_unfolded. -2: apply Mengolli_Sum_gen with (f := pi_seq). -2: algebra. -2: auto with arith. -2: rewrite <- H3; algebra. -set (z := One[-]Sin One) in *. -apply - leEq_transitive - with - (Sum (S (S N)) (pred m) - (fun i : nat => z[^]pred i[*] (pi_seq 2[-]pi_seq 1))). -apply Sum_resp_leEq. -rewrite <- H3; auto. -intros; apply pi_seq_bnd''. -apply le_trans with (S (S N)); auto with arith. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; - apply Sum_comm_scal with (s := fun i : nat => z[^]pred i). -rstepl - (Sum (S (S N)) (pred m) (fun i : nat => z[^]pred i) [*] (pi_seq 2[-]pi_seq 1)). -apply shift_mult_leEq with H1. -auto. -apply leEq_wdl with (Sum (S N) (pred (pred m)) (fun i : nat => z[^]i)). -2: cut (pred m = S (pred (pred m))); - [ intro | apply S_pred with N; auto with arith ]. -2: pattern (pred m) at 2 in |- *; rewrite H4. -2: apply Sum_shift; algebra. -cut (z[-]One [#] Zero). intro H4. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply Sum_c_exp with (H := H4). -rstepl ((z[^]S (pred (pred m)) [/] _[//]H4) [-] (z[^]S N[/] _[//]H4)). -apply leEq_transitive with ( [--] (z[^]S N) [/] _[//]H4). -apply shift_minus_leEq; rstepr ZeroR; apply less_leEq. -unfold z in |- *. -rstepl - ( [--] ((One[-]Sin One) [^]S (pred (pred m))) [/] Sin One[//] - pos_ap_zero _ _ Sin_One_pos). -apply shift_div_less. -apply Sin_One_pos. -astepr ZeroR; astepr ( [--]ZeroR). -apply inv_resp_less. -apply less_wdl with (ZeroR[^]S (pred (pred m))). -2: simpl in |- *; algebra. -apply nexp_resp_less. -auto with arith. -apply leEq_reflexive. -apply shift_less_minus; astepl (Sin One). -auto. -unfold z at 2 in |- *. -rstepl (z[^]S N[/] _[//]pos_ap_zero _ _ Sin_One_pos). -apply shift_div_leEq. -apply Sin_One_pos. -eapply leEq_transitive. -eapply leEq_transitive. -2: apply HN. -simpl in |- *. -astepr (nexp IR N z[*]One); apply mult_resp_leEq_lft. -unfold z in |- *. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; apply less_leEq; apply Sin_One_pos. -astepr (z[^]N); apply nexp_resp_nonneg. -unfold z in |- *. -apply shift_leEq_minus; astepl (Sin One). -apply less_leEq; auto. -apply eq_imp_leEq. -rational. -unfold z in |- *. -rstepl ( [--] (Sin One)). -apply inv_resp_ap_zero. -apply Greater_imp_ap; apply Sin_One_pos. -apply shift_leEq_minus. -apply less_leEq; astepl (Sin One); auto. -apply shift_minus_less; apply shift_less_plus'. -astepl ZeroR; apply Sin_One_pos. -apply div_resp_pos. -auto. -apply mult_resp_pos; auto. -apply Sin_One_pos. -apply Sin_less_One. -apply cos_pi_seq_pos with 1. -apply less_leEq; apply pos_one. -simpl in |- *. -apply eq_imp_leEq; Step_final (Cos Zero). -apply shift_less_minus; astepl (pi_seq 1). -apply pi_seq_incr; auto. +Proof. + intros e H. + cut (Zero [<] pi_seq 2[-]pi_seq 1). intro H0. + assert (H1 : pi_seq 2[-]pi_seq 1 [#] Zero). apply Greater_imp_ap; auto. + cut (Sin One [<] One). + intro Sin_One_less_One. + elim qi_yields_zero with (e := Sin One[*]e[/] _[//]H1) (q := One[-]Sin One). + intros N HN. + exists (S (S N)); intros. + apply AbsIR_imp_AbsSmall. + apply leEq_wdl with (pi_seq m[-]pi_seq (S (S N))). + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply shift_leEq_minus; astepl (pi_seq (S (S N))). + 2: apply local_mon_imp_mon'. + 2: intro; apply pi_seq_incr; auto. + 2: auto. + cut (m = S (pred m)); [ intro | apply S_pred with (S N); auto ]. + apply leEq_wdl with (Sum (S (S N)) (pred m) (fun i : nat => pi_seq (S i) [-]pi_seq i)). + 2: eapply eq_transitive_unfolded. + 2: apply Mengolli_Sum_gen with (f := pi_seq). + 2: algebra. + 2: auto with arith. + 2: rewrite <- H3; algebra. + set (z := One[-]Sin One) in *. + apply leEq_transitive with (Sum (S (S N)) (pred m) + (fun i : nat => z[^]pred i[*] (pi_seq 2[-]pi_seq 1))). + apply Sum_resp_leEq. + rewrite <- H3; auto. + intros; apply pi_seq_bnd''. + apply le_trans with (S (S N)); auto with arith. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Sum_comm_scal with (s := fun i : nat => z[^]pred i). + rstepl (Sum (S (S N)) (pred m) (fun i : nat => z[^]pred i) [*] (pi_seq 2[-]pi_seq 1)). + apply shift_mult_leEq with H1. + auto. + apply leEq_wdl with (Sum (S N) (pred (pred m)) (fun i : nat => z[^]i)). + 2: cut (pred m = S (pred (pred m))); [ intro | apply S_pred with N; auto with arith ]. + 2: pattern (pred m) at 2 in |- *; rewrite H4. + 2: apply Sum_shift; algebra. + cut (z[-]One [#] Zero). intro H4. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply Sum_c_exp with (H := H4). + rstepl ((z[^]S (pred (pred m)) [/] _[//]H4) [-] (z[^]S N[/] _[//]H4)). + apply leEq_transitive with ( [--] (z[^]S N) [/] _[//]H4). + apply shift_minus_leEq; rstepr ZeroR; apply less_leEq. + unfold z in |- *. + rstepl ( [--] ((One[-]Sin One) [^]S (pred (pred m))) [/] Sin One[//] pos_ap_zero _ _ Sin_One_pos). + apply shift_div_less. + apply Sin_One_pos. + astepr ZeroR; astepr ( [--]ZeroR). + apply inv_resp_less. + apply less_wdl with (ZeroR[^]S (pred (pred m))). + 2: simpl in |- *; algebra. + apply nexp_resp_less. + auto with arith. + apply leEq_reflexive. + apply shift_less_minus; astepl (Sin One). + auto. + unfold z at 2 in |- *. + rstepl (z[^]S N[/] _[//]pos_ap_zero _ _ Sin_One_pos). + apply shift_div_leEq. + apply Sin_One_pos. + eapply leEq_transitive. + eapply leEq_transitive. + 2: apply HN. + simpl in |- *. + astepr (nexp IR N z[*]One); apply mult_resp_leEq_lft. + unfold z in |- *. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; apply less_leEq; apply Sin_One_pos. + astepr (z[^]N); apply nexp_resp_nonneg. + unfold z in |- *. + apply shift_leEq_minus; astepl (Sin One). + apply less_leEq; auto. + apply eq_imp_leEq. + rational. + unfold z in |- *. + rstepl ( [--] (Sin One)). + apply inv_resp_ap_zero. + apply Greater_imp_ap; apply Sin_One_pos. + apply shift_leEq_minus. + apply less_leEq; astepl (Sin One); auto. + apply shift_minus_less; apply shift_less_plus'. + astepl ZeroR; apply Sin_One_pos. + apply div_resp_pos. + auto. + apply mult_resp_pos; auto. + apply Sin_One_pos. + apply Sin_less_One. + apply cos_pi_seq_pos with 1. + apply less_leEq; apply pos_one. + simpl in |- *. + apply eq_imp_leEq; Step_final (Cos Zero). + apply shift_less_minus; astepl (pi_seq 1). + apply pi_seq_incr; auto. Qed. Definition Pi := Two[*]Lim (Build_CauchySeq _ _ pi_seq_Cauchy). @@ -488,80 +479,74 @@ $\cos(\frac{pi}2)=0$#cos(π/2)=0#. *) Lemma pos_cos : forall x, Zero [<=] x -> x [<] Pi [/]TwoNZ -> Zero [<] Cos x. -intros x H H0. -assert (H1 : x [<] Lim (Build_CauchySeq _ _ pi_seq_Cauchy)). - apply less_wdr with (Pi [/]TwoNZ); auto; unfold Pi in |- *; rational. -elim (less_Lim_so_less_seq _ _ H1); intros N HN. -apply cos_pi_seq_pos with N. -auto. -apply less_leEq; auto. +Proof. + intros x H H0. + assert (H1 : x [<] Lim (Build_CauchySeq _ _ pi_seq_Cauchy)). + apply less_wdr with (Pi [/]TwoNZ); auto; unfold Pi in |- *; rational. + elim (less_Lim_so_less_seq _ _ H1); intros N HN. + apply cos_pi_seq_pos with N. + auto. + apply less_leEq; auto. Qed. Lemma Cos_HalfPi : Cos (Pi [/]TwoNZ) [=] Zero. -apply - eq_transitive_unfolded with (Cos (Lim (Build_CauchySeq _ _ pi_seq_Cauchy))). -apply Cos_wd; unfold Pi in |- *; rational. -astepr - (Lim (Build_CauchySeq _ _ pi_seq_Cauchy) [-] - Lim (Build_CauchySeq _ _ pi_seq_Cauchy)). -assert (H : Cauchy_prop (fun n : nat => pi_seq (S n))). - apply conv_seq_imp_conv_subseq with pi_seq S; auto with arith. - intro; exists (S n); split; apply lt_n_Sn. - simpl in |- *; auto. - algebra. - apply pi_seq_Cauchy. -apply - eq_transitive_unfolded - with - (Lim (Build_CauchySeq _ _ H) [-]Lim (Build_CauchySeq _ _ pi_seq_Cauchy)). -2: apply cg_minus_wd; algebra. -2: apply Lim_subseq_eq_Lim_seq with S; auto with arith. -2: intro; exists (S n); split; apply lt_n_Sn. -2: simpl in |- *; auto. -2: algebra. -2: left; intros; simpl in |- *. -2: apply local_mon_imp_mon'; auto; apply pi_seq_incr. -eapply eq_transitive_unfolded. -2: apply Lim_minus. -assert (H0 : Cauchy_prop (fun n : nat => Cosine (pi_seq n) (cos_domain _))). - apply Cauchy_prop_wd with (fun n : nat => pi_seq (S n) [-]pi_seq n). - 2: intros; simpl in |- *; rational. - exact - (Cauchy_minus (Build_CauchySeq _ _ H) (Build_CauchySeq _ _ pi_seq_Cauchy)). -apply eq_transitive_unfolded with (Lim (Build_CauchySeq _ _ H0)). -2: apply Lim_wd'; intros; simpl in |- *; rational. -simpl in |- *. -apply - Continuous_imp_comm_Lim - with - (e := OneR) - (x := Build_CauchySeq _ _ pi_seq_Cauchy) - (Hxn := fun n : nat => cos_domain (pi_seq n)). -apply pos_one. -apply Included_imp_Continuous with realline; Contin. + apply eq_transitive_unfolded with (Cos (Lim (Build_CauchySeq _ _ pi_seq_Cauchy))). +Proof. + apply Cos_wd; unfold Pi in |- *; rational. + astepr (Lim (Build_CauchySeq _ _ pi_seq_Cauchy) [-] Lim (Build_CauchySeq _ _ pi_seq_Cauchy)). + assert (H : Cauchy_prop (fun n : nat => pi_seq (S n))). + apply conv_seq_imp_conv_subseq with pi_seq S; auto with arith. + intro; exists (S n); split; apply lt_n_Sn. + simpl in |- *; auto. + algebra. + apply pi_seq_Cauchy. + apply eq_transitive_unfolded with + (Lim (Build_CauchySeq _ _ H) [-]Lim (Build_CauchySeq _ _ pi_seq_Cauchy)). + 2: apply cg_minus_wd; algebra. + 2: apply Lim_subseq_eq_Lim_seq with S; auto with arith. + 2: intro; exists (S n); split; apply lt_n_Sn. + 2: simpl in |- *; auto. + 2: algebra. + 2: left; intros; simpl in |- *. + 2: apply local_mon_imp_mon'; auto; apply pi_seq_incr. + eapply eq_transitive_unfolded. + 2: apply Lim_minus. + assert (H0 : Cauchy_prop (fun n : nat => Cosine (pi_seq n) (cos_domain _))). + apply Cauchy_prop_wd with (fun n : nat => pi_seq (S n) [-]pi_seq n). + 2: intros; simpl in |- *; rational. + exact (Cauchy_minus (Build_CauchySeq _ _ H) (Build_CauchySeq _ _ pi_seq_Cauchy)). + apply eq_transitive_unfolded with (Lim (Build_CauchySeq _ _ H0)). + 2: apply Lim_wd'; intros; simpl in |- *; rational. + simpl in |- *. + apply Continuous_imp_comm_Lim with (e := OneR) (x := Build_CauchySeq _ _ pi_seq_Cauchy) + (Hxn := fun n : nat => cos_domain (pi_seq n)). + apply pos_one. + apply Included_imp_Continuous with realline; Contin. Qed. (** Convergence to [Pi [/] Two] is increasing; therefore, [Pi] is positive. *) Lemma HalfPi_gt_pi_seq : forall n : nat, pi_seq n [<] Pi [/]TwoNZ. -intros. -unfold Pi in |- *. -rstepr (Lim (Build_CauchySeq _ _ pi_seq_Cauchy)). -apply less_leEq_trans with (pi_seq (S n)). -apply pi_seq_incr. -apply str_leEq_seq_so_leEq_Lim. -exists (S n); intros. -apply local_mon_imp_mon'. -apply pi_seq_incr. -auto. +Proof. + intros. + unfold Pi in |- *. + rstepr (Lim (Build_CauchySeq _ _ pi_seq_Cauchy)). + apply less_leEq_trans with (pi_seq (S n)). + apply pi_seq_incr. + apply str_leEq_seq_so_leEq_Lim. + exists (S n); intros. + apply local_mon_imp_mon'. + apply pi_seq_incr. + auto. Qed. Lemma pos_Pi : Zero [<] Pi. -astepr (Two[*]Pi [/]TwoNZ). -apply mult_resp_pos. -apply pos_two. -astepl (pi_seq 0). -apply HalfPi_gt_pi_seq. +Proof. + astepr (Two[*]Pi [/]TwoNZ). + apply mult_resp_pos. + apply pos_two. + astepl (pi_seq 0). + apply HalfPi_gt_pi_seq. Qed. End Properties_of_Pi. @@ -587,102 +572,122 @@ A summary of what is being proved is simply: *) Lemma pos_HalfPi : Zero [<] Pi [/]TwoNZ. -apply pos_div_two; apply pos_Pi. +Proof. + apply pos_div_two; apply pos_Pi. Qed. Lemma pos_QuarterPi : Zero [<] Pi [/]FourNZ. -apply pos_div_four; apply pos_Pi. +Proof. + apply pos_div_four; apply pos_Pi. Qed. Lemma QuarterPi_less_HalfPi : Pi [/]FourNZ [<] Pi [/]TwoNZ. -rstepl ((Pi [/]TwoNZ) [/]TwoNZ). -apply pos_div_two'; apply pos_HalfPi. +Proof. + rstepl ((Pi [/]TwoNZ) [/]TwoNZ). + apply pos_div_two'; apply pos_HalfPi. Qed. Lemma HalfPi_less_Pi : Pi [/]TwoNZ [<] Pi. -apply pos_div_two'; apply pos_Pi. +Proof. + apply pos_div_two'; apply pos_Pi. Qed. Lemma QuarterPi_less_Pi : Pi [/]FourNZ [<] Pi. -apply pos_div_four'; apply pos_Pi. +Proof. + apply pos_div_four'; apply pos_Pi. Qed. Lemma neg_invPi : [--]Pi [<] Zero. -astepr ( [--]ZeroR); apply inv_resp_less; apply pos_Pi. +Proof. + astepr ( [--]ZeroR); apply inv_resp_less; apply pos_Pi. Qed. Lemma neg_invHalfPi : [--] (Pi [/]TwoNZ) [<] Zero. -astepr ( [--]ZeroR); apply inv_resp_less; apply pos_HalfPi. +Proof. + astepr ( [--]ZeroR); apply inv_resp_less; apply pos_HalfPi. Qed. Lemma neg_invQuarterPi : [--] (Pi [/]FourNZ) [<] Zero. -astepr ( [--]ZeroR); apply inv_resp_less; apply pos_QuarterPi. +Proof. + astepr ( [--]ZeroR); apply inv_resp_less; apply pos_QuarterPi. Qed. Lemma invHalfPi_less_invQuarterPi : [--] (Pi [/]TwoNZ) [<] [--] (Pi [/]FourNZ). -apply inv_resp_less; apply QuarterPi_less_HalfPi. +Proof. + apply inv_resp_less; apply QuarterPi_less_HalfPi. Qed. Lemma invPi_less_invHalfPi : [--]Pi [<] [--] (Pi [/]TwoNZ). -apply inv_resp_less; apply HalfPi_less_Pi. +Proof. + apply inv_resp_less; apply HalfPi_less_Pi. Qed. Lemma invPi_less_invQuarterPi : [--]Pi [<] [--] (Pi [/]FourNZ). -apply inv_resp_less; apply QuarterPi_less_Pi. +Proof. + apply inv_resp_less; apply QuarterPi_less_Pi. Qed. Lemma invPi_less_Pi : [--]Pi [<] Pi. -apply less_transitive_unfolded with ZeroR. -apply neg_invPi. -apply pos_Pi. +Proof. + apply less_transitive_unfolded with ZeroR. + apply neg_invPi. + apply pos_Pi. Qed. Lemma invPi_less_HalfPi : [--]Pi [<] Pi [/]TwoNZ. -apply less_transitive_unfolded with ZeroR. -apply neg_invPi. -apply pos_HalfPi. +Proof. + apply less_transitive_unfolded with ZeroR. + apply neg_invPi. + apply pos_HalfPi. Qed. Lemma invPi_less_QuarterPi : [--]Pi [<] Pi [/]FourNZ. -apply less_transitive_unfolded with ZeroR. -apply neg_invPi. -apply pos_QuarterPi. +Proof. + apply less_transitive_unfolded with ZeroR. + apply neg_invPi. + apply pos_QuarterPi. Qed. Lemma invHalfPi_less_Pi : [--] (Pi [/]TwoNZ) [<] Pi. -apply less_transitive_unfolded with ZeroR. -apply neg_invHalfPi. -apply pos_Pi. +Proof. + apply less_transitive_unfolded with ZeroR. + apply neg_invHalfPi. + apply pos_Pi. Qed. Lemma invHalfPi_less_HalfPi : [--] (Pi [/]TwoNZ) [<] Pi [/]TwoNZ. -apply less_transitive_unfolded with ZeroR. -apply neg_invHalfPi. -apply pos_HalfPi. +Proof. + apply less_transitive_unfolded with ZeroR. + apply neg_invHalfPi. + apply pos_HalfPi. Qed. Lemma invHalfPi_less_QuarterPi : [--] (Pi [/]TwoNZ) [<] Pi [/]FourNZ. -apply less_transitive_unfolded with ZeroR. -apply neg_invHalfPi. -apply pos_QuarterPi. +Proof. + apply less_transitive_unfolded with ZeroR. + apply neg_invHalfPi. + apply pos_QuarterPi. Qed. Lemma invQuarterPi_less_Pi : [--] (Pi [/]FourNZ) [<] Pi. -apply less_transitive_unfolded with ZeroR. -apply neg_invQuarterPi. -apply pos_Pi. +Proof. + apply less_transitive_unfolded with ZeroR. + apply neg_invQuarterPi. + apply pos_Pi. Qed. Lemma invQuarterPi_less_HalfPi : [--] (Pi [/]FourNZ) [<] Pi [/]TwoNZ. -apply less_transitive_unfolded with ZeroR. -apply neg_invQuarterPi. -apply pos_HalfPi. +Proof. + apply less_transitive_unfolded with ZeroR. + apply neg_invQuarterPi. + apply pos_HalfPi. Qed. Lemma invQuarterPi_less_QuarterPi : [--] (Pi [/]FourNZ) [<] Pi [/]FourNZ. -apply less_transitive_unfolded with ZeroR. -apply neg_invQuarterPi. -apply pos_QuarterPi. +Proof. + apply less_transitive_unfolded with ZeroR. + apply neg_invQuarterPi. + apply pos_QuarterPi. Qed. End Pi_and_Order. @@ -708,122 +713,125 @@ the double. *) Lemma Cos_double : forall x : IR, Cos (Two[*]x) [=] Two[*]Cos x[^]2[-]One. -intros. -astepl (Cos (x[+]x)). -astepl (Cos x[*]Cos x[-]Sin x[*]Sin x). -astepl (Cos x[^]2[-]Sin x[^]2). -rstepr (Cos x[^]2[-] (One[-]Cos x[^]2)). -apply cg_minus_wd; algebra. -astepr (Cos x[^]2[+]Sin x[^]2[-]Cos x[^]2); rational. +Proof. + intros. + astepl (Cos (x[+]x)). + astepl (Cos x[*]Cos x[-]Sin x[*]Sin x). + astepl (Cos x[^]2[-]Sin x[^]2). + rstepr (Cos x[^]2[-] (One[-]Cos x[^]2)). + apply cg_minus_wd; algebra. + astepr (Cos x[^]2[+]Sin x[^]2[-]Cos x[^]2); rational. Qed. Lemma Sin_double : forall x : IR, Sin (Two[*]x) [=] Two[*]Sin x[*]Cos x. -intros. -astepl (Sin (x[+]x)). -eapply eq_transitive_unfolded. -apply Sin_plus. -rational. +Proof. + intros. + astepl (Sin (x[+]x)). + eapply eq_transitive_unfolded. + apply Sin_plus. + rational. Qed. Lemma Tan_double : forall x Hx Hx' H, Tan (Two[*]x) Hx' [=] (Two[*]Tan x Hx[/] One[-]Tan x Hx[^]2[//]H). -intros. -cut (Dom Tang (x[+]x)). intro H0. -astepl (Tan (x[+]x) H0). -cut (One[-]Tan x Hx[*]Tan x Hx [#] Zero). intro H1. -eapply eq_transitive_unfolded. -apply Tan_plus with (Hx := Hx) (Hy := Hx) (H := H1). -simpl in |- *; rational. -astepl (One[-]Tan x Hx[^]2). auto. -apply dom_wd with (Two[*]x); algebra. +Proof. + intros. + cut (Dom Tang (x[+]x)). intro H0. + astepl (Tan (x[+]x) H0). + cut (One[-]Tan x Hx[*]Tan x Hx [#] Zero). intro H1. + eapply eq_transitive_unfolded. + apply Tan_plus with (Hx := Hx) (Hy := Hx) (H := H1). + simpl in |- *; rational. + astepl (One[-]Tan x Hx[^]2). auto. + apply dom_wd with (Two[*]x); algebra. Qed. (* begin hide *) Lemma sqrt_lemma : forall Hpos H, One [/]TwoNZ [=] (One[/] sqrt Two Hpos[//]H) [^]2. -intros. -Step_final (One[^]2[/] _[//]nexp_resp_ap_zero 2 H). +Proof. + intros. + Step_final (One[^]2[/] _[//]nexp_resp_ap_zero 2 H). Qed. (* end hide *) (** Value of trigonometric functions at [Pi[/]Four]. *) Lemma Cos_QuarterPi : forall Hpos H, Cos (Pi [/]FourNZ) [=] (One[/] sqrt Two Hpos[//]H). -intros. -apply square_eq_pos. -apply recip_resp_pos. -apply power_cancel_less with 2. -apply sqrt_nonneg. -astepr (Two:IR). -simpl in |- *; fold (Two:IR) in |- *; astepl ZeroR. -apply pos_two. -apply pos_cos; PiSolve. -eapply eq_transitive_unfolded. -2: apply sqrt_lemma. -astepr ((ZeroR[+]One) [/]TwoNZ). -astepr ((Cos (Pi [/]TwoNZ) [+]One) [/]TwoNZ). -rstepl ((Two[*]Cos (Pi [/]FourNZ) [^]2[-]One[+]One) [/]TwoNZ). -apply div_wd. -2: algebra. -apply bin_op_wd_unfolded. -2: algebra. -apply eq_transitive_unfolded with (Cos (Two[*]Pi [/]FourNZ)). -apply eq_symmetric_unfolded; apply Cos_double. -apply Cos_wd; rational. +Proof. + intros. + apply square_eq_pos. + apply recip_resp_pos. + apply power_cancel_less with 2. + apply sqrt_nonneg. + astepr (Two:IR). + simpl in |- *; fold (Two:IR) in |- *; astepl ZeroR. + apply pos_two. + apply pos_cos; PiSolve. + eapply eq_transitive_unfolded. + 2: apply sqrt_lemma. + astepr ((ZeroR[+]One) [/]TwoNZ). + astepr ((Cos (Pi [/]TwoNZ) [+]One) [/]TwoNZ). + rstepl ((Two[*]Cos (Pi [/]FourNZ) [^]2[-]One[+]One) [/]TwoNZ). + apply div_wd. + 2: algebra. + apply bin_op_wd_unfolded. + 2: algebra. + apply eq_transitive_unfolded with (Cos (Two[*]Pi [/]FourNZ)). + apply eq_symmetric_unfolded; apply Cos_double. + apply Cos_wd; rational. Qed. Lemma Sin_QuarterPi : forall Hpos H, Sin (Pi [/]FourNZ) [=] (One[/] sqrt Two Hpos[//]H). -intros. -apply square_eq_pos. -apply recip_resp_pos. -apply power_cancel_less with 2. -apply sqrt_nonneg. -astepr (Two:IR). -simpl in |- *; fold (Two:IR) in |- *; astepl ZeroR. -apply pos_two. -apply less_leEq_trans with (Sin (One [/]TwoNZ)). -cut (Zero [<] Cos (One [/]TwoNZ)). intro H0. -apply less_wdr with ((Sin One[/] _[//]pos_ap_zero _ _ H0) [/]TwoNZ). -apply pos_div_two. -apply div_resp_pos. -auto. -apply Sin_One_pos. -rstepr - ((Two[*]Sin (One [/]TwoNZ) [*]Cos (One [/]TwoNZ) [/] _[//]pos_ap_zero _ _ H0) - [/]TwoNZ). -repeat apply div_wd. -astepl (Sin (Two[*]One [/]TwoNZ)). -apply Sin_double. -algebra. -algebra. -apply pos_cos; PiSolve. -apply pos_div_two; apply pos_one. -apply less_transitive_unfolded with (pi_seq 1). -simpl in |- *; astepr (Cos Zero); astepr OneR. -astepl (OneR [/]TwoNZ); apply pos_div_two'; apply pos_one. -apply HalfPi_gt_pi_seq. -elim - (less_Lim_so_less_seq (Build_CauchySeq _ _ pi_seq_Cauchy) (Pi [/]FourNZ)). -intros N HN; apply sin_pi_seq_mon with N. -apply less_leEq; apply pos_div_two; apply pos_one. -apply shift_div_leEq. -apply pos_two. -astepl (Cos Zero); astepl (Zero[+]Cos Zero). -rstepr (Pi [/]TwoNZ). -apply less_leEq; apply (HalfPi_gt_pi_seq 1). -apply less_leEq; auto. -eapply less_wdr. -apply QuarterPi_less_HalfPi. -unfold Pi in |- *; rational. -eapply eq_transitive_unfolded. -2: apply sqrt_lemma. -rstepr (One[-]OneR [/]TwoNZ). -astepr (Cos (Pi [/]FourNZ) [^]2[+]Sin (Pi [/]FourNZ) [^]2[-]One [/]TwoNZ). -rstepl ((One[/] _[//]H) [^]2[+]Sin (Pi [/]FourNZ) [^]2[-] (One[/] _[//]H) [^]2). -apply cg_minus_wd. -apply bin_op_wd_unfolded. -apply nexp_wd. -apply eq_symmetric_unfolded; apply Cos_QuarterPi. -algebra. -apply eq_symmetric_unfolded; apply sqrt_lemma. +Proof. + intros. + apply square_eq_pos. + apply recip_resp_pos. + apply power_cancel_less with 2. + apply sqrt_nonneg. + astepr (Two:IR). + simpl in |- *; fold (Two:IR) in |- *; astepl ZeroR. + apply pos_two. + apply less_leEq_trans with (Sin (One [/]TwoNZ)). + cut (Zero [<] Cos (One [/]TwoNZ)). intro H0. + apply less_wdr with ((Sin One[/] _[//]pos_ap_zero _ _ H0) [/]TwoNZ). + apply pos_div_two. + apply div_resp_pos. + auto. + apply Sin_One_pos. + rstepr ((Two[*]Sin (One [/]TwoNZ) [*]Cos (One [/]TwoNZ) [/] _[//]pos_ap_zero _ _ H0) [/]TwoNZ). + repeat apply div_wd. + astepl (Sin (Two[*]One [/]TwoNZ)). + apply Sin_double. + algebra. + algebra. + apply pos_cos; PiSolve. + apply pos_div_two; apply pos_one. + apply less_transitive_unfolded with (pi_seq 1). + simpl in |- *; astepr (Cos Zero); astepr OneR. + astepl (OneR [/]TwoNZ); apply pos_div_two'; apply pos_one. + apply HalfPi_gt_pi_seq. + elim (less_Lim_so_less_seq (Build_CauchySeq _ _ pi_seq_Cauchy) (Pi [/]FourNZ)). + intros N HN; apply sin_pi_seq_mon with N. + apply less_leEq; apply pos_div_two; apply pos_one. + apply shift_div_leEq. + apply pos_two. + astepl (Cos Zero); astepl (Zero[+]Cos Zero). + rstepr (Pi [/]TwoNZ). + apply less_leEq; apply (HalfPi_gt_pi_seq 1). + apply less_leEq; auto. + eapply less_wdr. + apply QuarterPi_less_HalfPi. + unfold Pi in |- *; rational. + eapply eq_transitive_unfolded. + 2: apply sqrt_lemma. + rstepr (One[-]OneR [/]TwoNZ). + astepr (Cos (Pi [/]FourNZ) [^]2[+]Sin (Pi [/]FourNZ) [^]2[-]One [/]TwoNZ). + rstepl ((One[/] _[//]H) [^]2[+]Sin (Pi [/]FourNZ) [^]2[-] (One[/] _[//]H) [^]2). + apply cg_minus_wd. + apply bin_op_wd_unfolded. + apply nexp_wd. + apply eq_symmetric_unfolded; apply Cos_QuarterPi. + algebra. + apply eq_symmetric_unfolded; apply sqrt_lemma. Qed. Hint Resolve Sin_QuarterPi Cos_QuarterPi: algebra. @@ -831,147 +839,157 @@ Hint Resolve Sin_QuarterPi Cos_QuarterPi: algebra. Opaque Sine Cosine. Lemma Tan_QuarterPi : forall H, Tan (Pi [/]FourNZ) H [=] One. -intros. -set (pos2 := less_leEq _ _ _ (pos_two IR)) in *. -cut (sqrt Two pos2 [#] Zero). -2: apply Greater_imp_ap. -2: apply power_cancel_less with 2. -2: apply sqrt_nonneg. -2: apply less_wdl with ZeroR. -2: astepr (Two:IR); apply pos_two. -2: simpl in |- *; algebra. -intro H0. -unfold Tan in |- *; simpl in |- *. -astepr ((One[/] _[//]H0) [/] _[//]recip_ap_zero _ _ H0). -apply div_wd. -astepr (Sin (Pi [/]FourNZ)). -simpl in |- *; algebra. -astepr (Cos (Pi [/]FourNZ)). -simpl in |- *; algebra. +Proof. + intros. + set (pos2 := less_leEq _ _ _ (pos_two IR)) in *. + cut (sqrt Two pos2 [#] Zero). + 2: apply Greater_imp_ap. + 2: apply power_cancel_less with 2. + 2: apply sqrt_nonneg. + 2: apply less_wdl with ZeroR. + 2: astepr (Two:IR); apply pos_two. + 2: simpl in |- *; algebra. + intro H0. + unfold Tan in |- *; simpl in |- *. + astepr ((One[/] _[//]H0) [/] _[//]recip_ap_zero _ _ H0). + apply div_wd. + astepr (Sin (Pi [/]FourNZ)). + simpl in |- *; algebra. + astepr (Cos (Pi [/]FourNZ)). + simpl in |- *; algebra. Qed. (** Shifting sine and cosine by [Pi[/]Two] and [Pi]. *) Lemma Sin_HalfPi : Sin (Pi [/]TwoNZ) [=] One. -apply eq_transitive_unfolded with (Sin (Two[*]Pi [/]FourNZ)). -apply Sin_wd; rational. -eapply eq_transitive_unfolded. -apply Sin_double. -astepr ((Two:IR) [*]One [/]TwoNZ). -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply mult_assoc_unfolded. -apply mult_wdr. -cut (sqrt _ (less_leEq _ _ _ (pos_two IR)) [#] Zero). intro H. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply (sqrt_lemma _ H). -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply mult_assoc_unfolded. -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply one_mult. -apply mult_wdr. -apply mult_wd. -apply Sin_QuarterPi. -apply Cos_QuarterPi. -apply Greater_imp_ap; apply sqrt_less. -simpl in |- *; astepl ZeroR; apply (pos_two IR). +Proof. + apply eq_transitive_unfolded with (Sin (Two[*]Pi [/]FourNZ)). + apply Sin_wd; rational. + eapply eq_transitive_unfolded. + apply Sin_double. + astepr ((Two:IR) [*]One [/]TwoNZ). + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply mult_assoc_unfolded. + apply mult_wdr. + cut (sqrt _ (less_leEq _ _ _ (pos_two IR)) [#] Zero). intro H. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply (sqrt_lemma _ H). + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply mult_assoc_unfolded. + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply one_mult. + apply mult_wdr. + apply mult_wd. + apply Sin_QuarterPi. + apply Cos_QuarterPi. + apply Greater_imp_ap; apply sqrt_less. + simpl in |- *; astepl ZeroR; apply (pos_two IR). Qed. Hint Resolve Sin_HalfPi: algebra. Lemma Sin_plus_HalfPi : forall x : IR, Sin (x[+]Pi [/]TwoNZ) [=] Cos x. -intro. -eapply eq_transitive_unfolded. -apply Sin_plus. -astepl (Sin x[*]Zero[+]Cos x[*]One). -Step_final (Zero[+]Cos x). +Proof. + intro. + eapply eq_transitive_unfolded. + apply Sin_plus. + astepl (Sin x[*]Zero[+]Cos x[*]One). + Step_final (Zero[+]Cos x). Qed. Lemma Sin_HalfPi_minus : forall x : IR, Sin (Pi [/]TwoNZ[-]x) [=] Cos x. -intros. -unfold cg_minus in |- *. -astepl (Sin ( [--]x[+]Pi [/]TwoNZ)). -eapply eq_transitive_unfolded. -apply Sin_plus_HalfPi. -algebra. +Proof. + intros. + unfold cg_minus in |- *. + astepl (Sin ( [--]x[+]Pi [/]TwoNZ)). + eapply eq_transitive_unfolded. + apply Sin_plus_HalfPi. + algebra. Qed. Lemma Cos_plus_HalfPi : forall x : IR, Cos (x[+]Pi [/]TwoNZ) [=] [--] (Sin x). -intro. -eapply eq_transitive_unfolded. -apply Cos_plus. -astepl (Cos x[*]Zero[-]Sin x[*]One). -Step_final (Zero[-]Sin x). +Proof. + intro. + eapply eq_transitive_unfolded. + apply Cos_plus. + astepl (Cos x[*]Zero[-]Sin x[*]One). + Step_final (Zero[-]Sin x). Qed. Lemma Cos_HalfPi_minus : forall x : IR, Cos (Pi [/]TwoNZ[-]x) [=] Sin x. -intros. -unfold cg_minus in |- *. -astepl (Cos ( [--]x[+]Pi [/]TwoNZ)). -eapply eq_transitive_unfolded. -apply Cos_plus_HalfPi. -Step_final (Sin [--][--]x). +Proof. + intros. + unfold cg_minus in |- *. + astepl (Cos ( [--]x[+]Pi [/]TwoNZ)). + eapply eq_transitive_unfolded. + apply Cos_plus_HalfPi. + Step_final (Sin [--][--]x). Qed. Lemma Sin_Pi : Sin Pi [=] Zero. -apply eq_transitive_unfolded with (Sin (Pi [/]TwoNZ[+]Pi [/]TwoNZ)). -apply Sin_wd; rational. -eapply eq_transitive_unfolded. -apply Sin_plus_HalfPi. -algebra. +Proof. + apply eq_transitive_unfolded with (Sin (Pi [/]TwoNZ[+]Pi [/]TwoNZ)). + apply Sin_wd; rational. + eapply eq_transitive_unfolded. + apply Sin_plus_HalfPi. + algebra. Qed. Lemma Cos_Pi : Cos Pi [=] [--]One. -apply eq_transitive_unfolded with (Cos (Pi [/]TwoNZ[+]Pi [/]TwoNZ)). -apply Cos_wd; rational. -eapply eq_transitive_unfolded. -apply Cos_plus_HalfPi. -algebra. +Proof. + apply eq_transitive_unfolded with (Cos (Pi [/]TwoNZ[+]Pi [/]TwoNZ)). + apply Cos_wd; rational. + eapply eq_transitive_unfolded. + apply Cos_plus_HalfPi. + algebra. Qed. Lemma Sin_plus_Pi : forall x : IR, Sin (x[+]Pi) [=] [--] (Sin x). -intros. -apply eq_transitive_unfolded with (Sin (x[+]Pi [/]TwoNZ[+]Pi [/]TwoNZ)). -apply Sin_wd; rational. -eapply eq_transitive_unfolded. -apply Sin_plus_HalfPi. -apply Cos_plus_HalfPi. +Proof. + intros. + apply eq_transitive_unfolded with (Sin (x[+]Pi [/]TwoNZ[+]Pi [/]TwoNZ)). + apply Sin_wd; rational. + eapply eq_transitive_unfolded. + apply Sin_plus_HalfPi. + apply Cos_plus_HalfPi. Qed. Lemma Cos_plus_Pi : forall x : IR, Cos (x[+]Pi) [=] [--] (Cos x). -intros. -apply eq_transitive_unfolded with (Cos (x[+]Pi [/]TwoNZ[+]Pi [/]TwoNZ)). -apply Cos_wd; rational. -eapply eq_transitive_unfolded. -apply Cos_plus_HalfPi. -apply un_op_wd_unfolded; apply Sin_plus_HalfPi. +Proof. + intros. + apply eq_transitive_unfolded with (Cos (x[+]Pi [/]TwoNZ[+]Pi [/]TwoNZ)). + apply Cos_wd; rational. + eapply eq_transitive_unfolded. + apply Cos_plus_HalfPi. + apply un_op_wd_unfolded; apply Sin_plus_HalfPi. Qed. Lemma Tan_plus_HalfPi : forall x Hx Hx' H, Tan (x[+]Pi[/]TwoNZ) Hx[=]([--]One[/](Tan x Hx')[//]H). Proof. -intros x Hy Hx H. -set (y:=x[+]Pi [/]TwoNZ) in *. -assert (H0:Cos y[#]Zero). - destruct Hy as [[] [[] Hy]]. - apply (Hy CI). -assert (H1:Cos x[#]Zero). - clear H. - destruct Hx as [[] [[] Hx]]. - apply (Hx CI). -csetoid_rewrite (Tan_Sin_over_Cos y Hy H0). -unfold y. -assert (H2:([--](Sin x))[#]Zero). - csetoid_rewrite_rev (Cos_plus_HalfPi x). - apply H0. -stepr (Cos x[/]([--](Sin x))[//]H2). - apply div_wd. - apply Sin_plus_HalfPi. - apply Cos_plus_HalfPi. -clear H0. -rstepl (((Cos x[/][--](Sin x)[//]H2)[*](Tan x Hx))[/](Tan x Hx)[//]H). -apply div_wd;[|apply eq_reflexive]. -csetoid_rewrite (Tan_Sin_over_Cos x Hx H1). -rational. + intros x Hy Hx H. + set (y:=x[+]Pi [/]TwoNZ) in *. + assert (H0:Cos y[#]Zero). + destruct Hy as [[] [[] Hy]]. + apply (Hy CI). + assert (H1:Cos x[#]Zero). + clear H. + destruct Hx as [[] [[] Hx]]. + apply (Hx CI). + csetoid_rewrite (Tan_Sin_over_Cos y Hy H0). + unfold y. + assert (H2:([--](Sin x))[#]Zero). + csetoid_rewrite_rev (Cos_plus_HalfPi x). + apply H0. + stepr (Cos x[/]([--](Sin x))[//]H2). + apply div_wd. + apply Sin_plus_HalfPi. + apply Cos_plus_HalfPi. + clear H0. + rstepl (((Cos x[/][--](Sin x)[//]H2)[*](Tan x Hx))[/](Tan x Hx)[//]H). + apply div_wd;[|apply eq_reflexive]. + csetoid_rewrite (Tan_Sin_over_Cos x Hx H1). + rational. Qed. Hint Resolve Sin_plus_Pi Cos_plus_Pi: algebra. @@ -979,118 +997,123 @@ Hint Resolve Sin_plus_Pi Cos_plus_Pi: algebra. (** Sine and cosine have period [Two Pi], tangent has period [Pi]. *) Lemma Sin_periodic : forall x : IR, Sin (x[+]Two[*]Pi) [=] Sin x. -intro. -apply eq_transitive_unfolded with (Sin (x[+]Pi[+]Pi)). -apply Sin_wd; rational. -astepl ( [--] (Sin (x[+]Pi))). -Step_final ( [--][--] (Sin x)). +Proof. + intro. + apply eq_transitive_unfolded with (Sin (x[+]Pi[+]Pi)). + apply Sin_wd; rational. + astepl ( [--] (Sin (x[+]Pi))). + Step_final ( [--][--] (Sin x)). Qed. Lemma Cos_periodic : forall x : IR, Cos (x[+]Two[*]Pi) [=] Cos x. -intro. -apply eq_transitive_unfolded with (Cos (x[+]Pi[+]Pi)). -apply Cos_wd; rational. -astepl ( [--] (Cos (x[+]Pi))). -Step_final ( [--][--] (Cos x)). +Proof. + intro. + apply eq_transitive_unfolded with (Cos (x[+]Pi[+]Pi)). + apply Cos_wd; rational. + astepl ( [--] (Cos (x[+]Pi))). + Step_final ( [--][--] (Cos x)). Qed. Lemma Sin_periodic_Z : forall (x : IR) z, Sin (x[+]zring z[*](Two[*]Pi)) [=] Sin x. Proof. -intros x z; revert x; induction z using Zind; intros x. - rational. - rewrite <- Zsucc_succ'. - unfold Zsucc. + intros x z; revert x; induction z using Zind; intros x. + rational. + rewrite <- Zsucc_succ'. + unfold Zsucc. + rewrite zring_plus. + rstepl (Sin (x[+]zring z[*](Two[*]Pi)[+]Two[*]Pi)). + rewrite Sin_periodic. + auto. + rewrite <- Zpred_pred'. + unfold Zpred. rewrite zring_plus. - rstepl (Sin (x[+]zring z[*](Two[*]Pi)[+]Two[*]Pi)). + rstepl (Sin (x[-]Two[*]Pi[+]zring z[*](Two[*]Pi))). + rstepr (Sin (x[-]Two[*]Pi[+]Two[*]Pi)). rewrite Sin_periodic. auto. -rewrite <- Zpred_pred'. -unfold Zpred. -rewrite zring_plus. -rstepl (Sin (x[-]Two[*]Pi[+]zring z[*](Two[*]Pi))). -rstepr (Sin (x[-]Two[*]Pi[+]Two[*]Pi)). -rewrite Sin_periodic. -auto. Qed. Lemma Cos_periodic_Z : forall (x : IR) z, Cos (x[+]zring z[*](Two[*]Pi)) [=] Cos x. Proof. -intros x z; revert x; induction z using Zind; intros x. - rational. - rewrite <- Zsucc_succ'. - unfold Zsucc. + intros x z; revert x; induction z using Zind; intros x. + rational. + rewrite <- Zsucc_succ'. + unfold Zsucc. + rewrite zring_plus. + rstepl (Cos (x[+]zring z[*](Two[*]Pi)[+]Two[*]Pi)). + rewrite Cos_periodic. + auto. + rewrite <- Zpred_pred'. + unfold Zpred. rewrite zring_plus. - rstepl (Cos (x[+]zring z[*](Two[*]Pi)[+]Two[*]Pi)). + rstepl (Cos (x[-]Two[*]Pi[+]zring z[*](Two[*]Pi))). + rstepr (Cos (x[-]Two[*]Pi[+]Two[*]Pi)). rewrite Cos_periodic. auto. -rewrite <- Zpred_pred'. -unfold Zpred. -rewrite zring_plus. -rstepl (Cos (x[-]Two[*]Pi[+]zring z[*](Two[*]Pi))). -rstepr (Cos (x[-]Two[*]Pi[+]Two[*]Pi)). -rewrite Cos_periodic. -auto. Qed. Lemma Tan_periodic : forall (x : IR) Hx Hx', Tan (x[+]Pi) Hx' [=] Tan x Hx. -intros. -cut (Cos x [#] Zero). intro H. -assert (H0 : [--] (Cos x) [#] Zero). apply inv_resp_ap_zero; auto. -apply eq_transitive_unfolded with (Sin x[/] _[//]H). -2: unfold Tan, Tang in |- *; simpl in |- *; algebra. -rstepr ( [--] (Sin x) [/] _[//]H0). -assert (H1 : Cos (x[+]Pi) [#] Zero). astepl ( [--] (Cos x)); auto. -astepr (Sin (x[+]Pi) [/] _[//]H1). -unfold Tan, Tang in |- *; simpl in |- *; algebra. -inversion_clear Hx. -inversion_clear X0. -simpl in |- *; auto. +Proof. + intros. + cut (Cos x [#] Zero). intro H. + assert (H0 : [--] (Cos x) [#] Zero). apply inv_resp_ap_zero; auto. + apply eq_transitive_unfolded with (Sin x[/] _[//]H). + 2: unfold Tan, Tang in |- *; simpl in |- *; algebra. + rstepr ( [--] (Sin x) [/] _[//]H0). + assert (H1 : Cos (x[+]Pi) [#] Zero). astepl ( [--] (Cos x)); auto. + astepr (Sin (x[+]Pi) [/] _[//]H1). + unfold Tan, Tang in |- *; simpl in |- *; algebra. + inversion_clear Hx. + inversion_clear X0. + simpl in |- *; auto. Qed. Lemma Cos_one_gt_0 : Zero [<] Cos One. -apply cos_pi_seq_pos with (1%nat). -apply less_leEq. -apply pos_one. -unfold pi_seq. -rewrite Cos_zero. -apply eq_imp_leEq. -rational. +Proof. + apply cos_pi_seq_pos with (1%nat). + apply less_leEq. + apply pos_one. + unfold pi_seq. + rewrite Cos_zero. + apply eq_imp_leEq. + rational. Qed. Lemma Pi_gt_2 : Two [<] Pi. -unfold Pi. -rstepl (Two [*] One:IR). -apply mult_resp_less_lft. -apply less_leEq_trans with (One [+] (Cos One)). -rstepl (One [+] Zero:IR). -apply plus_resp_leEq_less. -apply eq_imp_leEq. -reflexivity. -apply Cos_one_gt_0. -apply str_leEq_seq_so_leEq_Lim. -exists (2%nat). -intros i iH. -change (One [+] Cos One[<=] pi_seq i). -induction i. -elimtype False. -auto with *. -clear IHi. -induction i. -elimtype False. -auto with *. -clear iH. -clear IHi. -induction i. -unfold pi_seq. -rewrite Cos_zero. -setoid_replace (Zero [+] One:IR) with (One:IR);[|rational]. -apply eq_imp_leEq. -reflexivity. -apply leEq_transitive with (pi_seq (S (S i))). -assumption. -apply less_leEq. -apply pi_seq_incr. -apply pos_two. +Proof. + unfold Pi. + rstepl (Two [*] One:IR). + apply mult_resp_less_lft. + apply less_leEq_trans with (One [+] (Cos One)). + rstepl (One [+] Zero:IR). + apply plus_resp_leEq_less. + apply eq_imp_leEq. + reflexivity. + apply Cos_one_gt_0. + apply str_leEq_seq_so_leEq_Lim. + exists (2%nat). + intros i iH. + change (One [+] Cos One[<=] pi_seq i). + induction i. + elimtype False. + auto with *. + clear IHi. + induction i. + elimtype False. + auto with *. + clear iH. + clear IHi. + induction i. + unfold pi_seq. + rewrite Cos_zero. + setoid_replace (Zero [+] One:IR) with (One:IR);[|rational]. + apply eq_imp_leEq. + reflexivity. + apply leEq_transitive with (pi_seq (S (S i))). + assumption. + apply less_leEq. + apply pi_seq_incr. + apply pos_two. Qed. End Sin_And_Cos. diff --git a/transc/PowerSeries.v b/transc/PowerSeries.v index d3d0a0836..ac279dbb6 100644 --- a/transc/PowerSeries.v +++ b/transc/PowerSeries.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing Exp %\ensuremath{\exp}% *) (** printing Sin %\ensuremath{\sin}% *) @@ -82,86 +82,76 @@ Let Hr := ProjT1 (ProjT2 Ha). (* end show *) Lemma Dirichlet_crit : fun_series_abs_convergent_IR (olor (x0[-]r) (x0[+]r)) FPowerSeries. -fold r in (value of Hr). -red in |- *; intros. -red in |- *; intros. -apply fun_ratio_test_conv. -intro. -unfold FPowerSeries in |- *; Contin. -elim (ProjT2 (ProjT2 Ha)); intros N HN. -exists N. -cut - {z : IR | Zero [<] z and z [<] r | - forall x : IR, Compact Hab x -> AbsIR (x[-]x0) [<=] z}. -intro H. -elim H; intros z Hz. -elim Hz; clear Hz; intros H0z Hzr Hz. -clear H. -exists ((One[/] r[//]pos_ap_zero _ _ Hr) [*]z). -apply shift_mult_less with (pos_ap_zero _ _ H0z). -assumption. -apply recip_resp_less; assumption. -split. -apply less_leEq; apply mult_resp_pos. -apply recip_resp_pos; assumption. -assumption. -intros. -astepl (AbsIR (FPowerSeries (S n) x (ProjIR1 Hx'))). -apply leEq_wdl with (AbsIR (a (S n)) [*]AbsIR (x[-]x0) [*]AbsIR ((x[-]x0) [^]n)). -apply - leEq_wdr - with - ((One[/] r[//]pos_ap_zero _ _ Hr) [*]z[*]AbsIR (a n) [*] - AbsIR ((x[-]x0) [^]n)). -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -rstepr ((One[/] r[//]pos_ap_zero _ _ Hr) [*]AbsIR (a n) [*]z). -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -apply HN; assumption. -apply Hz; auto. -rstepl - ((One[/] r[//]pos_ap_zero _ _ Hr) [*]z[*](AbsIR (a n) [*]AbsIR ((x[-]x0) [^]n))). -apply mult_wdr. -astepr (AbsIR (FPowerSeries n x (ProjIR1 Hx))). -simpl in |- *; apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -simpl in |- *. -apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -apply AbsIR_resp_mult. -apply - eq_transitive_unfolded - with (AbsIR (a (S n)) [*](AbsIR ((x[-]x0) [^]n) [*]AbsIR (x[-]x0))). -apply mult_wdr; apply AbsIR_resp_mult. -simpl in |- *; rational. -clear HN. -cut - ((forall x : IR, Compact Hab x -> a0 [<=] x) /\ - (forall x : IR, Compact Hab x -> x [<=] b)); intros. -inversion_clear H. -exists (Max (Max (b[-]x0) (x0[-]a0)) (r [/]TwoNZ)). -repeat split. -eapply less_leEq_trans. -2: apply rht_leEq_Max. -apply pos_div_two; auto. -repeat apply Max_less. -apply shift_minus_less'. -elim (Hinc _ (compact_inc_rht _ _ Hab)); auto. -apply shift_minus_less; apply shift_less_plus'; - elim (Hinc _ (compact_inc_lft _ _ Hab)); auto. -apply pos_div_two'; auto. -intros. -simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. -apply leEq_transitive with (b[-]x0). -apply minus_resp_leEq; apply H1; auto. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply lft_leEq_Max. -apply leEq_transitive with (x0[-]a0). -rstepr ([--](a0[-]x0)); apply inv_resp_leEq. -apply minus_resp_leEq; apply H0; auto. -eapply leEq_transitive. -2: apply lft_leEq_Max. -apply rht_leEq_Max. -split; intros x H; elim H; auto. +Proof. + fold r in (value of Hr). + red in |- *; intros. + red in |- *; intros. + apply fun_ratio_test_conv. + intro. + unfold FPowerSeries in |- *; Contin. + elim (ProjT2 (ProjT2 Ha)); intros N HN. + exists N. + cut {z : IR | Zero [<] z and z [<] r | forall x : IR, Compact Hab x -> AbsIR (x[-]x0) [<=] z}. + intro H. + elim H; intros z Hz. + elim Hz; clear Hz; intros H0z Hzr Hz. + clear H. + exists ((One[/] r[//]pos_ap_zero _ _ Hr) [*]z). + apply shift_mult_less with (pos_ap_zero _ _ H0z). + assumption. + apply recip_resp_less; assumption. + split. + apply less_leEq; apply mult_resp_pos. + apply recip_resp_pos; assumption. + assumption. + intros. + astepl (AbsIR (FPowerSeries (S n) x (ProjIR1 Hx'))). + apply leEq_wdl with (AbsIR (a (S n)) [*]AbsIR (x[-]x0) [*]AbsIR ((x[-]x0) [^]n)). + apply leEq_wdr with ((One[/] r[//]pos_ap_zero _ _ Hr) [*]z[*]AbsIR (a n) [*] AbsIR ((x[-]x0) [^]n)). + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + rstepr ((One[/] r[//]pos_ap_zero _ _ Hr) [*]AbsIR (a n) [*]z). + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + apply HN; assumption. + apply Hz; auto. + rstepl ((One[/] r[//]pos_ap_zero _ _ Hr) [*]z[*](AbsIR (a n) [*]AbsIR ((x[-]x0) [^]n))). + apply mult_wdr. + astepr (AbsIR (FPowerSeries n x (ProjIR1 Hx))). + simpl in |- *; apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + simpl in |- *. + apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + apply AbsIR_resp_mult. + apply eq_transitive_unfolded with (AbsIR (a (S n)) [*](AbsIR ((x[-]x0) [^]n) [*]AbsIR (x[-]x0))). + apply mult_wdr; apply AbsIR_resp_mult. + simpl in |- *; rational. + clear HN. + cut ((forall x : IR, Compact Hab x -> a0 [<=] x) /\ + (forall x : IR, Compact Hab x -> x [<=] b)); intros. + inversion_clear H. + exists (Max (Max (b[-]x0) (x0[-]a0)) (r [/]TwoNZ)). + repeat split. + eapply less_leEq_trans. + 2: apply rht_leEq_Max. + apply pos_div_two; auto. + repeat apply Max_less. + apply shift_minus_less'. + elim (Hinc _ (compact_inc_rht _ _ Hab)); auto. + apply shift_minus_less; apply shift_less_plus'; elim (Hinc _ (compact_inc_lft _ _ Hab)); auto. + apply pos_div_two'; auto. + intros. + simpl in |- *; unfold ABSIR in |- *; apply Max_leEq. + apply leEq_transitive with (b[-]x0). + apply minus_resp_leEq; apply H1; auto. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply lft_leEq_Max. + apply leEq_transitive with (x0[-]a0). + rstepr ([--](a0[-]x0)); apply inv_resp_leEq. + apply minus_resp_leEq; apply H0; auto. + eapply leEq_transitive. + 2: apply lft_leEq_Max. + apply rht_leEq_Max. + split; intros x H; elim H; auto. Qed. (** @@ -175,12 +165,14 @@ This function is also continuous and has a good convergence ratio. *) Lemma FPowerSeries'_cont : forall n, Continuous realline (FPowerSeries' n). -intros; unfold FPowerSeries' in |- *. -Contin. +Proof. + intros; unfold FPowerSeries' in |- *. + Contin. Qed. Lemma included_FPowerSeries' : forall n P, included P (Dom (FPowerSeries' n)). -repeat split. +Proof. + repeat split. Qed. (* begin show *) @@ -189,131 +181,117 @@ Hypothesis Ha' : {N : nat | {c : IR | Zero [<] c | (* end show *) Lemma FPowerSeries'_conv' : fun_series_abs_convergent_IR realline FPowerSeries'. -clear Hr r Ha. -red in |- *; intros. -red in |- *; intros. -apply fun_ratio_test_conv. -intro. -unfold FPowerSeries' in |- *; Contin. -elim Ha'; intros N HN. -elim HN; intros c H H0. -clear HN Ha'. -elim (Archimedes (Max (Max b x0[-]Min a0 x0) One[*]Two[*]c)); intros y Hy. -exists (max N y); exists (Half:IR); repeat split. -unfold Half in |- *. -apply pos_div_two'; apply pos_one. -apply less_leEq; apply pos_half. -intros x H1; intros. -astepl (AbsIR (FPowerSeries' (S n) x (ProjIR1 Hx'))). -astepr (Half[*]AbsIR (FPowerSeries' n x (ProjIR1 Hx))). -simpl in |- *. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply - leEq_wdl - with - ((AbsIR (a (S n)) [/] _[//]nring_fac_ap_zero _ (S n)) [*] - (AbsIR ((x[-]x0) [^]n) [*]AbsIR (x[-]x0))). -2: apply mult_wd. -2: apply - eq_transitive_unfolded - with - (AbsIR (a (S n)) [/] _[//] - AbsIR_resp_ap_zero _ (nring_fac_ap_zero _ (S n))). -3: apply eq_symmetric_unfolded; apply AbsIR_division. -2: apply div_wd; algebra. -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x; apply nring_nonneg. -2: apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -2: apply AbsIR_resp_mult. -2: apply mult_wd; apply AbsIR_wd; simpl in |- *; algebra. -apply - leEq_wdr - with - (One [/]TwoNZ[*](AbsIR (a n) [/] _[//]nring_fac_ap_zero _ n) [*] - AbsIR ((x[-]x0) [^]n)). -2: apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. -3: apply mult_assoc_unfolded. -2: apply mult_wdr. -2: eapply eq_transitive_unfolded. -2: apply AbsIR_resp_mult. -2: apply mult_wdl; simpl in |- *; algebra. -2: apply - eq_transitive_unfolded - with (AbsIR (a n) [/] _[//]AbsIR_resp_ap_zero _ (nring_fac_ap_zero _ n)). -2: apply AbsIR_division. -2: apply div_wd; algebra. -2: apply AbsIR_eq_x; apply nring_nonneg. -rstepl - (AbsIR (a (S n)) [*]AbsIR (x[-]x0) [*]AbsIR ((x[-]x0) [^]n) [/] _[//] - nring_fac_ap_zero _ (S n)). -apply shift_div_leEq. -apply pos_nring_fac. -rstepr - (One [/]TwoNZ[*] - (AbsIR (a n) [*]nring (fac (S n)) [/] _[//]nring_fac_ap_zero _ n) [*] - AbsIR ((x[-]x0) [^]n)). -apply - leEq_wdr - with (One [/]TwoNZ[*](AbsIR (a n) [*]nring (S n)) [*]AbsIR ((x[-]x0) [^]n)). -2: apply mult_wdl; apply mult_wdr. -2: rstepr (AbsIR (a n) [*](nring (fac (S n)) [/] _[//]nring_fac_ap_zero _ n)). -2: apply mult_wdr. -2: astepr (nring (S n * fac n) [/] _[//]nring_fac_ap_zero IR n). -2: astepr (nring (S n) [*]nring (fac n) [/] _[//]nring_fac_ap_zero IR n); - rational. -rstepr (One [/]TwoNZ[*]nring (S n) [*]AbsIR (a n) [*]AbsIR ((x[-]x0) [^]n)). -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -apply leEq_transitive with (AbsIR (a (S n)) [*]AbsIR (Max b x0[-]Min a0 x0)). -apply mult_resp_leEq_lft. -cut (Min a0 x0 [<=] Max b x0). intro H3. -apply compact_elements with H3. -inversion_clear H1; split. -apply leEq_transitive with a0; auto; apply Min_leEq_lft. -apply leEq_transitive with b; auto; apply lft_leEq_Max. -split. -apply Min_leEq_rht. -apply rht_leEq_Max. -apply leEq_transitive with x0. -apply Min_leEq_rht. -apply rht_leEq_Max. -apply AbsIR_nonneg. -apply leEq_transitive with (AbsIR (a (S n)) [*]Max (Max b x0[-]Min a0 x0) One). -apply mult_resp_leEq_lft. -2: apply AbsIR_nonneg. -eapply leEq_wdl. -apply lft_leEq_Max. -apply eq_symmetric_unfolded; apply AbsIR_eq_x. -apply shift_leEq_minus; astepl (Min a0 x0). -apply leEq_transitive with x0. -apply Min_leEq_rht. -apply rht_leEq_Max. -apply shift_mult_leEq with (max_one_ap_zero (Max b x0[-]Min a0 x0)). -apply pos_max_one. -apply leEq_transitive with (c[*]AbsIR (a n)). -apply H0. -apply le_trans with (max N y); auto; apply le_max_l. -apply shift_leEq_div. -apply pos_max_one. -rstepl (c[*]Max (Max b x0[-]Min a0 x0) One[*]AbsIR (a n)). -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -rstepr (nring (R:=IR) (S n) [/]TwoNZ); apply shift_leEq_div. -apply pos_two. -apply less_leEq; apply leEq_less_trans with (nring (R:=IR) y). -eapply leEq_wdl. -apply Hy. -rational. -apply nring_less. -red in |- *. -cut (y <= n); intros; auto with arith. -apply le_trans with (max N y); auto with arith. +Proof. + clear Hr r Ha. + red in |- *; intros. + red in |- *; intros. + apply fun_ratio_test_conv. + intro. + unfold FPowerSeries' in |- *; Contin. + elim Ha'; intros N HN. + elim HN; intros c H H0. + clear HN Ha'. + elim (Archimedes (Max (Max b x0[-]Min a0 x0) One[*]Two[*]c)); intros y Hy. + exists (max N y); exists (Half:IR); repeat split. + unfold Half in |- *. + apply pos_div_two'; apply pos_one. + apply less_leEq; apply pos_half. + intros x H1; intros. + astepl (AbsIR (FPowerSeries' (S n) x (ProjIR1 Hx'))). + astepr (Half[*]AbsIR (FPowerSeries' n x (ProjIR1 Hx))). + simpl in |- *. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply leEq_wdl with ((AbsIR (a (S n)) [/] _[//]nring_fac_ap_zero _ (S n)) [*] + (AbsIR ((x[-]x0) [^]n) [*]AbsIR (x[-]x0))). + 2: apply mult_wd. + 2: apply eq_transitive_unfolded with (AbsIR (a (S n)) [/] _[//] + AbsIR_resp_ap_zero _ (nring_fac_ap_zero _ (S n))). + 3: apply eq_symmetric_unfolded; apply AbsIR_division. + 2: apply div_wd; algebra. + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x; apply nring_nonneg. + 2: apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 2: apply AbsIR_resp_mult. + 2: apply mult_wd; apply AbsIR_wd; simpl in |- *; algebra. + apply leEq_wdr with (One [/]TwoNZ[*](AbsIR (a n) [/] _[//]nring_fac_ap_zero _ n) [*] + AbsIR ((x[-]x0) [^]n)). + 2: apply eq_symmetric_unfolded; eapply eq_transitive_unfolded. + 3: apply mult_assoc_unfolded. + 2: apply mult_wdr. + 2: eapply eq_transitive_unfolded. + 2: apply AbsIR_resp_mult. + 2: apply mult_wdl; simpl in |- *; algebra. + 2: apply eq_transitive_unfolded + with (AbsIR (a n) [/] _[//]AbsIR_resp_ap_zero _ (nring_fac_ap_zero _ n)). + 2: apply AbsIR_division. + 2: apply div_wd; algebra. + 2: apply AbsIR_eq_x; apply nring_nonneg. + rstepl (AbsIR (a (S n)) [*]AbsIR (x[-]x0) [*]AbsIR ((x[-]x0) [^]n) [/] _[//] + nring_fac_ap_zero _ (S n)). + apply shift_div_leEq. + apply pos_nring_fac. + rstepr (One [/]TwoNZ[*] (AbsIR (a n) [*]nring (fac (S n)) [/] _[//]nring_fac_ap_zero _ n) [*] + AbsIR ((x[-]x0) [^]n)). + apply leEq_wdr with (One [/]TwoNZ[*](AbsIR (a n) [*]nring (S n)) [*]AbsIR ((x[-]x0) [^]n)). + 2: apply mult_wdl; apply mult_wdr. + 2: rstepr (AbsIR (a n) [*](nring (fac (S n)) [/] _[//]nring_fac_ap_zero _ n)). + 2: apply mult_wdr. + 2: astepr (nring (S n * fac n) [/] _[//]nring_fac_ap_zero IR n). + 2: astepr (nring (S n) [*]nring (fac n) [/] _[//]nring_fac_ap_zero IR n); rational. + rstepr (One [/]TwoNZ[*]nring (S n) [*]AbsIR (a n) [*]AbsIR ((x[-]x0) [^]n)). + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + apply leEq_transitive with (AbsIR (a (S n)) [*]AbsIR (Max b x0[-]Min a0 x0)). + apply mult_resp_leEq_lft. + cut (Min a0 x0 [<=] Max b x0). intro H3. + apply compact_elements with H3. + inversion_clear H1; split. + apply leEq_transitive with a0; auto; apply Min_leEq_lft. + apply leEq_transitive with b; auto; apply lft_leEq_Max. + split. + apply Min_leEq_rht. + apply rht_leEq_Max. + apply leEq_transitive with x0. + apply Min_leEq_rht. + apply rht_leEq_Max. + apply AbsIR_nonneg. + apply leEq_transitive with (AbsIR (a (S n)) [*]Max (Max b x0[-]Min a0 x0) One). + apply mult_resp_leEq_lft. + 2: apply AbsIR_nonneg. + eapply leEq_wdl. + apply lft_leEq_Max. + apply eq_symmetric_unfolded; apply AbsIR_eq_x. + apply shift_leEq_minus; astepl (Min a0 x0). + apply leEq_transitive with x0. + apply Min_leEq_rht. + apply rht_leEq_Max. + apply shift_mult_leEq with (max_one_ap_zero (Max b x0[-]Min a0 x0)). + apply pos_max_one. + apply leEq_transitive with (c[*]AbsIR (a n)). + apply H0. + apply le_trans with (max N y); auto; apply le_max_l. + apply shift_leEq_div. + apply pos_max_one. + rstepl (c[*]Max (Max b x0[-]Min a0 x0) One[*]AbsIR (a n)). + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + rstepr (nring (R:=IR) (S n) [/]TwoNZ); apply shift_leEq_div. + apply pos_two. + apply less_leEq; apply leEq_less_trans with (nring (R:=IR) y). + eapply leEq_wdl. + apply Hy. + rational. + apply nring_less. + red in |- *. + cut (y <= n); intros; auto with arith. + apply le_trans with (max N y); auto with arith. Qed. Lemma FPowerSeries'_conv : fun_series_convergent_IR realline FPowerSeries'. -apply abs_imp_conv_IR. -apply FPowerSeries'_cont. -apply FPowerSeries'_conv'. +Proof. + apply abs_imp_conv_IR. + apply FPowerSeries'_cont. + apply FPowerSeries'_conv'. Qed. End Power_Series. @@ -348,69 +326,64 @@ Hypothesis Hg : fun_series_convergent_IR J G. Lemma FPowerSeries'_comp : forall b, (forall n, AbsIR (b n) [<=] a n) -> fun_series_convergent_IR J (FPowerSeries' x0 b). -intros. -apply fun_comparison_IR with (fun n : nat => FAbs (FPowerSeries' x0 a n)). -intros n. -apply Included_imp_Continuous with realline;[Contin | auto with *]. -auto. -intros. -apply leEq_wdr with (AbsIR (FPowerSeries' x0 a n x (ProjIR1 Hx'))). -2: apply eq_symmetric_unfolded; apply FAbs_char. -simpl in |- *. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; - apply - AbsIR_division - with (y__ := AbsIR_resp_ap_zero _ (nring_fac_ap_zero IR n)). -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; - apply - AbsIR_division - with (y__ := AbsIR_resp_ap_zero _ (nring_fac_ap_zero IR n)). -apply div_resp_leEq. -eapply less_leEq_trans. -apply (pos_nring_fac IR n). -apply leEq_AbsIR. -apply leEq_transitive with (a n); [ auto | apply leEq_AbsIR ]. +Proof. + intros. + apply fun_comparison_IR with (fun n : nat => FAbs (FPowerSeries' x0 a n)). + intros n. + apply Included_imp_Continuous with realline;[Contin | auto with *]. + auto. + intros. + apply leEq_wdr with (AbsIR (FPowerSeries' x0 a n x (ProjIR1 Hx'))). + 2: apply eq_symmetric_unfolded; apply FAbs_char. + simpl in |- *. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_division + with (y__ := AbsIR_resp_ap_zero _ (nring_fac_ap_zero IR n)). + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_division + with (y__ := AbsIR_resp_ap_zero _ (nring_fac_ap_zero IR n)). + apply div_resp_leEq. + eapply less_leEq_trans. + apply (pos_nring_fac IR n). + apply leEq_AbsIR. + apply leEq_transitive with (a n); [ auto | apply leEq_AbsIR ]. Qed. (** And a rule for differentiation. *) Lemma Derivative_FPowerSeries1' : forall H, Derivative J H (FSeries_Sum Hf) (FSeries_Sum Hg). -intro. -eapply Derivative_wdr. -apply Feq_symmetric; apply (insert_series_sum _ _ Hg). -apply Derivative_FSeries. -intro; case n; clear n; intros. -simpl in |- *. -apply Derivative_wdl with (Fconst (S:=IR) (a 0)). -FEQ. -Deriv. -simpl in |- *. -Opaque nring fac. -unfold F, G, FPowerSeries' in |- *; simpl in |- *. -Derivative_Help. -apply eq_imp_Feq. -apply included_FScalMult; apply included_FScalMult. -apply included_FMult; Included. -apply included_FScalMult; Included. -intros; simpl in |- *. -set (y := nexp _ n (x[-]x0)) in *. -rstepl (a (S n) [*]y[*](nring (S n) [/] _[//]nring_fac_ap_zero _ (S n))). -rstepr - (a (S n) [*]y[*] - (nring (S n) [/] _[//] - mult_resp_ap_zero _ _ _ (pos_ap_zero _ _ (pos_nring_S _ n)) - (nring_fac_ap_zero _ n))). -apply mult_wdr. -apply div_wd; algebra. -Step_final (nring (R:=IR) (S n * fac n)). +Proof. + intro. + eapply Derivative_wdr. + apply Feq_symmetric; apply (insert_series_sum _ _ Hg). + apply Derivative_FSeries. + intro; case n; clear n; intros. + simpl in |- *. + apply Derivative_wdl with (Fconst (S:=IR) (a 0)). + FEQ. + Deriv. + simpl in |- *. + Opaque nring fac. + unfold F, G, FPowerSeries' in |- *; simpl in |- *. + Derivative_Help. + apply eq_imp_Feq. + apply included_FScalMult; apply included_FScalMult. + apply included_FMult; Included. + apply included_FScalMult; Included. + intros; simpl in |- *. + set (y := nexp _ n (x[-]x0)) in *. + rstepl (a (S n) [*]y[*](nring (S n) [/] _[//]nring_fac_ap_zero _ (S n))). + rstepr (a (S n) [*]y[*] (nring (S n) [/] _[//] + mult_resp_ap_zero _ _ _ (pos_ap_zero _ _ (pos_nring_S _ n)) (nring_fac_ap_zero _ n))). + apply mult_wdr. + apply div_wd; algebra. + Step_final (nring (R:=IR) (S n * fac n)). Qed. End More_on_PowerSeries. @@ -428,75 +401,77 @@ quotient of sine over cosine. Definition Exp_ps := FPowerSeries' Zero (fun n : nat => One). Definition sin_seq : nat -> IR. -intro n; elim (even_or_odd_plus n); intros k Hk; inversion_clear Hk. -apply ZeroR. -apply ([--]OneR[^]k). +Proof. + intro n; elim (even_or_odd_plus n); intros k Hk; inversion_clear Hk. + apply ZeroR. + apply ([--]OneR[^]k). Defined. Definition sin_ps := FPowerSeries' Zero sin_seq. Definition cos_seq : nat -> IR. -intro n; elim (even_or_odd_plus n); intros k Hk; inversion_clear Hk. -apply ([--]OneR[^]k). -apply ZeroR. +Proof. + intro n; elim (even_or_odd_plus n); intros k Hk; inversion_clear Hk. + apply ([--]OneR[^]k). + apply ZeroR. Defined. Definition cos_ps := FPowerSeries' Zero cos_seq. Lemma Exp_conv' : fun_series_abs_convergent_IR realline Exp_ps. -unfold Exp_ps in |- *. -apply FPowerSeries'_conv'. -exists 0; exists OneR. -apply pos_one. -intros; apply eq_imp_leEq; algebra. +Proof. + unfold Exp_ps in |- *. + apply FPowerSeries'_conv'. + exists 0; exists OneR. + apply pos_one. + intros; apply eq_imp_leEq; algebra. Qed. Lemma Exp_conv : fun_series_convergent_IR realline Exp_ps. -unfold Exp_ps in |- *. -apply FPowerSeries'_conv. -exists 0; exists OneR. -apply pos_one. -intros; apply eq_imp_leEq; algebra. +Proof. + unfold Exp_ps in |- *. + apply FPowerSeries'_conv. + exists 0; exists OneR. + apply pos_one. + intros; apply eq_imp_leEq; algebra. Qed. Lemma sin_conv : fun_series_convergent_IR realline sin_ps. -unfold sin_ps in |- *; apply FPowerSeries'_comp with (fun n : nat => OneR). -apply Exp_conv'. -intros; unfold sin_seq in |- *. -elim even_or_odd_plus; intros k Hk; simpl in |- *. -elim Hk; simpl in |- *; intro. -eapply leEq_wdl; - [ apply less_leEq; apply pos_one - | apply eq_symmetric_unfolded; apply AbsIRz_isz ]. -apply eq_imp_leEq. -elim (even_odd_dec k); intro. -apply eq_transitive_unfolded with (AbsIR One). -apply AbsIR_wd; astepl ([--]OneR[^]k); apply inv_one_even_nexp; auto. -apply AbsIR_eq_x; apply less_leEq; apply pos_one. -apply eq_transitive_unfolded with (AbsIR [--]One). -apply AbsIR_wd; astepl ([--]OneR[^]k); apply inv_one_odd_nexp; auto. -astepr ([--][--]OneR); apply AbsIR_eq_inv_x; apply less_leEq. -astepr ([--]ZeroR); apply inv_resp_less; apply pos_one. +Proof. + unfold sin_ps in |- *; apply FPowerSeries'_comp with (fun n : nat => OneR). + apply Exp_conv'. + intros; unfold sin_seq in |- *. + elim even_or_odd_plus; intros k Hk; simpl in |- *. + elim Hk; simpl in |- *; intro. + eapply leEq_wdl; [ apply less_leEq; apply pos_one | apply eq_symmetric_unfolded; apply AbsIRz_isz ]. + apply eq_imp_leEq. + elim (even_odd_dec k); intro. + apply eq_transitive_unfolded with (AbsIR One). + apply AbsIR_wd; astepl ([--]OneR[^]k); apply inv_one_even_nexp; auto. + apply AbsIR_eq_x; apply less_leEq; apply pos_one. + apply eq_transitive_unfolded with (AbsIR [--]One). + apply AbsIR_wd; astepl ([--]OneR[^]k); apply inv_one_odd_nexp; auto. + astepr ([--][--]OneR); apply AbsIR_eq_inv_x; apply less_leEq. + astepr ([--]ZeroR); apply inv_resp_less; apply pos_one. Qed. Lemma cos_conv : fun_series_convergent_IR realline cos_ps. -unfold cos_ps in |- *; apply FPowerSeries'_comp with (fun n : nat => OneR). -apply Exp_conv'. -intros; unfold cos_seq in |- *. -elim even_or_odd_plus; intros k Hk; simpl in |- *. -elim Hk; simpl in |- *; intro. -apply eq_imp_leEq. -elim (even_odd_dec k); intro. -apply eq_transitive_unfolded with (AbsIR One). -apply AbsIR_wd; astepl ([--]OneR[^]k); apply inv_one_even_nexp; auto. -apply AbsIR_eq_x; apply less_leEq; apply pos_one. -apply eq_transitive_unfolded with (AbsIR [--]One). -apply AbsIR_wd; astepl ([--]OneR[^]k); apply inv_one_odd_nexp; auto. -astepr ([--][--]OneR); apply AbsIR_eq_inv_x; apply less_leEq. -astepr ([--]ZeroR); apply inv_resp_less; apply pos_one. -eapply leEq_wdl; - [ apply less_leEq; apply pos_one - | apply eq_symmetric_unfolded; apply AbsIRz_isz ]. +Proof. + unfold cos_ps in |- *; apply FPowerSeries'_comp with (fun n : nat => OneR). + apply Exp_conv'. + intros; unfold cos_seq in |- *. + elim even_or_odd_plus; intros k Hk; simpl in |- *. + elim Hk; simpl in |- *; intro. + apply eq_imp_leEq. + elim (even_odd_dec k); intro. + apply eq_transitive_unfolded with (AbsIR One). + apply AbsIR_wd; astepl ([--]OneR[^]k); apply inv_one_even_nexp; auto. + apply AbsIR_eq_x; apply less_leEq; apply pos_one. + apply eq_transitive_unfolded with (AbsIR [--]One). + apply AbsIR_wd; astepl ([--]OneR[^]k); apply inv_one_odd_nexp; auto. + astepr ([--][--]OneR); apply AbsIR_eq_inv_x; apply less_leEq. + astepr ([--]ZeroR); apply inv_resp_less; apply pos_one. + eapply leEq_wdl; [ apply less_leEq; apply pos_one | apply eq_symmetric_unfolded; apply AbsIRz_isz ]. Qed. Definition Expon := FSeries_Sum Exp_conv. @@ -512,27 +487,33 @@ Some auxiliary domain results. *) Lemma Exp_domain : forall x : IR, Dom Expon x. -intros; simpl in |- *; auto. +Proof. + intros; simpl in |- *; auto. Qed. Lemma sin_domain : forall x : IR, Dom Sine x. -intros; simpl in |- *; auto. +Proof. + intros; simpl in |- *; auto. Qed. Lemma cos_domain : forall x : IR, Dom Cosine x. -intros; simpl in |- *; auto. +Proof. + intros; simpl in |- *; auto. Qed. Lemma included_Exp : forall P, included P (Dom Expon). -intro; simpl in |- *; Included. +Proof. + intro; simpl in |- *; Included. Qed. Lemma included_Sin : forall P, included P (Dom Sine). -intro; simpl in |- *; Included. +Proof. + intro; simpl in |- *; Included. Qed. Lemma included_Cos : forall P, included P (Dom Cosine). -intro; simpl in |- *; Included. +Proof. + intro; simpl in |- *; Included. Qed. (** @@ -540,18 +521,19 @@ Definition of the logarithm. *) Lemma log_defn_lemma : Continuous (openl Zero) {1/}FId. -apply Continuous_recip. -apply Continuous_id. -intros a b Hab H. -split. -Included. -assert (H0 : Zero [<] a). apply H; apply compact_inc_lft. -exists a. -auto. -intros y Hy H1; inversion_clear H1. -apply leEq_transitive with y. -auto. -apply leEq_AbsIR. +Proof. + apply Continuous_recip. + apply Continuous_id. + intros a b Hab H. + split. + Included. + assert (H0 : Zero [<] a). apply H; apply compact_inc_lft. + exists a. + auto. + intros y Hy H1; inversion_clear H1. + apply leEq_transitive with y. + auto. + apply leEq_AbsIR. Qed. Definition Logarithm := ( [-S-]log_defn_lemma) One (pos_one IR). @@ -565,24 +547,27 @@ As most of these functions are total, it makes sense to treat them as setoid fun *) Definition Exp : CSetoid_un_op IR. -red in |- *. -apply Build_CSetoid_fun with (fun x : IR => Expon x CI). -intros x y H. -exact (pfstrx _ _ _ _ _ _ H). +Proof. + red in |- *. + apply Build_CSetoid_fun with (fun x : IR => Expon x CI). + intros x y H. + exact (pfstrx _ _ _ _ _ _ H). Defined. Definition Sin : CSetoid_un_op IR. -red in |- *. -apply Build_CSetoid_fun with (fun x : IR => Sine x CI). -intros x y H. -exact (pfstrx _ _ _ _ _ _ H). +Proof. + red in |- *. + apply Build_CSetoid_fun with (fun x : IR => Sine x CI). + intros x y H. + exact (pfstrx _ _ _ _ _ _ H). Defined. Definition Cos : CSetoid_un_op IR. -red in |- *. -apply Build_CSetoid_fun with (fun x : IR => Cosine x CI). -intros x y H. -exact (pfstrx _ _ _ _ _ _ H). +Proof. + red in |- *. + apply Build_CSetoid_fun with (fun x : IR => Cosine x CI). + intros x y H. + exact (pfstrx _ _ _ _ _ _ H). Defined. Definition Log x (Hx : Zero [<] x) := Logarithm x Hx. diff --git a/transc/RealPowers.v b/transc/RealPowers.v index cdf021970..1f772fc50 100644 --- a/transc/RealPowers.v +++ b/transc/RealPowers.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) (** printing [!] %\ensuremath{\hat{\ }}% #^# *) (** printing {!} %\ensuremath{\hat{\ }}% #^# *) @@ -63,73 +63,81 @@ coincides with the exponential function. *) Lemma power_wd : forall x x' y y' Hx Hx', x [=] x' -> y [=] y' -> x[!]y[//]Hx [=] x'[!]y'[//]Hx'. -intros. -unfold power in |- *; algebra. +Proof. + intros. + unfold power in |- *; algebra. Qed. Lemma power_strext : forall x x' y y' Hx Hx', x[!]y[//]Hx [#] x'[!]y'[//]Hx' -> x [#] x' or y [#] y'. -intros. -cut (Log x Hx [#] Log x' Hx' or y [#] y'). intro H0. -elim H0; intro H1; [ left | right ]; auto; exact (Log_strext _ _ _ _ H1). -apply bin_op_strext_unfolded with (cr_mult (c:=IR)). -astepl (y[*]Log x Hx); astepr (y'[*]Log x' Hx'). -apply Exp_strext; auto. +Proof. + intros. + cut (Log x Hx [#] Log x' Hx' or y [#] y'). intro H0. + elim H0; intro H1; [ left | right ]; auto; exact (Log_strext _ _ _ _ H1). + apply bin_op_strext_unfolded with (cr_mult (c:=IR)). + astepl (y[*]Log x Hx); astepr (y'[*]Log x' Hx'). + apply Exp_strext; auto. Qed. Lemma power_plus : forall x y z Hx, x[!]y[+]z[//]Hx [=] x[!]y[//]Hx[*]x[!]z[//]Hx. -intros. -unfold power in |- *. -Step_final (Exp (y[*]Log x Hx[+]z[*]Log x Hx)). +Proof. + intros. + unfold power in |- *. + Step_final (Exp (y[*]Log x Hx[+]z[*]Log x Hx)). Qed. Lemma power_inv : forall x y Hx Hxy, x[!] [--]y[//]Hx [=] (One[/] x[!]y[//]Hx[//]Hxy). -intros; unfold power in |- *. -rstepr (One[/] _[//]Exp_ap_zero (y[*]Log x Hx)). -Step_final (Exp [--] (y[*]Log x Hx)). +Proof. + intros; unfold power in |- *. + rstepr (One[/] _[//]Exp_ap_zero (y[*]Log x Hx)). + Step_final (Exp [--] (y[*]Log x Hx)). Qed. Hint Resolve power_wd power_plus power_inv: algebra. Lemma power_minus : forall x y z Hx Hxz, x[!]y[-]z[//]Hx [=] (x[!]y[//]Hx[/] x[!]z[//]Hx[//]Hxz). -intros. -unfold cg_minus in |- *. -astepl (x[!]y[//]Hx[*]x[!][--]z[//]Hx). -rstepr (x[!]y[//]Hx[*] (One[/] _[//]Hxz)). -algebra. +Proof. + intros. + unfold cg_minus in |- *. + astepl (x[!]y[//]Hx[*]x[!][--]z[//]Hx). + rstepr (x[!]y[//]Hx[*] (One[/] _[//]Hxz)). + algebra. Qed. Lemma power_nat : forall x n Hx, x[!]nring n[//]Hx [=] x[^]n. -intros; unfold power in |- *. -induction n as [| n Hrecn]. -simpl in |- *; astepr (Exp Zero); simpl in |- *; algebra. -simpl in |- *. -astepr (Exp (nring n[*]Log x Hx) [*]Exp (Log x Hx)). -astepr (Exp (nring n[*]Log x Hx[+]Log x Hx)). -simpl in |- *; rational. +Proof. + intros; unfold power in |- *. + induction n as [| n Hrecn]. + simpl in |- *; astepr (Exp Zero); simpl in |- *; algebra. + simpl in |- *. + astepr (Exp (nring n[*]Log x Hx) [*]Exp (Log x Hx)). + astepr (Exp (nring n[*]Log x Hx[+]Log x Hx)). + simpl in |- *; rational. Qed. Hint Resolve power_minus power_nat: algebra. Lemma power_zero : forall (x : IR) Hx, x[!]Zero[//]Hx [=] One. -intros. -astepl (x[!]nring 0[//]Hx). -Step_final (x[^]0). +Proof. + intros. + astepl (x[!]nring 0[//]Hx). + Step_final (x[^]0). Qed. Lemma power_one : forall (x : IR) Hx, x[!]One[//]Hx [=] x. -intros. -astepr (x[^]1). -astepr (x[!]nring 1[//]Hx). -simpl in |- *; algebra. +Proof. + intros. + astepr (x[^]1). + astepr (x[!]nring 1[//]Hx). + simpl in |- *; algebra. Qed. Lemma one_power : forall (x : IR) H, One[!]x[//]H [=] One. Proof. -intros x H. -unfold power. -astepl (Exp (x[*]Zero)). -rstepl (Exp (Zero)). -algebra. + intros x H. + unfold power. + astepl (Exp (x[*]Zero)). + rstepl (Exp (Zero)). + algebra. Qed. Hint Resolve power_zero power_one one_power: algebra. @@ -137,94 +145,101 @@ Hint Resolve power_zero power_one one_power: algebra. Opaque nexp_op. Lemma power_int : forall x z Hx Hx', x[!]zring z[//]Hx [=] (x[//]Hx') [^^] (z). -intros; induction z as [| p| p]. -simpl in |- *. -Step_final (x[!]Zero[//]Hx). -simpl in |- *. -Step_final (x[!]nring (nat_of_P p) [//]Hx). -simpl in |- *. -astepl (x[!][--] (nring (nat_of_P p)) [//]Hx). -astepl (One[/] x[!]nring (nat_of_P p) [//]Hx[//]Exp_ap_zero _). -Step_final (One[/] x[^]nat_of_P p[//]nexp_resp_ap_zero _ Hx'). +Proof. + intros; induction z as [| p| p]. + simpl in |- *. + Step_final (x[!]Zero[//]Hx). + simpl in |- *. + Step_final (x[!]nring (nat_of_P p) [//]Hx). + simpl in |- *. + astepl (x[!][--] (nring (nat_of_P p)) [//]Hx). + astepl (One[/] x[!]nring (nat_of_P p) [//]Hx[//]Exp_ap_zero _). + Step_final (One[/] x[^]nat_of_P p[//]nexp_resp_ap_zero _ Hx'). Qed. Hint Resolve power_int: algebra. Lemma Exp_power : forall (x : IR) He, E[!]x[//]He [=] Exp x. -intros; unfold power in |- *. -Step_final (Exp (x[*]One)). +Proof. + intros; unfold power in |- *. + Step_final (Exp (x[*]One)). Qed. Lemma mult_power : forall x y z Hx Hy Hxy, (x[*]y) [!]z[//]Hxy [=] x[!]z[//]Hx[*]y[!]z[//]Hy. -intros; unfold power in |- *. -astepr (Exp (z[*]Log _ Hx[+]z[*]Log _ Hy)). -Step_final (Exp (z[*] (Log _ Hx[+]Log _ Hy))). +Proof. + intros; unfold power in |- *. + astepr (Exp (z[*]Log _ Hx[+]z[*]Log _ Hy)). + Step_final (Exp (z[*] (Log _ Hx[+]Log _ Hy))). Qed. Lemma recip_power : forall x y Hx Hx' Hx'' Hxy, (One[/] x[//]Hx') [!]y[//]Hx'' [=] (One[/] x[!]y[//]Hx[//]Hxy). -intros; unfold power in |- *. -rstepr (One[/] _[//]Exp_ap_zero (y[*]Log x Hx)). -astepr (Exp [--] (y[*]Log _ Hx)). -Step_final (Exp (y[*][--] (Log _ Hx))). +Proof. + intros; unfold power in |- *. + rstepr (One[/] _[//]Exp_ap_zero (y[*]Log x Hx)). + astepr (Exp [--] (y[*]Log _ Hx)). + Step_final (Exp (y[*][--] (Log _ Hx))). Qed. Hint Resolve Exp_power mult_power recip_power: algebra. Lemma div_power : forall x y z Hx Hy Hy' Hxy Hyz, (x[/] y[//]Hy') [!]z[//]Hxy [=] (x[!]z[//]Hx[/] y[!]z[//]Hy[//]Hyz). -intros. -apply - eq_transitive_unfolded - with - ((x[*] (One[/] _[//]Hy')) [!]z[//] - mult_resp_pos _ _ _ Hx (recip_resp_pos _ _ Hy' Hy)). -apply power_wd; rational. -rstepr (x[!]z[//]Hx[*] (One[/] _[//]Hyz)). -Step_final (x[!]z[//]Hx[*]_[!]z[//]recip_resp_pos _ _ Hy' Hy). +Proof. + intros. + apply eq_transitive_unfolded with ((x[*] (One[/] _[//]Hy')) [!]z[//] + mult_resp_pos _ _ _ Hx (recip_resp_pos _ _ Hy' Hy)). + apply power_wd; rational. + rstepr (x[!]z[//]Hx[*] (One[/] _[//]Hyz)). + Step_final (x[!]z[//]Hx[*]_[!]z[//]recip_resp_pos _ _ Hy' Hy). Qed. Hint Resolve div_power: algebra. Lemma power_ap_zero : forall (x y : IR) Hx, x[!]y[//]Hx [#] Zero. -intros; unfold power in |- *. -apply Exp_ap_zero. +Proof. + intros; unfold power in |- *. + apply Exp_ap_zero. Qed. Lemma power_mult : forall x y z Hx Hxy, x[!]y[*]z[//]Hx [=] (x[!]y[//]Hx) [!]z[//]Hxy. -intros; unfold power in |- *. -apply Exp_wd. -astepl (z[*]y[*]Log x Hx). -astepl (z[*] (y[*]Log x Hx)). -algebra. +Proof. + intros; unfold power in |- *. + apply Exp_wd. + astepl (z[*]y[*]Log x Hx). + astepl (z[*] (y[*]Log x Hx)). + algebra. Qed. Lemma power_pos : forall (x y : IR) Hx, Zero [<] x[!]y[//]Hx. -intros; unfold power in |- *. -apply Exp_pos. +Proof. + intros; unfold power in |- *. + apply Exp_pos. Qed. Hint Resolve power_mult: algebra. Lemma power_recip : forall x q Hx (Hx' : Zero [<=] x) Hq (Hq' : 0 < q), x[!]One[/] nring q[//]Hq[//]Hx [=] NRoot Hx' Hq'. -intros. -apply NRoot_unique. -apply less_leEq; apply power_pos. -apply power_pos. -astepr (x[!]One[//]Hx). -astepl (_[!]nring q[//]power_pos _ (One[/] _[//]Hq) Hx). -Step_final (x[!] (One[/] _[//]Hq) [*]nring q[//]Hx). +Proof. + intros. + apply NRoot_unique. + apply less_leEq; apply power_pos. + apply power_pos. + astepr (x[!]One[//]Hx). + astepl (_[!]nring q[//]power_pos _ (One[/] _[//]Hq) Hx). + Step_final (x[!] (One[/] _[//]Hq) [*]nring q[//]Hx). Qed. Hint Resolve power_recip: algebra. Lemma power_div : forall x p q Hx (Hx' : Zero [<=] x) Hq (Hq' : 0 < q), x[!]nring p[/] nring q[//]Hq[//]Hx [=] (NRoot Hx' Hq') [^]p. -intros. -apply eq_transitive_unfolded with (x[!] (One[/] _[//]Hq) [*]nring p[//]Hx). -apply power_wd; rational. -astepr (NRoot Hx' Hq'[!]nring p[//]NRoot_pos _ Hx' _ Hq' Hx). -Step_final ((x[!]One[/] _[//]Hq[//]Hx) [!]nring p[//]power_pos _ _ _). +Proof. + intros. + apply eq_transitive_unfolded with (x[!] (One[/] _[//]Hq) [*]nring p[//]Hx). + apply power_wd; rational. + astepr (NRoot Hx' Hq'[!]nring p[//]NRoot_pos _ Hx' _ Hq' Hx). + Step_final ((x[!]One[/] _[//]Hq[//]Hx) [!]nring p[//]power_pos _ _ _). Qed. Hint Resolve power_div: algebra. @@ -232,71 +247,69 @@ Hint Resolve power_div: algebra. Lemma real_power_resp_leEq_rht : forall x y p Hx Hy, Zero[<=] p -> x[<=]y -> x[!]p[//]Hx [<=] y[!]p[//]Hy. Proof. -intros x y p Hp Hx Hy H. -unfold power. -apply Exp_resp_leEq. -apply mult_resp_leEq_lft; try assumption. -apply Log_resp_leEq. -assumption. + intros x y p Hp Hx Hy H. + unfold power. + apply Exp_resp_leEq. + apply mult_resp_leEq_lft; try assumption. + apply Log_resp_leEq. + assumption. Qed. Lemma real_power_resp_less_rht : forall x y p Hx Hy, Zero[<] p -> x[<]y -> x[!]p[//]Hx [<] y[!]p[//]Hy. Proof. -intros x y p Hp Hx Hy H. -unfold power. -apply Exp_resp_less. -apply mult_resp_less_lft; try assumption. -apply Log_resp_less. -assumption. + intros x y p Hp Hx Hy H. + unfold power. + apply Exp_resp_less. + apply mult_resp_less_lft; try assumption. + apply Log_resp_less. + assumption. Qed. Lemma real_power_resp_leEq_lft : forall x p q Hx Hx', One[<=]x -> p[<=]q -> x[!]p[//]Hx [<=] x[!]q[//]Hx'. Proof. -intros x p q Hx Hx' Hx0 H. -unfold power. -apply Exp_resp_leEq. -stepr (q[*]Log x Hx) by - csetoid_rewrite (Log_wd x x Hx Hx' (eq_reflexive IR x)); apply eq_reflexive. -apply mult_resp_leEq_rht; try assumption. -apply Zero_leEq_Log. -assumption. + intros x p q Hx Hx' Hx0 H. + unfold power. + apply Exp_resp_leEq. + stepr (q[*]Log x Hx) by csetoid_rewrite (Log_wd x x Hx Hx' (eq_reflexive IR x)); apply eq_reflexive. + apply mult_resp_leEq_rht; try assumption. + apply Zero_leEq_Log. + assumption. Qed. Lemma real_power_resp_less_lft : forall x p q Hx Hx', One[<]x -> p[<]q -> x[!]p[//]Hx [<] x[!]q[//]Hx'. Proof. -intros x p q Hx Hx' Hx0 H. -unfold power. -apply Exp_resp_less. -stepr (q[*]Log x Hx) by - csetoid_rewrite (Log_wd x x Hx Hx' (eq_reflexive IR x)); apply eq_reflexive. -apply mult_resp_less; try assumption. -apply Zero_less_Log. -assumption. + intros x p q Hx Hx' Hx0 H. + unfold power. + apply Exp_resp_less. + stepr (q[*]Log x Hx) by csetoid_rewrite (Log_wd x x Hx Hx' (eq_reflexive IR x)); apply eq_reflexive. + apply mult_resp_less; try assumption. + apply Zero_less_Log. + assumption. Qed. Lemma real_power_resp_leEq_both : forall x y p q Hx Hy', - One[<=]x -> Zero [<=] p -> x[<=]y -> p[<=]q -> + One[<=]x -> Zero [<=] p -> x[<=]y -> p[<=]q -> x[!]p[//]Hx [<=] y[!]q[//]Hy'. Proof. -intros x y p q Hx Hy Hx0 Hp H0 H1. -apply leEq_transitive with (y[!]p[//]Hy). - apply real_power_resp_leEq_rht; assumption. -apply real_power_resp_leEq_lft; try assumption. -apply leEq_transitive with x; assumption. + intros x y p q Hx Hy Hx0 Hp H0 H1. + apply leEq_transitive with (y[!]p[//]Hy). + apply real_power_resp_leEq_rht; assumption. + apply real_power_resp_leEq_lft; try assumption. + apply leEq_transitive with x; assumption. Qed. Lemma real_power_resp_less_both : forall x y p q Hx Hy', - One[<]x -> Zero [<] p -> x[<]y -> p[<]q -> + One[<]x -> Zero [<] p -> x[<]y -> p[<]q -> x[!]p[//]Hx [<] y[!]q[//]Hy'. Proof. -intros x y p q Hx Hy Hx0 Hp H0 H1. -apply less_transitive_unfolded with (y[!]p[//]Hy). - apply real_power_resp_less_rht; assumption. -apply real_power_resp_less_lft; try assumption. -apply less_transitive_unfolded with x; assumption. + intros x y p q Hx Hy Hx0 Hp H0 H1. + apply less_transitive_unfolded with (y[!]p[//]Hy). + apply real_power_resp_less_rht; assumption. + apply real_power_resp_less_lft; try assumption. + apply less_transitive_unfolded with x; assumption. Qed. Section Power_Function. @@ -318,29 +331,30 @@ Definition FPower := Expon[o]G{*} (Logarithm[o]F). Lemma FPower_domain : forall x, Dom F x -> Dom G x -> (forall Hx, Zero [<] F x Hx) -> Dom FPower x. -intros x H H0 H1. -simpl in |- *. -cut (Conj (Dom G) (fun y : IR => {Hx : _ | Zero [<] Part F y Hx}) x). intro H2. -exists H2; split. -split; auto. -exists H; auto. +Proof. + intros x H H0 H1. + simpl in |- *. + cut (Conj (Dom G) (fun y : IR => {Hx : _ | Zero [<] Part F y Hx}) x). intro H2. + exists H2; split. + split; auto. + exists H; auto. Qed. Lemma Continuous_power : positive_fun J F -> Continuous J F -> Continuous J G -> Continuous J FPower. -intros H H0 H1. -unfold FPower in |- *. -apply Continuous_comp with realline. -3: apply Continuous_Exp. -2: apply Continuous_mult; - [ apply H1 | apply Continuous_comp with (openl Zero); auto ]. -3: apply Continuous_Log. -apply maps_compacts_into_strict_imp_weak; apply Continuous_imp_maps_compacts_into. -apply Continuous_mult; auto. -apply Continuous_comp with (openl Zero); auto. -2: apply Continuous_Log. -apply maps_compacts_into_strict_imp_weak; apply positive_imp_maps_compacts_into; auto. -apply maps_compacts_into_strict_imp_weak; apply positive_imp_maps_compacts_into; auto. +Proof. + intros H H0 H1. + unfold FPower in |- *. + apply Continuous_comp with realline. + 3: apply Continuous_Exp. + 2: apply Continuous_mult; [ apply H1 | apply Continuous_comp with (openl Zero); auto ]. + 3: apply Continuous_Log. + apply maps_compacts_into_strict_imp_weak; apply Continuous_imp_maps_compacts_into. + apply Continuous_mult; auto. + apply Continuous_comp with (openl Zero); auto. + 2: apply Continuous_Log. + apply maps_compacts_into_strict_imp_weak; apply positive_imp_maps_compacts_into; auto. + apply maps_compacts_into_strict_imp_weak; apply positive_imp_maps_compacts_into; auto. Qed. End Power_Function. @@ -355,12 +369,13 @@ Opaque Expon Logarithm. Lemma continuous_I_power : forall F G a b Hab, Continuous_I Hab F -> Continuous_I Hab G -> positive_fun (compact a b Hab) F -> Continuous_I Hab (F{!}G). -intros. -apply (Int_Continuous (clcr a b) Hab). -apply Continuous_power. -auto. -apply Continuous_Int with Hab Hab; auto. -apply Continuous_Int with Hab Hab; auto. +Proof. + intros. + apply (Int_Continuous (clcr a b) Hab). + apply Continuous_power. + auto. + apply Continuous_Int with Hab Hab; auto. + apply Continuous_Int with Hab Hab; auto. Qed. (** The rule for differentiation is a must. *) @@ -368,272 +383,217 @@ Qed. Lemma Derivative_power : forall (J : interval) pJ F F' G G', positive_fun J F -> Derivative J pJ F F' -> Derivative J pJ G G' -> Derivative J pJ (F{!}G) (G{*} (F{!} (G{-} [-C-]One) {*}F') {+}F{!}G{*} (G'{*} (Logarithm[o]F))). -intros J pJ F F' G G' H H0 H1. -unfold FPower in |- *. -assert (H2 : Derivative (openl Zero) CI Logarithm {1/}FId). - apply Derivative_Log. -assert (H3 : Derivative realline CI Expon Expon). - apply Derivative_Exp. -elim H; intros incF H'. -elim H'; intros c H4 H5; clear incF H'. -Derivative_Help. -apply eq_imp_Feq. -apply included_FMult. -apply included_FComp. -intros x H6. -repeat split. -apply (Derivative_imp_inc _ _ _ _ H1); auto. -simpl in |- *. -exists (Derivative_imp_inc _ _ _ _ H0 _ H6). -apply Log_domain; apply less_leEq_trans with c; auto. -intros; apply Exp_domain. -intros x H6; simpl in |- *; repeat split. -apply (Derivative_imp_inc _ _ _ _ H1); auto. -exists (Derivative_imp_inc _ _ _ _ H0 _ H6). -repeat split. -intros; simpl in |- *. -apply Greater_imp_ap; apply less_leEq_trans with c; auto. -apply (Derivative_imp_inc' _ _ _ _ H0); auto. -apply (Derivative_imp_inc' _ _ _ _ H1); auto. -exists (Derivative_imp_inc _ _ _ _ H0 _ H6). -intros; apply Log_domain; apply less_leEq_trans with c; auto. -apply included_FPlus. -apply included_FMult. -Included. -apply included_FMult. -apply included_FComp. -apply included_FMult. -Included. -apply included_FComp. -Included. -intros; apply Log_domain; apply less_leEq_trans with c; auto. -intros; apply Exp_domain. -Included. -apply included_FMult. -apply included_FComp. -apply included_FMult. -Included. -apply included_FComp. -Included. -intros; apply Log_domain; apply less_leEq_trans with c; auto. -intros; apply Exp_domain. -apply included_FMult. -Included. -apply included_FComp. -Included. -intros; apply Log_domain; apply less_leEq_trans with c; auto. -intros. -astepl (Part _ _ (ProjIR1 Hx) [*]Part _ _ (ProjIR2 Hx)). -elim Hx; intros Hx1 Hx2; clear Hx. -astepl (Part _ _ Hx1[*]Part _ _ Hx2). -astepl (Part _ _ (ProjT2 Hx1) [*]Part _ _ Hx2). -elim Hx1; clear Hx1; intros Hx1 Hx3. -astepl (Part _ (Part _ _ Hx1) Hx3[*]Part _ _ Hx2). -generalize Hx3; clear Hx3. -elim Hx1; intros Hx4 Hx5. -intro; - astepl - (Part _ - (Part _ _ (ProjIR1 (CAnd_intro _ _ Hx4 Hx5)) [*] - Part _ _ (ProjIR2 (CAnd_intro _ _ Hx4 Hx5))) Hx3[*] - Part _ _ Hx2). -cut (Dom Expon (Part _ _ Hx4[*]Part _ _ Hx5)). intro H7. -2: apply - dom_wd - with - (x := Part _ _ (ProjIR1 (CAnd_intro _ _ Hx4 Hx5)) [*] - Part _ _ (ProjIR2 (CAnd_intro _ _ Hx4 Hx5))); algebra. -astepl (Part _ (Part _ _ Hx4[*]Part _ _ Hx5) H7[*]Part _ _ Hx2). -clear Hx3; rename H7 into Hx3. -astepl (Part _ (Part _ _ Hx4[*]Part _ _ (ProjT2 Hx5)) Hx3[*]Part _ _ Hx2). -generalize Hx3; clear Hx3. -elim Hx5; intros Hx6 Hx7. -intro; astepl (Part _ (Part _ _ Hx4[*]Part _ _ Hx7) Hx3[*]Part _ _ Hx2). -set (A := Part _ (Part _ _ Hx4[*]Part _ _ Hx7) Hx3) in *. -astepl (A[*] (Part _ _ (ProjIR1 Hx2) [+]Part _ _ (ProjIR2 Hx2))). -elim Hx2; intros Hx8 Hx9. -astepl (A[*] (Part _ _ Hx8[+]Part _ _ Hx9)). -astepl (A[*] (Part _ _ (ProjIR1 Hx8) [*]Part _ _ (ProjIR2 Hx8) [+]Part _ _ Hx9)). -elim Hx8; intros Hx10 Hx11. -astepl (A[*] (Part _ _ Hx10[*]Part _ _ Hx11[+]Part _ _ Hx9)). -astepl - (A[*] - (Part _ _ Hx10[*]Part _ _ Hx11[+] - Part _ _ (ProjIR1 Hx9) [*]Part _ _ (ProjIR2 Hx9))). -elim Hx9; intros Hx12 Hx13. -astepl (A[*] (Part _ _ Hx10[*]Part _ _ Hx11[+]Part _ _ Hx12[*]Part _ _ Hx13)). -astepl - (A[*] - (Part _ _ Hx10[*] (Part _ _ (ProjIR1 Hx11) [*]Part _ _ (ProjIR2 Hx11)) [+] - Part _ _ Hx12[*]Part _ _ Hx13)). -elim Hx11; intros Hx14 Hx15. -apply - eq_transitive_unfolded - with - (A[*] - (Part _ _ Hx10[*] (Part _ _ Hx14[*]Part _ _ Hx15) [+] - Part _ _ Hx12[*]Part _ _ Hx13)). -apply mult_wd; algebra. -astepl - (A[*] - (Part _ _ Hx10[*] (Part _ _ Hx14[*]Part _ _ Hx15) [+] - Part _ _ Hx12[*]Part _ _ (ProjT2 Hx13))). -elim Hx13; intros Hx16 Hx17. -astepl - (A[*] - (Part _ _ Hx10[*] (Part _ _ Hx14[*]Part _ _ Hx15) [+] - Part _ _ Hx12[*]Part _ _ Hx17)). -astepl - (A[*] - (Part _ _ Hx10[*] (Part _ _ (ProjT2 Hx14) [*]Part _ _ Hx15) [+] - Part _ _ Hx12[*]Part _ _ Hx17)). -elim Hx14; intros Hx18 Hx19. -astepl - (A[*] - (Part _ _ Hx10[*] (Part _ _ Hx19[*]Part _ _ Hx15) [+] - Part _ _ Hx12[*]Part _ _ Hx17)). -elim Hx19; intros Hx20 Hx21. -assert (H7 : Dom G x). auto. -assert (H8 : Dom F x). auto. -cut (Zero [<] Part _ _ H8). intro H9. -assert (H10 : Part _ _ H8 [#] Zero). apply Greater_imp_ap; auto. -assert (H11 : Dom F' x). auto. -assert (H12 : Dom G' x). auto. -apply - eq_transitive_unfolded - with - (Exp (Part _ _ H7[*]Log _ H9) [*] - (Part _ _ H7[*] ((One[/] _[//]H10) [*]Part _ _ H11) [+] - Part _ _ H12[*]Log _ H9)). -unfold A, Log in |- *; simpl in |- *. -repeat first - [ apply mult_wd - | apply bin_op_wd_unfolded - | apply pfwdef - | apply div_wd - | apply eq_reflexive_unfolded ]. -clear Hx21 Hx20 Hx19 Hx18 Hx17 Hx16 Hx15 Hx14 Hx13 Hx12 Hx11 Hx10 Hx9 Hx8 A - Hx3 Hx7 Hx6 Hx5 Hx4 Hx1 Hx2. -astepr (Part _ _ (ProjIR1 Hx') [+]Part _ _ (ProjIR2 Hx')). -elim Hx'; clear Hx'; intros Hx1 Hx2. -astepr (Part _ _ Hx1[+]Part _ _ Hx2). -astepr (Part _ _ Hx1[+]Part _ _ (ProjIR1 Hx2) [*]Part _ _ (ProjIR2 Hx2)). -elim Hx2; clear Hx2; intros Hx2 Hx3. -astepr (Part _ _ Hx1[+]Part _ _ Hx2[*]Part _ _ Hx3). -astepr - (Part _ _ Hx1[+] - Part _ _ Hx2[*] (Part _ _ (ProjIR1 Hx3) [*]Part _ _ (ProjIR2 Hx3))). -elim Hx3; clear Hx3; intros Hx3 Hx4. -astepr (Part _ _ Hx1[+]Part _ _ Hx2[*] (Part _ _ H12[*]Part _ _ Hx4)); - clear Hx3. -astepr (Part _ _ Hx1[+]Part _ _ Hx2[*] (Part _ _ H12[*]Part _ _ (ProjT2 Hx4))). -elim Hx4; clear Hx4; intros Hx3 Hx4. -astepr (Part _ _ Hx1[+]Part _ _ Hx2[*] (Part _ _ H12[*]Part _ _ Hx4)). -apply - eq_transitive_unfolded - with (Part _ _ Hx1[+]Part _ _ Hx2[*] (Part _ _ H12[*]Log _ H9)). -2: unfold Log in |- *; apply bin_op_wd_unfolded; algebra. -clear Hx3 Hx4. -astepr (Part _ _ Hx1[+]Part _ _ (ProjT2 Hx2) [*] (Part _ _ H12[*]Log _ H9)). -elim Hx2; clear Hx2; intros Hx2 Hx3. -astepr (Part _ _ Hx1[+]Part _ _ Hx3[*] (Part _ _ H12[*]Log _ H9)). -generalize Hx3; clear Hx3. -elim Hx2; clear Hx2; intros Hx4 Hx5 Hx3. -assert (H13 : Dom Expon (Part _ _ Hx4[*]Part _ _ Hx5)). apply Exp_domain. -astepr - (Part _ _ Hx1[+] - Part _ - (Part _ _ (ProjIR1 (CAnd_intro _ _ Hx4 Hx5)) [*] - Part _ _ (ProjIR2 (CAnd_intro _ _ Hx4 Hx5))) Hx3[*] - (Part _ _ H12[*]Log _ H9)). -apply - eq_transitive_unfolded - with (Part _ _ Hx1[+]Part _ _ H13[*] (Part _ _ H12[*]Log _ H9)). -2: apply bin_op_wd_unfolded; algebra. -generalize H13; clear H13 Hx3. -elim Hx5; clear Hx5; intros Hx5 Hx6 Hx3. -astepr - (Part _ _ Hx1[+] - Part _ (Part _ _ Hx4[*]Part _ _ Hx6) Hx3[*] (Part _ _ H12[*]Log _ H9)). -apply - eq_transitive_unfolded - with - (Part _ _ Hx1[+]Exp (Part _ _ H7[*]Log _ H9) [*] (Part _ _ H12[*]Log _ H9)). -2: apply bin_op_wd_unfolded; [ algebra | unfold Log in |- *; simpl in |- * ]. -2: apply bin_op_wd_unfolded; algebra. -eapply eq_transitive_unfolded. -apply ring_dist_unfolded. -apply bin_op_wd_unfolded. -2: apply eq_reflexive_unfolded. -clear Hx3 Hx6 Hx5 Hx4. -astepr (Part _ _ (ProjIR1 Hx1) [*]Part _ _ (ProjIR2 Hx1)). -elim Hx1; clear Hx1; intros Hx1 Hx2. -astepr (Part _ _ Hx1[*]Part _ _ Hx2). -astepr (Part _ _ H7[*] (Part _ _ (ProjIR1 Hx2) [*]Part _ _ (ProjIR2 Hx2))). -elim Hx2; clear Hx2 Hx1; intros Hx1 Hx2. -astepr (Part _ _ H7[*] (Part _ _ Hx1[*]Part _ _ H11)). -astepr (Part _ _ H7[*] (Part _ _ (ProjT2 Hx1) [*]Part _ _ H11)). -elim Hx1; clear Hx1 Hx2; intros Hx1 Hx2. -astepr (Part _ _ H7[*] (Part _ _ Hx2[*]Part _ _ H11)). -apply - eq_transitive_unfolded - with (Part _ _ H7[*] (Exp (Part _ _ Hx1) [*]Part _ _ H11)). -2: simpl in |- *; algebra. -clear Hx2. -apply - eq_transitive_unfolded - with - (Part _ _ H7[*] +Proof. + intros J pJ F F' G G' H H0 H1. + unfold FPower in |- *. + assert (H2 : Derivative (openl Zero) CI Logarithm {1/}FId). + apply Derivative_Log. + assert (H3 : Derivative realline CI Expon Expon). + apply Derivative_Exp. + elim H; intros incF H'. + elim H'; intros c H4 H5; clear incF H'. + Derivative_Help. + apply eq_imp_Feq. + apply included_FMult. + apply included_FComp. + intros x H6. + repeat split. + apply (Derivative_imp_inc _ _ _ _ H1); auto. + simpl in |- *. + exists (Derivative_imp_inc _ _ _ _ H0 _ H6). + apply Log_domain; apply less_leEq_trans with c; auto. + intros; apply Exp_domain. + intros x H6; simpl in |- *; repeat split. + apply (Derivative_imp_inc _ _ _ _ H1); auto. + exists (Derivative_imp_inc _ _ _ _ H0 _ H6). + repeat split. + intros; simpl in |- *. + apply Greater_imp_ap; apply less_leEq_trans with c; auto. + apply (Derivative_imp_inc' _ _ _ _ H0); auto. + apply (Derivative_imp_inc' _ _ _ _ H1); auto. + exists (Derivative_imp_inc _ _ _ _ H0 _ H6). + intros; apply Log_domain; apply less_leEq_trans with c; auto. + apply included_FPlus. + apply included_FMult. + Included. + apply included_FMult. + apply included_FComp. + apply included_FMult. + Included. + apply included_FComp. + Included. + intros; apply Log_domain; apply less_leEq_trans with c; auto. + intros; apply Exp_domain. + Included. + apply included_FMult. + apply included_FComp. + apply included_FMult. + Included. + apply included_FComp. + Included. + intros; apply Log_domain; apply less_leEq_trans with c; auto. + intros; apply Exp_domain. + apply included_FMult. + Included. + apply included_FComp. + Included. + intros; apply Log_domain; apply less_leEq_trans with c; auto. + intros. + astepl (Part _ _ (ProjIR1 Hx) [*]Part _ _ (ProjIR2 Hx)). + elim Hx; intros Hx1 Hx2; clear Hx. + astepl (Part _ _ Hx1[*]Part _ _ Hx2). + astepl (Part _ _ (ProjT2 Hx1) [*]Part _ _ Hx2). + elim Hx1; clear Hx1; intros Hx1 Hx3. + astepl (Part _ (Part _ _ Hx1) Hx3[*]Part _ _ Hx2). + generalize Hx3; clear Hx3. + elim Hx1; intros Hx4 Hx5. + intro; astepl (Part _ (Part _ _ (ProjIR1 (CAnd_intro _ _ Hx4 Hx5)) [*] + Part _ _ (ProjIR2 (CAnd_intro _ _ Hx4 Hx5))) Hx3[*] Part _ _ Hx2). + cut (Dom Expon (Part _ _ Hx4[*]Part _ _ Hx5)). intro H7. + 2: apply dom_wd with (x := Part _ _ (ProjIR1 (CAnd_intro _ _ Hx4 Hx5)) [*] + Part _ _ (ProjIR2 (CAnd_intro _ _ Hx4 Hx5))); algebra. + astepl (Part _ (Part _ _ Hx4[*]Part _ _ Hx5) H7[*]Part _ _ Hx2). + clear Hx3; rename H7 into Hx3. + astepl (Part _ (Part _ _ Hx4[*]Part _ _ (ProjT2 Hx5)) Hx3[*]Part _ _ Hx2). + generalize Hx3; clear Hx3. + elim Hx5; intros Hx6 Hx7. + intro; astepl (Part _ (Part _ _ Hx4[*]Part _ _ Hx7) Hx3[*]Part _ _ Hx2). + set (A := Part _ (Part _ _ Hx4[*]Part _ _ Hx7) Hx3) in *. + astepl (A[*] (Part _ _ (ProjIR1 Hx2) [+]Part _ _ (ProjIR2 Hx2))). + elim Hx2; intros Hx8 Hx9. + astepl (A[*] (Part _ _ Hx8[+]Part _ _ Hx9)). + astepl (A[*] (Part _ _ (ProjIR1 Hx8) [*]Part _ _ (ProjIR2 Hx8) [+]Part _ _ Hx9)). + elim Hx8; intros Hx10 Hx11. + astepl (A[*] (Part _ _ Hx10[*]Part _ _ Hx11[+]Part _ _ Hx9)). + astepl (A[*] (Part _ _ Hx10[*]Part _ _ Hx11[+] Part _ _ (ProjIR1 Hx9) [*]Part _ _ (ProjIR2 Hx9))). + elim Hx9; intros Hx12 Hx13. + astepl (A[*] (Part _ _ Hx10[*]Part _ _ Hx11[+]Part _ _ Hx12[*]Part _ _ Hx13)). + astepl (A[*] (Part _ _ Hx10[*] (Part _ _ (ProjIR1 Hx11) [*]Part _ _ (ProjIR2 Hx11)) [+] + Part _ _ Hx12[*]Part _ _ Hx13)). + elim Hx11; intros Hx14 Hx15. + apply eq_transitive_unfolded with (A[*] (Part _ _ Hx10[*] (Part _ _ Hx14[*]Part _ _ Hx15) [+] + Part _ _ Hx12[*]Part _ _ Hx13)). + apply mult_wd; algebra. + astepl (A[*] (Part _ _ Hx10[*] (Part _ _ Hx14[*]Part _ _ Hx15) [+] + Part _ _ Hx12[*]Part _ _ (ProjT2 Hx13))). + elim Hx13; intros Hx16 Hx17. + astepl (A[*] (Part _ _ Hx10[*] (Part _ _ Hx14[*]Part _ _ Hx15) [+] Part _ _ Hx12[*]Part _ _ Hx17)). + astepl (A[*] (Part _ _ Hx10[*] (Part _ _ (ProjT2 Hx14) [*]Part _ _ Hx15) [+] + Part _ _ Hx12[*]Part _ _ Hx17)). + elim Hx14; intros Hx18 Hx19. + astepl (A[*] (Part _ _ Hx10[*] (Part _ _ Hx19[*]Part _ _ Hx15) [+] Part _ _ Hx12[*]Part _ _ Hx17)). + elim Hx19; intros Hx20 Hx21. + assert (H7 : Dom G x). auto. + assert (H8 : Dom F x). auto. + cut (Zero [<] Part _ _ H8). intro H9. + assert (H10 : Part _ _ H8 [#] Zero). apply Greater_imp_ap; auto. + assert (H11 : Dom F' x). auto. + assert (H12 : Dom G' x). auto. + apply eq_transitive_unfolded with (Exp (Part _ _ H7[*]Log _ H9) [*] + (Part _ _ H7[*] ((One[/] _[//]H10) [*]Part _ _ H11) [+] Part _ _ H12[*]Log _ H9)). + unfold A, Log in |- *; simpl in |- *. + repeat first [ apply mult_wd | apply bin_op_wd_unfolded | apply pfwdef | apply div_wd + | apply eq_reflexive_unfolded ]. + clear Hx21 Hx20 Hx19 Hx18 Hx17 Hx16 Hx15 Hx14 Hx13 Hx12 Hx11 Hx10 Hx9 Hx8 A + Hx3 Hx7 Hx6 Hx5 Hx4 Hx1 Hx2. + astepr (Part _ _ (ProjIR1 Hx') [+]Part _ _ (ProjIR2 Hx')). + elim Hx'; clear Hx'; intros Hx1 Hx2. + astepr (Part _ _ Hx1[+]Part _ _ Hx2). + astepr (Part _ _ Hx1[+]Part _ _ (ProjIR1 Hx2) [*]Part _ _ (ProjIR2 Hx2)). + elim Hx2; clear Hx2; intros Hx2 Hx3. + astepr (Part _ _ Hx1[+]Part _ _ Hx2[*]Part _ _ Hx3). + astepr (Part _ _ Hx1[+] Part _ _ Hx2[*] (Part _ _ (ProjIR1 Hx3) [*]Part _ _ (ProjIR2 Hx3))). + elim Hx3; clear Hx3; intros Hx3 Hx4. + astepr (Part _ _ Hx1[+]Part _ _ Hx2[*] (Part _ _ H12[*]Part _ _ Hx4)); clear Hx3. + astepr (Part _ _ Hx1[+]Part _ _ Hx2[*] (Part _ _ H12[*]Part _ _ (ProjT2 Hx4))). + elim Hx4; clear Hx4; intros Hx3 Hx4. + astepr (Part _ _ Hx1[+]Part _ _ Hx2[*] (Part _ _ H12[*]Part _ _ Hx4)). + apply eq_transitive_unfolded with (Part _ _ Hx1[+]Part _ _ Hx2[*] (Part _ _ H12[*]Log _ H9)). + 2: unfold Log in |- *; apply bin_op_wd_unfolded; algebra. + clear Hx3 Hx4. + astepr (Part _ _ Hx1[+]Part _ _ (ProjT2 Hx2) [*] (Part _ _ H12[*]Log _ H9)). + elim Hx2; clear Hx2; intros Hx2 Hx3. + astepr (Part _ _ Hx1[+]Part _ _ Hx3[*] (Part _ _ H12[*]Log _ H9)). + generalize Hx3; clear Hx3. + elim Hx2; clear Hx2; intros Hx4 Hx5 Hx3. + assert (H13 : Dom Expon (Part _ _ Hx4[*]Part _ _ Hx5)). apply Exp_domain. + astepr (Part _ _ Hx1[+] Part _ (Part _ _ (ProjIR1 (CAnd_intro _ _ Hx4 Hx5)) [*] + Part _ _ (ProjIR2 (CAnd_intro _ _ Hx4 Hx5))) Hx3[*] (Part _ _ H12[*]Log _ H9)). + apply eq_transitive_unfolded with (Part _ _ Hx1[+]Part _ _ H13[*] (Part _ _ H12[*]Log _ H9)). + 2: apply bin_op_wd_unfolded; algebra. + generalize H13; clear H13 Hx3. + elim Hx5; clear Hx5; intros Hx5 Hx6 Hx3. + astepr (Part _ _ Hx1[+] Part _ (Part _ _ Hx4[*]Part _ _ Hx6) Hx3[*] (Part _ _ H12[*]Log _ H9)). + apply eq_transitive_unfolded with + (Part _ _ Hx1[+]Exp (Part _ _ H7[*]Log _ H9) [*] (Part _ _ H12[*]Log _ H9)). + 2: apply bin_op_wd_unfolded; [ algebra | unfold Log in |- *; simpl in |- * ]. + 2: apply bin_op_wd_unfolded; algebra. + eapply eq_transitive_unfolded. + apply ring_dist_unfolded. + apply bin_op_wd_unfolded. + 2: apply eq_reflexive_unfolded. + clear Hx3 Hx6 Hx5 Hx4. + astepr (Part _ _ (ProjIR1 Hx1) [*]Part _ _ (ProjIR2 Hx1)). + elim Hx1; clear Hx1; intros Hx1 Hx2. + astepr (Part _ _ Hx1[*]Part _ _ Hx2). + astepr (Part _ _ H7[*] (Part _ _ (ProjIR1 Hx2) [*]Part _ _ (ProjIR2 Hx2))). + elim Hx2; clear Hx2 Hx1; intros Hx1 Hx2. + astepr (Part _ _ H7[*] (Part _ _ Hx1[*]Part _ _ H11)). + astepr (Part _ _ H7[*] (Part _ _ (ProjT2 Hx1) [*]Part _ _ H11)). + elim Hx1; clear Hx1 Hx2; intros Hx1 Hx2. + astepr (Part _ _ H7[*] (Part _ _ Hx2[*]Part _ _ H11)). + apply eq_transitive_unfolded with (Part _ _ H7[*] (Exp (Part _ _ Hx1) [*]Part _ _ H11)). + 2: simpl in |- *; algebra. + clear Hx2. + apply eq_transitive_unfolded with (Part _ _ H7[*] (Exp (Part _ _ (ProjIR1 Hx1) [*]Part _ _ (ProjIR2 Hx1)) [*]Part _ _ H11)). -2: apply mult_wdr; algebra. -elim Hx1; clear Hx1; intros Hx1 Hx2. -apply - eq_transitive_unfolded - with (Part _ _ H7[*] (Exp (Part _ _ Hx1[*]Part _ _ Hx2) [*]Part _ _ H11)). -2: apply mult_wdr; algebra. -apply - eq_transitive_unfolded - with (Part _ _ H7[*] (Exp ((Part _ _ H7[-]One) [*]Log _ H9) [*]Part _ _ H11)). -2: unfold Log in |- *; simpl in |- *. -2: apply mult_wdr; apply mult_wd; algebra. -clear Hx1 Hx2. -rstepl - ((Exp (Part _ _ H7[*]Log _ H9) [/] _[//]H10) [*] (Part _ _ H7[*]Part _ _ H11)). -rstepr (Exp ((Part _ _ H7[-]One) [*]Log _ H9) [*] (Part _ _ H7[*]Part _ _ H11)). -apply mult_wdl. -apply eq_transitive_unfolded with (Exp (Part _ _ H7[*]Log _ H9[-]Log _ H9)). -2: apply Exp_wd; rational. -astepr (Exp (G x H7[*]Log _ H9) [/] _[//]Exp_ap_zero (Log _ H9)). -algebra. -Transparent Logarithm. -astepr (Part _ _ Hx16); auto. -Opaque Logarithm. -apply Derivative_comp with realline CI; Deriv. -apply Continuous_imp_maps_compacts_into. -apply Continuous_mult. -apply Derivative_imp_Continuous with pJ G'; auto. -apply Continuous_comp with (openl Zero). -apply maps_compacts_into_strict_imp_weak; apply positive_imp_maps_compacts_into; auto. -apply Derivative_imp_Continuous with pJ F'; auto. -apply Derivative_imp_Continuous with pJ F'; auto. -apply Continuous_Log. -apply Derivative_mult. -auto. -apply Derivative_comp with (openl Zero) CI; Deriv. -apply positive_imp_maps_compacts_into; auto. -apply Derivative_imp_Continuous with pJ F'; auto. + 2: apply mult_wdr; algebra. + elim Hx1; clear Hx1; intros Hx1 Hx2. + apply eq_transitive_unfolded + with (Part _ _ H7[*] (Exp (Part _ _ Hx1[*]Part _ _ Hx2) [*]Part _ _ H11)). + 2: apply mult_wdr; algebra. + apply eq_transitive_unfolded + with (Part _ _ H7[*] (Exp ((Part _ _ H7[-]One) [*]Log _ H9) [*]Part _ _ H11)). + 2: unfold Log in |- *; simpl in |- *. + 2: apply mult_wdr; apply mult_wd; algebra. + clear Hx1 Hx2. + rstepl ((Exp (Part _ _ H7[*]Log _ H9) [/] _[//]H10) [*] (Part _ _ H7[*]Part _ _ H11)). + rstepr (Exp ((Part _ _ H7[-]One) [*]Log _ H9) [*] (Part _ _ H7[*]Part _ _ H11)). + apply mult_wdl. + apply eq_transitive_unfolded with (Exp (Part _ _ H7[*]Log _ H9[-]Log _ H9)). + 2: apply Exp_wd; rational. + astepr (Exp (G x H7[*]Log _ H9) [/] _[//]Exp_ap_zero (Log _ H9)). + algebra. + Transparent Logarithm. + astepr (Part _ _ Hx16); auto. + Opaque Logarithm. + apply Derivative_comp with realline CI; Deriv. + apply Continuous_imp_maps_compacts_into. + apply Continuous_mult. + apply Derivative_imp_Continuous with pJ G'; auto. + apply Continuous_comp with (openl Zero). + apply maps_compacts_into_strict_imp_weak; apply positive_imp_maps_compacts_into; auto. + apply Derivative_imp_Continuous with pJ F'; auto. + apply Derivative_imp_Continuous with pJ F'; auto. + apply Continuous_Log. + apply Derivative_mult. + auto. + apply Derivative_comp with (openl Zero) CI; Deriv. + apply positive_imp_maps_compacts_into; auto. + apply Derivative_imp_Continuous with pJ F'; auto. Qed. Lemma Diffble_power : forall (J : interval) pJ F G, positive_fun J F -> Diffble J pJ F -> Diffble J pJ G -> Diffble J pJ (F{!}G). -intros J pJ F G H H0 H1. -set (F1 := Deriv _ _ _ H0) in *. -set (G1 := Deriv _ _ _ H1) in *. -eapply Derivative_imp_Diffble. -apply Derivative_power with (F' := F1) (G' := G1). -auto. -unfold F1 in |- *; apply Deriv_lemma. -unfold G1 in |- *; apply Deriv_lemma. +Proof. + intros J pJ F G H H0 H1. + set (F1 := Deriv _ _ _ H0) in *. + set (G1 := Deriv _ _ _ H1) in *. + eapply Derivative_imp_Diffble. + apply Derivative_power with (F' := F1) (G' := G1). + auto. + unfold F1 in |- *; apply Deriv_lemma. + unfold G1 in |- *; apply Deriv_lemma. Qed. End More_on_Power_Function. diff --git a/transc/SinCos.v b/transc/SinCos.v index 8510fb497..154881325 100644 --- a/transc/SinCos.v +++ b/transc/SinCos.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Trigonometric. @@ -64,40 +64,42 @@ Let G' (y : IR) := (* end hide *) Lemma Sin_plus : forall x y : IR, Sin (x[+]y) [=] Sin x[*]Cos y[+]Cos x[*]Sin y. -intros. -cut (Feq realline (F y) (G y)). -intro H. -cut (Dom (F y) x). intro H0. -cut (Dom (G y) x). intro H1. -cut (Part _ _ H0 [=] Part _ _ H1). intro H2. -simpl in H2. -simpl in |- *. -eapply eq_transitive_unfolded. -eapply eq_transitive_unfolded. -2: apply H2. -algebra. -algebra. -apply Feq_imp_eq with (fun x : IR => CTrue); auto. -repeat split. -exists (CAnd_intro _ _ CI CI); split. -unfold F, G in |- *; apply Sin_plus_fun. +Proof. + intros. + cut (Feq realline (F y) (G y)). + intro H. + cut (Dom (F y) x). intro H0. + cut (Dom (G y) x). intro H1. + cut (Part _ _ H0 [=] Part _ _ H1). intro H2. + simpl in H2. + simpl in |- *. + eapply eq_transitive_unfolded. + eapply eq_transitive_unfolded. + 2: apply H2. + algebra. + algebra. + apply Feq_imp_eq with (fun x : IR => CTrue); auto. + repeat split. + exists (CAnd_intro _ _ CI CI); split. + unfold F, G in |- *; apply Sin_plus_fun. Qed. Lemma Cos_plus : forall x y : IR, Cos (x[+]y) [=] Cos x[*]Cos y[-]Sin x[*]Sin y. -intros. -elim (Cos_plus_fun y). intros. -elim b; intros H H0. -cut (Dom (Cosine[o]FId{+}[-C-]y) x). intro H1. -cut (Dom (Cosine{*}[-C-] (Cos y) {-}Sine{*}[-C-] (Sin y)) x). intro H2. -simpl in H0. -simpl in |- *. -eapply eq_transitive_unfolded. -eapply eq_transitive_unfolded. -2: apply (H0 x CI H1 H2). -algebra. -algebra. -repeat split. -exists (CAnd_intro _ _ CI CI); repeat split. +Proof. + intros. + elim (Cos_plus_fun y). intros. + elim b; intros H H0. + cut (Dom (Cosine[o]FId{+}[-C-]y) x). intro H1. + cut (Dom (Cosine{*}[-C-] (Cos y) {-}Sine{*}[-C-] (Sin y)) x). intro H2. + simpl in H0. + simpl in |- *. + eapply eq_transitive_unfolded. + eapply eq_transitive_unfolded. + 2: apply (H0 x CI H1 H2). + algebra. + algebra. + repeat split. + exists (CAnd_intro _ _ CI CI); repeat split. Qed. Opaque Sine Cosine. @@ -108,31 +110,31 @@ Hint Resolve Cos_plus Sin_plus: algebra. Lemma Tan_plus : forall x y Hx Hy Hxy H, Tan (x[+]y) Hxy [=] (Tan x Hx[+]Tan y Hy[/] One[-]Tan x Hx[*]Tan y Hy[//]H). -intros. -cut (Cos (x[+]y) [#] Zero). -cut (Cos y [#] Zero). -cut (Cos x [#] Zero). -intros H0 H1 H2. -apply eq_transitive_unfolded with (Sin (x[+]y) [/] _[//]H2). -unfold Tan in |- *; simpl in |- *; algebra. -rstepr - ((Tan x Hx[+]Tan y Hy) [*]Cos x[*]Cos y[/] _[//] - mult_resp_ap_zero _ _ _ H (mult_resp_ap_zero _ _ _ H0 H1)). -apply div_wd. -astepl (Sin x[*]Cos y[+]Cos x[*]Sin y). -unfold Tan, Tang in |- *; simpl in |- *. -unfold Sin, Cos in |- *; rational. -astepl (Cos x[*]Cos y[-]Sin x[*]Sin y). -unfold Tan, Tang in |- *; simpl in |- *; rational. -inversion_clear Hx. -inversion_clear X0. -simpl in |- *; auto. -inversion_clear Hy. -inversion_clear X0. -simpl in |- *; auto. -inversion_clear Hxy. -inversion_clear X0. -simpl in |- *; auto. +Proof. + intros. + cut (Cos (x[+]y) [#] Zero). + cut (Cos y [#] Zero). + cut (Cos x [#] Zero). + intros H0 H1 H2. + apply eq_transitive_unfolded with (Sin (x[+]y) [/] _[//]H2). + unfold Tan in |- *; simpl in |- *; algebra. + rstepr ((Tan x Hx[+]Tan y Hy) [*]Cos x[*]Cos y[/] _[//] + mult_resp_ap_zero _ _ _ H (mult_resp_ap_zero _ _ _ H0 H1)). + apply div_wd. + astepl (Sin x[*]Cos y[+]Cos x[*]Sin y). + unfold Tan, Tang in |- *; simpl in |- *. + unfold Sin, Cos in |- *; rational. + astepl (Cos x[*]Cos y[-]Sin x[*]Sin y). + unfold Tan, Tang in |- *; simpl in |- *; rational. + inversion_clear Hx. + inversion_clear X0. + simpl in |- *; auto. + inversion_clear Hy. + inversion_clear X0. + simpl in |- *; auto. + inversion_clear Hxy. + inversion_clear X0. + simpl in |- *; auto. Qed. Transparent Sine Cosine. @@ -140,52 +142,50 @@ Transparent Sine Cosine. (** Sine, cosine and tangent of [[--]x]. *) Lemma Cos_inv : forall x : IR, Cos [--]x [=] Cos x. -intros. -simpl in |- *. -apply series_sum_wd. -intro. -unfold cos_seq in |- *. -elim even_or_odd_plus; intros; simpl in |- *. -elim p; intros; simpl in |- *. -2: rational. -apply mult_wdr. -astepl (( [--]x[-]Zero) [^]n); astepr ((x[-]Zero) [^]n). -rewrite a. -eapply eq_transitive_unfolded. -2: apply inv_nexp_even; apply even_plus_n_n. -apply nexp_wd; rational. +Proof. + intros. + simpl in |- *. + apply series_sum_wd. + intro. + unfold cos_seq in |- *. + elim even_or_odd_plus; intros; simpl in |- *. + elim p; intros; simpl in |- *. + 2: rational. + apply mult_wdr. + astepl (( [--]x[-]Zero) [^]n); astepr ((x[-]Zero) [^]n). + rewrite a. + eapply eq_transitive_unfolded. + 2: apply inv_nexp_even; apply even_plus_n_n. + apply nexp_wd; rational. Qed. Lemma Sin_inv : forall x : IR, Sin [--]x [=] [--] (Sin x). -intros. -simpl in |- *. -assert - (H : - forall (x : nat -> IR) (convX : convergent x), - series_sum _ (conv_series_inv _ convX) [=] [--] (series_sum x convX)). intros; apply series_sum_inv. -eapply eq_transitive_unfolded. -2: apply H. -apply series_sum_wd. -intro. -unfold sin_seq in |- *. -elim even_or_odd_plus; intros; simpl in |- *. -elim p; intros; simpl in |- *. -rational. -apply - eq_transitive_unfolded - with ( [--]One[^]x0[*] ( [--]x[-]Zero) [^]n[/] _[//]nring_fac_ap_zero IR n). -simpl in |- *; rational. -apply - eq_transitive_unfolded - with ( [--]One[^]x0[*][--] ((x[-]Zero) [^]n) [/] _[//]nring_fac_ap_zero IR n). -2: simpl in |- *; rational. -apply div_wd. -2: algebra. -apply mult_wdr. -rewrite b. -eapply eq_transitive_unfolded. -2: apply inv_nexp_odd; apply odd_S; apply even_plus_n_n. -apply nexp_wd; rational. +Proof. + intros. + simpl in |- *. + assert (H : forall (x : nat -> IR) (convX : convergent x), + series_sum _ (conv_series_inv _ convX) [=] [--] (series_sum x convX)). intros; apply series_sum_inv. + eapply eq_transitive_unfolded. + 2: apply H. + apply series_sum_wd. + intro. + unfold sin_seq in |- *. + elim even_or_odd_plus; intros; simpl in |- *. + elim p; intros; simpl in |- *. + rational. + apply eq_transitive_unfolded + with ( [--]One[^]x0[*] ( [--]x[-]Zero) [^]n[/] _[//]nring_fac_ap_zero IR n). + simpl in |- *; rational. + apply eq_transitive_unfolded + with ( [--]One[^]x0[*][--] ((x[-]Zero) [^]n) [/] _[//]nring_fac_ap_zero IR n). + 2: simpl in |- *; rational. + apply div_wd. + 2: algebra. + apply mult_wdr. + rewrite b. + eapply eq_transitive_unfolded. + 2: apply inv_nexp_odd; apply odd_S; apply even_plus_n_n. + apply nexp_wd; rational. Qed. Opaque Sine Cosine. @@ -193,20 +193,21 @@ Opaque Sine Cosine. Hint Resolve Cos_inv Sin_inv: algebra. Lemma Tan_inv : forall x Hx Hx', Tan [--]x Hx' [=] [--] (Tan x Hx). -intros; unfold Tan, Tang in |- *. -cut (Cos x [#] Zero). -cut (Cos [--]x [#] Zero). intros H H0. -apply eq_transitive_unfolded with (Sin [--]x[/] _[//]H). -simpl in |- *; algebra. -astepl ( [--] (Sin x) [/] _[//]H0). -rstepl ( [--] (Sin x[/] _[//]H0)). -simpl in |- *; algebra. -inversion_clear Hx'. -inversion_clear X0. -simpl in |- *; auto. -inversion_clear Hx. -inversion_clear X0. -simpl in |- *; auto. +Proof. + intros; unfold Tan, Tang in |- *. + cut (Cos x [#] Zero). + cut (Cos [--]x [#] Zero). intros H H0. + apply eq_transitive_unfolded with (Sin [--]x[/] _[//]H). + simpl in |- *; algebra. + astepl ( [--] (Sin x) [/] _[//]H0). + rstepl ( [--] (Sin x[/] _[//]H0)). + simpl in |- *; algebra. + inversion_clear Hx'. + inversion_clear X0. + simpl in |- *; auto. + inversion_clear Hx. + inversion_clear X0. + simpl in |- *; auto. Qed. Transparent Sine Cosine. @@ -218,19 +219,20 @@ The fundamental formulas of trigonometry: $\cos(x)^2+\sin(x)^2=1$#cos(x)2 x [#] y. -intros x y H. -unfold Sin in H; exact (un_op_strext_unfolded _ _ _ _ H). +Proof. + intros x y H. + unfold Sin in H; exact (un_op_strext_unfolded _ _ _ _ H). Qed. Lemma Cos_strext : forall x y : IR, Cos x [#] Cos y -> x [#] y. -intros x y H. -unfold Cos in H; exact (un_op_strext_unfolded _ _ _ _ H). +Proof. + intros x y H. + unfold Cos in H; exact (un_op_strext_unfolded _ _ _ _ H). Qed. Lemma Tan_strext : forall x y Hx Hy, Tan x Hx [#] Tan y Hy -> x [#] y. -intros x y Hx Hy H. -unfold Tan in H; exact (pfstrx _ _ _ _ _ _ H). +Proof. + intros x y Hx Hy H. + unfold Tan in H; exact (pfstrx _ _ _ _ _ _ H). Qed. Lemma Sin_wd : forall x y : IR, x [=] y -> Sin x [=] Sin y. -intros; algebra. +Proof. + intros; algebra. Qed. Lemma Cos_wd : forall x y : IR, x [=] y -> Cos x [=] Cos y. -intros; algebra. +Proof. + intros; algebra. Qed. Lemma Tan_wd : forall x y Hx Hy, x [=] y -> Tan x Hx [=] Tan y Hy. -intros; unfold Tan in |- *; algebra. +Proof. + intros; unfold Tan in |- *; algebra. Qed. Lemma Tan_Sin_over_Cos : forall x Hx H, Tan x Hx[=](Sin x[/]Cos x[//]H). Proof. -intros x Hx H. -change ((Sine x (prj1 IR _ _ _ Hx)[/] - Cosine x - (ProjT1 - (ext2_a IR (Dom Cosine) - (fun (x0 : IR) (Hx0 : Dom Cosine x0) => Cosine x0 Hx0[#]Zero) x - (prj2 IR _ _ _ Hx)))[//] - ext2 (S:=IR) (P:=Dom Cosine) - (R:=fun (x0 : IR) (Hx0 : Dom Cosine x0) => Cosine x0 Hx0[#]Zero) (x:=x) - (prj2 _ _ _ _ Hx))[=](Sine x CI[/]Cosine x CI[//]H)). -algebra. + intros x Hx H. + change ((Sine x (prj1 IR _ _ _ Hx)[/] Cosine x (ProjT1 (ext2_a IR (Dom Cosine) + (fun (x0 : IR) (Hx0 : Dom Cosine x0) => Cosine x0 Hx0[#]Zero) x (prj2 IR _ _ _ Hx)))[//] + ext2 (S:=IR) (P:=Dom Cosine) + (R:=fun (x0 : IR) (Hx0 : Dom Cosine x0) => Cosine x0 Hx0[#]Zero) (x:=x) + (prj2 _ _ _ _ Hx))[=](Sine x CI[/]Cosine x CI[//]H)). + algebra. Qed. (** @@ -312,51 +317,53 @@ The sine and cosine produce values in [[-1,1]]. *) Lemma AbsIR_Sin_leEq_One : forall x : IR, AbsIR (Sin x) [<=] One. -intros. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; - apply AbsIR_sqrt_sqr with (x2pos := sqr_nonneg _ (Sin x)). -apply power_cancel_leEq with 2. -auto with arith. -apply less_leEq; apply pos_one. -astepl (Sin x[^]2). -astepr OneR. -eapply leEq_wdr. -2: apply FFT with (x := x). -apply shift_leEq_plus. -astepl ZeroR. -apply sqr_nonneg. +Proof. + intros. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_sqrt_sqr with (x2pos := sqr_nonneg _ (Sin x)). + apply power_cancel_leEq with 2. + auto with arith. + apply less_leEq; apply pos_one. + astepl (Sin x[^]2). + astepr OneR. + eapply leEq_wdr. + 2: apply FFT with (x := x). + apply shift_leEq_plus. + astepl ZeroR. + apply sqr_nonneg. Qed. Lemma AbsIR_Cos_leEq_One : forall x : IR, AbsIR (Cos x) [<=] One. -intros. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; - apply AbsIR_sqrt_sqr with (x2pos := sqr_nonneg _ (Cos x)). -apply power_cancel_leEq with 2. -auto with arith. -apply less_leEq; apply pos_one. -astepl (Cos x[^]2). -astepr OneR. -eapply leEq_wdr. -2: apply FFT with (x := x). -apply shift_leEq_plus'. -astepl ZeroR. -apply sqr_nonneg. +Proof. + intros. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_sqrt_sqr with (x2pos := sqr_nonneg _ (Cos x)). + apply power_cancel_leEq with 2. + auto with arith. + apply less_leEq; apply pos_one. + astepl (Cos x[^]2). + astepr OneR. + eapply leEq_wdr. + 2: apply FFT with (x := x). + apply shift_leEq_plus'. + astepl ZeroR. + apply sqr_nonneg. Qed. Lemma Sin_leEq_One : forall x : IR, Sin x [<=] One. -intro. -eapply leEq_transitive. -apply leEq_AbsIR. -apply AbsIR_Sin_leEq_One. +Proof. + intro. + eapply leEq_transitive. + apply leEq_AbsIR. + apply AbsIR_Sin_leEq_One. Qed. Lemma Cos_leEq_One : forall x : IR, Cos x [<=] One. -intro. -eapply leEq_transitive. -apply leEq_AbsIR. -apply AbsIR_Cos_leEq_One. +Proof. + intro. + eapply leEq_transitive. + apply leEq_AbsIR. + apply AbsIR_Cos_leEq_One. Qed. (** @@ -364,34 +371,36 @@ If the cosine is positive then the sine is in [(-1,1)]. *) Lemma Sin_less_One : forall x : IR, Zero [<] Cos x -> Sin x [<] One. -intros. -apply power_cancel_less with 2. -auto. -apply less_leEq; apply pos_one. -astepr OneR. -eapply less_wdr. -2: apply (FFT x). -apply shift_less_plus. -astepl ZeroR. -apply pos_square; apply Greater_imp_ap; auto. +Proof. + intros. + apply power_cancel_less with 2. + auto. + apply less_leEq; apply pos_one. + astepr OneR. + eapply less_wdr. + 2: apply (FFT x). + apply shift_less_plus. + astepl ZeroR. + apply pos_square; apply Greater_imp_ap; auto. Qed. Lemma AbsIR_Sin_less_One : forall x : IR, Zero [<] Cos x -> AbsIR (Sin x) [<] One. -intros. -apply power_cancel_less with 2. -auto. -apply less_leEq; apply pos_one. -astepr OneR. -eapply less_wdr. -2: apply (FFT x). -apply shift_less_plus. -apply less_wdl with ZeroR. -apply pos_square; apply Greater_imp_ap; auto. -apply eq_symmetric_unfolded; apply x_minus_x. -eapply eq_transitive_unfolded. -2: apply AbsIR_eq_x. -2: apply sqr_nonneg. -apply eq_symmetric_unfolded; apply AbsIR_nexp_op. +Proof. + intros. + apply power_cancel_less with 2. + auto. + apply less_leEq; apply pos_one. + astepr OneR. + eapply less_wdr. + 2: apply (FFT x). + apply shift_less_plus. + apply less_wdl with ZeroR. + apply pos_square; apply Greater_imp_ap; auto. + apply eq_symmetric_unfolded; apply x_minus_x. + eapply eq_transitive_unfolded. + 2: apply AbsIR_eq_x. + 2: apply sqr_nonneg. + apply eq_symmetric_unfolded; apply AbsIR_nexp_op. Qed. End Basic_Properties. diff --git a/transc/TaylorSeries.v b/transc/TaylorSeries.v index 00f0e52a7..86256752d 100644 --- a/transc/TaylorSeries.v +++ b/transc/TaylorSeries.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export PowerSeries. Require Export Taylor. @@ -85,51 +85,42 @@ Opaque N_Deriv. Lemma Taylor_Rem_char : forall n H x Hx Hx' Hx'', F x Hx[-]FSum0 (S n) Taylor_Series x Hx' [=] Taylor_Rem J pJ F a x Ha Hx'' n H. -intros; unfold Taylor_Rem in |- *; repeat apply cg_minus_wd. -algebra. -simpl in |- *. -apply bin_op_wd_unfolded. -2: apply mult_wdl. -apply eq_symmetric_unfolded. -cut - (ext_fun_seq' - (fun (i : nat) (l : i < n) => - [-C-] - (N_Deriv _ _ _ _ - (le_imp_Diffble_n _ _ _ _ (lt_n_Sm_le _ _ (lt_S _ _ l)) _ H) a Ha[/] +Proof. + intros; unfold Taylor_Rem in |- *; repeat apply cg_minus_wd. + algebra. + simpl in |- *. + apply bin_op_wd_unfolded. + 2: apply mult_wdl. + apply eq_symmetric_unfolded. + cut (ext_fun_seq' (fun (i : nat) (l : i < n) => [-C-] (N_Deriv _ _ _ _ + (le_imp_Diffble_n _ _ _ _ (lt_n_Sm_le _ _ (lt_S _ _ l)) _ H) a Ha[/] _[//]nring_fac_ap_zero _ i) {*} (FId{-} [-C-]a) {^}i)). intro H0. -apply - eq_transitive_unfolded - with - (Sumx - (fun (i : nat) (Hi : i < n) => - Part - ( [-C-] - (N_Deriv _ _ _ _ - (le_imp_Diffble_n _ _ _ _ (lt_n_Sm_le _ _ (lt_S _ _ Hi)) _ H) a - Ha[/] _[//]nring_fac_ap_zero _ i) {*} (FId{-} [-C-]a) {^}i) x - (FSumx_pred _ _ H0 _ (ProjIR1 (TaylorB _ _ _ a x Ha _ H)) i Hi))). -exact (FSumx_char _ _ _ _ H0). -apply Sumx_Sum0. -intros; simpl in |- *. -apply mult_wdl; apply div_wd. -2: algebra. -apply Feq_imp_eq with J; auto. -apply Derivative_n_unique with pJ i F; auto. -apply N_Deriv_lemma. -red in |- *; do 3 intro. -rewrite H0; intros; simpl in |- *; auto. -apply div_wd. -2: algebra. -apply Feq_imp_eq with J; auto. -apply Derivative_n_unique with pJ n F; auto. -Deriv. + apply eq_transitive_unfolded with (Sumx (fun (i : nat) (Hi : i < n) => Part ( [-C-] (N_Deriv _ _ _ _ + (le_imp_Diffble_n _ _ _ _ (lt_n_Sm_le _ _ (lt_S _ _ Hi)) _ H) a + Ha[/] _[//]nring_fac_ap_zero _ i) {*} (FId{-} [-C-]a) {^}i) x + (FSumx_pred _ _ H0 _ (ProjIR1 (TaylorB _ _ _ a x Ha _ H)) i Hi))). + exact (FSumx_char _ _ _ _ H0). + apply Sumx_Sum0. + intros; simpl in |- *. + apply mult_wdl; apply div_wd. + 2: algebra. + apply Feq_imp_eq with J; auto. + apply Derivative_n_unique with pJ i F; auto. + apply N_Deriv_lemma. + red in |- *; do 3 intro. + rewrite H0; intros; simpl in |- *; auto. + apply div_wd. + 2: algebra. + apply Feq_imp_eq with J; auto. + apply Derivative_n_unique with pJ n F; auto. + Deriv. Qed. Lemma abs_Taylor_Rem_char : forall n H x Hx Hx' Hx'', AbsIR (F x Hx[-]FSum0 (S n) Taylor_Series x Hx') [=] AbsIR (Taylor_Rem J pJ F a x Ha Hx'' n H). -intros; apply AbsIR_wd; apply Taylor_Rem_char. +Proof. + intros; apply AbsIR_wd; apply Taylor_Rem_char. Qed. End Definitions. @@ -156,20 +147,22 @@ Variable f : nat -> PartIR. Hypothesis derF : forall n, Derivative_n n realline H F (f n). Lemma Taylor_Series_imp_cont : Continuous realline F. -apply Derivative_n_imp_Continuous with H 1 (f 1); auto. +Proof. + apply Derivative_n_imp_Continuous with H 1 (f 1); auto. Qed. Lemma Taylor_Series_lemma_cont : forall r n, Continuous realline ((r[^]n[/] _[//]nring_fac_ap_zero _ n) {**}f n). -intros. -apply Continuous_scal; case n. -apply Continuous_wd with F. -apply Derivative_n_unique with H 0 F; auto. -apply Derivative_n_O. -apply Derivative_n_imp_inc with H n (f n); auto. -apply Taylor_Series_imp_cont. -clear n; intros. -apply Derivative_n_imp_Continuous' with H (S n) F; auto with arith. +Proof. + intros. + apply Continuous_scal; case n. + apply Continuous_wd with F. + apply Derivative_n_unique with H 0 F; auto. + apply Derivative_n_O. + apply Derivative_n_imp_inc with H n (f n); auto. + apply Taylor_Series_imp_cont. + clear n; intros. + apply Derivative_n_imp_Continuous' with H (S n) F; auto with arith. Qed. Definition Taylor_bnd := forall r H, conv_fun_seq'_IR realline @@ -183,7 +176,8 @@ Opaque nexp_op fac. (* begin hide *) Let H1 : forall n, Two[^]n [#] ZeroR. -intro; apply nexp_resp_ap_zero; apply two_ap_zero. +Proof. + intro; apply nexp_resp_ap_zero; apply two_ap_zero. Qed. Lemma Taylor_Series_conv_lemma1 : @@ -199,140 +193,124 @@ Lemma Taylor_Series_conv_lemma1 : (((Part _ _ (Derivative_n_imp_inc' _ _ _ _ _ (derF (S n)) w Hw) [/] _[//] nring_fac_ap_zero _ (S n)) {**} ((FId{-} [-C-]w) {^}n{*} (FId{-} [-C-]a))) z Hz) [<=] (e[/] _[//]H1 (S n))}. -intros. -set (r := Max y (Max a t) [-]Min x (Min a t)) in *. -cut (Min x (Min a t) [<=] Max y (Max a t)). -intro Hxy'; cut (included (Compact (Min_leEq_Max' x y t)) (Compact Hxy')). -intro Hinc'. -cut - (forall w z : IR, Compact Hxy z -> Compact Hxy' w -> AbsIR (z[+][--]w) [<=] r). intro. -2: intros w z H0 H2; fold (z[-]w) in |- *; unfold r in |- *. -set (r' := Two[*]Max r One) in *. -set (H' := Taylor_Series_lemma_cont r') in *. -elim - (bndf r' H' _ _ (Min_leEq_Max' x y t) - (included_interval' realline _ _ _ _ CI CI CI CI _) e He); - intros N HN. -exists N. intros n H2 w z H3 H4 Hw Hz. -simpl in |- *; fold (Two:IR) in |- *. -assert (H5 : forall n : nat, Zero [<] r'[^]n). -intro; unfold r' in |- *; apply nexp_resp_pos; unfold r' in |- *; - apply mult_resp_pos; [ apply pos_two | apply pos_max_one ]. -apply - leEq_transitive - with - ((e[/] _[//]pos_ap_zero _ _ (H5 (S n))) [*] - AbsIR ((z[+][--]w) [^]n[*] (z[+][--]a))). -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_rht. -2: apply AbsIR_nonneg. -apply shift_leEq_div. -auto. -clear Hz H3 z. -eapply leEq_transitive. -2: apply (HN (S n) (le_S _ _ H2) w H4). -simpl in |- *. -cut (forall z : IR, AbsIR z [=] AbsIR (z[-]Zero)); intros. -2: apply AbsIR_wd; algebra. -eapply leEq_wdr. -2: apply H3. -clear H3; eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_mult_pos'. -eapply leEq_wdr. -2: apply mult_commutes. -cut - (forall z : IR, - AbsIR (z[/] _[//]nring_fac_ap_zero _ (S n)) [*]r'[^]S n [=] - AbsIR z[*] (r'[^]S n[/] _[//]nring_fac_ap_zero _ (S n))); +Proof. intros. -eapply leEq_wdr. -2: apply H3. -clear H3; apply mult_resp_leEq_rht. -apply eq_imp_leEq; apply AbsIR_wd; algebra. -apply less_leEq; auto. -rstepr ((AbsIR z[/] _[//]nring_fac_ap_zero _ (S n)) [*]r'[^]S n). -apply mult_wdl. -eapply eq_transitive_unfolded. -apply - AbsIR_division with (y__ := AbsIR_resp_ap_zero _ (nring_fac_ap_zero _ (S n))). -apply div_wd. -algebra. -apply AbsIR_eq_x. -apply nring_nonneg. -apply less_leEq; apply div_resp_pos; [ apply pos_nring_fac | auto ]. -Transparent nexp_op. -apply shift_leEq_div. -apply nexp_resp_pos; apply pos_two. -unfold r' in |- *. -apply - leEq_wdl - with - (e[*] - (AbsIR ((z[+][--]w) [^]n[*] (z[+][--]a)) [/] _[//] + set (r := Max y (Max a t) [-]Min x (Min a t)) in *. + cut (Min x (Min a t) [<=] Max y (Max a t)). + intro Hxy'; cut (included (Compact (Min_leEq_Max' x y t)) (Compact Hxy')). + intro Hinc'. + cut (forall w z : IR, Compact Hxy z -> Compact Hxy' w -> AbsIR (z[+][--]w) [<=] r). intro. + 2: intros w z H0 H2; fold (z[-]w) in |- *; unfold r in |- *. + set (r' := Two[*]Max r One) in *. + set (H' := Taylor_Series_lemma_cont r') in *. + elim (bndf r' H' _ _ (Min_leEq_Max' x y t) (included_interval' realline _ _ _ _ CI CI CI CI _) e He); + intros N HN. + exists N. intros n H2 w z H3 H4 Hw Hz. + simpl in |- *; fold (Two:IR) in |- *. + assert (H5 : forall n : nat, Zero [<] r'[^]n). + intro; unfold r' in |- *; apply nexp_resp_pos; unfold r' in |- *; + apply mult_resp_pos; [ apply pos_two | apply pos_max_one ]. + apply leEq_transitive with ((e[/] _[//]pos_ap_zero _ _ (H5 (S n))) [*] + AbsIR ((z[+][--]w) [^]n[*] (z[+][--]a))). + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_rht. + 2: apply AbsIR_nonneg. + apply shift_leEq_div. + auto. + clear Hz H3 z. + eapply leEq_transitive. + 2: apply (HN (S n) (le_S _ _ H2) w H4). + simpl in |- *. + cut (forall z : IR, AbsIR z [=] AbsIR (z[-]Zero)); intros. + 2: apply AbsIR_wd; algebra. + eapply leEq_wdr. + 2: apply H3. + clear H3; eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_mult_pos'. + eapply leEq_wdr. + 2: apply mult_commutes. + cut (forall z : IR, AbsIR (z[/] _[//]nring_fac_ap_zero _ (S n)) [*]r'[^]S n [=] + AbsIR z[*] (r'[^]S n[/] _[//]nring_fac_ap_zero _ (S n))); intros. + eapply leEq_wdr. + 2: apply H3. + clear H3; apply mult_resp_leEq_rht. + apply eq_imp_leEq; apply AbsIR_wd; algebra. + apply less_leEq; auto. + rstepr ((AbsIR z[/] _[//]nring_fac_ap_zero _ (S n)) [*]r'[^]S n). + apply mult_wdl. + eapply eq_transitive_unfolded. + apply AbsIR_division with (y__ := AbsIR_resp_ap_zero _ (nring_fac_ap_zero _ (S n))). + apply div_wd. + algebra. + apply AbsIR_eq_x. + apply nring_nonneg. + apply less_leEq; apply div_resp_pos; [ apply pos_nring_fac | auto ]. + Transparent nexp_op. + apply shift_leEq_div. + apply nexp_resp_pos; apply pos_two. + unfold r' in |- *. + apply leEq_wdl with (e[*] (AbsIR ((z[+][--]w) [^]n[*] (z[+][--]a)) [/] _[//] nexp_resp_ap_zero (S n) (max_one_ap_zero r))). -astepr (e[*]One). -apply mult_resp_leEq_lft. -2: apply less_leEq; auto. -apply shift_div_leEq. -apply nexp_resp_pos; apply pos_max_one. -astepr (Max r One[^]S n). -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -astepr (Max r One[^]n[*]Max r One). -apply mult_resp_leEq_both; try apply AbsIR_nonneg. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_nexp_op. -apply nexp_resp_leEq. -apply AbsIR_nonneg. -apply leEq_transitive with r; auto. -apply lft_leEq_Max. -apply leEq_transitive with r. -apply H0; auto. -split. -eapply leEq_transitive. -apply Min_leEq_rht. -apply Min_leEq_lft. -eapply leEq_transitive. -2: apply rht_leEq_Max. -apply lft_leEq_Max. -apply lft_leEq_Max. -rstepl - ((e[/] _[//] - mult_resp_ap_zero _ _ _ (nexp_resp_ap_zero (S n) (max_one_ap_zero r)) - (H1 (S n))) [*]AbsIR ((z[+][--]w) [^]n[*] (z[+][--]a)) [*] - Two[^]S n). -repeat apply mult_wdl. -apply div_wd; algebra. -eapply eq_transitive_unfolded. -2: apply eq_symmetric_unfolded; apply mult_nexp. -algebra. -apply leEq_wdr with (AbsIR (Max y (Max a t) [-]Min x (Min a t))). -apply compact_elements with Hxy'; auto. -inversion_clear H0; split. -apply leEq_transitive with x; auto; apply Min_leEq_lft. -apply leEq_transitive with y; auto; apply lft_leEq_Max. -apply AbsIR_eq_x. -apply shift_leEq_minus; astepl (Min x (Min a t)); auto. -red in |- *; intros z Hz. -inversion_clear Hz; split. -eapply leEq_transitive. -2: apply H0. -apply leEq_Min. -apply Min_leEq_lft. -eapply leEq_transitive; apply Min_leEq_rht. -eapply leEq_transitive. -apply H2. -apply Max_leEq. -apply lft_leEq_Max. -eapply leEq_transitive. -2: apply rht_leEq_Max. -apply rht_leEq_Max. -apply leEq_transitive with t. -eapply leEq_transitive; apply Min_leEq_rht. -eapply leEq_transitive. -2: apply rht_leEq_Max. -apply rht_leEq_Max. + astepr (e[*]One). + apply mult_resp_leEq_lft. + 2: apply less_leEq; auto. + apply shift_div_leEq. + apply nexp_resp_pos; apply pos_max_one. + astepr (Max r One[^]S n). + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + astepr (Max r One[^]n[*]Max r One). + apply mult_resp_leEq_both; try apply AbsIR_nonneg. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_nexp_op. + apply nexp_resp_leEq. + apply AbsIR_nonneg. + apply leEq_transitive with r; auto. + apply lft_leEq_Max. + apply leEq_transitive with r. + apply H0; auto. + split. + eapply leEq_transitive. + apply Min_leEq_rht. + apply Min_leEq_lft. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + apply lft_leEq_Max. + apply lft_leEq_Max. + rstepl ((e[/] _[//] mult_resp_ap_zero _ _ _ (nexp_resp_ap_zero (S n) (max_one_ap_zero r)) + (H1 (S n))) [*]AbsIR ((z[+][--]w) [^]n[*] (z[+][--]a)) [*] Two[^]S n). + repeat apply mult_wdl. + apply div_wd; algebra. + eapply eq_transitive_unfolded. + 2: apply eq_symmetric_unfolded; apply mult_nexp. + algebra. + apply leEq_wdr with (AbsIR (Max y (Max a t) [-]Min x (Min a t))). + apply compact_elements with Hxy'; auto. + inversion_clear H0; split. + apply leEq_transitive with x; auto; apply Min_leEq_lft. + apply leEq_transitive with y; auto; apply lft_leEq_Max. + apply AbsIR_eq_x. + apply shift_leEq_minus; astepl (Min x (Min a t)); auto. + red in |- *; intros z Hz. + inversion_clear Hz; split. + eapply leEq_transitive. + 2: apply H0. + apply leEq_Min. + apply Min_leEq_lft. + eapply leEq_transitive; apply Min_leEq_rht. + eapply leEq_transitive. + apply H2. + apply Max_leEq. + apply lft_leEq_Max. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + apply rht_leEq_Max. + apply leEq_transitive with t. + eapply leEq_transitive; apply Min_leEq_rht. + eapply leEq_transitive. + 2: apply rht_leEq_Max. + apply rht_leEq_Max. Qed. Lemma Taylor_Series_conv_lemma2 : @@ -344,26 +322,24 @@ Lemma Taylor_Series_conv_lemma2 : compact x y Hxy z -> forall Hz, AbsIR (Taylor_Series _ _ _ a Ha _ derF n z Hz) [<=] (e[/] _[//]H1 n)}. -intros. -elim Taylor_Series_conv_lemma1 with (t := a) (Hxy := Hxy) (e := e); auto. -intros N HN; exists (S N). -intros n H0 z H2 Hz. -assert (n = S (pred n)). apply S_pred with N; auto with arith. -set (p := pred n) in *. -assert (N <= p). unfold p in |- *; apply le_S_n; rewrite <- S_pred with n N; auto with arith. -clearbody p; rewrite H3. -assert - (H5 : forall c d : IR, Dom (c{**} ((FId{-} [-C-]d) {^}p{*} (FId{-} [-C-]a))) z). - repeat split. -assert (H6 : Compact (Min_leEq_Max' x y a) a). - split; [ apply Min_leEq_rht | apply rht_leEq_Max ]. -eapply leEq_wdl. -apply - (HN p H4 a z H2 H6 Ha - (H5 - (Part _ _ (Derivative_n_imp_inc' _ _ _ _ _ (derF (S p)) a Ha) [/] _[//] - nring_fac_ap_zero _ (S p)) a)). -apply AbsIR_wd; algebra. +Proof. + intros. + elim Taylor_Series_conv_lemma1 with (t := a) (Hxy := Hxy) (e := e); auto. + intros N HN; exists (S N). + intros n H0 z H2 Hz. + assert (n = S (pred n)). apply S_pred with N; auto with arith. + set (p := pred n) in *. + assert (N <= p). unfold p in |- *; apply le_S_n; rewrite <- S_pred with n N; auto with arith. + clearbody p; rewrite H3. + assert (H5 : forall c d : IR, Dom (c{**} ((FId{-} [-C-]d) {^}p{*} (FId{-} [-C-]a))) z). + repeat split. + assert (H6 : Compact (Min_leEq_Max' x y a) a). + split; [ apply Min_leEq_rht | apply rht_leEq_Max ]. + eapply leEq_wdl. + apply (HN p H4 a z H2 H6 Ha (H5 + (Part _ _ (Derivative_n_imp_inc' _ _ _ _ _ (derF (S p)) a Ha) [/] _[//] + nring_fac_ap_zero _ (S p)) a)). + apply AbsIR_wd; algebra. Qed. (* end hide *) @@ -371,66 +347,66 @@ Qed. Lemma Taylor_Series_conv_IR : fun_series_convergent_IR realline (Taylor_Series _ _ _ a Ha _ derF). -red in |- *; intros. -unfold Taylor_Series, FPowerSeries' in |- *. -apply - fun_str_comparison with (fun n : nat => Fconst (S:=IR) ((One [/]TwoNZ) [^]n)). -Contin. -apply conv_fun_const_series with (x := fun n : nat => (OneR [/]TwoNZ) [^]n). -apply ratio_test_conv. -exists 0; exists (OneR [/]TwoNZ); repeat split. -apply pos_div_two'; apply pos_one. -apply less_leEq; fold (Half:IR) in |- *; apply pos_half. -intros; apply eq_imp_leEq. -eapply eq_transitive_unfolded. -2: apply mult_commutes. -eapply eq_transitive_unfolded. -2: apply AbsIR_mult_pos; apply less_leEq; fold (Half (R:=IR)) in |- *; - apply pos_half. -Transparent nexp_op. -apply AbsIR_wd; simpl in |- *; rational. -Opaque nexp_op. -elim (Taylor_Series_conv_lemma2 _ _ Hab One (pos_one _)); intros N HN; - exists N; intros n H0 x X Hx Hx'. -eapply leEq_wdr. -eapply leEq_wdl. -apply (HN _ H0 _ X Hx). -apply AbsIR_wd; algebra. -simpl in |- *; algebra. +Proof. + red in |- *; intros. + unfold Taylor_Series, FPowerSeries' in |- *. + apply fun_str_comparison with (fun n : nat => Fconst (S:=IR) ((One [/]TwoNZ) [^]n)). + Contin. + apply conv_fun_const_series with (x := fun n : nat => (OneR [/]TwoNZ) [^]n). + apply ratio_test_conv. + exists 0; exists (OneR [/]TwoNZ); repeat split. + apply pos_div_two'; apply pos_one. + apply less_leEq; fold (Half:IR) in |- *; apply pos_half. + intros; apply eq_imp_leEq. + eapply eq_transitive_unfolded. + 2: apply mult_commutes. + eapply eq_transitive_unfolded. + 2: apply AbsIR_mult_pos; apply less_leEq; fold (Half (R:=IR)) in |- *; apply pos_half. + Transparent nexp_op. + apply AbsIR_wd; simpl in |- *; rational. + Opaque nexp_op. + elim (Taylor_Series_conv_lemma2 _ _ Hab One (pos_one _)); intros N HN; + exists N; intros n H0 x X Hx Hx'. + eapply leEq_wdr. + eapply leEq_wdl. + apply (HN _ H0 _ X Hx). + apply AbsIR_wd; algebra. + simpl in |- *; algebra. Qed. (* begin hide *) Lemma Taylor_majoration_lemma : forall (n : nat) (e : IR), Zero [<] e -> e[*] (nring n[/] _[//]H1 n) [<=] e. -intro; case n. -intros; simpl in |- *; rstepl ZeroR; apply less_leEq; auto. -clear n; intro; induction n as [| n Hrecn]. -intros; simpl in |- *. -eapply leEq_wdl. -apply less_leEq; apply pos_div_two'; auto. -rational. -intros e H0. -eapply leEq_transitive. -2: apply Hrecn; auto. -apply mult_resp_leEq_lft. -2: apply less_leEq; auto. -apply shift_div_leEq. -repeat apply mult_resp_pos; try apply nexp_resp_pos; apply pos_two. -rstepr (nring (S n) [*]Two[^]S (S n) [/] _[//]H1 (S n)). -apply shift_leEq_div. -apply nexp_resp_pos; apply pos_two. -Transparent nexp_op. -set (p := S n) in *. -cut (p = S n); [ intro | auto ]. -clear H0; clearbody p. -simpl in |- *; fold (Two:IR) in |- *. -rstepl (nring (R:=IR) p[*]nexp _ p Two[+]nring 1[*]nexp _ p Two). -rstepr (nring (R:=IR) p[*]nexp _ p Two[+]nring p[*]nexp _ p Two). -apply plus_resp_leEq_lft. -apply mult_resp_leEq_rht. -apply nring_leEq; rewrite H2; auto with arith. -astepr ((Two:IR) [^]p); apply nexp_resp_nonneg. -apply less_leEq; apply pos_two. +Proof. + intro; case n. + intros; simpl in |- *; rstepl ZeroR; apply less_leEq; auto. + clear n; intro; induction n as [| n Hrecn]. + intros; simpl in |- *. + eapply leEq_wdl. + apply less_leEq; apply pos_div_two'; auto. + rational. + intros e H0. + eapply leEq_transitive. + 2: apply Hrecn; auto. + apply mult_resp_leEq_lft. + 2: apply less_leEq; auto. + apply shift_div_leEq. + repeat apply mult_resp_pos; try apply nexp_resp_pos; apply pos_two. + rstepr (nring (S n) [*]Two[^]S (S n) [/] _[//]H1 (S n)). + apply shift_leEq_div. + apply nexp_resp_pos; apply pos_two. + Transparent nexp_op. + set (p := S n) in *. + cut (p = S n); [ intro | auto ]. + clear H0; clearbody p. + simpl in |- *; fold (Two:IR) in |- *. + rstepl (nring (R:=IR) p[*]nexp _ p Two[+]nring 1[*]nexp _ p Two). + rstepr (nring (R:=IR) p[*]nexp _ p Two[+]nring p[*]nexp _ p Two). + apply plus_resp_leEq_lft. + apply mult_resp_leEq_rht. + apply nring_leEq; rewrite H2; auto with arith. + astepr ((Two:IR) [^]p); apply nexp_resp_nonneg. + apply less_leEq; apply pos_two. Qed. Opaque N_Deriv fac. @@ -441,34 +417,26 @@ Lemma Taylor_Series_conv_lemma3 : x [=] b[*]e -> Zero [<=] e -> forall Hb He Hx, - (AbsIR (a'[*] (One[/] b[//]Hb) [*]c[*]d) [/] e[//]He) [=] + (AbsIR (a'[*] (One[/] b[//]Hb) [*]c[*]d) [/] e[//]He) [=] AbsIR ((a''[/] x[//]Hx) [*] (c[*]d)). -intros. -astepr (AbsIR ((a''[/] x[//]Hx) [*]c[*]d)). -apply - eq_transitive_unfolded - with - (AbsIR a'[*] (One[/] _[//]AbsIR_resp_ap_zero _ Hb) [*]AbsIR c[*]AbsIR d[/] - e[//]He). -apply div_wd; algebra. -repeat - (eapply eq_transitive_unfolded; - [ apply AbsIR_resp_mult | apply mult_wdl ]). -eapply eq_transitive_unfolded; [ apply AbsIR_resp_mult | apply mult_wdr ]. -apply AbsIR_recip. -rstepl - ((AbsIR a'[/] _[//]mult_resp_ap_zero _ _ _ (AbsIR_resp_ap_zero _ Hb) He) [*] - AbsIR c[*]AbsIR d). -apply eq_symmetric_unfolded. -repeat - (eapply eq_transitive_unfolded; - [ apply AbsIR_resp_mult | apply mult_wdl ]). -eapply eq_transitive_unfolded; - [ apply AbsIR_division with (y__ := AbsIR_resp_ap_zero _ Hx) - | apply div_wd; algebra ]. -eapply eq_transitive_unfolded. -2: apply AbsIR_mult_pos; auto. -algebra. +Proof. + intros. + astepr (AbsIR ((a''[/] x[//]Hx) [*]c[*]d)). + apply eq_transitive_unfolded with + (AbsIR a'[*] (One[/] _[//]AbsIR_resp_ap_zero _ Hb) [*]AbsIR c[*]AbsIR d[/] e[//]He). + apply div_wd; algebra. + repeat (eapply eq_transitive_unfolded; [ apply AbsIR_resp_mult | apply mult_wdl ]). + eapply eq_transitive_unfolded; [ apply AbsIR_resp_mult | apply mult_wdr ]. + apply AbsIR_recip. + rstepl ((AbsIR a'[/] _[//]mult_resp_ap_zero _ _ _ (AbsIR_resp_ap_zero _ Hb) He) [*] + AbsIR c[*]AbsIR d). + apply eq_symmetric_unfolded. + repeat (eapply eq_transitive_unfolded; [ apply AbsIR_resp_mult | apply mult_wdl ]). + eapply eq_transitive_unfolded; [ apply AbsIR_division with (y__ := AbsIR_resp_ap_zero _ Hx) + | apply div_wd; algebra ]. + eapply eq_transitive_unfolded. + 2: apply AbsIR_mult_pos; auto. + algebra. Qed. (* end hide *) @@ -476,135 +444,101 @@ Qed. We now prove that, under our assumptions, it actually converges to the original function. For generality and also usability, however, we will separately assume convergence. -*) +*) (* begin show *) Hypothesis Hf : fun_series_convergent_IR realline (Taylor_Series _ _ _ a Ha _ derF). (* end show *) Lemma Taylor_Series_conv_to_fun : Feq realline F (FSeries_Sum Hf). -cut (Continuous realline (FSeries_Sum Hf)). intro H0. -cut - (forall n : nat, - Continuous realline (FSum0 n (Taylor_Series _ _ _ _ Ha _ derF))). -intro H2. -cut (Continuous realline F). intro H3. -eapply - FLim_unique_IR - with - (HG := H0) - (HF := H3) - (f := fun n : nat => FSum0 n (Taylor_Series _ _ _ _ Ha _ derF)) - (contf := H2). -2: apply FSeries_conv. -3: Contin. -2: apply Derivative_imp_Continuous with H (f 1). -2: apply Derivative_n_Sn with F 0. -2: apply Derivative_n_O; eapply Derivative_n_imp_inc; apply (derF 0). -2: auto. -2: unfold Taylor_Series in |- *; Contin. -intros a0 b Hab Hinc e H4. -set (Hab' := Min_leEq_Max' a0 b a) in *. -elim (Taylor_Series_conv_lemma1 a _ _ Hab _ (pos_div_two _ _ H4)); - intros N HN. -exists (S N); intros p Hp. -cut (p = S (pred p)); [ intro Hn | apply S_pred with N; auto ]. -set (n := pred p) in *; clearbody n. -generalize Hp; clear Hp; rewrite Hn; clear Hn p. -intros. -cut (Zero [<] nring (S n) [*]e [/]TwoNZ); [ intro He | apply mult_resp_pos ]. -2: apply pos_nring_S. -2: apply pos_div_two; auto. -elim - (Taylor' _ _ _ _ _ Ha (Hinc x Hx) n - (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF (S n))) - (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF n)) _ ( - pos_div_two _ _ H4)). -intros y H5 H6. -set - (H7 := - CAnd_intro _ _ (CAnd_intro _ _ CI CI) (CAnd_intro _ _ CI CI) - :Dom - (N_Deriv _ _ _ _ (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF (S n))) {*} - [-C-] (One[/] _[//]nring_fac_ap_zero _ n) {*} ( [-C-]x{-}FId) {^}n) y) - in *. -eapply leEq_wdl. -2: apply AbsIR_minus. -cut (forall z w : IR, AbsIR z [<=] AbsIR (z[-]w) [+]AbsIR w); intros. -2: eapply leEq_wdl. -2: apply triangle_IR. -2: apply AbsIR_wd; rational. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; - apply - (abs_Taylor_Rem_char realline H F a Ha f derF n - (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF n)) x - (contin_imp_inc _ _ _ _ (included_imp_Continuous _ _ H3 _ _ _ Hinc) _ - Hx) - (contin_imp_inc _ _ _ _ - (included_imp_Continuous _ _ (H2 (S n)) _ _ _ Hinc) _ Hx) - (Hinc _ Hx)). -rstepr (e [/]TwoNZ[+]e [/]TwoNZ). -eapply leEq_transitive. -apply - H8 - with - (w := Part - (N_Deriv _ _ _ _ - (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF (S n))) {*} - [-C-] (One[/] _[//]nring_fac_ap_zero _ n) {*} - ( [-C-]x{-}FId) {^}n) y H7[*] (x[-]a)). -apply plus_resp_leEq_both; auto. -eapply leEq_transitive. -2: apply Taylor_majoration_lemma with (n := S n); apply pos_div_two; auto. -rstepr (nring (S n) [*] (e [/]TwoNZ[/] _[//]H1 (S n))). -apply shift_leEq_mult' with (pos_ap_zero _ _ (pos_nring_S IR n)). -apply pos_nring_S. -set - (H9 := - CAnd_intro _ _ CI - (CAnd_intro _ _ (CAnd_intro _ _ CI CI) (CAnd_intro _ _ CI CI))) - in *. -eapply leEq_wdl. -apply HN with (n := n) (w := y) (z := x) (Hw := CI) (Hz := H9); - auto with arith. -inversion_clear Hx; inversion_clear H5; split. -apply leEq_transitive with (Min a x); auto. -apply leEq_Min. -apply Min_leEq_rht. -apply leEq_transitive with a0; auto. -apply Min_leEq_lft. -apply leEq_transitive with (Max a x); auto. -apply Max_leEq. -apply rht_leEq_Max. -apply leEq_transitive with b; auto. -apply lft_leEq_Max. -simpl in |- *. -unfold Taylor_Rem in |- *; simpl in |- *. -clear H8 H6 H4 He Hx Hp HN Hab' H3 H2 H0 bndf. -set (fy := Part _ _ (Derivative_n_imp_inc' _ _ _ _ _ (derF (S n)) y CI)) in *. -set - (Fy := - Part (N_Deriv _ _ _ _ (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF (S n)))) - y (ProjIR1 (ProjIR1 H7))) in *. -astepr - (AbsIR - (Fy[*] (One[/] _[//]nring_fac_ap_zero _ n) [*] (x[+][--]y) [^]n[*] (x[-]a)) [/] - _[//]pos_ap_zero _ _ (pos_nring_S _ n)). -unfold cg_minus in |- *. -apply eq_symmetric_unfolded; apply Taylor_Series_conv_lemma3. -unfold fy, Fy in |- *. -apply Feq_imp_eq with realline; auto. -apply Derivative_n_unique with H (S n) F; Deriv. -eapply eq_transitive_unfolded. -2: apply nring_comm_mult. -Transparent fac. -replace (fac (S n)) with (fac n * S n). -algebra. -Opaque mult. -unfold fac in |- *; fold (fac n) in |- *. -auto with arith. -apply nring_nonneg. +Proof. + cut (Continuous realline (FSeries_Sum Hf)). intro H0. + cut (forall n : nat, Continuous realline (FSum0 n (Taylor_Series _ _ _ _ Ha _ derF))). + intro H2. + cut (Continuous realline F). intro H3. + eapply FLim_unique_IR with (HG := H0) (HF := H3) + (f := fun n : nat => FSum0 n (Taylor_Series _ _ _ _ Ha _ derF)) (contf := H2). + 2: apply FSeries_conv. + 3: Contin. + 2: apply Derivative_imp_Continuous with H (f 1). + 2: apply Derivative_n_Sn with F 0. + 2: apply Derivative_n_O; eapply Derivative_n_imp_inc; apply (derF 0). + 2: auto. + 2: unfold Taylor_Series in |- *; Contin. + intros a0 b Hab Hinc e H4. + set (Hab' := Min_leEq_Max' a0 b a) in *. + elim (Taylor_Series_conv_lemma1 a _ _ Hab _ (pos_div_two _ _ H4)); intros N HN. + exists (S N); intros p Hp. + cut (p = S (pred p)); [ intro Hn | apply S_pred with N; auto ]. + set (n := pred p) in *; clearbody n. + generalize Hp; clear Hp; rewrite Hn; clear Hn p. + intros. + cut (Zero [<] nring (S n) [*]e [/]TwoNZ); [ intro He | apply mult_resp_pos ]. + 2: apply pos_nring_S. + 2: apply pos_div_two; auto. + elim (Taylor' _ _ _ _ _ Ha (Hinc x Hx) n (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF (S n))) + (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF n)) _ ( pos_div_two _ _ H4)). + intros y H5 H6. + set (H7 := CAnd_intro _ _ (CAnd_intro _ _ CI CI) (CAnd_intro _ _ CI CI) :Dom + (N_Deriv _ _ _ _ (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF (S n))) {*} + [-C-] (One[/] _[//]nring_fac_ap_zero _ n) {*} ( [-C-]x{-}FId) {^}n) y) in *. + eapply leEq_wdl. + 2: apply AbsIR_minus. + cut (forall z w : IR, AbsIR z [<=] AbsIR (z[-]w) [+]AbsIR w); intros. + 2: eapply leEq_wdl. + 2: apply triangle_IR. + 2: apply AbsIR_wd; rational. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply (abs_Taylor_Rem_char realline H F a Ha f derF n + (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF n)) x + (contin_imp_inc _ _ _ _ (included_imp_Continuous _ _ H3 _ _ _ Hinc) _ Hx) (contin_imp_inc _ _ _ _ + (included_imp_Continuous _ _ (H2 (S n)) _ _ _ Hinc) _ Hx) (Hinc _ Hx)). + rstepr (e [/]TwoNZ[+]e [/]TwoNZ). + eapply leEq_transitive. + apply H8 with (w := Part (N_Deriv _ _ _ _ (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF (S n))) {*} + [-C-] (One[/] _[//]nring_fac_ap_zero _ n) {*} ( [-C-]x{-}FId) {^}n) y H7[*] (x[-]a)). + apply plus_resp_leEq_both; auto. + eapply leEq_transitive. + 2: apply Taylor_majoration_lemma with (n := S n); apply pos_div_two; auto. + rstepr (nring (S n) [*] (e [/]TwoNZ[/] _[//]H1 (S n))). + apply shift_leEq_mult' with (pos_ap_zero _ _ (pos_nring_S IR n)). + apply pos_nring_S. + set (H9 := CAnd_intro _ _ CI (CAnd_intro _ _ (CAnd_intro _ _ CI CI) (CAnd_intro _ _ CI CI))) in *. + eapply leEq_wdl. + apply HN with (n := n) (w := y) (z := x) (Hw := CI) (Hz := H9); auto with arith. + inversion_clear Hx; inversion_clear H5; split. + apply leEq_transitive with (Min a x); auto. + apply leEq_Min. + apply Min_leEq_rht. + apply leEq_transitive with a0; auto. + apply Min_leEq_lft. + apply leEq_transitive with (Max a x); auto. + apply Max_leEq. + apply rht_leEq_Max. + apply leEq_transitive with b; auto. + apply lft_leEq_Max. + simpl in |- *. + unfold Taylor_Rem in |- *; simpl in |- *. + clear H8 H6 H4 He Hx Hp HN Hab' H3 H2 H0 bndf. + set (fy := Part _ _ (Derivative_n_imp_inc' _ _ _ _ _ (derF (S n)) y CI)) in *. + set (Fy := Part (N_Deriv _ _ _ _ (Derivative_n_imp_Diffble_n _ _ _ _ _ (derF (S n)))) + y (ProjIR1 (ProjIR1 H7))) in *. + astepr (AbsIR (Fy[*] (One[/] _[//]nring_fac_ap_zero _ n) [*] (x[+][--]y) [^]n[*] (x[-]a)) [/] + _[//]pos_ap_zero _ _ (pos_nring_S _ n)). + unfold cg_minus in |- *. + apply eq_symmetric_unfolded; apply Taylor_Series_conv_lemma3. + unfold fy, Fy in |- *. + apply Feq_imp_eq with realline; auto. + apply Derivative_n_unique with H (S n) F; Deriv. + eapply eq_transitive_unfolded. + 2: apply nring_comm_mult. + Transparent fac. + replace (fac (S n)) with (fac n * S n). + algebra. + Opaque mult. + unfold fac in |- *; fold (fac n) in |- *. + auto with arith. + apply nring_nonneg. Qed. End Convergence_in_IR. @@ -619,76 +553,67 @@ give some helpful lemmas. Lemma Taylor_bnd_trans : forall f g : nat -> PartIR, (forall n x Hx Hx', AbsIR (f n x Hx) [<=] AbsIR (g n x Hx')) -> (forall n, Continuous realline (g n)) -> Taylor_bnd g -> Taylor_bnd f. -intros f g bndf contg Gbnd r H a b Hab Hinc e H0. -elim - (Gbnd r (fun n : nat => Continuous_scal _ _ (contg n) _) _ _ _ Hinc e H0); - intros N HN. -exists N; intros. -eapply leEq_transitive. -2: apply HN with (n := n) (Hx := Hx); auto. -cut (forall (z t : IR) Ht, AbsIR z [=] AbsIR (z[-][-C-]Zero t Ht)); intros. -2: simpl in |- *; apply AbsIR_wd; algebra. -eapply leEq_wdl. -2: apply H2. -eapply leEq_wdr. -2: apply H2. -simpl in |- *. -eapply leEq_wdl. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply mult_resp_leEq_lft; auto. -apply AbsIR_nonneg. +Proof. + intros f g bndf contg Gbnd r H a b Hab Hinc e H0. + elim (Gbnd r (fun n : nat => Continuous_scal _ _ (contg n) _) _ _ _ Hinc e H0); intros N HN. + exists N; intros. + eapply leEq_transitive. + 2: apply HN with (n := n) (Hx := Hx); auto. + cut (forall (z t : IR) Ht, AbsIR z [=] AbsIR (z[-][-C-]Zero t Ht)); intros. + 2: simpl in |- *; apply AbsIR_wd; algebra. + eapply leEq_wdl. + 2: apply H2. + eapply leEq_wdr. + 2: apply H2. + simpl in |- *. + eapply leEq_wdl. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply mult_resp_leEq_lft; auto. + apply AbsIR_nonneg. Qed. (* begin hide *) Lemma convergence_lemma : forall r : IR, conv_fun_seq'_IR realline - (fun n : nat => [-C-] (r[^]n[/] _[//]nring_fac_ap_zero IR n)) + (fun n : nat => [-C-] (r[^]n[/] _[//]nring_fac_ap_zero IR n)) [-C-]Zero (fun n : nat => Continuous_const realline _) (Continuous_const realline _). -red in |- *; intros. -apply - seq_conv_imp_fun_conv - with (x := fun n : nat => r[^]n[/] _[//]nring_fac_ap_zero _ n). -clear Hinc Hab b a. -apply series_seq_Lim. -assert (H : forall n : nat, Dom (Exp_ps n) r). repeat split. -apply convergent_wd with (fun n : nat => Part (Exp_ps n) r (H n)). -Opaque nexp_op. -intros; simpl in |- *. -rstepl ((r[-]Zero) [^]n[/] _[//]nring_fac_ap_zero _ n). -algebra. -apply fun_series_conv_imp_conv_IR with realline. -apply Exp_conv. -split. +Proof. + red in |- *; intros. + apply seq_conv_imp_fun_conv with (x := fun n : nat => r[^]n[/] _[//]nring_fac_ap_zero _ n). + clear Hinc Hab b a. + apply series_seq_Lim. + assert (H : forall n : nat, Dom (Exp_ps n) r). repeat split. + apply convergent_wd with (fun n : nat => Part (Exp_ps n) r (H n)). + Opaque nexp_op. + intros; simpl in |- *. + rstepl ((r[-]Zero) [^]n[/] _[//]nring_fac_ap_zero _ n). + algebra. + apply fun_series_conv_imp_conv_IR with realline. + apply Exp_conv. + split. Qed. (* end hide *) Lemma bnd_imp_Taylor_bnd : forall (f : nat -> PartIR) (F : PartIR), (forall n x Hx Hx', AbsIR (f n x Hx) [<=] AbsIR (F x Hx')) -> Continuous realline F -> (forall n, included (fun _ => CTrue) (Dom (f n))) -> Taylor_bnd f. -intros f F H H0 H1. -apply Taylor_bnd_trans with (fun n : nat => F); auto. -red in |- *; intros. -unfold Fscalmult in |- *. -apply - conv_fun_seq'_wdr'_IR - with (contF := Continuous_mult _ _ _ (Continuous_const _ Zero) H0). -FEQ. -apply - fun_Lim_seq_mult'_IR - with - (f := fun n : nat => [-C-] (r[^]n[/] _[//]nring_fac_ap_zero _ n)) - (contf := fun n : nat => - Continuous_const realline (r[^]n[/] _[//]nring_fac_ap_zero _ n)) - (g := fun n : nat => F) - (contg := fun n : nat => H0) - (contF := Continuous_const realline Zero) - (contG := H0). -apply convergence_lemma. -apply fun_Lim_seq_const_IR. +Proof. + intros f F H H0 H1. + apply Taylor_bnd_trans with (fun n : nat => F); auto. + red in |- *; intros. + unfold Fscalmult in |- *. + apply conv_fun_seq'_wdr'_IR with (contF := Continuous_mult _ _ _ (Continuous_const _ Zero) H0). + FEQ. + apply fun_Lim_seq_mult'_IR with (f := fun n : nat => [-C-] (r[^]n[/] _[//]nring_fac_ap_zero _ n)) + (contf := fun n : nat => Continuous_const realline (r[^]n[/] _[//]nring_fac_ap_zero _ n)) + (g := fun n : nat => F) (contg := fun n : nat => H0) (contF := Continuous_const realline Zero) + (contG := H0). + apply convergence_lemma. + apply fun_Lim_seq_const_IR. Qed. (** @@ -717,17 +642,17 @@ Let Hf := Taylor_Series_conv_IR CI F a CI f derF bndf. (* end hide *) Lemma Taylor_unique_crit : Feq realline F (FSeries_Sum Hf) -> Feq realline F G. -intro H. -cut - (fun_series_convergent_IR realline (Taylor_Series realline CI G a CI g derG)). -intro Hg. -apply Feq_transitive with (FSeries_Sum Hf); auto. -apply Feq_transitive with (FSeries_Sum Hg). -apply eq_imp_Feq; simpl in |- *; Included. -intros; apply series_sum_wd. -intros; algebra. -apply Feq_symmetric; apply Taylor_Series_conv_to_fun; auto. -apply Taylor_Series_conv_IR; auto. +Proof. + intro H. + cut (fun_series_convergent_IR realline (Taylor_Series realline CI G a CI g derG)). + intro Hg. + apply Feq_transitive with (FSeries_Sum Hf); auto. + apply Feq_transitive with (FSeries_Sum Hg). + apply eq_imp_Feq; simpl in |- *; Included. + intros; apply series_sum_wd. + intros; algebra. + apply Feq_symmetric; apply Taylor_Series_conv_to_fun; auto. + apply Taylor_Series_conv_IR; auto. Qed. End Other_Results. diff --git a/transc/TrigMon.v b/transc/TrigMon.v index 25a11607f..b3f9924d0 100644 --- a/transc/TrigMon.v +++ b/transc/TrigMon.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export Pi. Require Import CornTac. @@ -46,116 +46,116 @@ $(0,\pi)$#(0,π)# and tangent in $(0,\frac{\pi}2)$#0,π/2)#. *) Lemma Cos_pos : forall x, [--] (Pi [/]TwoNZ) [<] x -> x [<] Pi [/]TwoNZ -> Zero [<] Cos x. -intros x H H0. -assert - (H1 : - Continuous_I (less_leEq _ _ _ (less_transitive_unfolded _ _ _ _ H H0)) - Cosine). - apply included_imp_Continuous with realline; Contin. -elim (contin_prop _ _ _ _ H1 Half (pos_half _)); intros d H2 H3. -elim (less_cotransitive_unfolded _ _ _ H2 x); intros. -apply pos_cos; try apply less_leEq; auto. -assert (H4 : [--]d [<] Zero). - astepr ( [--]ZeroR); apply inv_resp_less; auto. -elim (less_cotransitive_unfolded _ _ _ H4 x); intros. -2: astepr (Cos [--]x); apply pos_cos. -2: astepl ( [--]ZeroR); apply inv_resp_leEq; apply less_leEq; auto. -2: apply inv_cancel_less; astepr x; auto. -clear H4 H2 H1. -astepl (OneR[-]One). -apply shift_minus_less; apply shift_less_plus'. -apply leEq_less_trans with (Half:IR). -2: apply half_lt1. -astepl (Cos Zero[-]Cos x). -eapply leEq_transitive. -apply leEq_AbsIR. -simpl in |- *; apply H3. -split; PiSolve. -split; apply less_leEq; auto. -apply less_leEq; simpl in |- *; unfold ABSIR in |- *. -apply Max_less. -apply shift_minus_less; apply shift_less_plus'. -astepl ( [--]d); auto. -rstepl x; auto. +Proof. + intros x H H0. + assert (H1 : Continuous_I (less_leEq _ _ _ (less_transitive_unfolded _ _ _ _ H H0)) Cosine). + apply included_imp_Continuous with realline; Contin. + elim (contin_prop _ _ _ _ H1 Half (pos_half _)); intros d H2 H3. + elim (less_cotransitive_unfolded _ _ _ H2 x); intros. + apply pos_cos; try apply less_leEq; auto. + assert (H4 : [--]d [<] Zero). + astepr ( [--]ZeroR); apply inv_resp_less; auto. + elim (less_cotransitive_unfolded _ _ _ H4 x); intros. + 2: astepr (Cos [--]x); apply pos_cos. + 2: astepl ( [--]ZeroR); apply inv_resp_leEq; apply less_leEq; auto. + 2: apply inv_cancel_less; astepr x; auto. + clear H4 H2 H1. + astepl (OneR[-]One). + apply shift_minus_less; apply shift_less_plus'. + apply leEq_less_trans with (Half:IR). + 2: apply half_lt1. + astepl (Cos Zero[-]Cos x). + eapply leEq_transitive. + apply leEq_AbsIR. + simpl in |- *; apply H3. + split; PiSolve. + split; apply less_leEq; auto. + apply less_leEq; simpl in |- *; unfold ABSIR in |- *. + apply Max_less. + apply shift_minus_less; apply shift_less_plus'. + astepl ( [--]d); auto. + rstepl x; auto. Qed. Lemma Sin_pos : forall x : IR, Zero [<] x -> x [<] Pi -> Zero [<] Sin x. -intros. -astepr (Cos (Pi [/]TwoNZ[-]x)). -apply Cos_pos. -apply shift_less_minus; apply shift_plus_less'. -unfold cg_minus in |- *; rstepr Pi; auto. -apply shift_minus_less; apply shift_less_plus'. -astepl ZeroR; auto. +Proof. + intros. + astepr (Cos (Pi [/]TwoNZ[-]x)). + apply Cos_pos. + apply shift_less_minus; apply shift_plus_less'. + unfold cg_minus in |- *; rstepr Pi; auto. + apply shift_minus_less; apply shift_less_plus'. + astepl ZeroR; auto. Qed. Lemma Tan_pos : forall x, Zero [<] x -> x [<] Pi [/]TwoNZ -> forall Hx, Zero [<] Tan x Hx. -intros. -unfold Tan, Tang in |- *; simpl in |- *. -apply shift_less_div. -apply less_wdr with (Cos x). -apply Cos_pos; auto. -apply less_transitive_unfolded with ZeroR; PiSolve. -simpl in |- *; algebra. -astepl ZeroR; apply less_wdr with (Sin x). -apply Sin_pos; auto. -apply less_transitive_unfolded with (Pi [/]TwoNZ); PiSolve. -simpl in |- *; algebra. +Proof. + intros. + unfold Tan, Tang in |- *; simpl in |- *. + apply shift_less_div. + apply less_wdr with (Cos x). + apply Cos_pos; auto. + apply less_transitive_unfolded with ZeroR; PiSolve. + simpl in |- *; algebra. + astepl ZeroR; apply less_wdr with (Sin x). + apply Sin_pos; auto. + apply less_transitive_unfolded with (Pi [/]TwoNZ); PiSolve. + simpl in |- *; algebra. Qed. Lemma Cos_nonneg : forall x, [--] (Pi [/]TwoNZ) [<=] x -> x [<=] Pi [/]TwoNZ -> Zero [<=] Cos x. -simpl in |- *. -intros; - apply olor_pos_clcr_nonneg with ( [--] (Pi [/]TwoNZ)) (Pi [/]TwoNZ) CI CI. -PiSolve. -intros x0 H1 Hx; inversion_clear H1. -apply less_wdr with (Cos x0); - [ apply Cos_pos; auto | simpl in |- *; algebra ]. -astepr (Cos [--] (Pi [/]TwoNZ)); apply eq_imp_leEq; - Step_final (Cos (Pi [/]TwoNZ)). -fold (Cos (Pi [/]TwoNZ)) in |- *; apply eq_imp_leEq; algebra. -split; auto. +Proof. + simpl in |- *. + intros; apply olor_pos_clcr_nonneg with ( [--] (Pi [/]TwoNZ)) (Pi [/]TwoNZ) CI CI. + PiSolve. + intros x0 H1 Hx; inversion_clear H1. + apply less_wdr with (Cos x0); [ apply Cos_pos; auto | simpl in |- *; algebra ]. + astepr (Cos [--] (Pi [/]TwoNZ)); apply eq_imp_leEq; Step_final (Cos (Pi [/]TwoNZ)). + fold (Cos (Pi [/]TwoNZ)) in |- *; apply eq_imp_leEq; algebra. + split; auto. Qed. Lemma Sin_nonneg : forall x, Zero [<=] x -> x [<=] Pi -> Zero [<=] Sin x. -simpl in |- *. -intros; apply olor_pos_clcr_nonneg with ZeroR Pi CI CI. -PiSolve. -intros x0 H1 Hx; inversion_clear H1. -apply less_wdr with (Sin x0); - [ apply Sin_pos; auto | simpl in |- *; algebra ]. -fold (Sin Zero) in |- *; apply eq_imp_leEq; algebra. -fold (Sin Pi) in |- *; apply eq_imp_leEq; algebra. -split; auto. +Proof. + simpl in |- *. + intros; apply olor_pos_clcr_nonneg with ZeroR Pi CI CI. + PiSolve. + intros x0 H1 Hx; inversion_clear H1. + apply less_wdr with (Sin x0); [ apply Sin_pos; auto | simpl in |- *; algebra ]. + fold (Sin Zero) in |- *; apply eq_imp_leEq; algebra. + fold (Sin Pi) in |- *; apply eq_imp_leEq; algebra. + split; auto. Qed. (** Consequences. *) Lemma Abs_Sin_less_One : forall x, [--] (Pi [/]TwoNZ) [<] x -> x [<] Pi [/]TwoNZ -> AbsIR (Sin x) [<] One. -intros. -apply power_cancel_less with 2. -apply less_leEq; apply pos_one. -astepr OneR. -astepr (Cos x[^]2[+]Sin x[^]2). -apply less_wdl with (Sin x[^]2). -astepl (Zero[+]Sin x[^]2). -apply plus_resp_less_rht. -apply pos_square. -apply Greater_imp_ap; apply Cos_pos; auto. -apply eq_symmetric_unfolded. -eapply eq_transitive_unfolded. -2: apply AbsIR_eq_x; apply sqr_nonneg. -apply eq_symmetric_unfolded; apply AbsIR_nexp_op. +Proof. + intros. + apply power_cancel_less with 2. + apply less_leEq; apply pos_one. + astepr OneR. + astepr (Cos x[^]2[+]Sin x[^]2). + apply less_wdl with (Sin x[^]2). + astepl (Zero[+]Sin x[^]2). + apply plus_resp_less_rht. + apply pos_square. + apply Greater_imp_ap; apply Cos_pos; auto. + apply eq_symmetric_unfolded. + eapply eq_transitive_unfolded. + 2: apply AbsIR_eq_x; apply sqr_nonneg. + apply eq_symmetric_unfolded; apply AbsIR_nexp_op. Qed. Lemma Abs_Cos_less_One : forall x, Zero [<] x -> x [<] Pi -> AbsIR (Cos x) [<] One. -intros. -astepl (AbsIR (Sin (Pi [/]TwoNZ[-]x))). -apply Abs_Sin_less_One. -apply shift_less_minus; apply shift_plus_less'. -unfold cg_minus in |- *; rstepr Pi; auto. -apply shift_minus_less; apply shift_less_plus'. -astepl ZeroR; auto. +Proof. + intros. + astepl (AbsIR (Sin (Pi [/]TwoNZ[-]x))). + apply Abs_Sin_less_One. + apply shift_less_minus; apply shift_plus_less'. + unfold cg_minus in |- *; rstepr Pi; auto. + apply shift_minus_less; apply shift_less_plus'. + astepl ZeroR; auto. Qed. (** @@ -164,311 +164,303 @@ is (strictly) decreasing in [[Zero,Pi]]. *) Lemma Sin_resp_leEq : forall x y, [--] (Pi [/]TwoNZ) [<=] x -> y [<=] Pi [/]TwoNZ -> x [<=] y -> Sin x [<=] Sin y. -intros; simpl in |- *. -cut ( [--] (Pi [/]TwoNZ) [<] Pi [/]TwoNZ). intro H2. -apply - Derivative_imp_resp_leEq - with (clcr [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) H2 Cosine; - auto. -apply Included_imp_Derivative with realline CI; Deriv. -split; auto; apply leEq_transitive with y; auto. -split; auto; apply leEq_transitive with x; auto. -intros. -apply leEq_glb. intros y0 H3 Hy. -apply leEq_wdr with (Cos y0). -inversion_clear H3. -apply Cos_nonneg. -apply leEq_transitive with (Min y x); try apply leEq_Min; auto; - apply leEq_transitive with x; auto. -apply leEq_transitive with (Max y x); try apply Max_leEq; auto; - apply leEq_transitive with y; auto. -simpl in |- *; algebra. -PiSolve. +Proof. + intros; simpl in |- *. + cut ( [--] (Pi [/]TwoNZ) [<] Pi [/]TwoNZ). intro H2. + apply Derivative_imp_resp_leEq with (clcr [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) H2 Cosine; auto. + apply Included_imp_Derivative with realline CI; Deriv. + split; auto; apply leEq_transitive with y; auto. + split; auto; apply leEq_transitive with x; auto. + intros. + apply leEq_glb. intros y0 H3 Hy. + apply leEq_wdr with (Cos y0). + inversion_clear H3. + apply Cos_nonneg. + apply leEq_transitive with (Min y x); try apply leEq_Min; auto; apply leEq_transitive with x; auto. + apply leEq_transitive with (Max y x); try apply Max_leEq; auto; apply leEq_transitive with y; auto. + simpl in |- *; algebra. + PiSolve. Qed. Lemma Cos_resp_leEq : forall x y, Zero [<=] x -> y [<=] Pi -> x [<=] y -> Cos y [<=] Cos x. -intros. -astepl (Sin (Pi [/]TwoNZ[-]y)); astepr (Sin (Pi [/]TwoNZ[-]x)). -apply Sin_resp_leEq. -apply shift_leEq_minus; apply shift_plus_leEq'. -unfold cg_minus in |- *; rstepr Pi; auto. -apply shift_minus_leEq; apply shift_leEq_plus'. -astepl ZeroR; auto. -apply minus_resp_leEq_both. -apply leEq_reflexive. -auto. +Proof. + intros. + astepl (Sin (Pi [/]TwoNZ[-]y)); astepr (Sin (Pi [/]TwoNZ[-]x)). + apply Sin_resp_leEq. + apply shift_leEq_minus; apply shift_plus_leEq'. + unfold cg_minus in |- *; rstepr Pi; auto. + apply shift_minus_leEq; apply shift_leEq_plus'. + astepl ZeroR; auto. + apply minus_resp_leEq_both. + apply leEq_reflexive. + auto. Qed. (* begin hide *) Lemma Cos_resp_less_aux : forall x y : IR, Zero [<] x -> x [<] y -> y [<=] Pi [/]TwoNZ -> Cos y [<] Cos x. -intros x y H H0 H1. -astepl (Cos y[+]Zero). -apply shift_plus_less'. -assert (H2 : Continuous_I (less_leEq _ _ _ H0) Sine). - apply included_imp_Continuous with realline; Contin. -assert (H3 : Continuous_I (Min_leEq_Max x y) Sine). - apply included_imp_Continuous with realline; Contin. -assert (H4 : Continuous_I (Min_leEq_Max y x) Sine). - apply included_imp_Continuous with realline; Contin. -assert (H5 : Continuous_I (Min_leEq_Max y x) {--}Sine). - apply included_imp_Continuous with realline; Contin. -apply less_leEq_trans with (Sin x[*] (y[-]x)). -apply mult_resp_pos. -apply Sin_pos; auto. -apply less_transitive_unfolded with (Pi [/]TwoNZ). -apply less_leEq_trans with y; auto. -PiSolve. -apply shift_less_minus; astepl x; auto. -apply leEq_wdr with (Integral H3). -eapply leEq_wdr. -2: apply eq_symmetric_unfolded; apply (Integral_integral _ _ _ _ H3 _ H2). -apply lb_integral. -intros z H6 Hx. -apply leEq_wdr with (Sin z). -2: simpl in |- *; algebra. -cut ( [--] (Pi [/]TwoNZ) [<=] x); intros. -inversion_clear H6; apply Sin_resp_leEq; auto. -apply leEq_transitive with y; auto. -apply leEq_transitive with ZeroR; PiSolve. -astepl ( [--][--] (Integral H3)). -apply eq_transitive_unfolded with ( [--] (Integral H4)). -apply un_op_wd_unfolded; apply eq_symmetric_unfolded; apply Integral_op. -apply eq_transitive_unfolded with (Integral H5). -apply eq_symmetric_unfolded; apply Integral_inv. -assert (H6 : Derivative realline CI Cosine {--}Sine). Deriv. -eapply eq_transitive_unfolded. -apply - Barrow with (derG0 := H6) (Ha := CI) (Hb := CI) (pJ := CI); - Contin; split. -simpl in |- *; algebra. +Proof. + intros x y H H0 H1. + astepl (Cos y[+]Zero). + apply shift_plus_less'. + assert (H2 : Continuous_I (less_leEq _ _ _ H0) Sine). + apply included_imp_Continuous with realline; Contin. + assert (H3 : Continuous_I (Min_leEq_Max x y) Sine). + apply included_imp_Continuous with realline; Contin. + assert (H4 : Continuous_I (Min_leEq_Max y x) Sine). + apply included_imp_Continuous with realline; Contin. + assert (H5 : Continuous_I (Min_leEq_Max y x) {--}Sine). + apply included_imp_Continuous with realline; Contin. + apply less_leEq_trans with (Sin x[*] (y[-]x)). + apply mult_resp_pos. + apply Sin_pos; auto. + apply less_transitive_unfolded with (Pi [/]TwoNZ). + apply less_leEq_trans with y; auto. + PiSolve. + apply shift_less_minus; astepl x; auto. + apply leEq_wdr with (Integral H3). + eapply leEq_wdr. + 2: apply eq_symmetric_unfolded; apply (Integral_integral _ _ _ _ H3 _ H2). + apply lb_integral. + intros z H6 Hx. + apply leEq_wdr with (Sin z). + 2: simpl in |- *; algebra. + cut ( [--] (Pi [/]TwoNZ) [<=] x); intros. + inversion_clear H6; apply Sin_resp_leEq; auto. + apply leEq_transitive with y; auto. + apply leEq_transitive with ZeroR; PiSolve. + astepl ( [--][--] (Integral H3)). + apply eq_transitive_unfolded with ( [--] (Integral H4)). + apply un_op_wd_unfolded; apply eq_symmetric_unfolded; apply Integral_op. + apply eq_transitive_unfolded with (Integral H5). + apply eq_symmetric_unfolded; apply Integral_inv. + assert (H6 : Derivative realline CI Cosine {--}Sine). Deriv. + eapply eq_transitive_unfolded. + apply Barrow with (derG0 := H6) (Ha := CI) (Hb := CI) (pJ := CI); Contin; split. + simpl in |- *; algebra. Qed. Lemma Cos_resp_less_aux' : forall x y : IR, Zero [<=] x -> x [<] y -> y [<=] Pi [/]TwoNZ -> Cos y [<] Cos x. -intros. -apply less_leEq_trans with (Cos ((x[+]y) [/]TwoNZ)). -apply Cos_resp_less_aux; auto. -apply pos_div_two; astepl (ZeroR[+]Zero); apply plus_resp_leEq_less; - try apply leEq_less_trans with x; auto. -apply shift_div_less; [ apply pos_two | apply shift_plus_less ]. -rstepr y; auto. -apply Cos_resp_leEq; auto. -apply shift_div_leEq. -apply pos_two. -rstepr (Pi [/]TwoNZ[+]Pi [/]TwoNZ[+]Pi). -astepl (x[+]y[+]Zero). -repeat apply plus_resp_leEq_both; auto. -apply less_leEq; apply less_leEq_trans with y; auto. -PiSolve. -apply shift_leEq_div; [ apply pos_two | apply shift_leEq_plus' ]. -rstepl x; apply less_leEq; auto. +Proof. + intros. + apply less_leEq_trans with (Cos ((x[+]y) [/]TwoNZ)). + apply Cos_resp_less_aux; auto. + apply pos_div_two; astepl (ZeroR[+]Zero); apply plus_resp_leEq_less; + try apply leEq_less_trans with x; auto. + apply shift_div_less; [ apply pos_two | apply shift_plus_less ]. + rstepr y; auto. + apply Cos_resp_leEq; auto. + apply shift_div_leEq. + apply pos_two. + rstepr (Pi [/]TwoNZ[+]Pi [/]TwoNZ[+]Pi). + astepl (x[+]y[+]Zero). + repeat apply plus_resp_leEq_both; auto. + apply less_leEq; apply less_leEq_trans with y; auto. + PiSolve. + apply shift_leEq_div; [ apply pos_two | apply shift_leEq_plus' ]. + rstepl x; apply less_leEq; auto. Qed. (* end hide *) Lemma Cos_resp_less : forall x y, Zero [<=] x -> x [<] y -> y [<=] Pi -> Cos y [<] Cos x. -intros x y H H0 H1. -simpl in |- *. -assert (Hab : Zero [<=] Pi [/]TwoNZ). - apply less_leEq; apply pos_div_two; apply pos_Pi. -assert (Hbc : Pi [/]TwoNZ [<=] Pi). - apply less_leEq; apply pos_div_two'; apply pos_Pi. -assert (Hac : Zero [<=] Pi). - apply leEq_transitive with (Pi [/]TwoNZ); auto. -apply strict_dec_glues with (Hab := Hab) (Hbc := Hbc) (Hac := Hac). -Included. -intros x0 y0 H2 H3 H4 Hx Hy. -apply less_wdl with (Cos x0); [ apply less_wdr with (Cos y0) | idtac ]; - [ idtac | simpl in |- *; algebra | simpl in |- *; algebra ]. -inversion_clear H2; inversion_clear H3; apply Cos_resp_less_aux'; auto. -intros x0 y0 H2 H3 H4 Hx Hy. -apply less_wdl with (Cos x0); [ apply less_wdr with (Cos y0) | idtac ]; - [ idtac | simpl in |- *; algebra | simpl in |- *; algebra ]. -astepl (Cos [--]x0); astepl ( [--][--] (Cos [--]x0)); - astepl ( [--] (Cos ( [--]x0[+]Pi))). -apply less_wdl with ( [--] (Cos (Pi[-]x0))). -2: apply un_op_wd_unfolded; apply Cos_wd; rational. -astepr (Cos [--]y0); astepr ( [--][--] (Cos [--]y0)); - astepr ( [--] (Cos ( [--]y0[+]Pi))). -apply less_wdr with ( [--] (Cos (Pi[-]y0))). -2: apply un_op_wd_unfolded; apply Cos_wd; rational. -apply inv_resp_less. -inversion_clear H2; inversion_clear H3; apply Cos_resp_less_aux'. -apply shift_leEq_minus; astepl x0; auto. -unfold cg_minus in |- *; apply plus_resp_leEq_less; - [ apply leEq_reflexive | apply inv_resp_less; auto ]. -apply shift_minus_leEq; apply shift_leEq_plus'; rstepl (Pi [/]TwoNZ); auto. -split; auto; apply less_leEq; apply leEq_less_trans with x; auto. -split; auto; apply less_leEq; apply less_leEq_trans with y; auto. -auto. +Proof. + intros x y H H0 H1. + simpl in |- *. + assert (Hab : Zero [<=] Pi [/]TwoNZ). + apply less_leEq; apply pos_div_two; apply pos_Pi. + assert (Hbc : Pi [/]TwoNZ [<=] Pi). + apply less_leEq; apply pos_div_two'; apply pos_Pi. + assert (Hac : Zero [<=] Pi). + apply leEq_transitive with (Pi [/]TwoNZ); auto. + apply strict_dec_glues with (Hab := Hab) (Hbc := Hbc) (Hac := Hac). + Included. + intros x0 y0 H2 H3 H4 Hx Hy. + apply less_wdl with (Cos x0); [ apply less_wdr with (Cos y0) | idtac ]; + [ idtac | simpl in |- *; algebra | simpl in |- *; algebra ]. + inversion_clear H2; inversion_clear H3; apply Cos_resp_less_aux'; auto. + intros x0 y0 H2 H3 H4 Hx Hy. + apply less_wdl with (Cos x0); [ apply less_wdr with (Cos y0) | idtac ]; + [ idtac | simpl in |- *; algebra | simpl in |- *; algebra ]. + astepl (Cos [--]x0); astepl ( [--][--] (Cos [--]x0)); astepl ( [--] (Cos ( [--]x0[+]Pi))). + apply less_wdl with ( [--] (Cos (Pi[-]x0))). + 2: apply un_op_wd_unfolded; apply Cos_wd; rational. + astepr (Cos [--]y0); astepr ( [--][--] (Cos [--]y0)); astepr ( [--] (Cos ( [--]y0[+]Pi))). + apply less_wdr with ( [--] (Cos (Pi[-]y0))). + 2: apply un_op_wd_unfolded; apply Cos_wd; rational. + apply inv_resp_less. + inversion_clear H2; inversion_clear H3; apply Cos_resp_less_aux'. + apply shift_leEq_minus; astepl x0; auto. + unfold cg_minus in |- *; apply plus_resp_leEq_less; + [ apply leEq_reflexive | apply inv_resp_less; auto ]. + apply shift_minus_leEq; apply shift_leEq_plus'; rstepl (Pi [/]TwoNZ); auto. + split; auto; apply less_leEq; apply leEq_less_trans with x; auto. + split; auto; apply less_leEq; apply less_leEq_trans with y; auto. + auto. Qed. Lemma Sin_resp_less : forall x y, [--] (Pi [/]TwoNZ) [<=] x -> x [<] y -> y [<=] Pi [/]TwoNZ -> Sin x [<] Sin y. -intros. -astepl (Cos (Pi [/]TwoNZ[-]x)); astepr (Cos (Pi [/]TwoNZ[-]y)). -apply Cos_resp_less; auto. -apply shift_leEq_minus; astepl y; auto. -unfold cg_minus in |- *; apply plus_resp_leEq_less; - [ apply leEq_reflexive | apply inv_resp_less; auto ]. -apply shift_minus_leEq; apply shift_leEq_plus'; rstepl ( [--] (Pi [/]TwoNZ)); - auto. +Proof. + intros. + astepl (Cos (Pi [/]TwoNZ[-]x)); astepr (Cos (Pi [/]TwoNZ[-]y)). + apply Cos_resp_less; auto. + apply shift_leEq_minus; astepl y; auto. + unfold cg_minus in |- *; apply plus_resp_leEq_less; + [ apply leEq_reflexive | apply inv_resp_less; auto ]. + apply shift_minus_leEq; apply shift_leEq_plus'; rstepl ( [--] (Pi [/]TwoNZ)); auto. Qed. Lemma Sin_ap_Zero : forall x:IR, (forall z, x[#](zring z)[*]Pi) -> Sin x [#] Zero. Proof. -cut (forall x : IR, Zero[<]x -> (forall n : nat, x[#]nring (R:=IR) n[*]Pi) -> Sin x[#]Zero). - intros X x Hx. - destruct (ap_imp_less _ _ _ (Hx 0)). - rstepl ([--][--](Sin x)). - rstepr ([--]Zero:IR). - apply inv_resp_ap. - csetoid_rewrite_rev (Sin_inv x). + cut (forall x : IR, Zero[<]x -> (forall n : nat, x[#]nring (R:=IR) n[*]Pi) -> Sin x[#]Zero). + intros X x Hx. + destruct (ap_imp_less _ _ _ (Hx 0)). + rstepl ([--][--](Sin x)). + rstepr ([--]Zero:IR). + apply inv_resp_ap. + csetoid_rewrite_rev (Sin_inv x). + apply X. + rstepl ([--](Zero[*]Pi):IR). + apply inv_resp_less. + assumption. + intros n. + csetoid_rewrite_rev (zring_plus_nat IR n). + replace (n:Z) with (- - n)%Z by ring. + csetoid_rewrite (zring_inv IR (- n)%Z). + rstepr ([--](zring (-n)[*]Pi)). + apply inv_resp_ap. + apply Hx. apply X. - rstepl ([--](Zero[*]Pi):IR). - apply inv_resp_less. + rstepl (Zero[*]Pi). assumption. intros n. csetoid_rewrite_rev (zring_plus_nat IR n). - replace (n:Z) with (- - n)%Z by ring. - csetoid_rewrite (zring_inv IR (- n)%Z). - rstepr ([--](zring (-n)[*]Pi)). - apply inv_resp_ap. apply Hx. - apply X. - rstepl (Zero[*]Pi). - assumption. - intros n. - csetoid_rewrite_rev (zring_plus_nat IR n). - apply Hx. - -cut (forall x : IR, -Zero[<]x -> x[<]Two[*]Pi -> (x[#]Pi) -> Sin x[#]Zero). - intros X x Hx0 Hx1. - assert (Hpi : (Zero[<]Two[*]Pi)). - apply mult_resp_pos. - apply (nring_pos); auto with *. - auto with *. - destruct (Archimedes' (x[/](Two[*]Pi)[//](Greater_imp_ap _ _ _ Hpi))) as [n Hn]. - generalize x Hx0 Hx1 Hn. - clear x Hx0 Hx1 Hn. - induction n; intros x Hx0 Hx1 Hn. - elim (less_antisymmetric_unfolded _ _ _ Hn). - apply div_resp_pos; assumption. - destruct (ap_imp_less _ _ _ (Hx1 (2*n))). - apply IHn; try assumption. - apply shift_div_less'. - assumption. - rstepr ((nring 2[*]nring n)[*]Pi). - stepr (nring (R:=IR) (2 * n)[*]Pi). - assumption. - apply mult_wdl. - apply nring_comm_mult. - destruct n as [|n]. - apply X; try assumption. - rstepr ((Two[*]Pi)[*]One). - eapply shift_less_mult'. + cut (forall x : IR, Zero[<]x -> x[<]Two[*]Pi -> (x[#]Pi) -> Sin x[#]Zero). + intros X x Hx0 Hx1. + assert (Hpi : (Zero[<]Two[*]Pi)). + apply mult_resp_pos. + apply (nring_pos); auto with *. + auto with *. + destruct (Archimedes' (x[/](Two[*]Pi)[//](Greater_imp_ap _ _ _ Hpi))) as [n Hn]. + generalize x Hx0 Hx1 Hn. + clear x Hx0 Hx1 Hn. + induction n; intros x Hx0 Hx1 Hn. + elim (less_antisymmetric_unfolded _ _ _ Hn). + apply div_resp_pos; assumption. + destruct (ap_imp_less _ _ _ (Hx1 (2*n))). + apply IHn; try assumption. + apply shift_div_less'. assumption. - rstepr (nring 1:IR). - apply Hn. - rstepr ((nring 1:IR)[*]Pi). - apply Hx1. - rstepl (Sin (x[-]Two[*]Pi[+]Two[*]Pi)). - csetoid_rewrite (Sin_periodic (x[-]Two[*]Pi)). - apply IHn. - apply shift_zero_less_minus. - eapply leEq_less_trans;[|apply c]. - stepr ((Two:IR)[*]nring (S n)[*]Pi); - [|csetoid_rewrite (nring_comm_mult IR (2%nat) (S n)); apply eq_reflexive]. - rstepl (Two[*]Pi[*]nring 1). - rstepr (Two[*]Pi[*]nring (S n)). - apply mult_resp_leEq_lft. - apply nring_leEq; auto with *. - apply less_leEq; assumption. - intros i. - apply zero_minus_apart. - rstepl (x[-]((nring 2[+]nring i)[*]Pi)). - apply minus_ap_zero. - csetoid_rewrite_rev (nring_comm_plus IR 2 i). - apply Hx1. - rstepl ((x[/](Two[*]Pi)[//]Greater_imp_ap IR (Two[*]Pi) Zero Hpi)[-](nring 1)). - apply shift_minus_less. - csetoid_rewrite_rev (nring_comm_plus IR (S n) 1). - rewrite plus_comm. - assumption. - -intros x Hx0 Hx1 Hx2. -destruct (ap_imp_less _ _ _ Hx2). + rstepr ((nring 2[*]nring n)[*]Pi). + stepr (nring (R:=IR) (2 * n)[*]Pi). + assumption. + apply mult_wdl. + apply nring_comm_mult. + destruct n as [|n]. + apply X; try assumption. + rstepr ((Two[*]Pi)[*]One). + eapply shift_less_mult'. + assumption. + rstepr (nring 1:IR). + apply Hn. + rstepr ((nring 1:IR)[*]Pi). + apply Hx1. + rstepl (Sin (x[-]Two[*]Pi[+]Two[*]Pi)). + csetoid_rewrite (Sin_periodic (x[-]Two[*]Pi)). + apply IHn. + apply shift_zero_less_minus. + eapply leEq_less_trans;[|apply c]. + stepr ((Two:IR)[*]nring (S n)[*]Pi); + [|csetoid_rewrite (nring_comm_mult IR (2%nat) (S n)); apply eq_reflexive]. + rstepl (Two[*]Pi[*]nring 1). + rstepr (Two[*]Pi[*]nring (S n)). + apply mult_resp_leEq_lft. + apply nring_leEq; auto with *. + apply less_leEq; assumption. + intros i. + apply zero_minus_apart. + rstepl (x[-]((nring 2[+]nring i)[*]Pi)). + apply minus_ap_zero. + csetoid_rewrite_rev (nring_comm_plus IR 2 i). + apply Hx1. + rstepl ((x[/](Two[*]Pi)[//]Greater_imp_ap IR (Two[*]Pi) Zero Hpi)[-](nring 1)). + apply shift_minus_less. + csetoid_rewrite_rev (nring_comm_plus IR (S n) 1). + rewrite plus_comm. + assumption. + intros x Hx0 Hx1 Hx2. + destruct (ap_imp_less _ _ _ Hx2). + apply Greater_imp_ap. + apply Sin_pos; assumption. + rstepl (Sin (x[-]Pi[+]Pi)). + csetoid_rewrite (Sin_plus_Pi (x[-]Pi)). + rstepr ([--]Zero:IR). + apply inv_resp_ap. apply Greater_imp_ap. - apply Sin_pos; assumption. -rstepl (Sin (x[-]Pi[+]Pi)). -csetoid_rewrite (Sin_plus_Pi (x[-]Pi)). -rstepr ([--]Zero:IR). -apply inv_resp_ap. -apply Greater_imp_ap. -apply Sin_pos. - apply shift_zero_less_minus. + apply Sin_pos. + apply shift_zero_less_minus. + assumption. + apply shift_minus_less. + rstepr (Two[*]Pi). assumption. -apply shift_minus_less. -rstepr (Two[*]Pi). -assumption. Qed. Lemma Cos_ap_Zero : forall x:IR, (forall z, x[#]Pi[/]TwoNZ[+](zring z)[*]Pi) -> Cos x [#] Zero. Proof. -intros x Hx. -stepl (Cos (x[-](Pi[/]TwoNZ)[+](Pi[/]TwoNZ))) by - apply Cos_wd; rational. -csetoid_rewrite (Cos_plus_HalfPi (x[-](Pi[/]TwoNZ))). -rstepr ([--]Zero:IR). -apply inv_resp_ap. -apply Sin_ap_Zero. -intros i. -apply zero_minus_apart. -rstepl (x[-](Pi[/]TwoNZ[+]zring i[*]Pi)). -apply minus_ap_zero. -apply Hx. + intros x Hx. + stepl (Cos (x[-](Pi[/]TwoNZ)[+](Pi[/]TwoNZ))) by apply Cos_wd; rational. + csetoid_rewrite (Cos_plus_HalfPi (x[-](Pi[/]TwoNZ))). + rstepr ([--]Zero:IR). + apply inv_resp_ap. + apply Sin_ap_Zero. + intros i. + apply zero_minus_apart. + rstepl (x[-](Pi[/]TwoNZ[+]zring i[*]Pi)). + apply minus_ap_zero. + apply Hx. Qed. Section Tangent. Lemma Tang_Domain : forall x:IR, (forall z, x[#]Pi[/]TwoNZ[+](zring z)[*]Pi) -> Dom Tang x. Proof. -intros. -repeat split; try constructor. -intros []. -apply: Cos_ap_Zero. -assumption. + intros. + repeat split; try constructor. + intros []. + apply: Cos_ap_Zero. + assumption. Qed. Lemma Tang_Domain' : included (olor ([--](Pi[/]TwoNZ)) (Pi[/]TwoNZ)) (Dom Tang). Proof. -intros x [Hx0 Hx1]. -apply Tang_Domain. -intros z. -destruct (Z_lt_le_dec z 0). - apply Greater_imp_ap. - eapply leEq_less_trans;[|apply Hx0]. - rstepr ([--]Zero[*]Pi[-]Pi[/]TwoNZ). - apply shift_leEq_minus. - rstepl (((zring z)[+](zring 1))[*]Pi). - apply mult_resp_leEq_rht;[|apply less_leEq; auto with *]. - stepl (zring (z+1):IR) by apply zring_plus. - replace (z+1)%Z with (-(-z-1))%Z by ring. - assert (0<=-z-1)%Z. - auto with *. - rewrite (Z_to_nat_correct H). - stepl ([--](nring (Z_to_nat H)):IR) by apply eq_symmetric; apply zring_inv_nat. - apply inv_resp_leEq. + intros x [Hx0 Hx1]. + apply Tang_Domain. + intros z. + destruct (Z_lt_le_dec z 0). + apply Greater_imp_ap. + eapply leEq_less_trans;[|apply Hx0]. + rstepr ([--]Zero[*]Pi[-]Pi[/]TwoNZ). + apply shift_leEq_minus. + rstepl (((zring z)[+](zring 1))[*]Pi). + apply mult_resp_leEq_rht;[|apply less_leEq; auto with *]. + stepl (zring (z+1):IR) by apply zring_plus. + replace (z+1)%Z with (-(-z-1))%Z by ring. + assert (0<=-z-1)%Z. + auto with *. + rewrite (Z_to_nat_correct H). + stepl ([--](nring (Z_to_nat H)):IR) by apply eq_symmetric; apply zring_inv_nat. + apply inv_resp_leEq. + apply nring_nonneg. + apply less_imp_ap. + eapply less_leEq_trans. + apply Hx1. + rstepl (Pi[/]TwoNZ[+]Zero). + apply plus_resp_leEq_lft. + apply mult_resp_nonneg;[|apply less_leEq; auto with *]. + rewrite (Z_to_nat_correct z0). + stepr (nring (Z_to_nat z0):IR) by auto with *. apply nring_nonneg. -apply less_imp_ap. -eapply less_leEq_trans. - apply Hx1. -rstepl (Pi[/]TwoNZ[+]Zero). -apply plus_resp_leEq_lft. -apply mult_resp_nonneg;[|apply less_leEq; auto with *]. -rewrite (Z_to_nat_correct z0). -stepr (nring (Z_to_nat z0):IR) by auto with *. -apply nring_nonneg. Qed. (** @@ -479,281 +471,257 @@ monotonicity properties. *) Lemma bnd_Cos : bnd_away_zero_in_P Cosine (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)). -intros a b Hab H. -split. -Included. -set (pos2 := less_leEq _ _ _ (pos_two IR)) in *. -assert (H0 : Zero [<] sqrt Two pos2). - apply power_cancel_less with 2. - apply sqrt_nonneg. - astepl ZeroR; astepr (Two:IR); apply pos_two. -set (Hsqrt := pos_ap_zero _ _ H0) in *. -exists (Min (Min (Cos a) (Cos b)) (One[/] _[//]Hsqrt)). -elim (H _ (compact_inc_lft _ _ Hab)); intros. -elim (H _ (compact_inc_rht _ _ Hab)); intros. -repeat apply less_Min; try apply Cos_pos; auto. -apply recip_resp_pos. -apply power_cancel_less with 2. -apply sqrt_nonneg. -astepl ZeroR; astepr (Two:IR); apply pos_two. -intros y Hy X. -apply leEq_wdr with (Cos y). -2: apply eq_transitive_unfolded with (AbsIR (Cos y)). -2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. -2: apply less_leEq; elim (H y X); intros; apply Cos_pos; auto. -2: apply AbsIR_wd; simpl in |- *; algebra. -elim (less_cotransitive_unfolded _ _ _ pos_QuarterPi y); intros. -eapply leEq_transitive. -apply Min_leEq_lft. -apply leEq_transitive with (Cos b). -apply Min_leEq_rht. -elim (H _ (compact_inc_rht _ _ Hab)); elim (H y X); intros. -inversion_clear X. -apply Cos_resp_leEq; auto; apply less_leEq; auto. -apply less_transitive_unfolded with (Pi [/]TwoNZ); PiSolve. -elim (less_cotransitive_unfolded _ _ _ neg_invQuarterPi y); intros. -2: eapply leEq_transitive. -2: apply Min_leEq_lft. -2: apply leEq_transitive with (Cos a). -2: apply Min_leEq_lft. -2: astepl (Cos [--]a); astepr (Cos [--]y). -2: elim (H _ (compact_inc_lft _ _ Hab)); elim (H y X); intros. -2: inversion_clear X. -2: apply Cos_resp_leEq; auto. -2: astepl ( [--]ZeroR); apply less_leEq; apply inv_resp_less; auto. -2: apply less_leEq; apply less_transitive_unfolded with (Pi [/]TwoNZ). -2: astepr ( [--][--] (Pi [/]TwoNZ)); apply inv_resp_less; auto. -2: PiSolve. -2: apply inv_resp_leEq; auto. -eapply leEq_transitive. -apply Min_leEq_rht. -apply - leEq_wdr - with - ((One[/] _[//]Hsqrt) [*] (Cos (y[+]Pi [/]FourNZ) [+]Sin (y[+]Pi [/]FourNZ))). -apply shift_div_leEq; auto. -rstepr (Cos (y[+]Pi [/]FourNZ) [+]Sin (y[+]Pi [/]FourNZ)). -set (z := y[+]Pi [/]FourNZ) in *. -cut (Zero [<] z); intros. -2: unfold z in |- *; apply shift_less_plus. -2: astepl ( [--] (Pi [/]FourNZ)); auto. -cut (z [<] Pi [/]TwoNZ); intros. -2: unfold z in |- *; apply shift_plus_less. -2: rstepr (Pi [/]FourNZ); auto. -apply power_cancel_leEq with 2. -auto. -astepl (ZeroR[+]Zero); apply plus_resp_leEq_both. -apply less_leEq; apply pos_cos; try apply less_leEq; auto. -apply less_leEq; apply Sin_pos; try apply less_leEq; auto. -apply less_transitive_unfolded with (Pi [/]TwoNZ); PiSolve. -simpl in |- *. -astepl (One[*]OneR); astepl OneR. -apply leEq_wdr with (Cos z[^]2[+]Sin z[^]2[+]Two[*]Sin z[*]Cos z). -2: simpl in |- *; rational. -astepr (One[+]Sin (Two[*]z)). -astepl (One[+]ZeroR); apply less_leEq. -apply plus_resp_leEq_less. -apply leEq_reflexive. -apply Sin_pos. -apply shift_less_mult' with (two_ap_zero IR). -apply pos_two. -astepl ZeroR; auto. -astepl (z[*]Two). -apply shift_mult_less with (two_ap_zero IR). -apply pos_two. -auto. -apply - eq_transitive_unfolded with (Cos (y[+]Pi [/]FourNZ[+][--] (Pi [/]FourNZ))). -2: apply Cos_wd; rational. -astepl - ((One[/] _[//]Hsqrt) [*]Cos (y[+]Pi [/]FourNZ) [+] - (One[/] _[//]Hsqrt) [*]Sin (y[+]Pi [/]FourNZ)). -astepl - (Cos (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [+] - Sin (Pi [/]FourNZ) [*]Sin (y[+]Pi [/]FourNZ)). -astepl - (Cos (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [+] - [--][--] (Sin (Pi [/]FourNZ) [*]Sin (y[+]Pi [/]FourNZ))). -astepl - (Cos [--] (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [+] - [--] ( [--] (Sin (Pi [/]FourNZ)) [*]Sin (y[+]Pi [/]FourNZ))). -astepl - (Cos [--] (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [+] - [--] (Sin [--] (Pi [/]FourNZ) [*]Sin (y[+]Pi [/]FourNZ))). -astepl - (Cos [--] (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [-] - Sin [--] (Pi [/]FourNZ) [*]Sin (y[+]Pi [/]FourNZ)). -astepl - (Cos (y[+]Pi [/]FourNZ) [*]Cos [--] (Pi [/]FourNZ) [-] - Sin (y[+]Pi [/]FourNZ) [*]Sin [--] (Pi [/]FourNZ)). -apply eq_symmetric_unfolded; apply Cos_plus. +Proof. + intros a b Hab H. + split. + Included. + set (pos2 := less_leEq _ _ _ (pos_two IR)) in *. + assert (H0 : Zero [<] sqrt Two pos2). + apply power_cancel_less with 2. + apply sqrt_nonneg. + astepl ZeroR; astepr (Two:IR); apply pos_two. + set (Hsqrt := pos_ap_zero _ _ H0) in *. + exists (Min (Min (Cos a) (Cos b)) (One[/] _[//]Hsqrt)). + elim (H _ (compact_inc_lft _ _ Hab)); intros. + elim (H _ (compact_inc_rht _ _ Hab)); intros. + repeat apply less_Min; try apply Cos_pos; auto. + apply recip_resp_pos. + apply power_cancel_less with 2. + apply sqrt_nonneg. + astepl ZeroR; astepr (Two:IR); apply pos_two. + intros y Hy X. + apply leEq_wdr with (Cos y). + 2: apply eq_transitive_unfolded with (AbsIR (Cos y)). + 2: apply eq_symmetric_unfolded; apply AbsIR_eq_x. + 2: apply less_leEq; elim (H y X); intros; apply Cos_pos; auto. + 2: apply AbsIR_wd; simpl in |- *; algebra. + elim (less_cotransitive_unfolded _ _ _ pos_QuarterPi y); intros. + eapply leEq_transitive. + apply Min_leEq_lft. + apply leEq_transitive with (Cos b). + apply Min_leEq_rht. + elim (H _ (compact_inc_rht _ _ Hab)); elim (H y X); intros. + inversion_clear X. + apply Cos_resp_leEq; auto; apply less_leEq; auto. + apply less_transitive_unfolded with (Pi [/]TwoNZ); PiSolve. + elim (less_cotransitive_unfolded _ _ _ neg_invQuarterPi y); intros. + 2: eapply leEq_transitive. + 2: apply Min_leEq_lft. + 2: apply leEq_transitive with (Cos a). + 2: apply Min_leEq_lft. + 2: astepl (Cos [--]a); astepr (Cos [--]y). + 2: elim (H _ (compact_inc_lft _ _ Hab)); elim (H y X); intros. + 2: inversion_clear X. + 2: apply Cos_resp_leEq; auto. + 2: astepl ( [--]ZeroR); apply less_leEq; apply inv_resp_less; auto. + 2: apply less_leEq; apply less_transitive_unfolded with (Pi [/]TwoNZ). + 2: astepr ( [--][--] (Pi [/]TwoNZ)); apply inv_resp_less; auto. + 2: PiSolve. + 2: apply inv_resp_leEq; auto. + eapply leEq_transitive. + apply Min_leEq_rht. + apply leEq_wdr with ((One[/] _[//]Hsqrt) [*] (Cos (y[+]Pi [/]FourNZ) [+]Sin (y[+]Pi [/]FourNZ))). + apply shift_div_leEq; auto. + rstepr (Cos (y[+]Pi [/]FourNZ) [+]Sin (y[+]Pi [/]FourNZ)). + set (z := y[+]Pi [/]FourNZ) in *. + cut (Zero [<] z); intros. + 2: unfold z in |- *; apply shift_less_plus. + 2: astepl ( [--] (Pi [/]FourNZ)); auto. + cut (z [<] Pi [/]TwoNZ); intros. + 2: unfold z in |- *; apply shift_plus_less. + 2: rstepr (Pi [/]FourNZ); auto. + apply power_cancel_leEq with 2. + auto. + astepl (ZeroR[+]Zero); apply plus_resp_leEq_both. + apply less_leEq; apply pos_cos; try apply less_leEq; auto. + apply less_leEq; apply Sin_pos; try apply less_leEq; auto. + apply less_transitive_unfolded with (Pi [/]TwoNZ); PiSolve. + simpl in |- *. + astepl (One[*]OneR); astepl OneR. + apply leEq_wdr with (Cos z[^]2[+]Sin z[^]2[+]Two[*]Sin z[*]Cos z). + 2: simpl in |- *; rational. + astepr (One[+]Sin (Two[*]z)). + astepl (One[+]ZeroR); apply less_leEq. + apply plus_resp_leEq_less. + apply leEq_reflexive. + apply Sin_pos. + apply shift_less_mult' with (two_ap_zero IR). + apply pos_two. + astepl ZeroR; auto. + astepl (z[*]Two). + apply shift_mult_less with (two_ap_zero IR). + apply pos_two. + auto. + apply eq_transitive_unfolded with (Cos (y[+]Pi [/]FourNZ[+][--] (Pi [/]FourNZ))). + 2: apply Cos_wd; rational. + astepl ((One[/] _[//]Hsqrt) [*]Cos (y[+]Pi [/]FourNZ) [+] + (One[/] _[//]Hsqrt) [*]Sin (y[+]Pi [/]FourNZ)). + astepl (Cos (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [+] + Sin (Pi [/]FourNZ) [*]Sin (y[+]Pi [/]FourNZ)). + astepl (Cos (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [+] + [--][--] (Sin (Pi [/]FourNZ) [*]Sin (y[+]Pi [/]FourNZ))). + astepl (Cos [--] (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [+] + [--] ( [--] (Sin (Pi [/]FourNZ)) [*]Sin (y[+]Pi [/]FourNZ))). + astepl (Cos [--] (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [+] + [--] (Sin [--] (Pi [/]FourNZ) [*]Sin (y[+]Pi [/]FourNZ))). + astepl (Cos [--] (Pi [/]FourNZ) [*]Cos (y[+]Pi [/]FourNZ) [-] + Sin [--] (Pi [/]FourNZ) [*]Sin (y[+]Pi [/]FourNZ)). + astepl (Cos (y[+]Pi [/]FourNZ) [*]Cos [--] (Pi [/]FourNZ) [-] + Sin (y[+]Pi [/]FourNZ) [*]Sin [--] (Pi [/]FourNZ)). + apply eq_symmetric_unfolded; apply Cos_plus. Qed. Opaque Sine Cosine. Lemma Derivative_Tan_1 : forall H, Derivative (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) H Tang {1/} (Cosine{^}2). -intros. -assert (H0 : Derivative _ H Sine Cosine). - apply Included_imp_Derivative with realline CI; Deriv. -assert (H1 : Derivative _ H Cosine {--}Sine). - apply Included_imp_Derivative with realline CI; Deriv. -assert - (H2 : forall x : IR, olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ) x -> Cos x [#] Zero). - intros x H2; apply Greater_imp_ap; inversion_clear H2; apply Cos_pos; auto. -unfold Tang in |- *. -Derivative_Help. -apply eq_imp_Feq. -apply included_FDiv. -apply included_FMinus; Included. -Included. -intros; simpl in |- *; apply ap_wdl with (Cos x[*]Cos x). -apply mult_resp_ap_zero; auto. -simpl in |- *; algebra. -apply included_FRecip. -Included. -intros; simpl in |- *; apply ap_wdl with (Cos x[*]Cos x). -apply mult_resp_ap_zero; auto. -astepl (One[*]Cos x[*]Cos x); simpl in |- *; algebra. -intros x H3 Hx Hx'. -apply - eq_transitive_unfolded - with - (Cos x[*]Cos x[-]Sin x[*][--] (Sin x) [/] _[//] - mult_resp_ap_zero _ _ _ (H2 x H3) (H2 x H3)). -elim Hx; intros H4 H5. -astepl - (Part _ _ (ProjIR1 (CAnd_intro _ _ H4 H5)) [/] _[//] - ext2 (S:=IR) (ProjIR2 (CAnd_intro _ _ H4 H5))). -astepl (Part _ _ H4[/] _[//]ext2 (S:=IR) H5); clear Hx. -apply div_wd. -simpl in |- *. -astepl (Part _ _ (ProjIR1 H4) [-]Part _ _ (ProjIR2 H4)). -elim H4; clear H4; intros H6 H7. -astepl (Part _ _ H6[-]Part _ _ H7). -apply cg_minus_wd; simpl in |- *; algebra. -elim H5; clear H5; intros H6 H7. -astepl (Part _ _ H6). -simpl in |- *; algebra. -apply - eq_transitive_unfolded - with (One[/] _[//]mult_resp_ap_zero _ _ _ (H2 x H3) (H2 x H3)). -apply div_wd. -2: simpl in |- *; algebra. -astepr (Cos x[^]2[+]Sin x[^]2); simpl in |- *; rational. -simpl in Hx'; astepr (One[/] _[//]ext2 (S:=IR) Hx'). -apply div_wd. -algebra. -astepl (One[*]Cos x[*]Cos x); simpl in |- *; algebra. -apply Derivative_div. -Deriv. -Deriv. -apply bnd_Cos. +Proof. + intros. + assert (H0 : Derivative _ H Sine Cosine). + apply Included_imp_Derivative with realline CI; Deriv. + assert (H1 : Derivative _ H Cosine {--}Sine). + apply Included_imp_Derivative with realline CI; Deriv. + assert (H2 : forall x : IR, olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ) x -> Cos x [#] Zero). + intros x H2; apply Greater_imp_ap; inversion_clear H2; apply Cos_pos; auto. + unfold Tang in |- *. + Derivative_Help. + apply eq_imp_Feq. + apply included_FDiv. + apply included_FMinus; Included. + Included. + intros; simpl in |- *; apply ap_wdl with (Cos x[*]Cos x). + apply mult_resp_ap_zero; auto. + simpl in |- *; algebra. + apply included_FRecip. + Included. + intros; simpl in |- *; apply ap_wdl with (Cos x[*]Cos x). + apply mult_resp_ap_zero; auto. + astepl (One[*]Cos x[*]Cos x); simpl in |- *; algebra. + intros x H3 Hx Hx'. + apply eq_transitive_unfolded with (Cos x[*]Cos x[-]Sin x[*][--] (Sin x) [/] _[//] + mult_resp_ap_zero _ _ _ (H2 x H3) (H2 x H3)). + elim Hx; intros H4 H5. + astepl (Part _ _ (ProjIR1 (CAnd_intro _ _ H4 H5)) [/] _[//] + ext2 (S:=IR) (ProjIR2 (CAnd_intro _ _ H4 H5))). + astepl (Part _ _ H4[/] _[//]ext2 (S:=IR) H5); clear Hx. + apply div_wd. + simpl in |- *. + astepl (Part _ _ (ProjIR1 H4) [-]Part _ _ (ProjIR2 H4)). + elim H4; clear H4; intros H6 H7. + astepl (Part _ _ H6[-]Part _ _ H7). + apply cg_minus_wd; simpl in |- *; algebra. + elim H5; clear H5; intros H6 H7. + astepl (Part _ _ H6). + simpl in |- *; algebra. + apply eq_transitive_unfolded with (One[/] _[//]mult_resp_ap_zero _ _ _ (H2 x H3) (H2 x H3)). + apply div_wd. + 2: simpl in |- *; algebra. + astepr (Cos x[^]2[+]Sin x[^]2); simpl in |- *; rational. + simpl in Hx'; astepr (One[/] _[//]ext2 (S:=IR) Hx'). + apply div_wd. + algebra. + astepl (One[*]Cos x[*]Cos x); simpl in |- *; algebra. + apply Derivative_div. + Deriv. + Deriv. + apply bnd_Cos. Qed. Lemma Derivative_Tan_2 : forall H, Derivative (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) H Tang ( [-C-]One{+}Tang{^}2). -intros. -eapply Derivative_wdr. -2: apply Derivative_Tan_1. -assert - (H0 : forall x : IR, olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ) x -> Cos x [#] Zero). - intros x H0; apply Greater_imp_ap; inversion_clear H0; apply Cos_pos; auto. -apply eq_imp_Feq. -apply included_FRecip. -Included. -intros; simpl in |- *; apply ap_wdl with (Cos x[*]Cos x). -apply mult_resp_ap_zero; auto. -astepl (One[*]Cos x[*]Cos x); simpl in |- *; algebra. -apply included_FPlus. -Included. -apply included_FNth. -unfold Tang in |- *; apply included_FDiv. -Included. -Included. -intros; simpl in |- *; astepl (Cos x). algebra. -simpl in |- *; algebra. -intros x H1 Hx Hx'. -apply - eq_transitive_unfolded - with (One[/] _[//]mult_resp_ap_zero _ _ _ (H0 x H1) (H0 x H1)). -simpl in |- *; apply div_wd. -algebra. -astepr (One[*]Cos x[*]Cos x); simpl in |- *; algebra. -astepl - (Cos x[^]2[+]Sin x[^]2[/] _[//]mult_resp_ap_zero _ _ _ (H0 x H1) (H0 x H1)). -apply - eq_transitive_unfolded - with (One[+]One[*] (Sin x[/] _[//]H0 x H1) [*] (Sin x[/] _[//]H0 x H1)). -2: simpl in |- *; apply bin_op_wd_unfolded. -2: algebra. -2: repeat simple apply mult_wd; try apply div_wd; algebra. -simpl in |- *. -rational. +Proof. + intros. + eapply Derivative_wdr. + 2: apply Derivative_Tan_1. + assert (H0 : forall x : IR, olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ) x -> Cos x [#] Zero). + intros x H0; apply Greater_imp_ap; inversion_clear H0; apply Cos_pos; auto. + apply eq_imp_Feq. + apply included_FRecip. + Included. + intros; simpl in |- *; apply ap_wdl with (Cos x[*]Cos x). + apply mult_resp_ap_zero; auto. + astepl (One[*]Cos x[*]Cos x); simpl in |- *; algebra. + apply included_FPlus. + Included. + apply included_FNth. + unfold Tang in |- *; apply included_FDiv. + Included. + Included. + intros; simpl in |- *; astepl (Cos x). algebra. + simpl in |- *; algebra. + intros x H1 Hx Hx'. + apply eq_transitive_unfolded with (One[/] _[//]mult_resp_ap_zero _ _ _ (H0 x H1) (H0 x H1)). + simpl in |- *; apply div_wd. + algebra. + astepr (One[*]Cos x[*]Cos x); simpl in |- *; algebra. + astepl (Cos x[^]2[+]Sin x[^]2[/] _[//]mult_resp_ap_zero _ _ _ (H0 x H1) (H0 x H1)). + apply eq_transitive_unfolded with (One[+]One[*] (Sin x[/] _[//]H0 x H1) [*] (Sin x[/] _[//]H0 x H1)). + 2: simpl in |- *; apply bin_op_wd_unfolded. + 2: algebra. + 2: repeat simple apply mult_wd; try apply div_wd; algebra. + simpl in |- *. + rational. Qed. Lemma Tan_resp_less : forall x y, [--] (Pi [/]TwoNZ) [<] x -> y [<] Pi [/]TwoNZ -> forall Hx Hy, x [<] y -> Tan x Hx [<] Tan y Hy. -intros x y H H0 Hx Hy H1. -assert (H2 : [--] (Pi [/]TwoNZ) [<] Pi [/]TwoNZ). - apply less_transitive_unfolded with x; auto; - apply less_transitive_unfolded with y; auto. -unfold Tan in |- *. -apply - Derivative_imp_resp_less - with (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) H2 ( {1/} (Cosine{^}2)). -apply Derivative_Tan_1. -auto. -split; auto; apply less_transitive_unfolded with y; auto. -split; auto; apply less_transitive_unfolded with x; auto. -intros. -apply less_leEq_trans with OneR. -apply pos_one. -apply leEq_glb. -intros y0 H3 Hy0. -cut (Cos y0 [#] Zero). intro H4. -apply leEq_wdr with (One[/] _[//]mult_resp_ap_zero _ _ _ H4 H4). -2: simpl in |- *; rational. -apply shift_leEq_div. -astepr (Cos y0[^]2); apply pos_square; auto. -astepl (Cos y0[*]Cos y0). -apply leEq_wdl with (AbsIR (Cos y0) [^]2). -astepr (OneR[^]2). -apply nexp_resp_leEq. -apply AbsIR_nonneg. -apply AbsIR_Cos_leEq_One. -astepl (AbsIR (Cos y0) [*]AbsIR (Cos y0)). -eapply eq_transitive_unfolded. -apply eq_symmetric_unfolded; apply AbsIR_resp_mult. -apply AbsIR_eq_x. -astepr (Cos y0[^]2); apply sqr_nonneg. -inversion_clear Hy0. -apply cring_mult_ap_zero_op with OneR. -apply cring_mult_ap_zero with (Cos y0). -simpl in |- *; simpl in X0; auto. +Proof. + intros x y H H0 Hx Hy H1. + assert (H2 : [--] (Pi [/]TwoNZ) [<] Pi [/]TwoNZ). + apply less_transitive_unfolded with x; auto; apply less_transitive_unfolded with y; auto. + unfold Tan in |- *. + apply Derivative_imp_resp_less with (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) H2 ( {1/} (Cosine{^}2)). + apply Derivative_Tan_1. + auto. + split; auto; apply less_transitive_unfolded with y; auto. + split; auto; apply less_transitive_unfolded with x; auto. + intros. + apply less_leEq_trans with OneR. + apply pos_one. + apply leEq_glb. + intros y0 H3 Hy0. + cut (Cos y0 [#] Zero). intro H4. + apply leEq_wdr with (One[/] _[//]mult_resp_ap_zero _ _ _ H4 H4). + 2: simpl in |- *; rational. + apply shift_leEq_div. + astepr (Cos y0[^]2); apply pos_square; auto. + astepl (Cos y0[*]Cos y0). + apply leEq_wdl with (AbsIR (Cos y0) [^]2). + astepr (OneR[^]2). + apply nexp_resp_leEq. + apply AbsIR_nonneg. + apply AbsIR_Cos_leEq_One. + astepl (AbsIR (Cos y0) [*]AbsIR (Cos y0)). + eapply eq_transitive_unfolded. + apply eq_symmetric_unfolded; apply AbsIR_resp_mult. + apply AbsIR_eq_x. + astepr (Cos y0[^]2); apply sqr_nonneg. + inversion_clear Hy0. + apply cring_mult_ap_zero_op with OneR. + apply cring_mult_ap_zero with (Cos y0). + simpl in |- *; simpl in X0; auto. Qed. Lemma Tan_resp_leEq : forall x y, [--] (Pi [/]TwoNZ) [<] x -> y [<] Pi [/]TwoNZ -> forall Hx Hy, x [<=] y -> Tan x Hx [<=] Tan y Hy. -intros x y H H0 Hx Hy H1. -unfold Tan in |- *. -set (H2 := invHalfPi_less_HalfPi) in *. -apply - Derivative_imp_resp_leEq - with (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) H2 ( {1/} (Cosine{^}2)). -apply Derivative_Tan_1. -auto. -split; auto; apply leEq_less_trans with y; auto. -split; auto; apply less_leEq_trans with x; auto. -intros. -apply leEq_glb. -intros y0 H3 Hy0. -cut (Cos y0 [#] Zero). intro H4. -apply leEq_wdr with ((One[/] _[//]H4) [^]2). -apply sqr_nonneg. -simpl in |- *; rational. -inversion_clear Hy0. -apply cring_mult_ap_zero_op with OneR. -apply cring_mult_ap_zero with (Cos y0). -simpl in |- *; simpl in X0; auto. +Proof. + intros x y H H0 Hx Hy H1. + unfold Tan in |- *. + set (H2 := invHalfPi_less_HalfPi) in *. + apply Derivative_imp_resp_leEq with (olor [--] (Pi [/]TwoNZ) (Pi [/]TwoNZ)) H2 ( {1/} (Cosine{^}2)). + apply Derivative_Tan_1. + auto. + split; auto; apply leEq_less_trans with y; auto. + split; auto; apply less_leEq_trans with x; auto. + intros. + apply leEq_glb. + intros y0 H3 Hy0. + cut (Cos y0 [#] Zero). intro H4. + apply leEq_wdr with ((One[/] _[//]H4) [^]2). + apply sqr_nonneg. + simpl in |- *; rational. + inversion_clear Hy0. + apply cring_mult_ap_zero_op with OneR. + apply cring_mult_ap_zero with (Cos y0). + simpl in |- *; simpl in X0; auto. Qed. End Tangent. diff --git a/transc/Trigonometric.v b/transc/Trigonometric.v index ca2a8575c..1c193c9b3 100644 --- a/transc/Trigonometric.v +++ b/transc/Trigonometric.v @@ -18,21 +18,21 @@ * Dan Synek * Freek Wiedijk * Jan Zwanenburg - * + * * This work is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. - * + * * This work is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License along * with this work; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - *) + *) Require Export TaylorSeries. @@ -47,20 +47,21 @@ Section Lemmas. (** First, we need a lemma on mappings. *) Lemma maps_translation : forall y, maps_compacts_into realline realline (FId{+} [-C-]y). -intros y a b Hab H. -exists (a[+]y); exists (b[+]y[+]One). -cut (a[+]y [<] b[+]y[+]One). intro H0. -exists H0. -split. -split. -intros x Hx H1; simpl in |- *; inversion_clear H1; split. -apply plus_resp_leEq; auto. -apply less_leEq; apply leEq_less_trans with (b[+]y). -apply plus_resp_leEq; auto. -apply less_plusOne. -apply leEq_less_trans with (b[+]y). -apply plus_resp_leEq; auto. -apply less_plusOne. +Proof. + intros y a b Hab H. + exists (a[+]y); exists (b[+]y[+]One). + cut (a[+]y [<] b[+]y[+]One). intro H0. + exists H0. + split. + split. + intros x Hx H1; simpl in |- *; inversion_clear H1; split. + apply plus_resp_leEq; auto. + apply less_leEq; apply leEq_less_trans with (b[+]y). + apply plus_resp_leEq; auto. + apply less_plusOne. + apply leEq_less_trans with (b[+]y). + apply plus_resp_leEq; auto. + apply less_plusOne. Qed. End Lemmas. @@ -70,61 +71,59 @@ Section Sine_and_Cosine. (** Sine, cosine and tangent at [Zero]. *) Lemma Sin_zero : Sin Zero [=] Zero. -simpl in |- *. -eapply eq_transitive_unfolded. -2: apply (series_sum_zero conv_zero_series). -apply series_sum_wd; intros; simpl in |- *. -case n. -unfold sin_seq in |- *; simpl in |- *. -elim even_or_odd_plus; intros; simpl in |- *. -elim p; intros; simpl in |- *. -rational. -elimtype False; inversion b. -clear n; intro; simpl in |- *. -rational. +Proof. + simpl in |- *. + eapply eq_transitive_unfolded. + 2: apply (series_sum_zero conv_zero_series). + apply series_sum_wd; intros; simpl in |- *. + case n. + unfold sin_seq in |- *; simpl in |- *. + elim even_or_odd_plus; intros; simpl in |- *. + elim p; intros; simpl in |- *. + rational. + elimtype False; inversion b. + clear n; intro; simpl in |- *. + rational. Qed. Lemma Cos_zero : Cos Zero [=] One. -simpl in |- *. -unfold series_sum in |- *. -apply eq_symmetric_unfolded; apply Limits_unique. -intros eps H. -exists 1; intros. -apply AbsSmall_wdr_unfolded with ZeroR. -apply zero_AbsSmall; apply less_leEq; auto. -simpl in |- *. -unfold seq_part_sum in |- *. -induction m as [| m Hrecm]. -elimtype False; inversion H0. -clear Hrecm; induction m as [| m Hrecm]. -simpl in |- *. -unfold cos_seq in |- *. -elim even_or_odd_plus; intros; simpl in |- *. -elim p; intros; simpl in |- *. -cut (x = 0); [ intro | omega ]. -rewrite H1; simpl in |- *; rational. -elimtype False; inversion b. -set (n := S m) in *. -cut (1 <= n); [ intro | unfold n in |- *; auto with arith ]. -cut (n = S m); [ intro | auto ]. -clearbody n. -simpl in |- *. -set - (h := - fun i : nat => - (cos_seq i[/] _[//]nring_fac_ap_zero _ i) [*]nexp IR i (Zero[-]Zero)) - in *. -fold (h n) in |- *. -rstepr (h n[+] (Sum0 n h[-]One)). -astepl (ZeroR[+]Zero). -apply bin_op_wd_unfolded. -2: auto. -unfold h, cos_seq in |- *. -elim even_or_odd_plus; intros; simpl in |- *. -elim p; intros; simpl in |- *. -2: rational. -apply eq_symmetric_unfolded; apply x_mult_zero. -rewrite H2; simpl in |- *; rational. +Proof. + simpl in |- *. + unfold series_sum in |- *. + apply eq_symmetric_unfolded; apply Limits_unique. + intros eps H. + exists 1; intros. + apply AbsSmall_wdr_unfolded with ZeroR. + apply zero_AbsSmall; apply less_leEq; auto. + simpl in |- *. + unfold seq_part_sum in |- *. + induction m as [| m Hrecm]. + elimtype False; inversion H0. + clear Hrecm; induction m as [| m Hrecm]. + simpl in |- *. + unfold cos_seq in |- *. + elim even_or_odd_plus; intros; simpl in |- *. + elim p; intros; simpl in |- *. + cut (x = 0); [ intro | omega ]. + rewrite H1; simpl in |- *; rational. + elimtype False; inversion b. + set (n := S m) in *. + cut (1 <= n); [ intro | unfold n in |- *; auto with arith ]. + cut (n = S m); [ intro | auto ]. + clearbody n. + simpl in |- *. + set (h := fun i : nat => (cos_seq i[/] _[//]nring_fac_ap_zero _ i) [*]nexp IR i (Zero[-]Zero)) in *. + fold (h n) in |- *. + rstepr (h n[+] (Sum0 n h[-]One)). + astepl (ZeroR[+]Zero). + apply bin_op_wd_unfolded. + 2: auto. + unfold h, cos_seq in |- *. + elim even_or_odd_plus; intros; simpl in |- *. + elim p; intros; simpl in |- *. + 2: rational. + apply eq_symmetric_unfolded; apply x_mult_zero. + rewrite H2; simpl in |- *; rational. Qed. Hint Resolve Sin_zero Cos_zero: algebra. @@ -132,11 +131,12 @@ Hint Resolve Sin_zero Cos_zero: algebra. Opaque Sine Cosine. Lemma Tan_zero : forall H, Tan Zero H [=] Zero. -intros; unfold Tan, Tang in |- *. -simpl in |- *. -astepr (ZeroR [/]OneNZ); apply div_wd. -astepr (Sin Zero); simpl in |- *; algebra. -astepr (Cos Zero); simpl in |- *; algebra. +Proof. + intros; unfold Tan, Tang in |- *. + simpl in |- *. + astepr (ZeroR [/]OneNZ); apply div_wd. + astepr (Sin Zero); simpl in |- *; algebra. + astepr (Cos Zero); simpl in |- *; algebra. Qed. Transparent Sine Cosine. @@ -146,11 +146,13 @@ Continuity of sine and cosine are trivial. *) Lemma Continuous_Sin : Continuous realline Sine. -unfold Sine in |- *; Contin. +Proof. + unfold Sine in |- *; Contin. Qed. Lemma Continuous_Cos : Continuous realline Cosine. -unfold Cosine in |- *; Contin. +Proof. + unfold Cosine in |- *; Contin. Qed. (** @@ -158,117 +160,106 @@ The rules for the derivative of the sine and cosine function; we begin by provin *) Lemma cos_sin_seq : forall n : nat, cos_seq n [=] sin_seq (S n). -intro. -apply eq_symmetric_unfolded. -unfold sin_seq, cos_seq in |- *. -elim even_or_odd_plus; intros; simpl in |- *. -elim p; intros; simpl in |- *. -elim even_or_odd_plus; intros; simpl in |- *. -elim p0; intros; simpl in |- *. -elimtype False; omega. -algebra. -elim even_or_odd_plus; intros; simpl in |- *. -elim p0; intros; simpl in |- *. -cut (x0 = x); [ intro | omega ]. -rewrite H; algebra. -elimtype False; omega. +Proof. + intro. + apply eq_symmetric_unfolded. + unfold sin_seq, cos_seq in |- *. + elim even_or_odd_plus; intros; simpl in |- *. + elim p; intros; simpl in |- *. + elim even_or_odd_plus; intros; simpl in |- *. + elim p0; intros; simpl in |- *. + elimtype False; omega. + algebra. + elim even_or_odd_plus; intros; simpl in |- *. + elim p0; intros; simpl in |- *. + cut (x0 = x); [ intro | omega ]. + rewrite H; algebra. + elimtype False; omega. Qed. Lemma sin_cos_seq : forall n : nat, sin_seq n [=] [--] (cos_seq (S n)). -intros. -unfold sin_seq, cos_seq in |- *. -elim even_or_odd_plus; intros; simpl in |- *. -elim p; intros; simpl in |- *. -elim even_or_odd_plus; intros; simpl in |- *. -elim p0; intros; simpl in |- *. -elimtype False; omega. -algebra. -elim even_or_odd_plus; intros; simpl in |- *. -elim p0; intros; simpl in |- *. -cut (S x = x0); [ intro | omega ]. -rewrite <- H; simpl in |- *; rational. -elimtype False; omega. +Proof. + intros. + unfold sin_seq, cos_seq in |- *. + elim even_or_odd_plus; intros; simpl in |- *. + elim p; intros; simpl in |- *. + elim even_or_odd_plus; intros; simpl in |- *. + elim p0; intros; simpl in |- *. + elimtype False; omega. + algebra. + elim even_or_odd_plus; intros; simpl in |- *. + elim p0; intros; simpl in |- *. + cut (S x = x0); [ intro | omega ]. + rewrite <- H; simpl in |- *; rational. + elimtype False; omega. Qed. Lemma Derivative_Sin : forall H, Derivative realline H Sine Cosine. -intro. -unfold Sine, Cosine, sin_ps, cos_ps in |- *. -cut - (fun_series_convergent_IR realline - (FPowerSeries' Zero (fun n : nat => sin_seq (S n)))). intro H0. -eapply Derivative_wdr. -2: apply Derivative_FPowerSeries1' with (Hg := H0). -FEQ. -simpl in |- *. -apply series_sum_wd; intros. -apply mult_wdl. -apply div_wd. -apply eq_symmetric_unfolded; apply cos_sin_seq. -algebra. -apply fun_series_convergent_wd_IR with (FPowerSeries' Zero cos_seq). -intros; FEQ. -repeat split. -repeat split. -simpl in |- *. -apply mult_wdl. -apply div_wd. -apply cos_sin_seq. -algebra. -apply cos_conv. +Proof. + intro. + unfold Sine, Cosine, sin_ps, cos_ps in |- *. + cut (fun_series_convergent_IR realline + (FPowerSeries' Zero (fun n : nat => sin_seq (S n)))). intro H0. + eapply Derivative_wdr. + 2: apply Derivative_FPowerSeries1' with (Hg := H0). + FEQ. + simpl in |- *. + apply series_sum_wd; intros. + apply mult_wdl. + apply div_wd. + apply eq_symmetric_unfolded; apply cos_sin_seq. + algebra. + apply fun_series_convergent_wd_IR with (FPowerSeries' Zero cos_seq). + intros; FEQ. + repeat split. + repeat split. + simpl in |- *. + apply mult_wdl. + apply div_wd. + apply cos_sin_seq. + algebra. + apply cos_conv. Qed. Lemma Derivative_Cos : forall H, Derivative realline H Cosine {--}Sine. -intro. -unfold Sine, Cosine, sin_ps, cos_ps in |- *. -cut - (fun_series_convergent_IR realline - (FPowerSeries' Zero (fun n : nat => cos_seq (S n)))). intro H0. -eapply Derivative_wdr. -2: apply Derivative_FPowerSeries1' with (Hg := H0). -FEQ. -simpl in |- *. -apply - eq_transitive_unfolded - with - (series_sum _ - (conv_series_inv _ - (fun_series_conv_imp_conv _ _ (leEq_reflexive _ x) _ - (sin_conv _ _ (leEq_reflexive _ x) - (compact_single_iprop realline x Hx')) x - (compact_single_prop x) - (fun_series_inc_IR realline _ sin_conv x Hx')))). -apply series_sum_wd; intros. -simpl in |- *. -rstepr - (( [--] (sin_seq n) [/] _[//]nring_fac_ap_zero _ n) [*]nexp IR n (x[-]Zero)). -apply mult_wdl. -apply div_wd. -apply eq_symmetric_unfolded. -astepr ( [--][--] (cos_seq (S n))); apply un_op_wd_unfolded. -apply sin_cos_seq. -algebra. -simpl in |- *. -apply - series_sum_inv - with - (x := fun n : nat => - (sin_seq n[/] _[//]nring_fac_ap_zero IR n) [*]nexp IR n (x[-]Zero)). -apply - fun_series_convergent_wd_IR - with (fun n : nat => {--} (FPowerSeries' Zero sin_seq n)). -intros; FEQ. -repeat split. -repeat split. -simpl in |- *. -rstepl - (( [--] (sin_seq n) [/] _[//]nring_fac_ap_zero _ n) [*]nexp IR n (x[-]Zero)). -apply mult_wdl. -apply div_wd. -astepr ( [--][--] (cos_seq (S n))); apply un_op_wd_unfolded. -apply sin_cos_seq. -algebra. -apply FSeries_Sum_inv_conv. -apply sin_conv. +Proof. + intro. + unfold Sine, Cosine, sin_ps, cos_ps in |- *. + cut (fun_series_convergent_IR realline + (FPowerSeries' Zero (fun n : nat => cos_seq (S n)))). intro H0. + eapply Derivative_wdr. + 2: apply Derivative_FPowerSeries1' with (Hg := H0). + FEQ. + simpl in |- *. + apply eq_transitive_unfolded with (series_sum _ (conv_series_inv _ + (fun_series_conv_imp_conv _ _ (leEq_reflexive _ x) _ (sin_conv _ _ (leEq_reflexive _ x) + (compact_single_iprop realline x Hx')) x (compact_single_prop x) + (fun_series_inc_IR realline _ sin_conv x Hx')))). + apply series_sum_wd; intros. + simpl in |- *. + rstepr (( [--] (sin_seq n) [/] _[//]nring_fac_ap_zero _ n) [*]nexp IR n (x[-]Zero)). + apply mult_wdl. + apply div_wd. + apply eq_symmetric_unfolded. + astepr ( [--][--] (cos_seq (S n))); apply un_op_wd_unfolded. + apply sin_cos_seq. + algebra. + simpl in |- *. + apply series_sum_inv with (x := fun n : nat => + (sin_seq n[/] _[//]nring_fac_ap_zero IR n) [*]nexp IR n (x[-]Zero)). + apply fun_series_convergent_wd_IR with (fun n : nat => {--} (FPowerSeries' Zero sin_seq n)). + intros; FEQ. + repeat split. + repeat split. + simpl in |- *. + rstepl (( [--] (sin_seq n) [/] _[//]nring_fac_ap_zero _ n) [*]nexp IR n (x[-]Zero)). + apply mult_wdl. + apply div_wd. + astepr ( [--][--] (cos_seq (S n))); apply un_op_wd_unfolded. + apply sin_cos_seq. + algebra. + apply FSeries_Sum_inv_conv. + apply sin_conv. Qed. Hint Resolve Derivative_Sin Derivative_Cos: derivate. @@ -314,402 +305,326 @@ Let G' (y : IR) := Opaque Sine Cosine. Lemma Sin_plus_Taylor_bnd_lft : forall y : IR, Taylor_bnd (F' y). -clear F G G'; intros. -apply - bnd_imp_Taylor_bnd - with (FAbs (Sine[o]FId{+} [-C-]y) {+}FAbs (Cosine[o]FId{+} [-C-]y)). -intro; - apply - four_ind - with - (P := fun n : nat => - forall (x : IR) Hx Hx', - AbsIR (F' y n x Hx) [<=] - AbsIR - ((FAbs (Sine[o]FId{+} [-C-]y) {+}FAbs (Cosine[o]FId{+} [-C-]y)) x - Hx')). - -intros. -unfold F' in |- *. -Opaque FAbs. -simpl in |- *. -eapply leEq_transitive. -2: apply leEq_AbsIR. -astepl (AbsIR (Sine (x[+]y) (ProjT2 Hx)) [+]Zero). -apply plus_resp_leEq_both. -apply eq_imp_leEq; apply eq_symmetric_unfolded. -Transparent FAbs. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR1 Hx')))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; rational. -apply FAbs_nonneg. - -intros. -unfold F' in |- *. -Opaque FAbs. -simpl in |- *. -eapply leEq_transitive. -2: apply leEq_AbsIR. -astepl (Zero[+]AbsIR (Cosine (x[+]y) (ProjT2 Hx))). -apply plus_resp_leEq_both. -apply FAbs_nonneg. -apply eq_imp_leEq; apply eq_symmetric_unfolded. -Transparent FAbs. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR2 Hx')))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; rational. - -intros. -unfold F' in |- *. -Opaque FAbs. -simpl in |- *. -eapply leEq_transitive. -2: apply leEq_AbsIR. -astepl (AbsIR [--] (Sine (x[+]y) (ProjT2 Hx)) [+]Zero). -apply leEq_wdl with (AbsIR (Sine (x[+]y) (ProjT2 Hx)) [+]Zero). -apply plus_resp_leEq_both. -apply eq_imp_leEq; apply eq_symmetric_unfolded. -Transparent FAbs. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR1 Hx')))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; rational. -apply FAbs_nonneg. -apply bin_op_wd_unfolded. -apply AbsIR_inv. -algebra. - -intros. -unfold F' in |- *. -Opaque FAbs. -simpl in |- *. -eapply leEq_transitive. -2: apply leEq_AbsIR. -astepl (Zero[+]AbsIR [--] (Cosine (x[+]y) (ProjT2 Hx))). -apply leEq_wdl with (Zero[+]AbsIR (Cosine (x[+]y) (ProjT2 Hx))). -apply plus_resp_leEq_both. -apply FAbs_nonneg. -apply eq_imp_leEq; apply eq_symmetric_unfolded. -Transparent FAbs. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR2 Hx')))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; rational. -apply bin_op_wd_unfolded. -algebra. -apply AbsIR_inv. - -auto. - -cut (maps_compacts_into_weak realline realline (Fid IR{+} [-C-]y)); intros. -apply Continuous_plus; apply Continuous_abs; - apply Continuous_comp with realline; Contin. -intros a b Hab H. -exists (a[+]y); exists (b[+]y). -cut (a[+]y [<=] b[+]y). intro H0. -exists H0. -split. -Included. -intros x Hx H1; inversion_clear H1. -split. -simpl in |- *; apply plus_resp_leEq; auto. -simpl in |- *; apply plus_resp_leEq; auto. -apply plus_resp_leEq; auto. -apply - four_induction - with (P := fun n : nat => included (fun _ : IR => CTrue) (Dom (F' y n))); - auto; unfold F' in |- *; Included. +Proof. + clear F G G'; intros. + apply bnd_imp_Taylor_bnd with (FAbs (Sine[o]FId{+} [-C-]y) {+}FAbs (Cosine[o]FId{+} [-C-]y)). + intro; apply four_ind with (P := fun n : nat => forall (x : IR) Hx Hx', AbsIR (F' y n x Hx) [<=] + AbsIR ((FAbs (Sine[o]FId{+} [-C-]y) {+}FAbs (Cosine[o]FId{+} [-C-]y)) x Hx')). + intros. + unfold F' in |- *. + Opaque FAbs. + simpl in |- *. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + astepl (AbsIR (Sine (x[+]y) (ProjT2 Hx)) [+]Zero). + apply plus_resp_leEq_both. + apply eq_imp_leEq; apply eq_symmetric_unfolded. + Transparent FAbs. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR1 Hx')))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; rational. + apply FAbs_nonneg. + intros. + unfold F' in |- *. + Opaque FAbs. + simpl in |- *. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + astepl (Zero[+]AbsIR (Cosine (x[+]y) (ProjT2 Hx))). + apply plus_resp_leEq_both. + apply FAbs_nonneg. + apply eq_imp_leEq; apply eq_symmetric_unfolded. + Transparent FAbs. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR2 Hx')))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; rational. + intros. + unfold F' in |- *. + Opaque FAbs. + simpl in |- *. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + astepl (AbsIR [--] (Sine (x[+]y) (ProjT2 Hx)) [+]Zero). + apply leEq_wdl with (AbsIR (Sine (x[+]y) (ProjT2 Hx)) [+]Zero). + apply plus_resp_leEq_both. + apply eq_imp_leEq; apply eq_symmetric_unfolded. + Transparent FAbs. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR1 Hx')))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; rational. + apply FAbs_nonneg. + apply bin_op_wd_unfolded. + apply AbsIR_inv. + algebra. + intros. + unfold F' in |- *. + Opaque FAbs. + simpl in |- *. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + astepl (Zero[+]AbsIR [--] (Cosine (x[+]y) (ProjT2 Hx))). + apply leEq_wdl with (Zero[+]AbsIR (Cosine (x[+]y) (ProjT2 Hx))). + apply plus_resp_leEq_both. + apply FAbs_nonneg. + apply eq_imp_leEq; apply eq_symmetric_unfolded. + Transparent FAbs. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR2 Hx')))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; rational. + apply bin_op_wd_unfolded. + algebra. + apply AbsIR_inv. + auto. + cut (maps_compacts_into_weak realline realline (Fid IR{+} [-C-]y)); intros. + apply Continuous_plus; apply Continuous_abs; apply Continuous_comp with realline; Contin. + intros a b Hab H. + exists (a[+]y); exists (b[+]y). + cut (a[+]y [<=] b[+]y). intro H0. + exists H0. + split. + Included. + intros x Hx H1; inversion_clear H1. + split. + simpl in |- *; apply plus_resp_leEq; auto. + simpl in |- *; apply plus_resp_leEq; auto. + apply plus_resp_leEq; auto. + apply four_induction with (P := fun n : nat => included (fun _ : IR => CTrue) (Dom (F' y n))); + auto; unfold F' in |- *; Included. Qed. Lemma Sin_plus_Taylor_bnd_rht : forall y : IR, Taylor_bnd (G' y). -clear F G F'; intros. -apply - bnd_imp_Taylor_bnd - with - (FAbs (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y)) {+} - FAbs (Cosine{*} [-C-] (Cos y) {-}Sine{*} [-C-] (Sin y))). -intro; - apply - four_ind - with - (P := fun n : nat => - forall (x : IR) Hx Hx', - AbsIR (G' y n x Hx) [<=] - AbsIR - ((FAbs (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y)) {+} - FAbs (Cosine{*} [-C-] (Cos y) {-}Sine{*} [-C-] (Sin y))) x Hx')). - -intros. -unfold G' in |- *. -Opaque FAbs. -simpl in |- *. -eapply leEq_transitive. -2: apply leEq_AbsIR. -astepl - (AbsIR - (Sine x (ProjIR1 (ProjIR1 Hx)) [*]Cos y[+] - Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Sin y) [+]Zero). -apply plus_resp_leEq_both. -apply eq_imp_leEq; apply eq_symmetric_unfolded. -Transparent FAbs. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR1 Hx')))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; rational. -apply FAbs_nonneg. - -intros. -unfold G' in |- *. -Opaque FAbs. -simpl in |- *. -eapply leEq_transitive. -2: apply leEq_AbsIR. -astepl - (Zero[+] - AbsIR - (Cosine x (ProjIR1 (ProjIR1 Hx)) [*]Cos y[-] - Sine x (ProjIR1 (ProjIR2 Hx)) [*]Sin y)). -apply plus_resp_leEq_both. -apply FAbs_nonneg. -apply eq_imp_leEq; apply eq_symmetric_unfolded. -Transparent FAbs. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR2 Hx')))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; rational. - -intros. -unfold G' in |- *. -Opaque FAbs. -simpl in |- *. -eapply leEq_transitive. -2: apply leEq_AbsIR. -astepl - (AbsIR - [--] - (Sine x (ProjIR1 (ProjIR1 Hx)) [*]Cos y[+] - Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Sin y) [+]Zero). -apply - leEq_wdl - with - (AbsIR - (Sine x (ProjIR1 (ProjIR1 Hx)) [*]Cos y[+] - Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Sin y) [+]Zero). -apply plus_resp_leEq_both. -apply eq_imp_leEq; apply eq_symmetric_unfolded. -Transparent FAbs. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR1 Hx')))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; rational. -apply FAbs_nonneg. -apply bin_op_wd_unfolded. -apply AbsIR_inv. -algebra. - -intros. -unfold G' in |- *. -Opaque FAbs. -simpl in |- *. -eapply leEq_transitive. -2: apply leEq_AbsIR. -astepl - (Zero[+] - AbsIR - (Sine x (ProjIR1 (ProjIR1 Hx)) [*]Sin y[-] - Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Cos y)). -apply - leEq_wdl - with - (Zero[+] - AbsIR - (Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Cos y[-] - Sine x (ProjIR1 (ProjIR1 Hx)) [*]Sin y)). -apply plus_resp_leEq_both. -apply FAbs_nonneg. -apply eq_imp_leEq; apply eq_symmetric_unfolded. -Transparent FAbs. -apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR2 Hx')))). -apply FAbs_char. -apply AbsIR_wd; simpl in |- *; rational. -apply bin_op_wd_unfolded. -algebra. -apply AbsIR_minus. - -auto. -Contin. -apply - four_induction - with (P := fun n : nat => included (fun _ : IR => CTrue) (Dom (G' y n))); - auto; unfold G' in |- *. -apply included_FPlus; Included. -apply included_FMinus; Included. -apply included_FInv; apply included_FPlus; Included. -apply included_FMinus; Included. +Proof. + clear F G F'; intros. + apply bnd_imp_Taylor_bnd with (FAbs (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y)) {+} + FAbs (Cosine{*} [-C-] (Cos y) {-}Sine{*} [-C-] (Sin y))). + intro; apply four_ind with (P := fun n : nat => forall (x : IR) Hx Hx', AbsIR (G' y n x Hx) [<=] + AbsIR ((FAbs (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y)) {+} + FAbs (Cosine{*} [-C-] (Cos y) {-}Sine{*} [-C-] (Sin y))) x Hx')). + intros. + unfold G' in |- *. + Opaque FAbs. + simpl in |- *. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + astepl (AbsIR (Sine x (ProjIR1 (ProjIR1 Hx)) [*]Cos y[+] + Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Sin y) [+]Zero). + apply plus_resp_leEq_both. + apply eq_imp_leEq; apply eq_symmetric_unfolded. + Transparent FAbs. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR1 Hx')))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; rational. + apply FAbs_nonneg. + intros. + unfold G' in |- *. + Opaque FAbs. + simpl in |- *. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + astepl (Zero[+] AbsIR (Cosine x (ProjIR1 (ProjIR1 Hx)) [*]Cos y[-] + Sine x (ProjIR1 (ProjIR2 Hx)) [*]Sin y)). + apply plus_resp_leEq_both. + apply FAbs_nonneg. + apply eq_imp_leEq; apply eq_symmetric_unfolded. + Transparent FAbs. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR2 Hx')))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; rational. + intros. + unfold G' in |- *. + Opaque FAbs. + simpl in |- *. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + astepl (AbsIR [--] (Sine x (ProjIR1 (ProjIR1 Hx)) [*]Cos y[+] + Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Sin y) [+]Zero). + apply leEq_wdl with (AbsIR (Sine x (ProjIR1 (ProjIR1 Hx)) [*]Cos y[+] + Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Sin y) [+]Zero). + apply plus_resp_leEq_both. + apply eq_imp_leEq; apply eq_symmetric_unfolded. + Transparent FAbs. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR1 Hx')))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; rational. + apply FAbs_nonneg. + apply bin_op_wd_unfolded. + apply AbsIR_inv. + algebra. + intros. + unfold G' in |- *. + Opaque FAbs. + simpl in |- *. + eapply leEq_transitive. + 2: apply leEq_AbsIR. + astepl (Zero[+] AbsIR (Sine x (ProjIR1 (ProjIR1 Hx)) [*]Sin y[-] + Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Cos y)). + apply leEq_wdl with (Zero[+] AbsIR (Cosine x (ProjIR1 (ProjIR2 Hx)) [*]Cos y[-] + Sine x (ProjIR1 (ProjIR1 Hx)) [*]Sin y)). + apply plus_resp_leEq_both. + apply FAbs_nonneg. + apply eq_imp_leEq; apply eq_symmetric_unfolded. + Transparent FAbs. + apply eq_transitive_unfolded with (AbsIR (Part _ _ (ProjIR1 (ProjIR2 Hx')))). + apply FAbs_char. + apply AbsIR_wd; simpl in |- *; rational. + apply bin_op_wd_unfolded. + algebra. + apply AbsIR_minus. + auto. + Contin. + apply four_induction with (P := fun n : nat => included (fun _ : IR => CTrue) (Dom (G' y n))); + auto; unfold G' in |- *. + apply included_FPlus; Included. + apply included_FMinus; Included. + apply included_FInv; apply included_FPlus; Included. + apply included_FMinus; Included. Qed. Lemma Sin_plus_eq : forall y n HaF HaG, F' y n Zero HaF [=] G' y n Zero HaG. -do 2 intro; - apply - four_ind - with - (P := fun n : nat => forall HaF HaG, F' y n Zero HaF [=] G' y n Zero HaG). -intros; simpl in |- *. -apply eq_transitive_unfolded with (Sin y). -simpl in |- *; rational. -apply eq_transitive_unfolded with (Sin Zero[*]Cos y[+]Cos Zero[*]Sin y). -2: simpl in |- *; algebra. -rstepl (Zero[*]Cos y[+]One[*]Sin y). -algebra. - -intros; simpl in |- *. -apply eq_transitive_unfolded with (Cos y). -simpl in |- *; rational. -apply eq_transitive_unfolded with (Cos Zero[*]Cos y[-]Sin Zero[*]Sin y). -2: simpl in |- *; algebra. -rstepl (One[*]Cos y[-]Zero[*]Sin y). -algebra. - -intros; simpl in |- *. -apply un_op_wd_unfolded. -apply eq_transitive_unfolded with (Sin y). -simpl in |- *; rational. -apply eq_transitive_unfolded with (Sin Zero[*]Cos y[+]Cos Zero[*]Sin y). -2: simpl in |- *; algebra. -rstepl (Zero[*]Cos y[+]One[*]Sin y). -algebra. - -intros; simpl in |- *. -apply eq_transitive_unfolded with ( [--] (Cos y)). -simpl in |- *; rational. -apply eq_transitive_unfolded with (Sin Zero[*]Sin y[-]Cos Zero[*]Cos y). -2: simpl in |- *; algebra. -rstepl (Zero[*]Sin y[-]One[*]Cos y). -algebra. - -intros. -simpl in |- *; auto. +Proof. + do 2 intro; apply four_ind with + (P := fun n : nat => forall HaF HaG, F' y n Zero HaF [=] G' y n Zero HaG). + intros; simpl in |- *. + apply eq_transitive_unfolded with (Sin y). + simpl in |- *; rational. + apply eq_transitive_unfolded with (Sin Zero[*]Cos y[+]Cos Zero[*]Sin y). + 2: simpl in |- *; algebra. + rstepl (Zero[*]Cos y[+]One[*]Sin y). + algebra. + intros; simpl in |- *. + apply eq_transitive_unfolded with (Cos y). + simpl in |- *; rational. + apply eq_transitive_unfolded with (Cos Zero[*]Cos y[-]Sin Zero[*]Sin y). + 2: simpl in |- *; algebra. + rstepl (One[*]Cos y[-]Zero[*]Sin y). + algebra. + intros; simpl in |- *. + apply un_op_wd_unfolded. + apply eq_transitive_unfolded with (Sin y). + simpl in |- *; rational. + apply eq_transitive_unfolded with (Sin Zero[*]Cos y[+]Cos Zero[*]Sin y). + 2: simpl in |- *; algebra. + rstepl (Zero[*]Cos y[+]One[*]Sin y). + algebra. + intros; simpl in |- *. + apply eq_transitive_unfolded with ( [--] (Cos y)). + simpl in |- *; rational. + apply eq_transitive_unfolded with (Sin Zero[*]Sin y[-]Cos Zero[*]Cos y). + 2: simpl in |- *; algebra. + rstepl (Zero[*]Sin y[-]One[*]Cos y). + algebra. + intros. + simpl in |- *; auto. Qed. Lemma Sin_plus_der_lft : forall y n, Derivative_n n realline CI (F y) (F' y n). -intro; apply Derivative_n_chain. -simpl in |- *; unfold F in |- *. -apply Feq_reflexive. -apply included_FComp; Included. -intro. - -cut (maps_compacts_into realline realline (FId{+} [-C-]y)); - [ intro | apply maps_translation ]. - -cut (Derivative realline CI (FId{+} [-C-]y) [-C-]One); intros. -2: apply Derivative_wdr with ( [-C-]One{+} [-C-]Zero:PartIR). -2: FEQ. -2: Deriv. - -apply - four_induction - with (P := fun n : nat => Derivative realline CI (F' y n) (F' y (S n))). -simpl in |- *. -apply Derivative_wdr with ((Cosine[o]FId{+} [-C-]y) {*} [-C-]One). -FEQ. -apply Derivative_comp with realline CI; auto. -Deriv. - -simpl in |- *. -apply Derivative_wdr with (( {--}Sine[o]FId{+} [-C-]y) {*} [-C-]One). -FEQ. -apply Derivative_comp with realline CI; auto. -Deriv. - -simpl in |- *. -apply Derivative_inv. -apply Derivative_wdr with ((Cosine[o]FId{+} [-C-]y) {*} [-C-]One). -FEQ. -apply Derivative_comp with realline CI; auto. -Deriv. - -simpl in |- *. -apply Derivative_wdr with ( {--} (( {--}Sine[o]FId{+} [-C-]y) {*} [-C-]One)). -FEQ. -apply Derivative_inv. -apply Derivative_comp with realline CI; auto. -Deriv. - -intros. -auto. +Proof. + intro; apply Derivative_n_chain. + simpl in |- *; unfold F in |- *. + apply Feq_reflexive. + apply included_FComp; Included. + intro. + cut (maps_compacts_into realline realline (FId{+} [-C-]y)); [ intro | apply maps_translation ]. + cut (Derivative realline CI (FId{+} [-C-]y) [-C-]One); intros. + 2: apply Derivative_wdr with ( [-C-]One{+} [-C-]Zero:PartIR). + 2: FEQ. + 2: Deriv. + apply four_induction with (P := fun n : nat => Derivative realline CI (F' y n) (F' y (S n))). + simpl in |- *. + apply Derivative_wdr with ((Cosine[o]FId{+} [-C-]y) {*} [-C-]One). + FEQ. + apply Derivative_comp with realline CI; auto. + Deriv. + simpl in |- *. + apply Derivative_wdr with (( {--}Sine[o]FId{+} [-C-]y) {*} [-C-]One). + FEQ. + apply Derivative_comp with realline CI; auto. + Deriv. + simpl in |- *. + apply Derivative_inv. + apply Derivative_wdr with ((Cosine[o]FId{+} [-C-]y) {*} [-C-]One). + FEQ. + apply Derivative_comp with realline CI; auto. + Deriv. + simpl in |- *. + apply Derivative_wdr with ( {--} (( {--}Sine[o]FId{+} [-C-]y) {*} [-C-]One)). + FEQ. + apply Derivative_inv. + apply Derivative_comp with realline CI; auto. + Deriv. + intros. + auto. Qed. Lemma Sin_plus_der_rht : forall y n, Derivative_n n realline CI (G y) (G' y n). -intro; apply Derivative_n_chain. -simpl in |- *; unfold G in |- *. -apply Feq_reflexive. -apply included_FPlus; Included. -intro. -cut (Derivative realline CI Sine Cosine); [ intro | Deriv ]. -cut (Derivative realline CI Cosine {--}Sine); [ intro | Deriv ]. - -apply - four_induction - with (P := fun n : nat => Derivative realline CI (G' y n) (G' y (S n))). -simpl in |- *. -let r := PartIR_to_symbPF (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y)) in -apply Derivative_wdr with (symbPF_deriv r). -simpl in |- *. -apply eq_imp_Feq. -repeat split. -repeat split. -intros; simpl in |- *; rational. -simpl in |- *; Deriv. - -simpl in |- *. -let r := PartIR_to_symbPF (Cosine{*} [-C-] (Cos y) {-}Sine{*} [-C-] (Sin y)) in -apply Derivative_wdr with (symbPF_deriv r). -simpl in |- *. -apply eq_imp_Feq. -repeat split. -repeat split. -intros; simpl in |- *; rational. -simpl in |- *; Deriv. - -simpl in |- *. -let r := - PartIR_to_symbPF ( {--} (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y))) in -apply Derivative_wdr with (symbPF_deriv r). -simpl in |- *. -apply eq_imp_Feq. -repeat split. -repeat split. -intros; simpl in |- *; rational. -simpl in |- *; Deriv. - -simpl in |- *. -let r := PartIR_to_symbPF (Sine{*} [-C-] (Sin y) {-}Cosine{*} [-C-] (Cos y)) in -apply Derivative_wdr with (symbPF_deriv r). -simpl in |- *. -apply eq_imp_Feq. -repeat split. -repeat split. -intros; simpl in |- *; rational. -simpl in |- *; Deriv. - -auto. +Proof. + intro; apply Derivative_n_chain. + simpl in |- *; unfold G in |- *. + apply Feq_reflexive. + apply included_FPlus; Included. + intro. + cut (Derivative realline CI Sine Cosine); [ intro | Deriv ]. + cut (Derivative realline CI Cosine {--}Sine); [ intro | Deriv ]. + apply four_induction with (P := fun n : nat => Derivative realline CI (G' y n) (G' y (S n))). + simpl in |- *. + let r := PartIR_to_symbPF (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y)) in + apply Derivative_wdr with (symbPF_deriv r). + simpl in |- *. + apply eq_imp_Feq. + repeat split. + repeat split. + intros; simpl in |- *; rational. + simpl in |- *; Deriv. + simpl in |- *. + let r := PartIR_to_symbPF (Cosine{*} [-C-] (Cos y) {-}Sine{*} [-C-] (Sin y)) in + apply Derivative_wdr with (symbPF_deriv r). + simpl in |- *. + apply eq_imp_Feq. + repeat split. + repeat split. + intros; simpl in |- *; rational. + simpl in |- *; Deriv. + simpl in |- *. + let r := PartIR_to_symbPF ( {--} (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y))) in + apply Derivative_wdr with (symbPF_deriv r). + simpl in |- *. + apply eq_imp_Feq. + repeat split. + repeat split. + intros; simpl in |- *; rational. + simpl in |- *; Deriv. + simpl in |- *. + let r := PartIR_to_symbPF (Sine{*} [-C-] (Sin y) {-}Cosine{*} [-C-] (Cos y)) in + apply Derivative_wdr with (symbPF_deriv r). + simpl in |- *. + apply eq_imp_Feq. + repeat split. + repeat split. + intros; simpl in |- *; rational. + simpl in |- *; Deriv. + auto. Qed. Lemma Sin_plus_fun : forall y : IR, Feq realline (F y) (G y). -intro. -cut (Taylor_bnd (F' y)). intro H. -cut (Taylor_bnd (G' y)). intro H0. -cut (forall n : nat, Continuous realline (G' y n)). -intro H1; - apply Taylor_unique_crit with ZeroR (F' y) (G' y) (Sin_plus_der_lft y) H. -exact (Sin_plus_der_rht y). -auto. -apply Sin_plus_eq. -apply Taylor_Series_conv_to_fun. -auto. -apply four_induction with (P := fun n : nat => Continuous realline (G' y n)). -simpl in |- *; Contin. -simpl in |- *; Contin. -simpl in |- *; Contin. -simpl in |- *; Contin. -auto. -apply Sin_plus_Taylor_bnd_rht. -apply Sin_plus_Taylor_bnd_lft. +Proof. + intro. + cut (Taylor_bnd (F' y)). intro H. + cut (Taylor_bnd (G' y)). intro H0. + cut (forall n : nat, Continuous realline (G' y n)). + intro H1; apply Taylor_unique_crit with ZeroR (F' y) (G' y) (Sin_plus_der_lft y) H. + exact (Sin_plus_der_rht y). + auto. + apply Sin_plus_eq. + apply Taylor_Series_conv_to_fun. + auto. + apply four_induction with (P := fun n : nat => Continuous realline (G' y n)). + simpl in |- *; Contin. + simpl in |- *; Contin. + simpl in |- *; Contin. + simpl in |- *; Contin. + auto. + apply Sin_plus_Taylor_bnd_rht. + apply Sin_plus_Taylor_bnd_lft. Qed. End Sine_of_Sum. @@ -717,29 +632,30 @@ End Sine_of_Sum. Opaque Sine Cosine. Lemma Cos_plus_fun : forall y, Feq realline (Cosine[o]FId{+} [-C-]y) (Cosine{*} [-C-] (Cos y) {-}Sine{*} [-C-] (Sin y)). -intro. -assert (H : Derivative realline CI Sine Cosine). Deriv. -assert (H0 : Derivative realline CI Cosine {--}Sine). Deriv. -apply Derivative_unique with CI (Sine[o]FId{+} [-C-]y). -Derivative_Help. -FEQ. -apply Derivative_comp with realline CI. -apply maps_translation. -Deriv. -Deriv. -apply Derivative_wdl with (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y)). -apply Feq_symmetric; apply Sin_plus_fun. -apply Derivative_wdl with (Cos y{**}Sine{+}Sin y{**}Cosine). -apply eq_imp_Feq. -apply included_FPlus; Included. -apply included_FPlus; Included. -intros; simpl in |- *; rational. -apply Derivative_wdr with (Cos y{**}Cosine{+}Sin y{**}{--}Sine). -apply eq_imp_Feq. -apply included_FPlus; Included. -apply included_FMinus; Included. -intros; simpl in |- *; rational. -Deriv. +Proof. + intro. + assert (H : Derivative realline CI Sine Cosine). Deriv. + assert (H0 : Derivative realline CI Cosine {--}Sine). Deriv. + apply Derivative_unique with CI (Sine[o]FId{+} [-C-]y). + Derivative_Help. + FEQ. + apply Derivative_comp with realline CI. + apply maps_translation. + Deriv. + Deriv. + apply Derivative_wdl with (Sine{*} [-C-] (Cos y) {+}Cosine{*} [-C-] (Sin y)). + apply Feq_symmetric; apply Sin_plus_fun. + apply Derivative_wdl with (Cos y{**}Sine{+}Sin y{**}Cosine). + apply eq_imp_Feq. + apply included_FPlus; Included. + apply included_FPlus; Included. + intros; simpl in |- *; rational. + apply Derivative_wdr with (Cos y{**}Cosine{+}Sin y{**}{--}Sine). + apply eq_imp_Feq. + apply included_FPlus; Included. + apply included_FMinus; Included. + intros; simpl in |- *; rational. + Deriv. Qed. End Sine_and_Cosine.